Merge pull request #67 from hypirion/jn-day-07

Day 7 in Standard ML

Author: Arxcis

days/day-07/solutions/day07.sml

@@ -0,0 +1,64 @@
+use "../../../util.sml";
+
+local
+    structure SS = StringSet
+    structure SM = StringMap
+in
+
+fun toDigit c = Char.ord c - Char.ord #"0"
+fun toRule s =
+    let
+        val (parent, rawChildClauses) =
+            case String.substring (s, 0, String.size s - 1)
+                         >> String.fields (fn c => c = #" ")
+                         >> splitWith (fn x => x = "contain") of
+                [a, b] => (String.concatWith " " a, String.concatWith " " b)
+              | _ => raise Fail $ "bad input: " ^ s
+        (* sigh *)
+        fun clause 0 (#" " :: rest) = clause 0 rest
+          | clause 1 (#" " :: name) = SOME (1, (String.implode name) ^ "s")
+          | clause n (#" " :: name) = SOME (n, String.implode name)
+          | clause n (#"n" :: _) = NONE
+          | clause n (x :: rest) = clause (n*10 + toDigit x) rest
+          | clause _ _ = NONE
+
+        val childClauses = String.fields (fn c => c = #",") rawChildClauses
+                                         >> List.mapPartial (clause 0 o String.explode)
+    in
+        (parent, childClauses)
+    end
+
+fun solve1 clauses =
+    let fun consRule s p c = SM.updateWithDefault [] (fn xs => p :: xs) c s
+        fun invertRules ((p, cs), s) = List.foldl (fn ((_, c), s) => consRule s p c) s cs
+        val rules = List.foldl invertRules SM.empty clauses
+        fun dfs n seen [] = n
+          | dfs n seen (x :: xs) =
+            if SS.contains x seen then
+                dfs n seen xs
+            else
+                let val children = getOpt (SM.lookup x rules, [])
+                in
+                    dfs (n + 1) (SS.insert x seen) (children @ xs)
+                end
+    in
+        dfs ~1 SS.empty ["shiny gold bags"]
+    end
+
+fun solve2 clauses =
+    let val rules = SM.fromList clauses
+        fun sum ((count, name), acc) = acc + count + count * dfs name
+        and dfs k = List.foldl sum 0 $ valOf $ SM.lookup k rules
+    in
+        dfs "shiny gold bags"
+    end
+
+fun main () =
+    let val input = TextIO.inputAll TextIO.stdIn
+                                    >> String.tokens (fn c => c = #"\n")
+                                    >> List.map toRule
+    in
+        println $ Int.toString $ solve1 input;
+        println $ Int.toString $ solve2 input
+    end
+end

days/day-07/test.sh

@@ -6,6 +6,7 @@ D=$(dirname $(realpath $0))
 
 echo ""
 echo "--- Day 7: Handy Haversacks ---"
-$D/../../languages/node.sh   $D/input.txt $D/output.txt $D/solutions/day07.mjs
+$D/../../languages/sml.sh    $D/input.txt $D/output.txt $D/solutions/day07.sml
 $D/../../languages/python.sh $D/input.txt $D/output.txt $D/solutions/day07.stektpotet.py
+$D/../../languages/node.sh   $D/input.txt $D/output.txt $D/solutions/day07.mjs
 echo ""

util.sml

@@ -6,14 +6,14 @@ fun println x = print $ x ^ "\n"
 fun splitWith pred list =
     let
         fun acc done [] [] = done
-          | acc done last [] = last :: done
+          | acc done last [] = List.rev last :: done
           | acc done last (x :: xs) =
             if pred x then
-                acc (last :: done) [] xs
+                acc (List.rev last :: done) [] xs
             else
                 acc done (x :: last) xs
     in
-        acc [] [] list
+        List.rev $ acc [] [] list
     end
 
 fun foldl' f (x :: xs) = List.foldl f x xs
@@ -22,6 +22,7 @@ fun foldl' f (x :: xs) = List.foldl f x xs
 val listSum = List.foldl (op +) 0
 val listProduct = List.foldl (op *) 1
 
+
 signature ORD =
 sig
     type t
@@ -37,6 +38,8 @@ sig
     val empty : 'a Coll
     val lookup : K -> 'a Coll -> 'a option
     val insert : K -> 'a -> 'a Coll -> 'a Coll
+    val update : ('a option -> 'a) -> K -> 'a Coll -> 'a Coll
+    val updateWithDefault : 'a -> ('a -> 'a) -> K -> 'a Coll -> 'a Coll
     val foldl : (K * 'a * 'b -> 'b) -> 'b -> 'a Coll -> 'b
     val size : 'a Coll -> int
     val fromList : (K * 'a) list -> 'a Coll
@@ -83,6 +86,13 @@ fun insert k v s =
         T (B, a, y, b)
     end
 
+fun update f k coll =
+    insert k (f $ lookup k coll) coll
+
+fun updateWithDefault default f k coll =
+    update (fn v => f $ getOpt (v, default)) k coll
+
+
 fun foldl f acc E = acc
   | foldl f acc (T(_, a, (k, v), b)) =
     let
@@ -97,7 +107,6 @@ fun size coll = foldl (fn (_, _, n) => n + 1) 0 coll
 fun fromList list = List.foldl (fn ((k, v), s) => insert k v s) empty list
 end
 
-
 signature SET =
 sig
     type V
@@ -136,3 +145,11 @@ structure CharMap = Map(
     end)
 
 structure CharSet = Set(CharMap)
+
+structure StringMap = Map(
+    struct
+    type t = string
+    val cmp = String.compare
+    end)
+
+structure StringSet = Set(StringMap)