---
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).