AdventOfCode 2018 PureScript - Day 2

Main.purs

module Main where

import Prelude
import Effect (Effect)
import Effect.Console (logShow)
import Data.Foldable (foldl)
import Data.Maybe (Maybe(..))
import Data.List (List(..), fromFoldable, zip, filter, (:))
import Data.Map (Map, empty, lookup, insert, toUnfoldableUnordered)
import Data.String.Yarn (toChars)
import Data.String (singleton, codePointFromChar)
import Data.Tuple (Tuple(..), uncurry, fst)
import Data.Either (Either(..))

input :: Array String
input = [ "efmyhuxcqqldtwjzvisepargvo" , "efuyhuxckqldtwjrvrsbpargno" , "efmyhuxckqlxtwjxvisbpargoo" , "efmyhuxczqbdtwjzvisbpargjo" , "efmyhugckqldtwjzvisfpargnq" , "tfmyhuxckqljtwjzvisbpargko" , "efmyhuxckqldtvuzvisbpavgno" , "efmyhufcrqldtwjzvishpargno" , "tfmyhuxbkqlduwjzvisbpargno" , "efayhtxckqldbwjzvisbpargno" , "efgyhuxckuldtwjzvisbpardno" , "efmyhuxckuldtwizvisbpargqo" , "efmyhuxcknldtjjzvihbpargno" , "efmyhuxcnqddtwjzvisbpafgno" , "efmyhubokqldtwjzvisbpargdo" , "efmhhuxckqldtwdzvisbpjrgno" , "efmyhuxckqldtwjrcisbpargny" , "efmyhuxckqsdtwjzlisbpargng" , "effyhuxckqlqtwjzjisbpargno" , "nfmyhjxckqldtwjzcisbpargno" , "efmyhvxckqldtwszvwsbpargno" , "efmyhuxckqldtwutvisbpprgno" , "kfmyhuxckqldtwzuvisbpargno" , "efhyhtxckqldtwjmvisbpargno" , "efmyhuhckqldtwjzvisbpxwgno" , "efmyhuxcfqldtrjzvitbpargno" , "efmyhudckqldtwjfvisbparvno" , "ekmyhuxckqlstwjzvisbdargno" , "efmyhuxckqlxtwjftisbpargno" , "etsyhuxckqldtwjzvisbpargnf" , "exmyhusckqldtwjzvisbpakgno" , "efmyhubckqlrtljzvisbpargno" , "efmyhuxckwldtwjovizbpargno" , "efmyhulckqzdtwjzvisbpargpo" , "efmyhuxckbcdlwjzvisbpargno" , "zfmyhulckqbdtwjzvisbpargno" , "efmyquxckfldtwazvisbpargno" , "efxyhuxakqldtwjzvisupargno" , "efmlhuxckkedtwjzvisbpargno" , "efhyhuxwkqldtwjzvisbparjno" , "efmyhuxfkqldtwjzvisvparyno" , "efmyhuxckqfdtijzvisblargno" , "efmyhuxckqldtfjzvisbwhrgno" , "efmymuxcknldtwzzvisbpargno" , "eomybuxckqldtwkzvisbpargno" , "pfmyhuxckqldtwgzvasbpargno" , "vfmyhuxcoqldtwjzvisbparvno" , "eflyhuxckqldtwjzvirypargno" , "efmyvuxckqldtwizvisbpaqgno" , "epmyhuxckqldtwjzvesbparpno" , "efoyhuxckoldtwjmvisbpargno" , "efmyhuxckqydtwpzvisbpaqgno" , "efmyhuxckqldezbzvisbpargno" , "efmyhuxckqldtwjzvisboalxno" , "efmyhuxckqldtwuzvipbjargno" , "efmymuxcuqldtwjzvasbpargno" , "jfmyhuxckqldtwjzvzsbpargdo" , "nfmyhuxckqlntsjzvisbpargno" , "efmxhuxckqgdtwjzvisbparjno" , "efmyhuxckpldtpjzvpsbpargno" , "efmyhuxcyqldtwjhvisbpargqo" , "efmyhexgkqydtwjzvisbpargno" , "ffmyhuxckqldtwjzvisbpafgnk" , "efmyfuxckqldtwjpvisbpartno" , "efmyhoxckcmdtwjzvisbpargno" , "efmyhuxxkqldtwjzviabparyno" , "jfmyhuxakqldtwgzvisbpargno" , "efmjhuxckqcdtwjzvisbjargno" , "efmyhuxccqldtwjzxisbxargno" , "efmyhurckqldiwjzvrsbpargno" , "efmyhuxckasdtwjzvisboargno" , "efmyhvxckmldtwjgvisbpargno" , "efmyhuxckoldtwjuvisbpardno" , "efmyduxckqldtwjgvzsbpargno" , "ejmyhuxckqldtwbzvisbpargnb" , "efmymuxchqldtwjzvibbpargno" , "efmyhjxckqldtwjgvinbpargno" , "efmyhuxhyqldtwbzvisbpargno" , "efmyhuxckqldtwjzvisbpzignq" , "efmyuueckqldxwjzvisbpargno" , "qfmyhyxckqldtwizvisbpargno" , "efmyhupckqldtwjzvpgbpargno" , "efmycuxckqldtwjzvfdbpargno" , "efmyhugcrqldtwjfvisbpargno" , "efmyhexckqldtwjzvischargno" , "efmyhuxckqldtljzvasbpamgno" , "efmyzdxckqldtwjovisbpargno" , "efmyhuxccqldtwjzvdsbpaigno" , "ufmyhuxekqldtwjzvisbpargne" , "efmyhuxckqldfwozvisgpargno" , "afmyhuackqldtwjzvisbdargno" , "efmyauxckqldtwjzvisiparmno" , "efmysuxckqldtwjzvisbeaggno" , "efmyhuxckqldtwjzvisbgzigno" , "efryhuxlkqldtwozvisbpargno" , "lfmyhuxckqldtwjzvhsbparuno" , "efmyhzxckqldswjzvisqpargno" , "efmyhuxrkqldtwjzvisgpargco" , "efmyhudckqldtwjzyisbkargno" , "efmyhuacqqldtwjzviabpargno" , "jfmyhuxckqldtwvzvicbpargno" , "efmkhuxckqlftejzvisbpargno" , "nfmyhuxckqldnwjzvisbxargno" , "efmyhuxckqldtwjvvisjpyrgno" , "efmyhuxcmxldtwjzvisbpargto" , "efmyhuxckqldtwqbvpsbpargno" , "efmyhuxckzldjwjzvisbplrgno" , "efmywgxckqldtwxzvisbpargno" , "efmsguxckqldhwjzvisbpargno" , "nfmyhuxlkqldtwjzvisbgargno" , "etmyhuxckqldtwjzvqsbptrgno" , "efmyxuxckqldtfjzvisbyargno" , "cfmihuxckqldtwjzvisbpargnf" , "jfzyhuxckqldtwjzviscpargno" , "efmyhuxckqldtmjzvisbpbzgno" , "bfmyhuzckqldcwjzvisbpargno" , "efmyhuxckqldtmjzvmslpargno" , "efqyvuxckqldtwazvisbpargno" , "efmecrxckqldtwjzvisbpargno" , "efmyhuuckqldtwjzvisrpargnt" , "efmphuxckqldtwjzvisbparmho" , "ifmyhuxckqldtwjzvismpsrgno" , "efmyhuookqldywjzvisbpargno" , "efmyhfxckyldtwjnvisbpargno" , "efmyhxhckqldtwjzvisqpargno" , "efryhuxcfqldtwjzvisbparkno" , "efmyhutckqldpwjzvixbpargno" , "efmyoukckqldtwjzvisbpargko" , "efmyhuxckqldtwjzviseparynv" , "efmyhuxcksldvwjzvisbnargno" , "efmyhuxckqrdtwlzmisbpargno" , "efmyhuxcwqldtwjzviqapargno" , "eymyhuxckqrdtwkzvisbpargno" , "efmyhuxckqldtwjzpisopargnj" , "efmyhuxikqldtwjzvirupargno" , "efmyhuxcuzldtnjzvisbpargno" , "efmyhxxikqldtwjzvisbpalgno" , "efmyhuxceqldtwjzvdsbparguo" , "efmyhuxwkqldtwjmvisbparxno" , "efmyhuxpkqldtwjzvisfpargfo" , "efmyfuxckaldtwjzvirbpargno" , "efmyhuxckqrdtwjzvismprrgno" , "efmyhuxckqldzwjzvisbpnrgfo" , "efmyhfuckqldtwjyvisipargno" , "efmyhuxcpqlqfwjzvisbpargno" , "efmyyuxckqldtwjzvrsepargno" , "efmphuxckqlptqjzvisbpargno" , "efmyhuxnfqldtwjzvisbpmrgno" , "efmyhuxckqldtwjzkisnpnrgno" , "mfmyhuxckqldtwjzvisbzarcno" , "efmyhuxckqldtwlzviszpargwo" , "efmytuxckqndtwjqvisbpargno" , "efmyzuxckqldtwjzvisbaargjo" , "efmihuxckqlutwjzvimbpargno" , "efmyhuxckqldgwjzvixbparono" , "tfmyduxckqldtyjzvisbpargno" , "ejmyhuockqldtwjzvidbpargno" , "efmyheyckqkdtwjzvisbpargno" , "efmyhuxckqldtwjzoisbpargfj" , "efqyhuxcxqldtwxzvisbpargno" , "jfmyhaxckqldtwjzvisbvargno" , "hfmyhqxckqldtwjzvisbparvno" , "efmyhukckqlrtwjzvqsbpargno" , "efmyhuxckqldvwmzvisbparrno" , "efoyhuxckqldtwjzvilwpargno" , "ejmyhuxckqldtwjzxisbprrgno" , "efmyhuxckqldtsjzvisupdrgno" , "efzyhjxckqldtwjzvisbpasgno" , "ebmyhulckqldtwjzvisbpargnr" , "efmyhuxcjqlntwjzqisbpargno" , "efmlocxckqldtwjzvisbpargno" , "efmyhuxckqldtwjzvizkpargnm" , "ebmyhuxckqldtwjzvlfbpargno" , "efmyhuxckqldtwjyvisbpjrgnq" , "afmyhuxckqldtwjzvpsbpargnv" , "efmyxuxckqwdzwjzvisbpargno" , "efmyhuxskqlqthjzvisbpargno" , "efmyhuxckqldtwdzvisbearglo" , "mfmyhuxckqldtzjzvisbparggo" , "efmyhuqckqodtwjzvisbpadgno" , "efmyhuxctqldywjzvisspargno" , "efmyhuxckqqdtwjnvisbporgno" , "efmyhixckqldowjzvisbpaagno" , "efmyhuxckqldtsszvisbpargns" , "edmyhuxckqpdtwjzrisbpargno" , "efsyhuxckqldtijzvisbparano" , "efmyhuxckqxdzwjzviqbpargno" , "efmyhuxckqldtwjzviqqpsrgno" , "efmyhuockqlatwjzvisbpargho" , "efmyhuxckqldtwjzvishkavgno" , "vfmyhuxckqldtwjzvksbaargno" , "efmahuxckqudtwbzvisbpargno" , "ewmyhixckqudtwjzvisbpargno" , "efmywuxczqldtwjzvisbpargao" , "efmyhuqjkqldtwyzvisbpargno" , "efmyhuxekqldtwjzmksbpargno" , "efmyhuxcoqtdtwjzvinbpargno" , "ebmyhuxkkqldtwjzvisbdargno" , "ecmyhnxckqldtwnzvisbpargno" , "efmyhuxbkqldtwjzvksbpaigno" , "efayhuxckqidtwjzvisbpavgno" , "efmrhuxckqldswjzvisbpaugno" , "efmyhuuckqldtwjyvisipargno" , "xfmyhuxckqldawjzvosbpargno" , "efmyhuxckklhtwjzvisbpargnq" , "efmyhmxcaqldzwjzvisbpargno" , "efiyhuxcksldtwjzvisbpamgno" , "zfmyhuzckqldtwjzvisbparhno" , "efmyhuxckqlvtwjdvisbparsno" , "efmyhmxckaldtwjzmisbpargno" , "efmysuxcqoldtwjzvisbpargno" , "efmyhuxckqldtwjzvisbsargrb" , "effyhuxckqldtwjzvisbpwfgno" , "efmyhuxclqmdtwjzxisbpargno" , "edmohuxckqldtwjziisbpargno" , "efmyhuxckpldtwjzviubpaegno" , "efmyhuxcpqldtwjzjimbpargno" , "ehmyhuxckqldtwjzsisbpargnq" , "efmyhcxcdqldtwjzvisbqargno" , "efmjhuxckqldmwjzviybpargno" , "efeyhzxckqlxtwjzvisbpargno" , "efmyhuxczqadtwazvisbpargno" , "efmahuxckqldtwjzvisbpafgnl" , "efmyouxckqldtwjzvizbpacgno" , "emmrhuxckqldtwjzvisqpargno" , "exmyhuxckqlftwjnvisbpargno" , "efuyhuxckqldrwjzvisbpargnw" , "efmywuxfkqldtwjztisbpargno" , "efmyhuxdkqldtwjzvisbpqrzno" , "eemyhuxckqldrwjzvisbpajgno" , "efmyiuxckqldtbjzvrsbpargno" , "eqmyhuxckqldlwjzfisbpargno" , "efmyhuxckqlitwuzvisbpvrgno" , "ecoyhuxckqldtwjzvishpargno" , "efmyhuxckcldtwjzlisbparlno" , "efmyhsxcknldtwjfvisbpargno" , "efmyhuxckqldtwjrvosbpargbo" , "enmehuxckzldtwjzvisbpargno" , "hfmyhuxckqqdtwjzvisbpawgno" , "efmyhufckcjdtwjzvisbpargno" , "efmxhuxckqldthjzvisfpargno" , "efmyaukckqldtwjsvisbpargno" , "efmyhukckqldtwpzvisbpmrgno" , "dfmyhuxckqldtwjzvisbvarmno" , "afmbhuxckqldtwjzvssbpargno" , "efmyhuxchqldtwezvisbpargzo" , "efmphuxckqlxjwjzvisbpargno" , "efhyxuxckqldtwjzvisbpargko" , "sfmyhexckqldtwjzvisbqargno" , "efmghuxckqldtwjzvitbparnno" ]

