From 3a6a0886d3cf63b7f11a41360cefe69e18af5e07 Mon Sep 17 00:00:00 2001 From: eutro Date: Mon, 9 Dec 2024 09:27:14 +0000 Subject: [PATCH] Day 9 --- aoc2024-eutro.el | 50 ++++++++++++++++--- days/day09.st | 117 ++++++++++++++++++++++++++++++++++++++++++++ days/interaction.st | 53 +++++++++++++++++--- days/utils.st | 13 +++-- explore.sh | 11 +++++ run.sh | 8 ++- 6 files changed, 233 insertions(+), 19 deletions(-) create mode 100644 days/day09.st create mode 100755 explore.sh diff --git a/aoc2024-eutro.el b/aoc2024-eutro.el index 2a578d4..2122693 100644 --- a/aoc2024-eutro.el +++ b/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) diff --git a/days/day09.st b/days/day09.st new file mode 100644 index 0000000..a7c28f0 --- /dev/null +++ b/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. diff --git a/days/interaction.st b/days/interaction.st index 5a8edf1..4821bb8 100644 --- a/days/interaction.st +++ b/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 ] diff --git a/days/utils.st b/days/utils.st index df8fd3a..0afc4ff 100644 --- a/days/utils.st +++ b/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. diff --git a/explore.sh b/explore.sh new file mode 100755 index 0000000..2789a43 --- /dev/null +++ b/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 "$@" -- diff --git a/run.sh b/run.sh index 9811507..e99189a 100755 --- a/run.sh +++ b/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"