module Exercise02 where

import Data.List
import Data.Ord
import Data.Function
--import Data.Array
import qualified Data.Map as Map
--import qualified Data.Set as Set
--import System.Random


{-H2.1a)-}
twoThirdsAverageWinners :: [(String, Int)] -> [String]
twoThirdsAverageWinners gs = [s | (s, diff) <- distances, diff == minDiff]
    where   twoThirdAvg =  (2 * sum (map snd gs)) `div` (genericLength gs * 3)
            distances = [(s, abs $ x - twoThirdAvg) | (s, x) <- gs]
            minDiff = minimum [diff | (_, diff) <- distances]

{-H2.1b)-}
lowestUniqueBidder :: [(String, Int)] -> String
lowestUniqueBidder bs = if null minUniqueBidder then "Nobody" else head minUniqueBidder
    where   bids = [bid | (_, bid) <- bs]
            countElem x xs = length [e | e <- xs, e == x]
            uniqueBids = [bid | bid <- bids, countElem bid bids == 1]
            minUniqueBidder = if null uniqueBids then [] else [person | (person, bid) <- bs, bid == minimum uniqueBids]


{-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 = [j | j <- players tournament, i `elem` dominion tournament j]

{-H2.2b)-}
covers :: [[Int]] -> Int -> Int-> Bool
covers tournament i j = i == j || isSubsequenceOf (dominion tournament j) (dominion tournament i)

{-2.2c)-}
dominant :: [[Int]] -> [Int] -> Bool
dominant tournament xs = not (null xs) && all (isSubsequenceOf others . dominion tournament) xs
    where others = players tournament \\ xs

{-WETT-}

{-H2.2d)-}
copeland :: [[Int]] -> [Int]
copeland tournament = ((== maximum (map length tournament)) . length . dominion tournament) `filter` players tournament

{-H2.2e)-}
uncoveredSet :: [[Int]] -> [Int]
uncoveredSet tournament =
    (\player -> not $ any (flip (covers tournament) player) $ players tournament \\ pure player) `filter` players tournament

{-H2.2f)-} 
-- Proof that copeland `subset` topCycle. Proof by contratiction:
-- Let L = copeland tournament, C = topCycle tournament, p `elem` L, and let k be defined as the number of losses from p
-- Suppose not p `elem` C. Further let n := |C|.
-- Since p is not in C but C is dominant, p must have lost against all elemnts of C, hence n <= k
-- Now let q `elem` L be arbitrary. Let m be the number of losses from q. By definition m >= k and q won against p
-- Since every player whom q lost against must also be in C, we know |C| >= m + 1
-- Hence |C| >= m + 1 >= k + 1 >= n + 1 = |C| + 1   A contradiction.
-- Hence p must be in C

-- We now look at the graph of Players which has a directed edge g -> f iff g lost against f
-- That a BFS starting from a arbitrary Element g of L yields C is a corollary of the fact, that every from g reachable node f
-- with a distance of >= 2 has the same "directed Zusammenhangskomponente" than g, since f must have lost against g in this case.
topCycle :: [[Int]] -> [Int]
topCycle tournament = addToDZHK tournament mempty [head $ copeland tournament]

addToDZHK :: [[Int]] -> [Int] -> [Int] -> [Int]
addToDZHK tournament oldDZHK currDZHK  =
    if oldDZHK == currDZHK then oldDZHK
    else addToDZHK tournament currDZHK $ nub $ currDZHK ++ concatMap (dominators tournament) currDZHK

{-TTEW-}

-- BFS Algorithm
addToDZHKList::[[Int]] -> [Int] -> [Int] -> [Int]
addToDZHKList tournament currDZHK newElements = if null newElements then currDZHK else
        addToDZHKList tournament (currDZHK ++ uniqueNewElements) $ concatMap (dominators tournament) uniqueNewElements
    where   uniqueNewElements = nub newElements \\ currDZHK

topCycle' :: [[Int]] -> [Int]
topCycle' tournament = shortest $ (addToDZHKList tournament mempty . pure) `map` copeland tournament

topCycleFAST :: [[Int]] -> [Int]
topCycleFAST tournament = if length tournament == 1 then [1] else shortest $ map snd $ Map.toList $ foldl (\oldMap player -> if Map.member player oldMap then oldMap else 
    Map.union oldMap $ addToDZHKListFAST tournament mempty [player] 0 [player]) Map.empty $ players tournament

