hurt + attract
This commit is contained in:
parent
2a5cc869cf
commit
9f4d8b4343
30
Main.hs
30
Main.hs
@ -1,7 +1,10 @@
|
|||||||
newtype Group = [MainCharacter]
|
import Data.List
|
||||||
newtype NeoTokyo = [Group]
|
|
||||||
|
type Group = [MainCharacter]
|
||||||
|
type NeoTokyo = [Group]
|
||||||
|
|
||||||
data MainCharacter = Asuka | Shinji | Rei | Misato | Ritsuko | Gendo
|
data MainCharacter = Asuka | Shinji | Rei | Misato | Ritsuko | Gendo
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
defFrens :: MainCharacter -> [MainCharacter]
|
defFrens :: MainCharacter -> [MainCharacter]
|
||||||
defFrens Asuka = [Rei, Shinji, Misato]
|
defFrens Asuka = [Rei, Shinji, Misato]
|
||||||
@ -12,23 +15,30 @@ defFrens Ritsuko = [Misato, Shinji, Gendo]
|
|||||||
defFrens Gendo = [Rei, Shinji, Ritsuko]
|
defFrens Gendo = [Rei, Shinji, Ritsuko]
|
||||||
|
|
||||||
charsGroup :: MainCharacter -> NeoTokyo -> Group
|
charsGroup :: MainCharacter -> NeoTokyo -> Group
|
||||||
charsGroup x nt = filter (\g -> x `elem` g) nt
|
charsGroup x nt = head $ filter (\g -> x `elem` g) nt
|
||||||
|
|
||||||
curFrens :: MainCharacter -> NeoTokyo -> [MainCharacter]
|
curFrens :: MainCharacter -> NeoTokyo -> [MainCharacter]
|
||||||
curFrens x nt = filter (/= x) $ charsGroup x nt
|
curFrens x nt = filter (/= x) $ charsGroup x nt
|
||||||
|
|
||||||
uniq :: (Ord a) => [a] -> [a]
|
uniq :: (Eq a) => [a] -> [a]
|
||||||
uniq = map head . group . sort
|
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 :: MainCharacter -> NeoTokyo -> [Group]
|
||||||
adjGroups x nt = filter (\g -> any (elem adjFrens) g) otherGroups
|
adjGroups x nt = filter (\g -> any (\x -> x `elem` adjFrens) g) (otherGroups x nt)
|
||||||
where
|
where
|
||||||
otherGroups = filter (\g -> not $ x `elem` g) nt
|
adjFrens = uniq $ foldr (++) [] (map defFrens $ curFrens x nt)
|
||||||
adjFrens = uniq $ fold (++) (map defFrens $ curFrens x nt)
|
|
||||||
|
otherGroups :: MainCharacter -> NeoTokyo -> [Group]
|
||||||
|
otherGroups x nt = filter (\g -> not $ x `elem` g) nt
|
||||||
|
|
||||||
getAdj :: MainCharacter -> NeoTokyo -> [MainCharacter]
|
getAdj :: MainCharacter -> NeoTokyo -> [MainCharacter]
|
||||||
getAdj x nt = curFrens x nt ++ (fold (++) adjGroups x nt)
|
getAdj x nt = curFrens x nt ++ (foldr (++) [] (adjGroups x nt))
|
||||||
|
|
||||||
hurt :: MainCharacter -> NeoTokyo -> NeoTokyo
|
hurt :: MainCharacter -> NeoTokyo -> NeoTokyo
|
||||||
|
hurt x nt = [x] : (filter (/= x) $ charsGroup x nt) : (otherGroups x nt)
|
||||||
|
|
||||||
attract :: MainCharacter -> NeoTokyo -> NeoTokyo
|
attract :: MainCharacter -> MainCharacter -> NeoTokyo -> NeoTokyo
|
||||||
|
attract x y nt = (uniq (charsGroup x nt ++ charsGroup y nt)) : (otherGroups y (otherGroups x nt))
|
||||||
|
Loading…
Reference in New Issue
Block a user