Merge pull request #75 from hypirion/jn-day-08

Day 8 in Standard ML

Author: Arxcis

days/day-08/solutions/day08.sml

@@ -0,0 +1,65 @@
+use "../../../util.sml";
+
+local
+    structure IS = IntSet
+in
+
+datatype Op = ACC | JMP | NOP
+
+fun opFromString "acc" = ACC
+  | opFromString "jmp" = JMP
+  | opFromString "nop" = NOP
+  | opFromString s = raise Fail $ "opFromString - bad input: " ^ s
+
+fun toInstruction s =
+    case String.tokens (fn c => c = #" ") s of
+        [a, b] => (opFromString a, valOf $ Int.fromString b)
+      | _  => raise Fail $ "bad input: " ^ s
+
+datatype TerminationReason = STOPPED of int
+                           | INF_LOOP of int
+
+fun programResult (STOPPED n) = n
+  | programResult (INF_LOOP n) = n
+
+fun run (program : (Op * int) RList.Coll) : TerminationReason =
+    let fun go seen pc acc =
+            if IS.contains pc seen then
+                INF_LOOP acc
+            else if RList.size program <= pc then
+                STOPPED acc
+            else
+                let val seen' = IS.insert pc seen
+                in
+                case RList.get (pc, program) of
+                    (ACC, n) => go seen' (pc + 1) (acc + n)
+                  | (JMP, n)  => go seen' (pc + n) acc
+                  | (NOP, _) => go seen' (pc + 1) acc
+                end
+    in
+        go IS.empty 0 0
+    end
+
+fun flip (ACC, n) = NONE
+  | flip (JMP, n) = SOME (NOP, n)
+  | flip (NOP, n) = SOME (JMP, n)
+
+fun findFlip program i =
+    case flip $ RList.get (i, program) of
+        NONE => findFlip program (i+1)
+      | SOME newOp =>
+        case run (RList.set (i, newOp, program)) of
+            INF_LOOP _ => findFlip program (i+1)
+          | STOPPED n => n
+
+fun main () =
+    let val program = TextIO.inputAll TextIO.stdIn
+                                      >> String.tokens (fn c => c = #"\n")
+                                      >> List.map toInstruction
+                                      >> RList.fromList
+    in
+        println $ Int.toString $ programResult $ run program;
+        println $ Int.toString $ findFlip program 0
+    end
+    handle Subscript => println "boo"
+end

days/day-08/test.sh

@@ -6,5 +6,6 @@ D=$(dirname $(realpath $0))
 
 echo ""
 echo "--- Day 8: Handheld Halting ---"
+$D/../../languages/sml.sh    $D/input.txt $D/output.txt $D/solutions/day08.sml
 $D/../../languages/deno.sh   $D/input.txt $D/output.txt $D/solutions/day08.ts
 echo ""

util.sml

@@ -138,6 +138,80 @@ val size = Map.size
 fun fromList list = List.foldl (fn (v, s) => insert v s) empty list
 end
 
+structure UncountedRList =
+struct
+datatype 'a Tree = Leaf of 'a | Node of 'a * 'a Tree * 'a Tree
+type 'a Coll = (int * 'a Tree) list
+
+val empty = []
+fun isEmpty ts = null ts
+
+fun cons (x, ts as (w1, t1) :: (w2, t2) :: ts') =
+    if w1 = w2 then
+        (1 + w1 + w2, Node (x, t1, t2)) :: ts'
+    else
+        (1, Leaf x) :: ts
+  | cons (x, ts) = (1, Leaf x) :: ts
+
+fun head ((1, Leaf x) :: _) = x
+  | head ((_, Node (x, _, _)) :: _) = x
+  | head _ = raise Empty
+
+fun tail ((1, Leaf _) :: ts) = ts
+  | tail ((w, Node (x, t1, t2)) :: ts) = (w div 2, t1) :: (w div 2, t2) :: ts
+  | tail _ = raise Empty
+
+fun getTree (1, 0, Leaf x) = x
+  | getTree (w, i, Leaf x) = raise Subscript
+  | getTree (w, 0, Node (x, t1, t2)) = x
+  | getTree (w, i, Node (x, t1, t2)) =
+
+    if i <= w div 2 then
+        getTree (w div 2, i - 1, t1)
+    else
+        getTree (w div 2, i - 1 - w div 2, t2)
+
+fun setTree (1, 0, y, Leaf x) = Leaf y
+  | setTree (w, i, y, Leaf x) = raise Subscript
+  | setTree (w, 0, y, Node (x, t1, t2)) = Node (y, t1, t2)
+  | setTree (w, i, y, Node (x, t1, t2)) =
+    if i <= w div 2 then
+        Node (x, setTree (w div 2, i - 1, y, t1), t2)
+    else
+        Node (x, t1, setTree (w div 2, i - 1 - w div 2, y, t2))
+
+fun get (i, []) = raise Subscript
+  | get (i, (w, t) :: ts) =
+    if i < w then
+        getTree (w, i, t)
+    else
+        get (i - w, ts)
+
+fun set (i, y, []) = raise Subscript
+  | set (i, y, (w, t) :: ts) =
+    if i < w then
+        (w, setTree (w, i, y, t)) :: ts
+    else
+        (w, t) :: set (i - w, y, ts)
+end
+
+structure RList =
+struct
+type 'a Coll = (int * 'a UncountedRList.Coll)
+
+val empty = (0, UncountedRList.empty)
+fun isEmpty (0, _) = true
+  | isEmpty _ = false
+fun size (n, _) = n
+
+fun cons (x, (n, s)) = (n+1, UncountedRList.cons (x, s))
+fun head (_, s) = UncountedRList.head s
+fun tail (n, s) = (n - 1, UncountedRList.tail s)
+fun get (i, (n, s)) = UncountedRList.get (i, s)
+fun set (i, y, (n, s)) = (n, UncountedRList.set (i, y, s))
+fun fromList list = List.foldr cons empty list
+end
+
 structure CharMap = Map(
     struct
     type t = char
@@ -153,3 +227,11 @@ structure StringMap = Map(
     end)
 
 structure StringSet = Set(StringMap)
+
+structure IntMap = Map(
+    struct
+    type t = int
+    val cmp = Int.compare
+    end)
+
+structure IntSet = Set(IntMap)