-- BFS Algorithm with optimization which uses the graph structure (between 2 nodes there is always a edge (in one or the other direction))
addToDZHKListFAST::[[Int]] -> [Int] -> [Int] -> Int -> [Int] -> Map.Map Int [Int]
addToDZHKListFAST tournament currDZHK sameDZHKelements n newElements = if null newElements then Map.fromList $ sameDZHKelements `zip` pure currDZHK else
        addToDZHKListFAST tournament (currDZHK ++ uniqueNewElements) (if n >= 2 then sameDZHKelements ++ uniqueNewElements else sameDZHKelements)
            (succ n) $ concatMap (dominators tournament) uniqueNewElements
    where   uniqueNewElements = nub newElements \\ currDZHK

-- Testing
{-
testFunction n = do 
    g <- newStdGen
    let randomList = take (n * (n - 1) `div` 2) (randomRs (0,1) g :: [Int])
    let tournamentEdges = [if randomList!!(sum [(n - i + 1)..(n-1)] + (j - i - 1)) == 0 then (j, i) else (i, j) | i <- [1..n], j <- [(i+1)..n]]
    let tournament = [[j | j <- [1..n], (i, j) `elem` tournamentEdges] | i <- [1..n]]
    --print tournament
    let x = topCycleFAST tournament
    print $ sum x
    --print [if randomRIO (0, 1) == 0 then (j, i) else (i, j) | i <- [1..n], j <- [(i+1)..n]]
-}
-- Alternative Functions
{-
topCycle :: [[Int]] -> [Int]
topCycle tournament = shortest [addToDZHKList tournament mempty [p] | p <- players tournament]

uncoveredSet :: [[Int]] -> [Int]
uncoveredSet tournament = [player | player <- players tournament,
                                    not $ any (flip (covers tournament) player) $ players tournament \\ pure player]
topCycleSet :: [[Int]] -> [Int]
topCycleSet tournament = shortest allCycles
    where allCycles = [Set.toList (addToDZHKSet tournament Set.empty (Set.singleton p)) | p <- players tournament]

addToDZHKSet::[[Int]] -> Set.Set Int -> Set.Set Int -> Set.Set Int
addToDZHKSet tournament currDZHK newElements = if Set.null newElements then currDZHK else
        addToDZHKSet tournament newCycle (Set.unions $ Set.map (Set.fromList . dominators tournament) uniqueNewElements) `Set.union` currDZHK
    where   uniqueNewElements = Set.difference newElements currDZHK
            newCycle = currDZHK `Set.union` uniqueNewElements -- == nub $ currDZHK ++ newElements
-}
-- Test Data

ex10 :: [[Int]]
ex10 = [[2,3,4,5,6,8,9],
        [3,5,6],
        [5,8],
        [2,3,5,6,7,8,9,10],
        [],
        [3,5,8],
        [1,2,3,5,6,8,9],
        [2,5],
        [2,3,5,6,8],
        [1,2,3,5,6,7,8,9]]
-- CO: [4, 10]
-- UC: [1, 4, 10]
-- TC: [1, 4, 7, 10]

ex20 :: [[Int]]
ex20 = [[2,3,4,5,6,7,8,9,10,11,12,13,15,16,18,19,20],[3,4,5,8,10,13,15,19],[4,5,12,13,15,19,20],[6,10,13,15,19],[4,9,10,13,15,19,20],[2,3,5,9,13,15,19],[2,3,4,5,6,8,9,10,11,12,13,15,19],[3,4,5,6,9,11,13,15,19],[2,3,4,10,11,13,15,19,20],[3,6,8,11,13,15,19],[2,3,4,5,6,13,15,19],[2,4,5,6,8,9,10,11,13,15,19],[19],[1,2,3,4,5,6,7,8,9,10,11,12,13,15,17,19,20],[13,19],[2,3,4,5,6,7,8,9,10,11,12,13,14,15,18,19,20],[1,2,3,4,5,6,7,8,9,10,11,12,13,15,16,18,19,20],[2,3,4,5,6,7,8,9,10,11,12,13,14,15,19,20],[],[2,4,6,7,8,10,11,12,13,15,19]]
-- CO: [17]
-- UC: [14,16,17]
-- TC: [1,14,16,17,18]

