---
layout: ../Site.layout.js
---
# cl-unicode-chicken-sudoku : a common lisp program on the back of a cereal box
```
π β¬ π· π¦ πͺ³ π¦ β¬ π π
β¬ β¬ π¦ πͺ³ β¬ π· π π¦ β¬
π πͺ³ π¦ π¦ π π¦ π· π π
π· π¦ π β¬ π¦ π π π¦ πͺ³
π¦ β¬ π π β¬ π β¬ π¦ π·
πͺ³ β¬ β¬ β¬ π π π¦ π· β¬
β¬ π· π π π π¦ β¬ πͺ³ π
π β¬ π¦ π· β¬ πͺ³ π π π¦
β¬ π¦ πͺ³ π π· π β¬ π π¦
```
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](
https://ciberlandia.pt/@shizamura) [(O Sarilho Future Romans webcomic)](
https://sarilho.net/en/) saying ['sudoku lisp engine' on the Mastodon](
https://ciberlandia.pt/@shizamura/114972299471462758).
Without further ado
# `map-derangements` from Alexandria sudoku
[Alexandria](
https://alexandria.common-lisp.dev/), 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](
https://www.dreamsongs.com/Files/PatternsOfSoftware.pdf) essays - anyway, it's stuff-you-need-that's-not-in-the-ANSI-standard for common lisp.
One thing is computing [derangement](
https://en.wikipedia.org/wiki/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.
## Setup
```
β’ (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 sudoku
This 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))
```
# Simple approach to making one sudoku
```
(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*)))
((π§ π£ π¦ 𦫠𦀠π 𦩠π¦ π¦) (𦫠𦩠π£ π§ π¦ π¦ π¦ π π¦€) (π¦ 𦫠π§ 𦩠π¦ π¦ 𦀠π£ π)
(𦩠π¦ 𦫠π£ π 𦀠π¦ π¦ π§) (𦀠π π¦ π¦ 𦩠π§ π£ π¦ π¦«) (π¦ π¦ 𦀠π π£ π¦ 𦫠π§ π¦©)
(π¦ π¦ π 𦀠𦫠π£ π§ 𦩠π¦) (π£ π§ 𦩠π¦ π¦ 𦫠π 𦀠π¦) (π 𦀠π¦ π¦ π§ 𦩠π¦ 𦫠π£))
```
## Put that setq scheme in a function
```
(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).
## Nice printing function
```
(defun print-sudoku (list-of-lists &optional (stream t))
(format stream "~{~{~2,,,' a~}~^~%~}" list-of-lists))
```
Good old [lisp formatted output aesthetic print parameters](
https://novaspec.org/cl/22_3_Formatted_Output#sec_22_3_2_2).
# Print that bird sudoku
```
'((π π¦ π π π¬ π‘ π π¦ π))
(make-complete-sudoku *)
(print-sudoku *)
```
```
CL-USER> '((π π¦ π π π¬ π‘ π π¦ π))
((π π¦ π π π¬ π‘ π π¦ π))
CL-USER> (make-complete-sudoku *)
((π π¬ π‘ π π π¦ π π¦ π) (π π π π¦ π¦ π π¬ π‘ π ) (π¬ π π π¦ π¦ π π‘ π π)
(π π¦ π¬ π‘ π π π¦ π π) (π π π¦ π π π π¦ π¬ π‘) (π π¦ π π π¬ π‘ π π¦ π)
(π¦ π π π π‘ π¬ π π π¦) (π¦ π‘ π π¬ π π π π π¦) (π‘ π π¦ π π π¦ π π π¬))
CL-USER> (print-sudoku *)
π π¬ π‘ π π π¦ π π¦ π
π π π π¦ π¦ π π¬ π‘ π
π¬ π π π¦ π¦ π π‘ π π
π π¦ π¬ π‘ π π π¦ π π
π π π¦ π π π π¦ π¬ π‘
π π¦ π π π¬ π‘ π π¦ π
π¦ π π π π‘ π¬ π π π¦
π¦ π‘ π π¬ π π π π π¦
π‘ π π¦ π π π¦ π π π¬
NIL
```
# Fish unicode
π‘πβπ₯π£π π¦π¦«πβ₯Ώππ¦ππ¦ππ¬πͺΈπ¦
thanks to [unix_surrealism](
https://analognowhere.com/) for puffy of fish linux.
More unicode came from [my bespoke collection over here](/lispgames/LCKR-running-the-simulation/) of unicode plants, birds and bugs.
# Randomly erase tiles
```
(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))))
```
# Complete example with numbers
```
'((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.
# Bug sudoku
```
CL-USER> '((π π π¦ π· π¦ πͺ³ π π π¦))
((π π π¦ π· π¦ πͺ³ π π π¦))
CL-USER> (make-complete-sudoku *)
((π π π· π¦ πͺ³ π¦ π¦ π π) (π π π¦ πͺ³ π¦ π· π π¦ π) (π πͺ³ π¦ π¦ π π¦ π· π π)
(π· π¦ π π π¦ π π π¦ πͺ³) (π¦ π¦ π π π π πͺ³ π¦ π·) (πͺ³ π π π¦ π π π¦ π· π¦)
(π¦ π· π π π π¦ π¦ πͺ³ π) (π π π¦ π· π¦ πͺ³ π π π¦) (π¦ π¦ πͺ³ π π· π π π π¦))
CL-USER> (randomly-erase 20 *)
((π β¬ π· π¦ πͺ³ π¦ β¬ π π) (β¬ β¬ π¦ πͺ³ β¬ π· π π¦ β¬) (π πͺ³ π¦ π¦ π π¦ π· π π)
(π· π¦ π β¬ π¦ π π π¦ πͺ³) (π¦ β¬ π π β¬ π β¬ π¦ π·) (πͺ³ β¬ β¬ β¬ π π π¦ π· β¬)
(β¬ π· π π π π¦ β¬ πͺ³ π) (π β¬ π¦ π· β¬ πͺ³ π π π¦) (β¬ π¦ πͺ³ π π· π β¬ π π¦))
CL-USER> (print-sudoku *)
π β¬ π· π¦ πͺ³ π¦ β¬ π π
β¬ β¬ π¦ πͺ³ β¬ π· π π¦ β¬
π πͺ³ π¦ π¦ π π¦ π· π π
π· π¦ π β¬ π¦ π π π¦ πͺ³
π¦ β¬ π π β¬ π β¬ π¦ π·
πͺ³ β¬ β¬ β¬ π π π¦ π· β¬
β¬ π· π π π π¦ β¬ πͺ³ π
π β¬ π¦ π· β¬ πͺ³ π π π¦
β¬ π¦ πͺ³ π π· π β¬ π π¦
NIL
```
# Conclusion
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.
# Fin.
See everyone in one hour on
https://anonradio.net:8443/anonradio for my live interview with Larian of the [Chronicles of Ember ttrpg](
https://www.chroniclesofember.com/)!
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
```
Also [on the Mastodon to talk about this fun post](
https://gamerplus.org/@screwlisp/114978530713751015).
