December Adventure 2024

This is my log for December Adventure. I don’t have a clear plan for the contents, we’ll see where it goes :)

The December Adventure is low key. The goal is to write a little bit of code every day in December.
–– Eli Mellen

Dec 31

Big gap for the update, but I didn’t really touch computers over the vacation. So I’ll finish up with AoC 2024 day 23 in Prolog. Just part one though :)

The solution is, like the others, quite short:

link(X-Y) :- conn(X-Y); conn(Y-X).

triangle(A-B-C) :-
  link(A-B),
  link(B-C),
  link(A-C),
  A @< B, B @< C.

starts_with_t([t | _ ]).

t_triangle(A-B-C) :-
  triangle(A-B-C),
  once((starts_with_t(A) ; starts_with_t(B) ; starts_with_t(C))).

solve1(Count) :-
  findall((A-B-C), t_triangle(A-B-C), Triangles),
  length(Triangles, Count).

We start out by making the connections bidirectional with the link predicate. We then provide the triangle query to find all groups of three computers – to prevent getting duplicates, we establish an ordering for the nodes.

From these found triangles, we filter out any groups that don’t contain a t as the first letter. Solving is then simply counting these t_triangles.

I ran into some problems with the t_triangle predicate producing too many results; the key was once to ensure we stop early.

These small exercises have really taught me a lot of Prolog, really neat!

That’s all, thanks!

Dec 17 & 18

I did AoC 2024 day 17 across two days, but didn’t get to finish part 2 of it. I didn’t bother brute forcing. Also I skipped parsing anything as the inputs were so small

:- use_module(library(lists)).
:- use_module(library(clpz)).

load_program(short, vm_state(0, [729,0,0], [0,1,5,4,3,0], [])).

solve1(Program) :-
  load_program(Program, State),
  run(State).

op_operand(vm_state(IP, _, Mem, _), Op, Operand) :-
  OperandIdx #= IP + 1,
  nth0(IP, Mem, Op),
  nth0(OperandIdx, Mem, Operand), !.

run(State) :-
  op_operand(State, Op, Operand),
  execute(Op, Operand, State, NextState),
  run(NextState), !.
run(vm_state(_, _, _, Out)) :- write(Out), nl.


get_value(Op, _, Op) :- Op #< 4.
get_value(4, [A,_,_], A).
get_value(5, [_,B,_], B).
get_value(6, [_,_,C], C).

% adv
execute(0, Op, vm_state(IP, [A,B,C], Mem, Out), vm_state(NextIP, [NewA,B,C], Mem, Out)) :-
  NextIP #= IP + 2,
  get_value(Op, [A,B,C], Val),
  NewA #= A >> Val.

% bxl
execute(1, Op, vm_state(IP, [A,B,C], Mem, Out), vm_state(NextIP, [A,NewB,C], Mem, Out)) :-
  NextIP #= IP + 2,
  NewB #= B xor Op.

% bst
execute(2, Op, vm_state(IP, [A,B,C], Mem, Out), vm_state(NextIP, [A,NewB,C], Mem, Out)) :-
  NextIP #= IP + 2,
  get_value(Op, [A,B,C], Val),
  NewB #= Val mod 8.

% jnz
execute(3, Target, vm_state(IP, [A,B,C], Mem, Out), vm_state(NextIP, [A,B,C], Mem, Out)) :-
  (A #\= 0 -> NextIP = Target ; NextIP #= IP + 2).

% bxc
execute(4, _, vm_state(IP, [A,B,C], Mem, Out), vm_state(NextIP, [A,NewB,C], Mem, Out)) :-
  NextIP #= IP + 2,
  NewB #= B xor C.

% out
execute(5, Op, vm_state(IP, Regs, Mem, Out), vm_state(NextIP, Regs, Mem, NewOut)) :-
  NextIP #= IP + 2,
  get_value(Op, Regs, Val),
  Value #= Val mod 8,
  (Out = [] -> NewOut = [Value] ; append(Out, [Value], NewOut)).

% bdv
execute(6, Op, vm_state(IP, [A,B,C], Mem, Out), vm_state(NextIP, [A,NewB,C], Mem, Out)) :-
  NextIP #= IP + 2,
  get_value(Op, [A,B,C], Val),
  NewB #= A >> Val.

% cdv
execute(7, Op, vm_state(IP, [A,B,C], Mem, Out), vm_state(NextIP, [A,B,NewC], Mem, Out)) :-
  NextIP #= IP + 2,
  get_value(Op, [A,B,C], Val),
  NewC #= A >> Val.

This all works pretty well. The VM is initialized by the atom of load_program, so we solve by running solve1(short). I made sure to use the #=/2 operator from clpz for all assignments since I was hoping for part 2 that I could use constraint solving to find the register A for part 2.

That didn’t really work - at least not well enough!

solve2(A) :-
  Program = [0,3,5,4,3,0],
  A in 1..10000000000,
  A mod 8 #= 0,
  State = vm_state(0, [A,0,0], Program, []),
  run(State),
  vm_state(_, _, Program, Program) = State,
  labeling([min(A)], [A]).

I don’t really want to invest too much time into this, but I think this sort of thing is perfect for clpz, SMT solvers or even symbolic execution. After this not going as expected, I saw some people did something similar in Prolog too, but I don’t plan on just copying it entirely :)

