type Group = [MainCharacter] type NeoTokyo = [Group] data MainCharacter = Asuka | Shinji | Rei | Misato | Ritsuko | Gendo deriving (Show, Eq) defFrens :: MainCharacter -> [MainCharacter] defFrens Asuka = [Rei, Shinji, Misato] defFrens Shinji = [Rei, Gendo, Ritsuko, Misato, Asuka] defFrens Rei = [Gendo, Shinji, Asuka] defFrens Misato = [Asuka, Shinji, Ritsuko] defFrens Ritsuko = [Misato, Shinji, Gendo] defFrens Gendo = [Rei, Shinji, Ritsuko] charsGroup :: MainCharacter -> NeoTokyo -> Group charsGroup x nt = head $ filter (\g -> x `elem` g) nt curFrens :: MainCharacter -> NeoTokyo -> [MainCharacter] curFrens x nt = filter (/= x) $ charsGroup x nt uniq :: (Eq a) => [a] -> [a] uniq x = go x [] where go [] al = al go (c:cs) al = if (c `elem` al) then (go cs al) else (go cs (c:al)) adjGroups :: MainCharacter -> NeoTokyo -> [Group] adjGroups x nt = filter (\g -> any (\x -> x `elem` adjFrens) g) (otherGroups x nt) where adjFrens = uniq $ foldr (++) [] (map defFrens $ charsGroup x nt) otherGroups :: MainCharacter -> NeoTokyo -> [Group] otherGroups x nt = filter (\g -> not $ x `elem` g) nt getAdj :: MainCharacter -> NeoTokyo -> [MainCharacter] getAdj x nt = curFrens x nt ++ (foldr (++) [] (adjGroups x nt)) hurt :: MainCharacter -> NeoTokyo -> NeoTokyo hurt x nt | curFrens x nt == [] = nt | otherwise = [x] : (filter (/= x) $ charsGroup x nt) : (otherGroups x nt) attract :: MainCharacter -> MainCharacter -> NeoTokyo -> NeoTokyo attract x y nt = (uniq (charsGroup x nt ++ charsGroup y nt)) : (otherGroups y (otherGroups x nt))