ex30 :: [[Int]]
ex30 = [[2,3,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,28,29,30],[18,23,29],[2,7,8,10,11,14,18,19,20,21,22,23,25,26,27,28,29],[1,2,3,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,28,29,30],[2,3,4,6,7,8,9,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,28,29,30],[2,3,7,8,10,11,13,14,15,17,18,19,20,22,23,24,25,26,27,28,29,30],[2,8,10,11,14,17,18,20,22,23,24,25,26,27,28,29],[2,10,11,14,18,19,20,23,25,26,27,28],[1,2,3,4,6,7,8,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30],[2,18,23,28],[2,10,18,23,28],[2,3,6,7,8,10,11,13,14,15,17,18,19,20,21,22,23,24,25,26,27,28,29],[2,3,7,8,10,11,14,17,18,19,20,21,22,23,24,25,26,27,28,29,30],[2,10,11,18,19,20,23,25,26,27,28,29],[2,3,7,8,10,11,13,14,17,18,19,20,22,23,25,26,27,28,29],[1,2,3,4,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,28,29,30],[2,3,8,10,11,14,18,19,20,23,25,26,27,28,29],[23],[2,7,10,11,18,23,25,28],[2,10,11,18,19,22,23,25,26,27,28,29],[2,6,7,8,10,11,14,15,17,18,19,20,22,23,24,25,26,27,28,29,30],[2,8,10,11,14,17,18,19,23,24,25,26,27,28,29,30],[],[2,3,8,10,11,14,15,17,18,19,20,23,25,26,27,28,29],[2,10,11,18,23,28],[2,10,11,18,19,23,25,27,28],[2,10,11,18,19,23,25,28],[2,18,23],[8,10,11,18,19,23,25,26,27,28],[2,3,7,8,10,11,12,14,15,17,18,19,20,23,24,25,26,27,28,29]]
-- CO: [9,16]
-- UC: [5,9,16]
-- TC: [1,4,5,9,16]

ex35 :: [[Int]]
ex35 = [[2,3,4,5,6,7,9,12,13,14,18,19,20,21,22,23,24,25,26,27,29,30,31,34,35],[3,4,5,6,7,9,14,18,19,20,21,22,23,24,25,26,27,29,30,31,34,35],[4,5,6,12,14,18,19,20,21,22,23,24,25,26,27,29,30,31,34,35],[5,6,12,14,18,19,20,21,22,23,24,25,26,27,29,30,31,34,35],[29],[5,14,18,21,22,23,24,26,27,29,31,35],[3,4,5,6,9,12,14,18,19,20,21,22,23,24,25,26,27,29,30,31,35],[1,2,3,4,5,6,7,9,10,12,14,18,19,20,21,22,23,24,25,26,27,29,30,31,34,35],[3,4,5,6,14,18,19,21,22,23,24,25,26,27,29,30,35],[1,2,3,4,5,6,7,9,11,12,14,18,19,20,21,22,23,24,25,26,27,29,30,31,34,35],[1,2,3,4,5,6,7,8,9,12,14,18,19,20,21,22,23,24,25,26,27,29,30,31,34,35],[2,5,6,9,13,14,18,19,20,21,22,23,24,25,26,27,29,30,31,34,35],[2,3,4,5,6,7,8,9,10,11,14,18,19,20,21,22,23,24,25,26,27,29,30,31,34,35],[5,18,27,35],[1,2,3,4,5,6,7,8,9,10,11,12,13,14,17,18,19,20,21,22,23,24,25,26,27,29,30,31,32,33,34,35],[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,29,30,31,33,34,35],[1,2,3,4,5,6,7,8,9,10,11,12,13,14,18,19,20,21,22,23,24,25,26,27,28,29,30,31,34,35],[5],[5,6,14,18,21,22,23,26,27,29,31,35],[5,6,9,14,18,19,21,23,26,27,29,30,31,34,35],[5,14,18,23,27,31],[5,14,18,20,21,23,27,29,30,31,35],[5,14,18,27,35],[5,14,18,19,20,21,22,23,27,29,31,35],[5,6,14,18,19,20,21,22,23,24,26,27,29,30,31,35],[5,14,18,21,22,23,24,27,29,30,31,34,35],[5,18,29,31],[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,18,19,20,21,22,23,24,25,26,27,29,30,31,34,35],[14,18,21,23],[5,6,14,18,19,21,23,24,27,29,31,35],[5,9,14,18,23,29],[1,2,3,4,5,6,7,8,9,10,11,12,13,14,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,34,35],[1,2,3,4,5,6,7,8,9,10,11,12,13,14,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,34,35],[5,6,7,9,14,18,19,21,22,23,24,25,27,29,30,31,35],[5,18,21,27,29,31]]
-- CO: [15,16,32,33]
-- UC: [15,16,28,32,33]
-- TC: [15,16,17,28,32,33]