Here’s the solution that uses constraint solving. They add “fuel” for limiting computation and “residuals” which consist of all intermediate registers. Clever!

Edit: I ran the code linked above - it immediately solves in SWI-Prolog, but not in Scryer! Perhaps my original code would have worked in SWI?

Dec 14

Didn’t expect to have this much fun with AoC. Did 2024 day 14 today. Again in Prolog because it hasn’t let me down yet.

:- use_module(library(clpz)).

final_pos(robot(P,Q,VX,VY), Width, Height, T, pos(X,Y)) :-
  X #= ((P + VX * T mod Width) + Width) mod Width,
  Y #= ((Q + VY * T mod Height) + Height) mod Height.

in_quad(MidW, MidH, 1, pos(X,Y)) :- X #< MidW, Y #< MidH.
in_quad(MidW, MidH, 2, pos(X,Y)) :- X #> MidW, Y #< MidH.
in_quad(MidW, MidH, 3, pos(X,Y)) :- X #< MidW, Y #> MidH.
in_quad(MidW, MidH, 4, pos(X,Y)) :- X #> MidW, Y #> MidH.

step_safety_factor(SafetyFactor, Time, Width, Height) :-
  robots(Robots),
  findall(
    pos(X,Y),
    (member(R, Robots), final_pos(R, Width, Height, Time, pos(X,Y))),
    Positions
  ),

  MidW #= Width // 2,
  MidH #= Height // 2,

  findall(P, (member(P, Positions), in_quad(MidW, MidH, 1, P)), Q1), length(Q1, C1),
  findall(P, (member(P, Positions), in_quad(MidW, MidH, 2, P)), Q2), length(Q2, C2),
  findall(P, (member(P, Positions), in_quad(MidW, MidH, 3, P)), Q3), length(Q3, C3),
  findall(P, (member(P, Positions), in_quad(MidW, MidH, 4, P)), Q4), length(Q4, C4),

  SafetyFactor #= C1 * C2 * C3 * C4.

solve1(Answer) :- step_safety_factor(Answer, 100, 101, 103).

We start out by defining how to calculate the safety product. We do this by:

The answer is simply just going 100 time steps ahead on a board that is 101x103 tiles.

I didn’t like part 2 that much. I didn’t really know what this tree was going to look like, so I tried a couple of different things. I ended up consulting other solutions to find a way to do it without too much hassle (i.e., brute force). I simply find the first time step that provides a unique configuration of positions. It’s very inefficient in Prolog to do it this way.

:- use_module(library(between)).

solve2(Answer) :-
  between(1, 10000, T),
  robots(Robots),
  findall(
    Pos,
    ( member(R, Robots),
      final_pos(R, 101, 103, T, pos(X,Y)),
       Pos #= X * 103 + Y
    ),
    Positions
  ),
  all_different(Positions),
  Answer = T, !.

It takes a while to find the result. I was hoping that clpz might be of use here, but modeling the problem with T being a finite domain doesn’t help at all since we still have to enumerate all time steps one by one with this technique.

Would like to see a nicer way! Also, parsing is getting nicer. I found out about the | alternative syntax which I didn’t see in the documentation before.

:- use_module(library(dcgs)).
:- use_module(library(charsio)).
:- use_module(library(pio)).

load_input(File) :-
    retractall(robot(_, _, _, _)),
    phrase_from_file(input, File), !.

input --> robots(Rs), { retractall(robots(_)), assertz(robots(Rs)) }.

