Day 9

aoc2024-eutro.el

@@ -25,7 +25,9 @@
    (when-let ((file-name (buffer-file-name)))
      (and (string-match aoc-dayfile-pattern file-name)
           (string-to-number (match-string 1 file-name))))
-   (cadr (calendar-current-date))))
+   (progn
+     (require 'calendar)
+     (cadr (calendar-current-date)))))
 
 (defun aoc-get-out-buffer (&optional clear day)
   "Get the *aoc-output* buffer."
@@ -39,6 +41,9 @@
         (aoc-run-mode)))
     buf))
 
+(defconst aoc--run-script (expand-file-name "run.sh" aoc-root))
+(defconst aoc--explore-script (expand-file-name "explore.sh" aoc-root))
+
 (defun aoc-run (&optional prefix)
   "Run the current day.
 
@@ -48,11 +53,7 @@ With PREFIX, read input from the buffer."
          (inp-args (when prefix '("--")))
          (buf (aoc-get-out-buffer t day))
          (args (cons (number-to-string day) inp-args))
-         (proc (apply
-                #'start-process
-                "aoc-run" buf
-                (expand-file-name "run.sh" aoc-root)
-                args))
+         (proc (apply #'start-process "aoc-run" buf aoc--run-script args))
          (win (selected-window)))
     (set-process-sentinel
      proc
@@ -65,6 +66,43 @@ With PREFIX, read input from the buffer."
         (display-buffer buf 'display-buffer-use-least-recent-window)))
     (message "./run.sh %s" (string-join (mapcar #'shell-quote-argument args) " "))))
 
+(defun aoc-explore--filter (proc output)
+  (with-current-buffer (process-buffer proc)
+    (insert output)))
+
+(defun aoc-explore--sentinel (proc status)
+  (message status))
+
+(defun aoc-explore (what)
+  "Start an interactive explorer on WHAT for the current day."
+  (interactive "MExplore: ")
+  (let* ((day (aoc-day-number))
+         (args (list aoc--explore-script what (number-to-string day)))
+         (buf (get-buffer-create "*aoc-explore*"))
+         (proc (get-buffer-process buf)))
+    (when (process-live-p proc)
+      (quit-process proc))
+    (with-current-buffer buf
+      (erase-buffer)
+      (setq aoc-pinned-day-number day)
+      (org-mode))
+    (setq proc
+          (make-process
+           :name "aoc-explore"
+           :buffer buf
+           :command args
+           :filter #'aoc-explore--filter
+           :sentinel #'aoc-explore--sentinel))
+    (pop-to-buffer buf 'display-buffer-use-least-recent-window)))
+
+(defun aoc-follow-link (path prefix)
+  "Follow the AoC link PATH with universal PREFIX argument."
+  (aoc-explore link))
+
+(with-eval-after-load 'ol
+  (setf (alist-get "aoc2024eutro" org-link-parameters nil nil #'equal)
+        (list :follow #'aoc-follow-link)))
+
 (defun aoc-copy-part-answer (part)
   "Copy the answer for the given PART from *aoc-output*."
   (with-current-buffer (aoc-get-out-buffer)

days/day09.st

@@ -0,0 +1,117 @@
+Object subclass: DriveBase [
+    | ids |
+    ids [^ids]
+    diskSize [^ids size]
+    idAt: i [^ids at: i]
+
+    isEmpty: i [^(ids at: i ifAbsent: [1]) isNil]
+    isFull: i [^(ids at: i ifAbsent: [nil]) isNil not]
+
+    addBlock: id length: len [ len timesRepeat: [ids add: id] ]
+    addFreeLength: len [ len timesRepeat: [ids add: nil] ]
+
+    mappingPos [^ids size]
+    map: diskMap
+    [ | id toPut len |
+      ids := OrderedCollection new.
+      id := 0. toPut := id.
+      diskMap do: [
+          :c | len := c digitValue.
+          toPut
+              ifNil: [self addFreeLength: len.
+                      id := id + 1.
+                      toPut := id]
+              ifNotNil: [self addBlock: id length: len.
+                         toPut := nil] ].
+      ids := ids asArray ]
+
+    checksum
+    [ ^((1 to: self diskSize) collect:
+            [ :i | (self idAt: i) ifNil: [0] ifNotNil: [:x | (i - 1) * x] ])
+           sum ]
+
+    compress
+    [ | end | end := ids size.
+      [ self isEmpty: end ] whileTrue: [ end := end - 1 ].
+      ids := (1 to: end) collect: [ :i | ids at: i ].
+      ^ids ]
+
+    printOn: st
+    [ (1 to: self diskSize) do:
+          [ :i | (self idAt: i) ifNil: [st << '. '] ifNotNil: [:id | st << id << ' '] ] ]
+]
+
+DriveBase subclass: DriveP1 [
+    compact
+    [ | start end |
+      start := 1. end := ids size.
+      [ true ] whileTrue: [
+          [ self isFull: start ] whileTrue: [ start := start + 1 ].
+          [ self isEmpty: end ] whileTrue: [ end := end - 1 ].
+          end > start ifFalse: [^self compress].
+          ids at: start put: (ids at: end).
+          ids at: end put: nil ]]
+]
+
+Link subclass: Block [
+    | pos len |
+    pos: p [pos:=p]
+    pos [^pos]
+    len: n [len:=n]
+    len [^len]
+
+    fillFree: by [pos := pos + by. len := len - by]
+    isEmpty [^len = 0]
+
+    printOn: st [st << '#[' << len << ']@' << pos]
+]
+
+DriveBase subclass: DriveP2 [
+    | freeList idMap lastId |
+    map: m
+    [ freeList := LinkedList new.
+      idMap := Dictionary new.
+      super map: m ]
+
+    newBlock: len [^Block new pos: self mappingPos; len: len]
+
+    addBlock: id length: len
+    [ | block | block := self newBlock: len.
+      idMap at: id put: block.
+      lastId := id.
+      super addBlock: id length: len ]
+    addFreeLength: len
+    [ freeList add: (self newBlock: len).
+      super addFreeLength: len ]
+
+    compact
+    [ (lastId to: 0 by: -1) do: [:id | self compactBlock: id].
+      self compress ]
+
+    moveBlock: block to: free
+    [ (1 to: block len) do:
+          [ :off |
+            ids at: free pos + off put: (ids at: block pos + off).
+            ids at: block pos + off put: nil.
+            "Do not create a free space where the block was moved from
+            -- all of the blocks that will be moved are on the left"
+          ].
+      free fillFree: block len.
+      free isEmpty ifTrue: [freeList remove: free] ]
+
+    compactBlock: id
+    [ | block | block := idMap at: id.
+      freeList do: [
+          :free |
+          free pos > block pos ifTrue: [^self].
+          free len >= block len ifTrue: [
+              self moveBlock: block to: free.
+              ^self
+          ]]]
+]
+
+AOC input: [ stdin nextLine ];
+    part1: DriveP1;
+    part2: DriveP2;
+    result: [ :map :Drive | Drive new map: map; compact; checksum ];
+    finish.

days/interaction.st

@@ -1,21 +1,21 @@
 Object subclass: ExplorerStream [
     | stream objects | on: aStream
-    [ stream := aStream.
-      objects := OrderedCollection new. ]
+    [ stream := aStream. objects := OrderedCollection new. ]
 
-    title: title [ stream << '# ' << title ; nl. ]
-    subtitle: block [ stream << '**'. block value. stream << '**'; nl; nl. ]
+    title: title [ stream << '* ' << title; nl. ]
+    subtitle: block [ stream << '- '. block value. stream nl; nl. ]
     text: text [ text displayOn: stream ]
     nl [ stream nl ]
+    flush [ stream flush ]
 
     linkTextTo: obj name: text
-    [ |r| r := '[%1][%2]' % {text . objects size}.
+    [ |r| r := '[[aoc2024eutro:objects/%2][%1]]' % {text . objects size}.
       objects add: obj. ^r ]
 
     linkTo: obj name: text [ self text: (self linkTextTo: obj name: text). ]
 
-    section: title do: block [ self text: '## '; text: title; nl. block value ]
-    ssection: title do: block [ self text: '### '; text: title; nl. block value ]
+    section: title do: block [ self text: '** '; text: title; nl. block value ]
+    ssection: title do: block [ self text: '*** '; text: title; nl. block value ]
 ]
 ExplorerStream class extend [ on: stream [ ^super new on: stream ] ]
 
@@ -59,8 +59,45 @@ Class extend [
               :selector | | method |
               exs ssection: selector asString do:
                   [ (self sourceCodeAt: selector ifAbsent: [nil])
-                        ifNotNil: [ :source | exs text: source ]
+                        ifNotNil: [
+                      :source |
+                      exs
+                      text: '#+begin_src smalltalk'; nl;
+                      text: source; nl;
+                      text: '#+end_src'
+                  ]
                         ifNil: [ exs text: 'No source available.' ] ]; nl; nl.
           ] ]
     ]
 ]
+
+Object subclass: Explorer [
+    | what obj estream | what: n [what:=n]
+
+    explore
+    [ obj := Namespace current at: what ifAbsent: [nil].
+      obj ifNil: [self reportNotFound]
+          ifNotNil: [self doExplore].
+      self exploreLoop ]
+
+    exploreLoop
+    [ | line |
+      [ stdin atEnd ] whileFalse: [
+          line := stdin nextLine.
+          line printNl.
+      ]]
+
+    reportNotFound
+    [ stdout << what << ' is undefined.'; nl ]
+    doExplore
+    [ estream := ExplorerStream on: stdout.
+      obj emacsExploreOn: estream.
+      estream flush.
+    ]
+]
+
+AOC action: 'explore' do:
+    [ | what |
+      what := (Smalltalk getenv: 'AOC_WHAT') ifNil: ['Object'].
+      what := Symbol intern: what.
+      Explorer new what: what; explore ]

days/utils.st

@@ -1,7 +1,7 @@
 "--- AOC helper class ---"
 Object subclass: AOC []
 AOC class extend [
-    | savedP1 savedP2 mapper getInput |
+    | savedP1 savedP2 mapper getInput actionDict |
     input: inpBlock [ getInput := inpBlock ]
     part1: p1Block [ savedP1 := p1Block ]
     part2: p2Block [ savedP2 := p2Block ]
@@ -19,12 +19,19 @@ AOC class extend [
       self runPart: savedP1 part: 1 arg: inp.
       self runPart: savedP2 part: 2 arg: inp. ]
 
+    action: name do: block
+    [ actionDict ifNil: [actionDict := Dictionary new].
+      actionDict at: name put: block ]
+
     "TODO: save as an image?"
     finish
-    [ | startTime stopTime |
-      (Smalltalk getenv: 'AOC_RUN') ifNil: [
+    [ | startTime stopTime action |
+      action := (Smalltalk getenv: 'AOC_RUN') ifNil: [
           stdout << 'AOC_RUN not set -- not running.'.
           ^nil ].
+      action := actionDict ifNotNil: [ :ad | ad at: action ifAbsent: [nil] ].
+      action ifNotNil: [ ^action value ].
+
       startTime := Time millisecondClock.
       self run.
       stopTime := Time millisecondClock.

explore.sh

@@ -0,0 +1,11 @@
+#!/usr/bin/env sh
+
+DIR="$(readlink -f "$(dirname "$0")")"
+cd "$DIR" || exit 1
+
+export AOC_RUN='explore'
+export AOC_EXTRA_FILES="$AOC_EXTRA_FILES $DIR/days/interaction.st"
+export AOC_WHAT="$1"
+shift
+
+exec ./run.sh "$@" --

run.sh

@@ -23,6 +23,10 @@ else
 fi
 
 export AOC_VIS="$DIR/vis/day$DAYP"
-export AOC_RUN=1
 
-exec gst -g "days/utils.st" "days/day$DAYP.st" < "$AOC_INPUT"
+export AOC_RUN
+if [ -z "$AOC_RUN" ] ; then
+    AOC_RUN=1
+fi
+
+exec gst -g "days/utils.st" $AOC_EXTRA_FILES "days/day$DAYP.st" < "$AOC_INPUT"