From 9f4d8b43436b050d85ec2253b9f0bf05f7198bc1 Mon Sep 17 00:00:00 2001 From: Shaun Kerr Date: Wed, 15 May 2019 16:48:51 +1200 Subject: [PATCH] hurt + attract --- Main.hs | 30 ++++++++++++++++++++---------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/Main.hs b/Main.hs index e0d30d7..5d01817 100644 --- a/Main.hs +++ b/Main.hs @@ -1,7 +1,10 @@ -newtype Group = [MainCharacter] -newtype NeoTokyo = [Group] +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] @@ -12,23 +15,30 @@ defFrens Ritsuko = [Misato, Shinji, Gendo] defFrens Gendo = [Rei, Shinji, Ritsuko] 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 x nt = filter (/= x) $ charsGroup x nt -uniq :: (Ord a) => [a] -> [a] -uniq = map head . group . sort +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 (elem adjFrens) g) otherGroups +adjGroups x nt = filter (\g -> any (\x -> x `elem` adjFrens) g) (otherGroups x nt) where - otherGroups = filter (\g -> not $ x `elem` g) nt - adjFrens = uniq $ fold (++) (map defFrens $ curFrens x nt) + 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 ++ (fold (++) adjGroups x nt) +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 -> NeoTokyo -> NeoTokyo +attract :: MainCharacter -> MainCharacter -> NeoTokyo -> NeoTokyo +attract x y nt = (uniq (charsGroup x nt ++ charsGroup y nt)) : (otherGroups y (otherGroups x nt))