-- vim: set tabstop=2 softtabstop=0 expandtab shiftwidth=2:
module Exercise02 where

import Data.Function
import Data.List
import Data.Ord
import Control.Monad

{-H2.1a)-}
twoThirdsAverageWinners :: [(String, Int)] -> [String]
twoThirdsAverageWinners gs =
  map fst $ filter ((==min_off) . calc_offset) gs
  where
    avg = realToFrac (sum (map snd gs)) / genericLength gs
    avg_23 = floor (2 * avg / 3)
    calc_offset = abs . subtract avg_23 . snd
    min_off = minimum $ map calc_offset gs

--test_1 = twoThirdsAverageWinners [("Alice",1),("Bob",3),("Claus",8),("Dodo",4)]
--test_1 = twoThirdsAverageWinners [("Madison",30),
--  ("Jack",26),("Carter",1),
--  ("Eleanor",28),("Julian",9),
--  ("Ella",24),("Mason",11),
--  ("Hazel",0),("Avery",21),
--  ("Lily",5),("Jackson",23),
--  ("Wyatt",22)]

{-H2.1b)-}
--lowestUniqueBidder :: [(String, Int)] -> String
lowestUniqueBidder bs =
  if null f then "Nobody" else fst $ head $ head f
  where
    f = filter ((== 1) . length)
      $ groupBy (\x y -> snd x == snd y)
      $ sortBy (compare `on` snd) bs

--test_2 = lowestUniqueBidder [("Alice",1),("Bob",5),("Claus",1),("Dodo",5)]
--test_2 = lowestUniqueBidder [("Alice",1),("Bob",2),("Claus",1),("Dodo",5)]
--test_2 = lowestUniqueBidder [("Alice",1),("Bob",1),("Claus",1),("Dodo",5)]

{-H2-}

-- returns the shortest list in a list of lists
shortest :: [[Int]] -> [Int]
shortest = minimumBy (comparing length)

-- returns the set of all players in a tournament
players :: [[Int]] -> [Int]
players tournament = [1..length tournament]

-- returns the dominion of player i
dominion :: [[Int]] -> Int -> [Int]
dominion tournament i = tournament !! (i - 1)


{-H2.2a)-}
dominators :: [[Int]] -> Int -> [Int]
dominators tournament i =
  concat [[j | i `elem` dominion tournament j] | j <- players tournament]

{-H2.2b)-}
covers :: [[Int]] -> Int -> Int -> Bool
covers tournament i j =
  null $ dominion tournament j \\ dominion tournament i

{-2.2c)-}
dominant :: [[Int]] -> [Int] -> Bool
dominant tournament xs = not (null xs) &&
  and [covers tournament i j | i <- xs, j <- players tournament \\ xs]

{-WETT-}

{-H2.2d)-}
copeland :: [[Int]] -> [Int]
copeland tournament =
  map succ $ elemIndices (maximum ps) ps
  where ps = map length tournament

{-H2.2e)-}
uncoveredSet :: [[Int]] -> [Int]
uncoveredSet tournament =
  players tournament \\
    [x | x <- players tournament, y <- players tournament, covers tournament y x, x /= y]

{-H2.2f)-}

converge :: Eq a => (a -> a) -> a -> a
converge = until =<< ((==) =<<)
    
topCycle :: [[Int]] -> [Int]
topCycle tournament = converge gen $ uncoveredSet tournament
    -- Apply gen 16 times. This should be stable for any reasonable input length.
    -- It would be better to converge the result like commented below, but this would cost more tokens.
    --   converge :: Eq a => (a -> a) -> a -> a
    --   converge = until =<< ((==) =<<)
    --
    --   converge gen $ uncoveredSet tournament
  where gen x = players tournament \\ (foldl1 intersect $ dominion tournament <$> x)

{-TTEW-}