ex50 :: [[Int]]
ex50 = [[2,5,7,10,11,12,13,14,17,18,19,20,21,22,23,24,26,27,29,30,31,32,33,34,35,36,37,38,39,41,42,44,49,50],[5,7,8,10,11,12,14,15,17,18,19,20,21,22,23,24,26,27,29,30,31,32,33,35,36,37,38,39,41,42,43,44,48,49,50],[1,2,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,41,42,43,44,45,46,48,49,50],[1,2,3,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,41,42,43,44,45,48,49,50],[7,11,36,37],[1,2,5,7,8,9,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50],[26,36],[1,5,7,10,11,12,14,18,19,20,21,22,23,24,26,27,29,30,31,32,33,35,36,37,38,39,41,42,44,49,50],[1,2,3,4,5,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50],[5,7,11,12,14,18,21,22,24,26,27,29,30,31,32,33,35,36,37,39,41,42,44,49,50],[7,27,36],[5,7,11,18,21,22,24,26,27,29,30,33,35,36,37,39,42,50],[2,5,7,8,10,11,12,14,17,18,19,20,21,22,23,24,26,27,29,30,31,32,33,34,35,36,37,38,39,41,42,43,44,49,50],[5,7,11,12,18,21,22,24,26,27,29,30,31,32,33,35,36,37,39,42,44,49,50],[1,5,7,8,10,11,12,13,14,17,18,19,20,21,22,23,24,25,26,27,29,30,31,32,33,34,35,36,37,38,39,41,42,43,44,45,49,50],[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,41,42,43,44,45,46,47,48,49,50],[5,7,8,10,11,12,14,18,19,21,22,23,24,26,27,29,30,31,32,33,34,35,36,37,39,41,42,44,49,50],[5,7,11,22,24,26,27,29,30,32,33,36,37,39,42,44,50],[5,7,10,11,12,14,18,21,22,24,26,27,29,30,31,32,33,34,35,36,37,38,39,41,42,44,49,50],[5,7,10,11,12,14,17,18,19,21,22,24,26,27,29,30,31,32,33,34,35,36,37,38,39,41,42,44,49,50],[5,7,11,18,22,24,26,27,29,30,33,36,37,39,44],[5,7,11,27,29,36],[5,7,10,11,12,14,18,19,20,21,22,24,26,27,29,30,31,32,33,35,36,37,38,39,41,42,44,49,50],[5,7,11,22,26,27,29,33,36,39,42,50],[1,2,5,7,8,10,11,12,13,14,17,18,19,20,21,22,23,24,26,27,29,30,31,32,33,34,35,36,37,38,39,41,42,43,44,48,49,50],[5,11,22,29,33,36,39],[5,7,26,29,33,36,37,44],[1,2,5,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,29,30,31,32,33,34,35,36,37,38,39,41,42,43,44,45,48,49,50],[5,7,11,36,42],[5,7,11,22,24,26,27,29,33,36],[5,7,11,12,18,21,22,24,26,27,29,30,32,33,35,36,37,38,39,41,42,44,49,50],[5,7,11,12,21,22,24,26,27,29,30,33,35,36,37,39,41,42,44,50],[5,7,11,22,29,36],[2,5,7,8,10,11,12,14,18,21,22,23,24,26,27,29,30,31,32,33,35,36,37,38,39,41,42,44,49,50],[5,7,11,18,21,22,24,26,27,29,30,33,36,37,39,41,42,44,50],[],[7,11,22,24,26,29,30,33,36,42],[5,7,10,11,12,14,17,18,21,22,24,26,27,29,30,32,33,35,36,37,39,41,42,44,49,50],[5,7,11,22,27,29,30,33,36,37],[1,2,3,4,5,7,8,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,41,42,43,44,45,47,48,49,50],[5,7,11,12,14,18,21,22,24,26,27,29,30,33,36,37,39,42,44,49],[5,7,11,21,22,26,27,30,33,36,39],[1,5,7,8,10,11,12,14,17,18,19,20,21,22,23,24,26,27,29,30,31,32,33,34,35,36,37,38,39,41,42,44,48,49,50],[5,7,11,12,22,24,26,29,30,33,36,37,39,42,49],[1,2,5,7,8,10,11,12,13,14,17,18,19,20,21,22,23,24,25,26,27,29,30,31,32,33,34,35,36,37,38,39,41,42,43,44,48,49,50],[1,2,4,5,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,47,48,49,50],[1,2,3,4,5,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,41,42,43,44,45,48,49,50],[1,5,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,26,27,29,30,31,32,33,34,35,36,37,38,39,41,42,44,49,50],[5,7,11,12,18,21,22,24,26,27,29,30,32,33,35,36,37,39,42,50],[5,7,11,21,22,26,27,29,30,33,36,37,39,41,42,44]]
-- CO: [16]
-- UC: [6,9,16,40]
-- TC: [3,4,6,9,16,40,46,47]