occurrences :: String -> Map Char Int
occurrences s =
  foldl insert' empty (toChars s :: List Char)
  where
    insert' :: Map Char Int -> Char -> Map Char Int
    insert' m k =
      case lookup k m of
        Just v -> insert k (v + 1) m
        Nothing -> insert k 1 m

twosAndThrees :: Map Char Int -> Tuple Int Int
twosAndThrees m =
  foldl count (Tuple 0 0) xs
  where
    xs :: List (Tuple Char Int)
    xs = toUnfoldableUnordered m
    count :: Tuple Int Int -> Tuple Char Int -> Tuple Int Int
    count (Tuple x y) (Tuple _ 3) = Tuple x 1
    count (Tuple x y) (Tuple _ 2) = Tuple 1 y
    count t _ = t

sum' :: List (Tuple Int Int) -> Tuple Int Int
sum' =
  foldl sumTuples (Tuple 0 0)
  where
    sumTuples :: Tuple Int Int -> Tuple Int Int -> Tuple Int Int
    sumTuples (Tuple x y) (Tuple a b) = Tuple (x + a) (y + b)

product' :: Tuple Int Int -> Int
product' (Tuple x y) = x * y

checksum :: List String -> Int
checksum =
  product' <<< sum' <<< map twosAndThrees <<< map occurrences

