more

day3.pl

@@ -0,0 +1,79 @@
+char(X, L, C0, L, C) -->
+  [X0], {X0 \= 0'\n, char_code(X, X0), C is C0 + 1}, !.
+
+digit(D, L0, C0, L, C) --> char(D, L0, C0, L, C), {char_type(D, digit)}.
+
+digits([D|Ds], L0, C0, L, C) -->
+  digit(D, L0, C0, L1, C1),
+  digits0(Ds, L1, C1, L, C).
+digits0(Ds, L0, C0, L, C) --> digits(Ds, L0, C0, L, C).
+digits0([], L,  C,  L, C) --> [].
+
+newline(L0, _, L, 0) --> "\n", {L is L0 + 1}.
+
+num(n(N, L-C0-C1), L, C0, L, C) -->
+  digits(Ds, L, C0, L, C), !,
+  {number_chars(N, Ds), C1 is C - 1}.
+
+dot(L0, C0, L, C) --> char('.', L0, C0, L, C).
+
+sym(s(X, L-C0), L, C0, L, C) -->
+  char(X, L, C0, L, C),
+  {\+ char_type(X, digit), X \= '.'}.
+
+thing(X, L0, C0, L, C) --> num(X, L0, C0, L, C).
+thing(X, L0, C0, L, C) --> sym(X, L0, C0, L, C).
+
+nonthing(L0, C0, L, C) --> dot(L0, C0, L, C).
+nonthing(L0, C0, L, C) --> newline(L0, C0, L, C).
+
+input([], L, C, L, C) --> [].
+
+input([I|Is], L0, C0, L, C) -->
+  thing(I, L0, C0, L1, C1), !,
+  input(Is, L1, C1, L, C).
+
+input(Is, L0, C0, L, C) -->
+  nonthing(L0, C0, L1, C1), !,
+  input(Is, L1, C1, L, C).
+
+input(Is) --> input(Is, 0, 0, _, _).
+
+
+adjacent(LN-CN0-CN1, LS-CS) :-
+  LLo is LN  - 1, LHi is LN  + 1, LS >= LLo, LS =< LHi,
+  CLo is CN0 - 1, CHi is CN1 + 1, CS >= CLo, CS =< CHi.
+
+part_number(N) :-
+  n(N, NLoc), s(_, SLoc), adjacent(NLoc, SLoc).
+
+number_next_to(N, SLoc) :-
+  n(N, NLoc), adjacent(NLoc, SLoc).
+
+gear(Ratio) :-
+  s('*', SLoc),
+  bagof(N, number_next_to(N, SLoc), [A, B]),
+  Ratio is A * B.
+
+
+parse_setup(File) :- parse(File, Items), setup(Items).
+
+parse(File, Items) :- phrase_from_file(input(Items), File), !.
+
+setup(Items) :-
+  transaction((abolish(n/2), abolish(s/2), maplist(assert, Items))).
+:- dynamic n/2, s/2.
+
+sum(Xs, X) :- foldl(plus, Xs, 0, X).
+
+part1(File) :-
+  parse_setup(File),
+  bagof(N, part_number(N), Ns),
+  sum(Ns, Total),
+  writeln(Total).
+
+part2(File) :-
+  parse_setup(File),
+  bagof(R, gear(R), Rs),
+  sum(Rs, Total),
+  writeln(Total).

day4.quox

@@ -29,8 +29,8 @@ def split-line : ω.String → Line =
 def mem : ω.ℕ → ω.(List ℕ) → Bool =
   λ n ⇒ list.foldlω ℕ Bool 'false (λ b n' ⇒ bool.or b (nat.eq n n'))
 
-def all-members : ω.(List ℕ) → ω.(List ℕ) → List ℕ =
-  λ g w ⇒ list.filter ℕ (λ n ⇒ mem n w) g
+def all-members : ω.Line → List ℕ =
+  λ ln ⇒ list.filter ℕ (λ n ⇒ mem n (snd ln)) (fst ln)
 
 def score-from-len : ω.(List ℕ) → ℕ =
   λ xs ⇒
@@ -39,16 +39,63 @@ def score-from-len : ω.(List ℕ) → ℕ =
       (list.uncons ℕ xs)
 
 def score : ω.Line → ℕ =
-  λ ln ⇒ score-from-len (all-members (fst ln) (snd ln))
+  λ ln ⇒ score-from-len (all-members ln)
 
 def total-score : ω.(List Line) → ℕ =
   list.foldlω Line ℕ 0 (λ n l ⇒ nat.plus n (score l))
 
+def part1 =
+  io.bindω String True
+    (io.read-fileω "in/day4")
+    (λ s ⇒ io.dump (List Line)
+      (letω lines = string.split (char.eq char.newline) s;
+            lines = list.mapω String Line split-line lines in
+       lines))
+
+
+def0 Copies : ★ = List ℕ
+
+def CNil  = list.Nil  ℕ
+def CCons = list.Cons ℕ
+
+def decr-copies : Copies → ℕ × Copies =
+  let0 Ret : ★ = ℕ × Copies in
+  list.foldr ℕ Ret (1, CNil)
+    (λ cur nrest ⇒
+      case nrest return Ret of { (n, rest) ⇒
+      case cur return Ret of {
+        0        ⇒ (n, rest);
+        succ cur ⇒ (succ n, CCons cur rest)
+      }})
+
+def new-copies : ℕ → ω.ℕ → Copies → Copies =
+  λ count value cs ⇒
+    case count return Copies of {
+      0           ⇒ cs;
+      succ _, cs' ⇒ CCons value cs'
+    }
+
+def total-cards : ω.(List Line) → ℕ =
+  λ lines ⇒
+    let 0.State : ★ = ℕ × Copies;
+        ω.start : State = (0, CNil);
+        ω.next  : ω.State → ω.Line → State =
+          λ st ln ⇒
+            letω total = fst st;
+                 nc = decr-copies (snd st);
+                 copies-this = fst nc;
+                 copies-rest = snd nc;
+                 score1 = list.length ℕ (all-members ln);
+                 copies-out = new-copies copies-this score1 copies-rest;
+                 total' = nat.plus total copies-this in
+            (total', copies-out) in
+    fst (list.foldlω Line State start next lines)
+
 #[main]
-def main =
+def part2 =
   io.bindω String True
     (io.read-fileω "in/day4")
     (λ s ⇒ io.dump ℕ
       (letω lines = string.split (char.eq char.newline) s;
             lines = list.mapω String Line split-line lines in
-       total-score lines))
+       total-cards lines))

unfinished/day8.quox

@@ -0,0 +1,50 @@
+load "bool.quox"
+load "string.quox"
+load "maybe.quox"
+load "io.quox"
+
+def if = bool.if
+
+def Nil = list.Nil; def Cons = list.Cons
+
+def0 Direction : ★ = {left, right}
+
+namespace direction {
+  def from-char : Char → Maybe Direction =
+    λ c ⇒
+      let0 Res = Maybe Direction in
+      letω L = char.from-ℕ 0x4C; R = char.from-ℕ 0x52 in
+      case char.dup c return Res of { [c] ⇒
+        if Res (char.eq c L) (Just Direction 'left)
+          (if Res (char.eq c R) (Just Direction 'right)
+            (Nothing Direction))
+      }
+
+  -- skips unknown characters, e.g. spaces
+  def from-string : String → List Direction =
+    let0 Res = List Direction in
+    λ str ⇒
+      list.foldr Char Res (Nil Direction)
+        (λ c ⇒ maybe.fold Direction (Res → Res)
+          (λ lst ⇒ lst) (Cons Direction) (from-char c))
+        (string.to-list str)
+}
+
+def which : 0.(A : ★) → ω.(A × A) → Direction → A =
+  λ A xy d ⇒ case d return A of { 'left ⇒ fst xy; 'right ⇒ snd xy }
+
+def lookup : 0.(A B : ★) → ω.(ω.A → Bool) → ω.(List (A × B)) → Maybe B =
+  λ A B p ⇒
+    list.foldlω (A × B) (Maybe B) (Nothing B)
+      (λ st x ⇒ maybe.foldω B (Maybe B)
+        (if (Maybe B) (p (fst x)) (Just B (snd x)) (Nothing B))
+        (λ ok ⇒ Just B ok) st)
+
+def0 Map : ★ = List (String × String × String)
+
+def next : ω.Map → ω.String → ω.Direction → Maybe String =
+  λ map here d ⇒
+    maybe.foldω (String × String) (Maybe String)
+      (Nothing String)
+      (λ res ⇒ Just String (which String res d))
+      (lookup String (String × String) (string.eq here) map)