fix 16

diff --git a/16/one.icl b/16/one.icl
index 12cfe84..a950986 100644 (file)
--- a/16/one.icl
+++ b/16/one.icl
@@ -5,6 +5,7 @@ import Data.Tuple
 import Data.Either
 import Data.Func
 import Data.List
+import Text => qualified join
 import Data.Functor
 import Control.Applicative
 import Control.Monad
@@ -24,39 +25,35 @@ Start w
        # nearby = filter (not o isEmpty) nearby
        = (one fields nearby, two fields myticket nearby)
 
+one :: [([Char], [Int])] -> ([[Int]] -> Int)
 one fields = sum o flatten o map (filter \e->not $ isMember e $ flatten $ map snd fields)
 
 valid fields = isEmpty o filter \e->not $ isMember e $ flatten $ map snd fields
 
-foldr1 f [x:xs] = foldr f x xs
-foldr1 f [] = []
-
-intersect` [] xs = xs
-intersect` xs [] = xs
-intersect` ys xs = intersect ys xs
-
 // for every ticket, for every field, every option
-//two :: [([Char],[Int])] a [[Int]] -> [[[String]]]
-two fields myticket nearby = (\x->proc x x [] []) $ map (foldr1 intersect) $ transpose $ map (collectConstraints fields) $ filter (valid fields) nearby
+two :: [([Char], [Int])] [Int] [[Int]] -> Int
+two fields myticket nearby
+       // Translate to numbers and multiply
+       = prod $ zipWith (\i [s]->if (startsWith ['departure'] s) i 1) myticket
+       // iteratively find all singletons and apply constraint
+       $ proc []
+       // Transpose and merge all fieldconstraints
+       $ map (\[x:xs]->foldr intersect x xs) $ transpose
+       // Remove all invalid fields
+       $ map (collectConstraints fields)
+       // Remove all invalid tickets
+       $ filter (valid fields) nearby
 where
-       //Per field show all options for the field
-       collectConstraints :: [([Char], [Int])] [Int] -> [[String]]
+       collectConstraints :: [([Char], [Int])] [Int] -> [[[Char]]]
        collectConstraints fields fs = map collectConstraint fs
        where
-               //For a field, return the possible fields
-               collectConstraint :: Int -> [String]
-               collectConstraint num = [toString f\\(f, rng)<-fields | isMember num rng]
+               collectConstraint :: Int -> [[Char]]
+               collectConstraint num = [f\\(f, rng)<-fields | isMember num rng]
 
-       proc :: [[String]] [[String]] [String] [[String]] -> [[String]]
-       proc orig [[x:xs]:xxs] acc accum = proc orig (map (filter ((<>)x)) xxs) [x:acc] $ proc orig [xs:xxs] acc accum
-       proc orig [[]:xxs] acc accum = proc orig xxs acc accum
-       proc orig [] acc accum = if (valid orig (reverse acc)) [acc:accum] accum
-       where
-               valid :: [[String]] [String] -> Bool
-               valid [x:xs] [y:ys]
-                       | isMember y x = valid xs ys
-               valid [] [] = True
-               valid _ _ = False
+       proc :: [[[Char]]] [[[Char]]] -> [[[Char]]]
+       proc had [[x]:todo] = proc [[x]:map (filter ((<>)x)) had] $ map (filter ((<>)x)) todo
+       proc had [x:todo] = proc [x:had] todo
+       proc had [] = if (any ((<>) 1 o length) had) (proc [] had) had
 
 parseInput :: Parser Char ([([Char], [Int])], [Int], [[Int]])
 parseInput = tuple3 <$> many pField