evac/Main.hs

import Data.List

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 $ curFrens 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 = [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))