areDifferByOneChar :: String -> String -> Boolean
areDifferByOneChar x y =
  foldl diffs 0 (pairs x y) == 1
  where
    diffs :: Int -> Tuple Char Char -> Int
    diffs i (Tuple a b)
      | a == b    = i
      | otherwise = i + 1

pairs :: String -> String -> List (Tuple Char Char)
pairs x y = zip (toChars x :: List Char) (toChars y :: List Char)

filterDifferByOneChar :: List String -> List String
filterDifferByOneChar xs =
  map fst $ filter areDifferByOneChar' (combinations xs)
  where
    combinations :: List String -> List (Tuple String String)
    combinations = cartesianProduct
    areDifferByOneChar' :: Tuple String String -> Boolean
    areDifferByOneChar' = uncurry areDifferByOneChar

commonChars :: List String -> Either String String
commonChars (x : y : Nil) =
  Right $ foldl keepCommon "" (pairs x y)
  where
    keepCommon :: String -> Tuple Char Char -> String
    keepCommon acc (Tuple a b)
      | a == b    = acc <> charToString a
      | otherwise = acc
    charToString :: Char -> String
    charToString c = singleton (codePointFromChar c)
commonChars _ = Left "Only two ids are expected to differ by one char!"

cartesianProduct :: List String -> List (Tuple String String)
cartesianProduct xs = do
  x <- xs
  x' <- xs
  Tuple x x' : Nil

main :: Effect Unit
main = do
  logShow $ checksum $ fromFoldable input
  logShow $ commonChars $ filterDifferByOneChar $ fromFoldable input