module Exercise02 where

import Control.Arrow
import Data.Bifunctor
import Data.List
import Data.Ord
import Data.Function ((&))
import Control.Applicative (liftA2)

{-H2.1a)-}
twoThirdsAverageWinners :: [(String, Int)] -> [String]
twoThirdsAverageWinners gs = map fst (takeWhile (\(_, y) -> y == snd (head a)) a)
  where
    a = sortOn snd $ Data.Bifunctor.second (abs . (twoThirdsAvg -)) <$> gs
    twoThirdsAvg = (2 * sum [snd x | x <- gs]) `div` (length gs * 3)

{-H2.1b)-}
lowestUniqueBidder :: [(String, Int)] -> String
lowestUniqueBidder bs = fst $ head $ head $ filter (\x -> length x == 1) (groupBy (\a b -> snd a == snd b) $ sortOn snd bs) ++ [[("Nobody", -1)]]

{-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 = players tournament \\ (i : dominion tournament i)

{-H2.2b)-}
covers :: [[Int]] -> Int -> Int -> Bool
covers tournament i j = null [x | x <- dominion tournament j, x `notElem` dominion tournament i]

{-2.2c)-}
dominant :: [[Int]] -> [Int] -> Bool
dominant tournament xs = (not . null) xs && foldl intersect (players tournament \\ xs) (map ((\\ xs) . dominion tournament) xs) == (players tournament \\ xs)

{-WETT-}

{-H2.2d)-}
copeland :: [[Int]] -> [Int]
copeland = map succ <<< flip elemIndices <*> maximum <<< map length

{-H2.2e)-}
uncoveredSet :: [[Int]] -> [Int]
uncoveredSet = liftA2 filter notCoveredByAnyOthers players

-- Normally this would be a local function but it saves a token to do it like this
notCoveredByAnyOthers :: [[Int]] -> Int -> Bool
notCoveredByAnyOthers t x = not $ covers t `flip` x & any $ delete x . players $ t



{-H2.2f)-}
topCycle :: [[Int]] -> [Int]
topCycle = concat <<< flip take . liftA2 iterate (fmap fmap fmap nub concatMap <<< dominators) copeland <*> length

{-MCCOMMENT
Is there really no default operator for fmap fmap fmap on functions (Function composition of a 1 parameter and 2 parameter function)?
  Alternative solution, that uses one more token than the solution above
  
topCycle tournament = concat $ length tournament & take $ (nub . concatMap (dominators tournament)) `iterate` copeland tournament
  -}
{-TTEW-}