🐜 ⬜ 🕷 🦟 🪳 🦀 ⬜ 🐌 🐚
⬜ ⬜ 🦀 🪳 ⬜ 🕷 🐜 🦂 ⬜
🐚 🪳 🦂 🦀 🐌 🦟 🕷 🐞 🐜
🕷 🦟 🐜 ⬜ 🦂 🐌 🐚 🦀 🪳
🦀 ⬜ 🐌 🐚 ⬜ 🐞 ⬜ 🦟 🕷
🪳 ⬜ ⬜ ⬜ 🐞 🐜 🦟 🕷 ⬜
⬜ 🕷 🐞 🐜 🐚 🦂 ⬜ 🪳 🐌
🐞 ⬜ 🦟 🕷 ⬜ 🪳 🐌 🐚 🦂
⬜ 🦀 🪳 🐌 🕷 🐚 ⬜ 🐜 🦟
I had a lot of fun writing this - my reward over effort fraction was much greater than 1. Initially I tried polishing it but I think the polish made it worse, somehow. So here’s cl-unicode-chicken-sudoku. I wrote it as a joke response to my friend shizamura (O Sarilho Future Romans webcomic) saying ‘sudoku lisp engine’ on the Mastodon.
Without further ado
map-derangements from Alexandria sudokuAlexandria, whose name I think is a play on the library at Alexandria and the UCal Architect Christopher Alexander who wrote a forward to Richard P Gabriel’s Patterns of Software essays - anyway, it’s stuff-you-need-that’s-not-in-the-ANSI-standard for common lisp.
One thing is computing derangement permutations, which would be tedious to program yourself but reduce the search space of making-a-sudoku a lot.
ACT is a derangement of TAC because every letter changed position.
• (setq inferior-lisp-program "ecl")
• (slime)
• (setq eepitch-buffer-name "*slime-repl ECL*")
(require :alexandria)
(use-package :alexandria)
'(a b c d)
(map-derangements 'print *)
(B A D C)
(D A B C)
(C A D B)
(B D A C)
(C D A B)
(D C A B)
(B C D A)
(C D B A)
(D C B A)
try-derangement - maybe add a row to the sudokuThis is just how it worked when I programmed it; initially I had the idea to keep shrinking the derangements, but it seemed to be fast-enough in practice already, so. Similarly I initially tried randomising the starting point in the derangement, but this basically made it a lot slower and was a reasonably subtle improvement best handled differently; not a key issue.
(defun try-derangement
(all-syms
&aux (syms (car all-syms)))
(let* ((ders '((9 . 133496)
(8 . 14833)
(7 . 1854)
(6 . 265)
(5 . 44)
(4 . 9)
(3 . 2)
(2 . 1)))
(count 0)
(max (cdr (assoc (length syms) ders))))
(flet
((any-equal (&rest rest)
(mapl
(lambda (l)
(when (member (car l) (cdr l))
(return-from any-equal t)))
rest)
(values)))
(map-derangements
(lambda (d)
(let* ((any-equals
(apply 'mapcar #'any-equal d all-syms)))
(when (not (some 'identity any-equals))
(return-from try-derangement
(nconc all-syms (list d)))))
(incf count)
(when (equal count max)
(return-from try-derangement nil)))
syms))))
Whence.
TRY-DERANGEMENT
CL-USER> '((🐙 🦑 🐚 🐋 🐬 🐡 🐠 🦈 🐟))
((🐙 🦑 🐚 🐋 🐬 🐡 🐠 🦈 🐟))
CL-USER> (try-derangement *)
((🐙 🦑 🐚 🐋 🐬 🐡 🐠 🦈 🐟) (🦑 🐙 🐋 🐚 🐡 🐬 🐟 🐠 🦈))
CL-USER> (try-derangement *)
((🐙 🦑 🐚 🐋 🐬 🐡 🐠 🦈 🐟) (🦑 🐙 🐋 🐚 🐡 🐬 🐟 🐠 🦈) (🐚 🐋 🐙 🦑 🦈 🐟 🐬 🐡 🐠))
CL-USER>
It doesn’t matter what pictures you use in a Latin squares like sudoku: We could use numbers.
'((1 2 3 4 5 6 7 8 g))
(try-derangement *)
CL-USER> '((1 2 3 4 5 6 7 8 g))
((1 2 3 4 5 6 7 8 G))
CL-USER> (try-derangement *)
((1 2 3 4 5 6 7 8 G) (2 1 4 3 6 5 G 7 8))
(defvar *last*)
(setq *last* `(,(shuffle '(🦤 🦩 🐣 🦉 🐧 🦚 🦃 🦫 🍎))))
(loop :while (< (length *last*) 9) :do
(setq *last* (or (try-derangement *last*)
*last*))
:finally (return (shuffle *last*)))
CL-USER> (defvar *last*)
*LAST*
CL-USER> (setq *last* `(,(shuffle '(🦤 🦩 🐣 🦉 🐧 🦚 🦃 🦫 🍎))))
((🍎 🦤 🦉 🦃 🐧 🦩 🦚 🦫 🐣))
CL-USER> (loop :while (< (length *last*) 9) :do
(setq *last* (or (try-random-derangement *last*)
*last*))
:finally (return (shuffle *last*)))
((🐧 🐣 🦚 🦫 🦤 🍎 🦩 🦉 🦃) (🦫 🦩 🐣 🐧 🦚 🦉 🦃 🍎 🦤) (🦚 🦫 🐧 🦩 🦉 🦃 🦤 🐣 🍎)
(🦩 🦚 🦫 🐣 🍎 🦤 🦉 🦃 🐧) (🦤 🍎 🦃 🦉 🦩 🐧 🐣 🦚 🦫) (🦃 🦉 🦤 🍎 🐣 🦚 🦫 🐧 🦩)
(🦉 🦃 🍎 🦤 🦫 🐣 🐧 🦩 🦚) (🐣 🐧 🦩 🦚 🦃 🦫 🍎 🦤 🦉) (🍎 🦤 🦉 🦃 🐧 🦩 🦚 🦫 🐣))
(defun make-complete-sudoku (things)
"
things should be a list, elements different under EQL. Returns a shuffled 9x9 sudoku, hopefully.
"
(loop
:for last := (list things) :then (or new last)
:for new := (try-derangement last)
:while (< (length last) 9)
:finally (return (shuffle last))))
We Knuth shuffle the rows in the end (we should probably transpose it and shuffle again, but eh).
(defun print-sudoku (list-of-lists &optional (stream t))
(format stream "~{~{~2,,,' a~}~^~%~}" list-of-lists))
Good old lisp formatted output aesthetic print parameters.
'((🐙 🦑 🐚 🐋 🐬 🐡 🐠 🦈 🐟))
(make-complete-sudoku *)
(print-sudoku *)
CL-USER> '((🐙 🦑 🐚 🐋 🐬 🐡 🐠 🦈 🐟))
((🐙 🦑 🐚 🐋 🐬 🐡 🐠 🦈 🐟))
CL-USER> (make-complete-sudoku *)
((🐟 🐬 🐡 🐠 🐋 🦈 🐙 🦑 🐚) (🐚 🐋 🐙 🦑 🦈 🐟 🐬 🐡 🐠) (🐬 🐟 🐠 🦈 🦑 🐙 🐡 🐚 🐋)
(🐠 🦈 🐬 🐡 🐚 🐋 🦑 🐟 🐙) (🐋 🐚 🦑 🐙 🐟 🐠 🦈 🐬 🐡) (🐙 🦑 🐚 🐋 🐬 🐡 🐠 🦈 🐟)
(🦑 🐙 🐋 🐚 🐡 🐬 🐟 🐠 🦈) (🦈 🐡 🐟 🐬 🐠 🐚 🐋 🐙 🦑) (🐡 🐠 🦈 🐟 🐙 🦑 🐚 🐋 🐬))
CL-USER> (print-sudoku *)
🐟 🐬 🐡 🐠 🐋 🦈 🐙 🦑 🐚
🐚 🐋 🐙 🦑 🦈 🐟 🐬 🐡 🐠
🐬 🐟 🐠 🦈 🦑 🐙 🐡 🐚 🐋
🐠 🦈 🐬 🐡 🐚 🐋 🦑 🐟 🐙
🐋 🐚 🦑 🐙 🐟 🐠 🦈 🐬 🐡
🐙 🦑 🐚 🐋 🐬 🐡 🐠 🦈 🐟
🦑 🐙 🐋 🐚 🐡 🐬 🐟 🐠 🦈
🦈 🐡 🐟 🐬 🐠 🐚 🐋 🐙 🦑
🐡 🐠 🦈 🐟 🐙 🦑 🐚 🐋 🐬
NIL
🐡🐟◉🍥🎣🐠🦈🦫🐉⥿🐙🦑🐚🦭🐋🐬🪸🦀
thanks to unix_surrealism for puffy of fish linux.
More unicode came from my bespoke collection over here of unicode plants, birds and bugs.
(defun randomly-erase (n sudoku &key (blank '⬜))
(let ((cols (length (car sudoku)))
(rows (length sudoku))
(count 0))
(loop
:while (< count n)
:for r := (random rows)
:for c := (random cols)
:unless (equal (nth c (nth r sudoku)) blank) :do
(setf (nth c (nth r sudoku)) blank
count (1+ count))
:finally (return sudoku))))
'((1 2 3 4 5 6 7 8 9))
(make-complete-sudoku *)
(randomly-erase 20 * :blank '_)
(print-sudoku *)
CL-USER> '((1 2 3 4 5 6 7 8 9))
((1 2 3 4 5 6 7 8 9))
CL-USER> (make-complete-sudoku *)
(randomly-erase 20 * :blank '_)
((9 5 6 7 4 8 1 2 3) (6 7 8 9 1 2 3 4 5) (2 1 4 3 6 5 9 7 8)
(8 6 9 5 7 3 4 1 2) (4 3 2 1 9 7 8 5 6) (5 9 7 8 2 1 6 3 4)
(3 4 1 2 8 9 5 6 7) (7 8 5 6 3 4 2 9 1) (1 2 3 4 5 6 7 8 9))
CL-USER> ((9 5 6 7 4 _ _ _ _) (_ _ 8 9 1 2 3 4 _) (2 1 4 3 6 5 9 7 8)
(8 6 _ _ 7 3 4 1 2) (4 3 2 _ 9 _ _ 5 6) (5 9 7 _ 2 1 6 3 4)
(3 _ 1 2 8 9 5 _ 7) (7 8 5 _ 3 4 _ _ _) (1 2 3 4 _ 6 7 8 9))
CL-USER> (print-sudoku *)
9 5 6 7 4 _ _ _ _
_ _ 8 9 1 2 3 4 _
2 1 4 3 6 5 9 7 8
8 6 _ _ 7 3 4 1 2
4 3 2 _ 9 _ _ 5 6
5 9 7 _ 2 1 6 3 4
3 _ 1 2 8 9 5 _ 7
7 8 5 _ 3 4 _ _ _
1 2 3 4 _ 6 7 8 9
NIL
emoji are bigger than alphanumeric characters, hence the changing of the :blank symbol for numbers above.
CL-USER> '((🐞 🐜 🦟 🕷 🦀 🪳 🐌 🐚 🦂))
((🐞 🐜 🦟 🕷 🦀 🪳 🐌 🐚 🦂))
CL-USER> (make-complete-sudoku *)
((🐜 🐞 🕷 🦟 🪳 🦀 🦂 🐌 🐚) (🐌 🐚 🦀 🪳 🦟 🕷 🐜 🦂 🐞) (🐚 🪳 🦂 🦀 🐌 🦟 🕷 🐞 🐜)
(🕷 🦟 🐜 🐞 🦂 🐌 🐚 🦀 🪳) (🦀 🦂 🐌 🐚 🐜 🐞 🪳 🦟 🕷) (🪳 🐌 🐚 🦂 🐞 🐜 🦟 🕷 🦀)
(🦟 🕷 🐞 🐜 🐚 🦂 🦀 🪳 🐌) (🐞 🐜 🦟 🕷 🦀 🪳 🐌 🐚 🦂) (🦂 🦀 🪳 🐌 🕷 🐚 🐞 🐜 🦟))
CL-USER> (randomly-erase 20 *)
((🐜 ⬜ 🕷 🦟 🪳 🦀 ⬜ 🐌 🐚) (⬜ ⬜ 🦀 🪳 ⬜ 🕷 🐜 🦂 ⬜) (🐚 🪳 🦂 🦀 🐌 🦟 🕷 🐞 🐜)
(🕷 🦟 🐜 ⬜ 🦂 🐌 🐚 🦀 🪳) (🦀 ⬜ 🐌 🐚 ⬜ 🐞 ⬜ 🦟 🕷) (🪳 ⬜ ⬜ ⬜ 🐞 🐜 🦟 🕷 ⬜)
(⬜ 🕷 🐞 🐜 🐚 🦂 ⬜ 🪳 🐌) (🐞 ⬜ 🦟 🕷 ⬜ 🪳 🐌 🐚 🦂) (⬜ 🦀 🪳 🐌 🕷 🐚 ⬜ 🐜 🦟))
CL-USER> (print-sudoku *)
🐜 ⬜ 🕷 🦟 🪳 🦀 ⬜ 🐌 🐚
⬜ ⬜ 🦀 🪳 ⬜ 🕷 🐜 🦂 ⬜
🐚 🪳 🦂 🦀 🐌 🦟 🕷 🐞 🐜
🕷 🦟 🐜 ⬜ 🦂 🐌 🐚 🦀 🪳
🦀 ⬜ 🐌 🐚 ⬜ 🐞 ⬜ 🦟 🕷
🪳 ⬜ ⬜ ⬜ 🐞 🐜 🦟 🕷 ⬜
⬜ 🕷 🐞 🐜 🐚 🦂 ⬜ 🪳 🐌
🐞 ⬜ 🦟 🕷 ⬜ 🪳 🐌 🐚 🦂
⬜ 🦀 🪳 🐌 🕷 🐚 ⬜ 🐜 🦟
NIL
Anyway, I thought it was a lot of fun! Shizamura says that sudoku with at least 21 clues have a unique solution. My joke was that instead of writing numbers, you have to draw the emojis: Then if all of an emoji got lost the sudoku becomes unsolveable (what animal was it?).
I’ll stick sudoku on the front page in an editable textbox after the show.
I am not sure if one of my mathematical friends is going to tell me there was a better way than iteratively checking derangements of a single row: I couldn’t come up with one off hand, and what we did was fast enough and quite concise.
See everyone in one hour on https://anonradio.net:8443/anonradio for my live interview with Larian of the Chronicles of Ember ttrpg!
This being 000UTC / 0:00 Zulu time Wednesday (8pm Tuesday in Boston). If you saw this late the archive will be at https://communitymedia.video/c/screwtape_channel/videos as normal now.
Remember live chat for the show happens in lambdaMOO. This would work:
telnet lambda.moo.mud.org 8888
co guest
@join screwtape>
"Hey, I have a question for Larian!
:presses enter but does not close quotes in MOOlish