Xah Talk Show 2022-12-30 Advent of Code Day 5 B, in Emacs Lisp, Live Coding
(setq xinput " [D]
[N] [C]
[Z] [M] [P]
1 2 3
move 1 from 2 to 1
move 3 from 1 to 3
move 2 from 2 to 1
move 1 from 1 to 2")
(setq xinputParts (split-string xinput "\n\n"))
(setq xBoxesText (nth 0 xinputParts))
(setq xProcedureText (nth 1 xinputParts))
"move 1 from 2 to 1
move 3 from 1 to 3
move 2 from 2 to 1
move 1 from 1 to 2"
(setq xBoxesLineList (split-string xBoxesText "\n"))
(setq
xNumOfColumns
(string-to-number
(car (last
(split-string
(car (last xBoxesLineList)) " +" t) ))))
(setq xBoxesLineList (butlast xBoxesLineList) )
(require 'subr-x)
(setq xBoxMatrix nil)
(mapc
(lambda (yy)
(let ((xx (string-pad yy (* 4 xNumOfColumns) 32))
(xlist nil))
(message "%s" xx)
(while (not (equal (length xx) 0))
(push (string-trim (substring xx 0 4)) xlist)
(setq xx (substring xx 4)))
(setq xlist (reverse xlist))
(message "%s" xlist)
(push xlist xBoxMatrix)))
xBoxesLineList)
(setq xBoxMatrix (reverse xBoxMatrix))
(setq xBoxMatrix
(vconcat
(mapcar
(lambda (x) (vconcat x))
xBoxMatrix)))
(defun xah-make-matrix (Row Col Val)
"Create a matrix of dimensions Row by Col, filled by Val.
The result is lisp vector datatype, each row is also a vector.
URL `http://xahlee.info/emacs/emacs/elisp_transpose.html'
Version 2022-12-29 2022-12-30"
(interactive)
(let (($mtx (make-vector Row Val)))
(dotimes ($i Row $mtx)
(aset $mtx $i (make-vector Col Val)))))
(defun xah-transpose (Matrix)
"Transpose a Matrix.
The Matrix is assumed to be 2D.
Matrix must be a lisp vector datatype, and row are vectors too.
Example:
(xah-transpose [ [1 2 3] [4 5 6] ] )
return [[1 4] [2 5] [3 6]]
URL `http://xahlee.info/emacs/emacs/elisp_transpose.html'
Version 2022-12-29 2022-12-30"
(interactive)
(let (($rowCount (length Matrix))
($colCount (length (aref Matrix 0)))
$mtx )
(setq $mtx (xah-make-matrix $colCount $rowCount 1))
(dotimes ($r $rowCount)
(dotimes ($c $colCount)
(aset (aref $mtx $c) $r (aref (aref Matrix $r) $c))))
$mtx
))
(setq xStacks (xah-transpose xBoxMatrix ))
(setq xStacks
(mapcar
(lambda (x)
(append x nil))
xStacks))
(setq xStacks
(mapcar
(lambda (x)
(while (string-equal (car x) "") (pop x))
x
)
xStacks))
(setq
xArgsString
(split-string
(with-temp-buffer
(insert xProcedureText)
(goto-char (point-min))
(while (re-search-forward "move \\|from \\|to " nil t)
(replace-match ""))
(buffer-substring-no-properties (point-min) (point-max)))
"\n" t))
(defun move-stacks (X Y Z)
"move one box from stack Y to stack Z, do it X times."
(dotimes (i X) (push (pop (nth (1- Y) xStacks)) (nth (1- Z) xStacks))))
(mapc
(lambda (x)
(apply
#'move-stacks
(mapcar (lambda (y) (string-to-number y)) (split-string x " "))))
xArgsString)
xStacks
(defun x-get-top-boxes (xStacks)
"get a list of top boxes, return one string"
(mapconcat
(lambda (x)
(substring (car x) 1 2))
xStacks ""))
(x-get-top-boxes xStacks)