From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 17 Dec 2020 13:15:36 +0000 (+0100)
Subject: fix 16
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=6dca2d1a5b6042a376f0cda2f749d87c51149c72;p=aoc20.git

fix 16
---

diff --git a/16/one.icl b/16/one.icl
index 12cfe84..a950986 100644
--- 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