robots([R|Rs]) -->
  robot(R), white, robots(Rs)
  | robot(R), { Rs = [] }
  | { R = [], Rs = [] }.

robot(robot(X,Y,VX,VY)) -->
  "p=", number(X), ",", number(Y)," v=", number(VX), ",", number(VY).

number(N) -->
  "-", digits(Ds), { number_chars(N1, Ds), N #= -N1 }
  | digits(Ds), { number_chars(N, Ds) }.

digits([D|Ds]) -->
  [D], { char_type(D, decimal_digit) }, digits(Ds)
  | [D], { char_type(D, decimal_digit) }, { Ds = [] }.

white -->
  [W], { char_type(W, whitespace) }, white
  | [].

Dec 13

Wanted to do another AoC in Prolog today, 2024 day 13. It seemed like an integer constraint problem, which is easily done with CLP(ℤ).

It was surprisingly easy again today

:- use_module(library(clpz)).
:- use_module(library(lists)).

constraint(config((AX-AY),(BX-BY), (PX-PY)), Offset, Solution) :-
  NA #>= 0 #/\ NB #>= 0,
  Offset #= 0 #==> (NA #=< 100 #/\ NB #=< 100),

  NA * AX + NB * BX #= PX + Offset,
  NA * AY + NB * BY #= PY + Offset,

  MinCost #= NA * 3 + NB * 1,
  labeling([min(MinCost)], [NA, NB]),

  Solution is MinCost.

solve_sum(Offset, Sum) :-
  findall(Cost, (config(A,B,P), constraint(config(A,B,P), Offset, Cost)), Costs),
  sum_list(Costs, Sum).

solve1(Sum) :- solve_sum(0, Sum).
solve2(Sum) :- solve_sum(10000000000000, Sum).

That’s the solution for both problems! We just define the constraints of the problem:

Extremely satisfying that so much work is handled by so little code.

And parsing input:

:- use_module(library(dcgs)).
:- use_module(library(charsio)).
:- use_module(library(pio)).

load_input(File) :-
    retractall(config(_, _, _)),
    phrase_from_file(input, File), !.

input --> sections.

sections --> section, white, sections.
sections --> [].

section -->
    button_a_line(AX, AY), white,
    button_b_line(BX, BY), white,
    prize_line(PX, PY),
    { assertz(config((AX-AY),(BX-BY), (PX-PY))) }.

button_a_line(X, Y) --> "Button A: X+", number(X), ", Y+", number(Y).

button_b_line(X, Y) --> "Button B: X+", number(X), ", Y+", number(Y).

prize_line(X, Y) --> "Prize: X=", number(X), ", Y=", number(Y).

number(N) --> digits(Ds), { number_chars(N, Ds) }.
digits([D|Ds]) --> [D], { char_type(D, decimal_digit) }, digits(Ds).
digits([D]) --> [D], { char_type(D, decimal_digit) }.

white --> [W], { char_type(W, whitespace) }, white.
white --> [].

Very similar to yesterday, DCGs are making more sense now, but still sort of strange. By the way, the AX-AY is syntax for pairs.

Prolog bonus:

Since the solution is defined in terms of CLP(ℤ), we can use the definitions to generate problems. For example, generating all problems where the minimum cost is 220:

?- constraint(config((AX-AY),(BX-BY), (PX-PY)), 0, 220).
   clpz:(40*AX#=_A), clpz:(_A+_B#=PX), clpz:(100*BX#=_B), clpz:(40*AY#=_C), clpz:(_C+_D#=PY), clpz:(100*BY#=_D)
;  clpz:(41*AX#=_A), clpz:(_A+_B#=PX), clpz:(97*BX#=_B), clpz:(41*AY#=_C), clpz:(_C+_D#=PY), clpz:(97*BY#=_D)
;  clpz:(42*AX#=_A), clpz:(_A+_B#=PX), clpz:(94*BX#=_B), clpz:(42*AY#=_C), clpz:(_C+_D#=PY), clpz:(94*BY#=_D)
;  ... .

By unbinding the Solution (220), we can even go through all solutions for all minimum costs. That’s amazing!

Dec 12

I did AoC 2024 day 5 today. This time in (Scryer) Prolog since the ordering part of the problem seemed like a database of facts and checking the pages seemed like querying the database.

I sat down and solved the ordering first, which was very simple without the parsing!

:- use_module(library(lists)).

middle_item(List, Middle) :-
  length(List, Length),
  Position is Length // 2,
  nth0(Position, List, Middle).

in_order([A,B|Xs]) :- page_order(A,B), in_order([B|Xs]).
in_order([_]).
in_order([]).

solve1(Sum) :-
  findall(Xs, (pages(Xs), in_order(Xs)), OrderedLists),
  maplist(middle_item, OrderedLists, Middles),
  sum_list(Middles, Sum).

This assumes facts in the shape page_order(X,Y) for all the page orderings, and pages([_]) for page numbers. The predicate in_order works by checking elements of page numbers per update, recursively making sure that each pair of numbers satisfies a page_order to be considered “in order”. Solving puzzle one is all about filtering for pages/1 that are in_order/1 and extracting the middle element of those for summation - here we use the stdlib for lists.

For the second part, we have to fix unordered page numbers. We can apply the same utilities and use a helper:

fix_list(List, Result) :-
  % If we can fix
  (fix_pair(List, Fixed) ->
    % Keep fixing recursively
    fix_list(Fixed, Result)
  % Otherwise we have hit a fixpoint
  ; Result = List).

fix_pair([A,B|Rest], [B,A|Rest]) :-
  page_order(B,A), !.
fix_pair([A|Rest], [A|Fixed]) :-
  fix_pair(Rest, Fixed).

solve2(Sum) :-
  findall(Xs, (pages(Xs), \+ in_order(Xs)), UnorderedLists),
  maplist(fix_list, UnorderedLists, OrderedLists),
  maplist(middle_item, OrderedLists, Middles),
  sum_list(Middles, Sum).

The structure is somewhat similar - we filter pages/1 for all facts that are not in_order/1, then fix the list by making pairwise swaps (using the fix_list/2 predicate) and finish off with the same middle-item sum of the fixed ordered lists.

There was some tinkering with fix_list to get it to work properly. We just want to keep trying to swap until we see that the list of page numbers is unchanged. The actual swapping itself is quite simple: given input [A,B|Rest], if it is not in order, swap the items in the result. If the items are in order, we recurse.

That was very short and concise! But we also have to consider parsing the input to the puzzle. This is done with DCGs (Definite Clause Grammars).

It looks pretty wild, but if you squint at it hard enough it looks similar to a BNF grammar.

:- use_module(library(dcgs)).
:- use_module(library(charsio)).
:- use_module(library(pio)).

load_input(File) :-
    % Useful for multiple runs of different files
    retractall(page_order(_, _)),
    retractall(pages(_)),
    phrase_from_file(input, File), !.

input --> white, orderings, white, pages_lists.

orderings --> order, white, orderings.
orderings --> [].

order -->
    number(A), "|", number(B), "\n",
    { assertz(page_order(A, B)) }.

pages_lists --> pages_list, white, pages_lists.
pages_lists --> [].

pages_list -->
    number(N), numbers(Ns), "\n",
    { assertz(pages([N|Ns])) }.

numbers([N|Ns]) --> ",", number(N), numbers(Ns).
numbers([]) --> [].

number(N) --> digits(Ds), { number_chars(N, Ds) }.
digits([D|Ds]) --> [D], { char_type(D, decimal_digit) }, digits(Ds).
digits([D]) --> [D], { char_type(D, decimal_digit) }.

white --> [W], { char_type(W, whitespace) }, white.
white --> [].

We use char_type/2 from the charsio library to categorize the input we see and assertz any new facts as we parse the input, ignoring any whitespace. I didn’t find an easier way to parse the digits. It still feels kind of foreign for me to use. Markus Triska’s online prolog resource is a great place to find info on this stuff.

Putting this together, we can run the following in the REPL to solve

?- load_input('input/day05'), solve1(Sum1), solve2(Sum2).
   Sum1 = 5639, Sum2 = 5273.

Dec 11

A bit of a break from writing, but today I did day 3 of AoC in Roc, which was fun!

parseJunk =
    Parser.const (Err {})
    |> Parser.skip (String.anyCodeunit)
    |> Parser.skip (Parser.chompWhile \b -> b != 'm' && b != 'd')

parseMul =
    Parser.const \x -> \y -> Ok (Mul { x, y })
    |> Parser.skip (String.string "mul(")
    |> Parser.keep String.digits
    |> Parser.skip (String.string ",")
    |> Parser.keep String.digits
    |> Parser.skip (String.string ")")

parseDo =
    Parser.const (Ok (Do))
    |> Parser.skip (String.string "do()")

parseDont =
    Parser.const (Ok (Dont))
    |> Parser.skip (String.string "don't()")

parseInput = Parser.oneOf [parseMul, parseDo, parseDont, parseJunk] |> Parser.many

calcPart1 = \vals ->
    List.keepOks vals (\x -> x)
    |> List.walk
        (0, true)
        (\(acc, should), current ->
            when current is
                Mul { x, y } -> (acc + x * y, should)
                _ -> (acc, should)
        )

calcPart2 = \vals ->
    List.keepOks vals (\x -> x)
    |> List.walk
        (0, true)
        (\(acc, should), current ->
            when current is
                Mul { x, y } -> (acc + x * y, should)
                Do -> (acc, true)
                Dont -> (acc, false)
                _ -> (acc, should)
        )

The language is pretty nice considering how WIP it is. Some parts of the dev experience is a little rough but overall it is quite nice!

Dec 08

Continuing from yesterday, I completed the compilation and execution steps and solved the simple part of the correctness proof.

-- From the lean book
inductive Vect (α : Type u) : {_ : Nat} -> Type u where
   | nil : @Vect α 0
   | cons : α → @Vect α n → @Vect α (n + 1)
   deriving Repr

def stack (n: Nat) := @Vect Int n

def empty_stack : stack 0 := @Vect.nil Int

mutual
  -- The nats here track number of ints on the stack.
  -- Since we don't have heterogeneous stacks, we can do this.
  inductive Op : (s: Nat) → (s': Nat) → Type
    | PUSH : Int → Op s (Nat.succ s)
    | ADD : Op (Nat.succ (Nat.succ s)) (Nat.succ s)
    | EQ: Op (Nat.succ (Nat.succ s)) (Nat.succ s)
    | IF : Code s s' → Code s s' → Op (Nat.succ s) s'
    deriving Repr

  inductive Code : (s: Nat) → (s': Nat) → Type where
    | nil : Code s s
    | cons : Op s s' → Code s' s'' → Code s s''
    deriving Repr
end

mutual
  def exec_op {s s' : Nat} (c: Op s s') (st : stack s): stack s' :=
    match c, st with
    | Op.PUSH n, st => Vect.cons n st
    | Op.IF c1 c2, Vect.cons b st =>
      if intToBool b then exec c1 st else exec c2 st
    | Op.ADD, Vect.cons e1 (Vect.cons e2 st) =>
      Vect.cons (e1 + e2) st
    | Op.EQ, Vect.cons e1 (Vect.cons e2 st) =>
      Vect.cons ((e1 == e2).toNat) st

  def exec {s s' : Nat} (c: Code s s') (st : stack s): stack s' :=
    match c with
    | Code.nil => st
    | Code.cons op c' => exec c' (exec_op op st)
end

def append {s s' s'' : Nat} : Code s s' → Code s' s'' → Code s s''
| Code.nil, c => c
| Code.cons x xs, c => Code.cons x (append xs c)

def compile : Exp → Code n (Nat.succ n)
| Exp.val_exp v => Code.cons (Op.PUSH v) Code.nil
| Exp.plus_exp e1 e2 =>
    append (compile e1)
          (append (compile e2)
                 (Code.cons Op.ADD Code.nil))
| Exp.comp_exp e1 e2 =>
    append (compile e1)
          (append (compile e2)
                 (Code.cons Op.EQ Code.nil))
| Exp.if_exp b e1 e2 =>
    append (compile b)
          (Code.cons (Op.IF (compile e1) (compile e2)) Code.nil)

#eval exec (compile some_simple_exp) empty_stack

theorem exec_compile_eval_correct {n : Nat} (e : Exp) (s : stack n) :
  exec (compile e) s = Vect.cons (eval e) s := by
    induction e  with
    | val_exp v =>
      simp [compile, exec, exec_op]
      rfl

    | plus_exp e1 e2 ih1 ih2 =>
      sorry

    | comp_exp e1 e2 ih1 ih2 =>
      sorry

    | if_exp b e1 e2 ih1 ih2 ih3 =>
      sorry

I found out that the old version with the Val t def can progress if we add @[reducible]. I ran into other roadblocks with that approach, though. So for now this is fine!

The proof is yet to be complete, but I’m happy with the progress so far.

Dec 07

I’m going another route with the Lean compiler I was working on yesterday. I just want to do small increments on something that works.

This is what I reduced down to

inductive Exp where
  | val_exp : Int → Exp
  | plus_exp : Exp → Exp → Exp
  | comp_exp : Exp → Exp → Exp
  | if_exp : Exp → Exp → Exp → Exp

def intToBool (n: Int) : Bool := if n == 0 then True else False

def eval  : Exp → Int
  | Exp.val_exp v => v
  | Exp.plus_exp e1 e2 => eval e1 + eval e2
  | Exp.comp_exp e1 e2 => (eval e1 == eval e2).toNat
  | .if_exp b e1 e2 => if intToBool $ eval b then eval e1 else eval e2

#eval eval (Exp.if_exp (Exp.comp_exp (Exp.val_exp 4) (Exp.val_exp 3)) (Exp.val_exp 42) (Exp.val_exp 5))

The Val t definition above couldn’t really unify easily, it’s clear I shouldn’t be doing that from the type system complaints. Instead this is just a simple interpreter, very simple in fact. I will be adding opcodes for a simple stack machine later. Obviously I can simplify a lot of things because we don’t have heterogeneous stack values in this version of the language. Instead everything is an Int :)

Dec 06

Continued looking at Lean4, wanted to translate the functional pearl I talked about a couple of days ago to Lean, but it didn’t go as smoothly as I expected. “A type-correct, stack-safe, provably correct, expression compiler in Epigram”

This is what I had, translated from the Idris version I made.

inductive TyExp
  | tnat
  | tbool
  deriving Repr

def Val : TyExp → Type
  | .tnat => Nat
  | .tbool => Bool

-- Coercions doesn't address the issue
-- instance : Coe (Val TyExp.tnat) Nat where
--   coe x := x

-- instance : Coe Nat (Val TyExp.tnat) where
--   coe x := x

inductive Exp : TyExp → Type
  | val_exp : Val t → Exp t
  | plus_exp : Exp tnat → Exp tnat → Exp tnat
  | if_exp : Exp tbool → Exp t → Exp t → Exp t

instance : Add (Val tnat) where
  add x y := Nat.add x y
  /- Error here      ^
  application type mismatch
    Nat.add x
  argument
    x
  has type
    Val tnat : Type
  but is expected to have type
    Nat : Type
  -/

def eval {t : TyExp} : Exp t → Val t
  | .val_exp v => v
  | .plus_exp e1 e2 => (eval e1) + (eval e2)
  --                      vvvvvv errors too
  | .if_exp b e1 e2 => if eval b then eval e1 else eval e2

It seems that type coercions aren’t as easy to use in Lean. I tried to use the Coe typeclass, but it didn’t work as I expected.

Hopefully I’ll get some time to look at this more tomorrow.

Dec 05

Today I decided to dig into Lean4. I started out by solving some of the simple Software Foundations induction exercises.

The syntax is very clean (heh), and the tactic language is similar to Coq (Rocq now?).

I did some basic natural number proofs:

theorem add_0_r (n : Nat) : n + 0 = n := by
  induction n <;> simp

theorem minus_n_n (n: Nat) : n - n = 0 := by
  induction n <;> simp

theorem add_comm (n m : Nat) : n + m = m + n := by
  intros
  -- `omega` to take the short path :)
  induction n
  . induction m <;> simp
  . induction m
    . simp
    . rw [Nat.succ_add, Nat.add_succ]
      congr 1

theorem add_assoc (n m p : Nat) : n + (m + p) = (n + m) + p := by
  induction n with
  | zero => rw [add_comm, add_comm]
            simp
  | succ n => omega -- didn't want to think too hard here..

theorem mul_0_r (n: Nat) : n * 0 = 0 := by
  induction n <;> simp

def double (n: Nat) := match n with
  | Nat.zero => Nat.zero
  | Nat.succ n' => Nat.succ (Nat.succ (double n'))

theorem double_plus (n : Nat) : double n = n + n := by
  induction n with
  | zero => rfl
  | succ n ih => simp [double]
                 rw [ih]
                 rw [Nat.succ_add, Nat.succ_add, add_assoc]

I am aware of the “Please do not post solutions to the exercises in a public place” notice in the Software Foundations book.

I will refrain from posting every part of my proofs if I continue with this.

It feels very snappy in the VS Code plugin. When comparing the solutions to my Rocq solutions, there are definitely places where the proof is more concise in Lean4. E.g., the minus_n_n proof in Rocq is:

Theorem minus_n_n : forall n,
  minus n n = 0.
Proof.
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *)
    simpl. reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.

The induction hypothesis is just applied immediately. It seems that the simp in Lean4 may be closer to what simpl + auto does in Rocq in conjunction. Very neat!

Dec 03

Didn’t do a lot today. I updated my nix config a little after updating my flake lock.

I also followed along the API Authentication guide for Phoenix Framework’s mix phx.gen.auth. Was really easy to get working. Not really sure what to do with it though. I have a little playground project going that I want to do some exploration/learning with. Mostly learning about effective domain design and rapid prototyping with LiveView. No code to show though.

Dec 02

Got that correctness proof done! Very exciting. It got a little long, so I’ll rather just link to the commit.

It’s very messy and Idris1 isn’t the best at error messages so I ported to Idris2 and backported once it worked – though both versions are more or less the same.

I also wanted to do something less mind straining, so I did AoC day 1 in Idris2 too

import Data.String

part1 : List (Integer, Integer) -> Integer
part1 loc =
  let (left, right) = unzip loc
      sortedPairs = zip (sort left) (sort right) in
   sum . map (abs . uncurry (-)) $ sortedPairs

part2 : List (Integer, Integer) -> Integer
part2 locs =
    let (left, right) = unzip locs in
    sum $ map (\l => l * cast (count_x l right)) left
    where
      count_x : (Eq t, Foldable m) => t -> m t -> Nat
      count_x v = count (== v)

parse : String -> List (Integer, Integer)
parse = map parseLine . lines
  where
    parseLine str = case words str of
      [l, r] => (cast l, cast r)
      _ => (0, 0)


readInput : IO (List String)
readInput = case !getLine of
  "" => pure []
  line => pure (line :: !readInput)

main : IO ()
main =
  let input = !readInput
      pairs = parse (unlines input)
  in do
    putStrLn $ "Part 1: " ++ show (part1 pairs)
    putStrLn $ "Part 2: " ++ show (part2 pairs)

I especially enjoy the !-notation which acts similar to an inline do-block. It’s syntax sugar that roughly provides (!) : m a -> a. It reminds me of the new ! and ? suffix in Roc. I think it’s a great way to make code more readable and is advantageous over the old backpassing syntax we had before.

That’s all for today. I didn’t want to do much more coding after all that Idris stuff :’)

Dec 01

I did a handful of things today. Not a lot of coding, mostly uni work.

Set the blog up and replaced my old simple placeholder site. I’m using zola with Duckquill which I found very pretty. I stumbled into a fair bit of issues with nothing working in the beginning with a blank zola project, setting some post metas and blog extras did the trick.

Today was mostly writing the technical report for ComRaTT which is a part of a preliminary research project I’m working on with my mate kaep. The project is a compiled functional language that borrows the type system of Async RaTT which our supervisor(s) created. I wrote a couple of typst helper methods to help make the paper a little prettier and consistent. Mostly helper methods like

#let modality_circle(symbol) = {
  let circle-size = 1em
  let text-size = 0.9em
  circle(height:circle-size, stroke: 0.5pt)

  place(center+horizon, dx: -circle-size/2)[
    #set align(center+horizon)
    #set text(size: text-size)
    #box(width: text-size, height: text-size)[$symbol$]
  ]
}

#let mod_exists = modality_circle($exists$)
#let mod_forall = modality_circle($forall$)

#let turns = symbol(
  "⊢",
  ("double", "⊨"),
  ("triple", "⫢")
)

#let darrow = math.arrow.b.double

Typst is such a nice break from LaTeX.

I’ve been holding off working on the correctness proof of a primitive, verified compiler in Idris for a couple of days (not related to above). Hopefully holding back will bring out some ideas to crack the problem once I find time to look at it. Idris is pretty cool! We are basing this work on “functional pearls”

Functional pearls are elegant, instructive examples of functional programming. They are supposed to be fun, and they teach important programming techniques and fundamental design principles [..]

Specifically we’re translating “A type-correct, stack-safe, provably correct, expression compiler in Epigram” into Idris and adding exceptions and let bindings. May show some of that in the coming days.

Rest of the evening will be spent with my lovely wife.