Topic: SUDOKU Challenge

[ribarm]

I am lost somewhere... John's one works : link here : http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html

But the other one from newspaper should be solvable, but I am lost in the woods...

Code - Auto/Visual Lisp: [Select]

1. (defun c:sudoku-mr ( / rcs solve solve-adv check v r i j f fl fll flll fllll mm fffl fff ff fi fj x z loop )
2.  
3.   (defun rcs ( m i j / r c s )
4.     (setq r (nth (1- i) m))
5.     (setq c (nth (1- j) (apply 'mapcar (cons 'list m))))
6.     (setq s
7.       (cond
8.         ( (and (<= 1 i 3) (<= 1 j 3))
9.           (list (nth 0 (nth 0 m)) (nth 1 (nth 0 m)) (nth 2 (nth 0 m)) (nth 0 (nth 1 m)) (nth 1 (nth 1 m)) (nth 2 (nth 1 m)) (nth 0 (nth 2 m)) (nth 1 (nth 2 m)) (nth 2 (nth 2 m)))
10.         )
11.         ( (and (<= 1 i 3) (<= 4 j 6))
12.           (list (nth 3 (nth 0 m)) (nth 4 (nth 0 m)) (nth 5 (nth 0 m)) (nth 3 (nth 1 m)) (nth 4 (nth 1 m)) (nth 5 (nth 1 m)) (nth 3 (nth 2 m)) (nth 4 (nth 2 m)) (nth 5 (nth 2 m)))
13.         )
14.         ( (and (<= 1 i 3) (<= 7 j 9))
15.           (list (nth 6 (nth 0 m)) (nth 7 (nth 0 m)) (nth 8 (nth 0 m)) (nth 6 (nth 1 m)) (nth 7 (nth 1 m)) (nth 8 (nth 1 m)) (nth 6 (nth 2 m)) (nth 7 (nth 2 m)) (nth 8 (nth 2 m)))
16.         )
17.  
18.         ( (and (<= 4 i 6) (<= 1 j 3))
19.           (list (nth 0 (nth 3 m)) (nth 1 (nth 3 m)) (nth 2 (nth 3 m)) (nth 0 (nth 4 m)) (nth 1 (nth 4 m)) (nth 2 (nth 4 m)) (nth 0 (nth 5 m)) (nth 1 (nth 5 m)) (nth 2 (nth 5 m)))
20.         )
21.         ( (and (<= 4 i 6) (<= 4 j 6))
22.           (list (nth 3 (nth 3 m)) (nth 4 (nth 3 m)) (nth 5 (nth 3 m)) (nth 3 (nth 4 m)) (nth 4 (nth 4 m)) (nth 5 (nth 4 m)) (nth 3 (nth 5 m)) (nth 4 (nth 5 m)) (nth 5 (nth 5 m)))
23.         )
24.         ( (and (<= 4 i 6) (<= 7 j 9))
25.           (list (nth 6 (nth 3 m)) (nth 7 (nth 3 m)) (nth 8 (nth 3 m)) (nth 6 (nth 4 m)) (nth 7 (nth 4 m)) (nth 8 (nth 4 m)) (nth 6 (nth 5 m)) (nth 7 (nth 5 m)) (nth 8 (nth 5 m)))
26.         )
27.  
28.         ( (and (<= 7 i 9) (<= 1 j 3))
29.           (list (nth 0 (nth 6 m)) (nth 1 (nth 6 m)) (nth 2 (nth 6 m)) (nth 0 (nth 7 m)) (nth 1 (nth 7 m)) (nth 2 (nth 7 m)) (nth 0 (nth 8 m)) (nth 1 (nth 8 m)) (nth 2 (nth 8 m)))
30.         )
31.         ( (and (<= 7 i 9) (<= 4 j 6))
32.           (list (nth 3 (nth 6 m)) (nth 4 (nth 6 m)) (nth 5 (nth 6 m)) (nth 3 (nth 7 m)) (nth 4 (nth 7 m)) (nth 5 (nth 7 m)) (nth 3 (nth 8 m)) (nth 4 (nth 8 m)) (nth 5 (nth 8 m)))
33.         )
34.         ( (and (<= 7 i 9) (<= 7 j 9))
35.           (list (nth 6 (nth 6 m)) (nth 7 (nth 6 m)) (nth 8 (nth 6 m)) (nth 6 (nth 7 m)) (nth 7 (nth 7 m)) (nth 8 (nth 7 m)) (nth 6 (nth 8 m)) (nth 7 (nth 8 m)) (nth 8 (nth 8 m)))
36.         )
37.       )
38.     )
39.     (list r c s)
40.   )
41.  
42.   (defun solve ( m i j / v r c s rn cn sn nn )
43.     (setq v '(1 2 3 4 5 6 7 8 9))
44.     (mapcar 'set '(r c s) (rcs m i j))
45.     (setq nn (vl-remove-if '(lambda ( x ) (vl-position x s)) v))
46.     (setq nn (vl-remove-if '(lambda ( x ) (vl-position x r)) nn))
47.     (setq nn (vl-remove-if '(lambda ( x ) (vl-position x c)) nn))
48.     (vl-sort nn '<)
49.   )
50.  
51.   (defun solve-adv ( m i j / nn ii jj x gx rfs cfs sfs rfsg cfsg sfsg )
52.     (setq nn (solve m i j))
53.     (setq jj 0)
54.     (setq rfs (vl-remove nil (mapcar '(lambda ( x ) (setq jj (1+ jj)) (if (null x) (read (strcat "f" (itoa i) (itoa jj))))) r)))
55.     (setq ii 0)
56.     (setq cfs (vl-remove nil (mapcar '(lambda ( x ) (setq ii (1+ ii)) (if (null x) (read (strcat "f" (itoa ii) (itoa j))))) c)))
57.     (setq sfs (vl-remove nil
58.       (cond
59.         ( (and (<= 1 i 3) (<= 1 j 3))
60.           (list (if (numberp (nth 0 (nth 0 m))) nil (read "f11")) (if (numberp (nth 1 (nth 0 m))) nil (read "f12")) (if (numberp (nth 2 (nth 0 m))) nil (read "f13")) (if (numberp (nth 0 (nth 1 m))) nil (read "f21")) (if (numberp (nth 1 (nth 1 m))) nil (read "f22")) (if (numberp (nth 2 (nth 1 m))) nil (read "f23")) (if (numberp (nth 0 (nth 2 m))) nil (read "f31")) (if (numberp (nth 1 (nth 2 m))) nil (read "f32")) (if (numberp (nth 2 (nth 2 m))) nil (read "f33")))
61.         )
62.         ( (and (<= 1 i 3) (<= 4 j 6))
63.           (list (if (numberp (nth 3 (nth 0 m))) nil (read "f14")) (if (numberp (nth 4 (nth 0 m))) nil (read "f15")) (if (numberp (nth 5 (nth 0 m))) nil (read "f16")) (if (numberp (nth 3 (nth 1 m))) nil (read "f24")) (if (numberp (nth 4 (nth 1 m))) nil (read "f25")) (if (numberp (nth 5 (nth 1 m))) nil (read "f26")) (if (numberp (nth 3 (nth 2 m))) nil (read "f34")) (if (numberp (nth 4 (nth 2 m))) nil (read "f35")) (if (numberp (nth 5 (nth 2 m))) nil (read "f36")))
64.         )
65.         ( (and (<= 1 i 3) (<= 7 j 9))
66.           (list (if (numberp (nth 6 (nth 0 m))) nil (read "f17")) (if (numberp (nth 7 (nth 0 m))) nil (read "f18")) (if (numberp (nth 8 (nth 0 m))) nil (read "f19")) (if (numberp (nth 6 (nth 1 m))) nil (read "f27")) (if (numberp (nth 7 (nth 1 m))) nil (read "f28")) (if (numberp (nth 8 (nth 1 m))) nil (read "f29")) (if (numberp (nth 6 (nth 2 m))) nil (read "f37")) (if (numberp (nth 7 (nth 2 m))) nil (read "f38")) (if (numberp (nth 8 (nth 2 m))) nil (read "f39")))
67.         )
68.  
69.         ( (and (<= 4 i 6) (<= 1 j 3))
70.           (list (if (numberp (nth 0 (nth 3 m))) nil (read "f41")) (if (numberp (nth 1 (nth 3 m))) nil (read "f42")) (if (numberp (nth 2 (nth 3 m))) nil (read "f43")) (if (numberp (nth 0 (nth 4 m))) nil (read "f51")) (if (numberp (nth 1 (nth 4 m))) nil (read "f52")) (if (numberp (nth 2 (nth 4 m))) nil (read "f53")) (if (numberp (nth 0 (nth 5 m))) nil (read "f61")) (if (numberp (nth 1 (nth 5 m))) nil (read "f62")) (if (numberp (nth 2 (nth 5 m))) nil (read "f63")))
71.         )
72.         ( (and (<= 4 i 6) (<= 4 j 6))
73.           (list (if (numberp (nth 3 (nth 3 m))) nil (read "f44")) (if (numberp (nth 4 (nth 3 m))) nil (read "f45")) (if (numberp (nth 5 (nth 3 m))) nil (read "f46")) (if (numberp (nth 3 (nth 4 m))) nil (read "f54")) (if (numberp (nth 4 (nth 4 m))) nil (read "f55")) (if (numberp (nth 5 (nth 4 m))) nil (read "f56")) (if (numberp (nth 3 (nth 5 m))) nil (read "f64")) (if (numberp (nth 4 (nth 5 m))) nil (read "f65")) (if (numberp (nth 5 (nth 5 m))) nil (read "f66")))
74.         )
75.         ( (and (<= 4 i 6) (<= 7 j 9))
76.           (list (if (numberp (nth 6 (nth 3 m))) nil (read "f47")) (if (numberp (nth 7 (nth 3 m))) nil (read "f48")) (if (numberp (nth 8 (nth 3 m))) nil (read "f49")) (if (numberp (nth 6 (nth 4 m))) nil (read "f57")) (if (numberp (nth 7 (nth 4 m))) nil (read "f58")) (if (numberp (nth 8 (nth 4 m))) nil (read "f59")) (if (numberp (nth 6 (nth 5 m))) nil (read "f67")) (if (numberp (nth 7 (nth 5 m))) nil (read "f68")) (if (numberp (nth 8 (nth 5 m))) nil (read "f69")))
77.         )
78.  
79.         ( (and (<= 7 i 9) (<= 1 j 3))
80.           (list (if (numberp (nth 0 (nth 6 m))) nil (read "f71")) (if (numberp (nth 1 (nth 6 m))) nil (read "f72")) (if (numberp (nth 2 (nth 6 m))) nil (read "f73")) (if (numberp (nth 0 (nth 7 m))) nil (read "f81")) (if (numberp (nth 1 (nth 7 m))) nil (read "f82")) (if (numberp (nth 2 (nth 7 m))) nil (read "f83")) (if (numberp (nth 0 (nth 8 m))) nil (read "f91")) (if (numberp (nth 1 (nth 8 m))) nil (read "f92")) (if (numberp (nth 2 (nth 8 m))) nil (read "f93")))
81.         )
82.         ( (and (<= 7 i 9) (<= 4 j 6))
83.           (list (if (numberp (nth 3 (nth 6 m))) nil (read "f74")) (if (numberp (nth 4 (nth 6 m))) nil (read "f75")) (if (numberp (nth 5 (nth 6 m))) nil (read "f76")) (if (numberp (nth 3 (nth 7 m))) nil (read "f84")) (if (numberp (nth 4 (nth 7 m))) nil (read "f85")) (if (numberp (nth 5 (nth 7 m))) nil (read "f86")) (if (numberp (nth 3 (nth 8 m))) nil (read "f94")) (if (numberp (nth 4 (nth 8 m))) nil (read "f95")) (if (numberp (nth 5 (nth 8 m))) nil (read "f96")))
84.         )
85.         ( (and (<= 7 i 9) (<= 7 j 9))
86.           (list (if (numberp (nth 6 (nth 6 m))) nil (read "f77")) (if (numberp (nth 7 (nth 6 m))) nil (read "f78")) (if (numberp (nth 8 (nth 6 m))) nil (read "f79")) (if (numberp (nth 6 (nth 7 m))) nil (read "f87")) (if (numberp (nth 7 (nth 7 m))) nil (read "f88")) (if (numberp (nth 8 (nth 7 m))) nil (read "f89")) (if (numberp (nth 6 (nth 8 m))) nil (read "f97")) (if (numberp (nth 7 (nth 8 m))) nil (read "f98")) (if (numberp (nth 8 (nth 8 m))) nil (read "f99")))
87.         )
88.       )
89.     ))
90.     (setq rfs (vl-remove (read (strcat "f" (itoa i) (itoa j))) rfs))
91.     (setq cfs (vl-remove (read (strcat "f" (itoa i) (itoa j))) cfs))
92.     (setq sfs (vl-remove (read (strcat "f" (itoa i) (itoa j))) sfs))
93.     (setq rfs (mapcar '(lambda ( x ) (eval x)) rfs))
94.     (setq cfs (mapcar '(lambda ( x ) (eval x)) cfs))
95.     (setq sfs (mapcar '(lambda ( x ) (eval x)) sfs))
96.     (while (setq x (car rfs))
97.       (setq gx (vl-remove-if-not '(lambda ( a ) (equal x a)) rfs))
98.       (setq rfs (vl-remove-if '(lambda ( a ) (vl-position a gx)) rfs))
99.       (setq rfsg (cons gx rfsg))
100.     )
101.     (while (setq x (car cfs))
102.       (setq gx (vl-remove-if-not '(lambda ( a ) (equal x a)) cfs))
103.       (setq cfs (vl-remove-if '(lambda ( a ) (vl-position a gx)) cfs))
104.       (setq cfsg (cons gx cfsg))
105.     )
106.     (while (setq x (car sfs))
107.       (setq gx (vl-remove-if-not '(lambda ( a ) (equal x a)) sfs))
108.       (setq sfs (vl-remove-if '(lambda ( a ) (vl-position a gx)) sfs))
109.       (setq sfsg (cons gx sfsg))
110.     )
111.     (foreach g rfsg
112.       (if (and (> (length g) 1) (= (length g) (length (car g))))
113.         (setq nn (vl-remove-if '(lambda ( x ) (vl-position x (car g))) nn))
114.       )
115.     )
116.     (foreach g cfsg
117.       (if (and (> (length g) 1) (= (length g) (length (car g))))
118.         (setq nn (vl-remove-if '(lambda ( x ) (vl-position x (car g))) nn))
119.       )
120.     )
121.     (foreach g sfsg
122.       (if (and (> (length g) 1) (= (length g) (length (car g))))
123.         (setq nn (vl-remove-if '(lambda ( x ) (vl-position x (car g))) nn))
124.       )
125.     )
126.     (vl-sort nn '<)
127.   )
128.  
129.   (defun check ( m / v i j r c s rtn )
130.     (setq v '(1 2 3 4 5 6 7 8 9))
131.     (setq i 0)
132.     (repeat 9
133.       (setq i (1+ i) j 0)
134.       (repeat 9
135.         (setq j (1+ j))
136.         (mapcar 'set '(r c s) (rcs m i j))
137.         (if
138.           (and
139.             (null (vl-remove-if '(lambda ( x ) (vl-position x s)) v))
140.             (null (vl-remove-if '(lambda ( x ) (vl-position x r)) v))
141.             (null (vl-remove-if '(lambda ( x ) (vl-position x c)) v))
142.           )
143.           (setq rtn (cons t rtn))
144.           (setq rtn (cons nil rtn))
145.         )
146.       )
147.     )
148.     (apply 'and rtn)
149.   )
150.  
151.   (setq m '((nil nil 4 8 nil nil nil 1 7)
152.             (6 7 nil 9 nil nil nil nil nil)
153.             (5 nil 8 nil 3 nil nil nil 4)
154.             (3 nil nil 7 4 nil 1 nil nil)
155.             (nil 6 9 nil nil nil 7 8 nil)
156.             (nil nil 1 nil 6 9 nil nil 5)
157.             (1 nil nil nil 8 nil 3 nil 6)
158.             (nil nil nil nil nil 6 nil 9 1)
159.             (2 4 nil nil nil 1 5 nil nil))) ;;; Remove initial matrix if you want to specify new SUDOKU puzzle
160.   ;;; This one works - John's link example
161.   ;|
162.   (setq m '((6 nil nil nil 8 5 1 nil nil)
163.             (nil nil nil nil nil nil nil 5 3)
164.             (4 nil nil nil nil 9 8 nil nil)
165.             (nil nil nil nil nil nil nil 1 nil)
166.             (nil 8 nil 3 2 6 nil 7 nil)
167.             (nil 3 nil 1 nil nil nil nil nil)
168.             (nil nil 7 nil nil nil nil nil 4)
169.             (nil 5 nil nil nil nil nil nil nil)
170.             (nil nil nil 9 4 nil nil nil 2))) ;;; Remove initial matrix if you want to specify new SUDOKU puzzle
171.   ;;; This one won't work ;;;
172.   ;;; Solution ->
173.   '((6 7 3 2 8 5 1 4 9)
174.     (2 9 8 4 7 1 6 5 3)
175.     (4 1 5 6 3 9 8 2 7)
176.     (5 4 2 7 9 8 3 1 6)
177.     (1 8 9 3 2 6 4 7 5)
178.     (7 3 6 1 5 4 2 9 8)
179.     (8 2 7 5 1 3 9 6 4)
180.     (9 5 4 8 6 2 7 3 1)
181.     (3 6 1 9 4 7 5 8 2))
182.   |;
183.   (if (null m)
184.     (progn
185.       (prompt "\nSpecify values of SUDOKU 9x9 matrix - PRESS ENTER for empty field...")
186.       (setq i 0)
187.       (repeat 9
188.         (setq i (1+ i) j 0)
189.         (repeat 9
190.           (setq j (1+ j))
191.           (setq v (getint (strcat "\nRow : " (itoa i) " Column : " (itoa j) " = ")))
192.           (setq r (cons v r))
193.         )
194.         (setq r (reverse r))
195.         (setq m (cons r m))
196.         (setq r nil)
197.       )
198.       (setq m (reverse m))
199.     )
200.   )
201.   (setq i 0)
202.   (repeat 9
203.     (setq i (1+ i) j 0 r (nth (1- i) m))
204.     (repeat 9
205.       (setq j (1+ j))
206.       (set (read (strcat "f" (itoa i) (itoa j))) (nth (1- j) r))
207.     )
208.   )
209.   (setq i 0)
210.   (repeat 9
211.     (setq i (1+ i) j 0)
212.     (repeat 9
213.       (setq j (1+ j))
214.       (if (null (eval (read (strcat "f" (itoa i) (itoa j)))))
215.         (setq fl (cons (list (read (strcat "f" (itoa i) (itoa j))) i j) fl))
216.       )
217.     )
218.   )
219.   (setq fl (reverse fl) flll fl mm m z 0 loop t)
220.   (while (and loop (or fl flll) (not (check mm)) (< z 81))
221.     (setq fll fl fllll flll)
222.     (if (equal m mm)
223.       (progn
224.         (foreach f fl
225.           (set (car f) (solve-adv m (cadr f) (caddr f)))
226.           (set (read (strcat "ff" (itoa (cadr f)) (itoa (caddr f)))) (eval (car f)))
227.           (if (= (length (eval (car f))) 1)
228.             (progn
229.               (setq i nil j nil)
230.               (setq m (mapcar '(lambda ( r ) (if (null i) (setq i 1 j 0) (setq i (1+ i) j 0)) (mapcar '(lambda ( c ) (setq j (1+ j)) (if (and (= i (cadr f)) (= j (caddr f))) (car (eval (car f))) c)) r)) m))
231.               (setq fl (vl-remove f fl))
232.             )
233.           )
234.         )
235.         (setq mm m)
236.       )
237.     )
238.     (if (or (null fl) (null flll))
239.       (setq mm m)
240.     )
241.     (if (equal fll fl)
242.       (progn
243.         (if (null fff)
244.           (setq fff (car (vl-remove-if '(lambda ( x ) (vl-position x fffl)) flll)))
245.         )
246.         (if (null ff)
247.           (setq ff (eval (car fff)))
248.         )
249.         (setq fi (cadr fff) fj (caddr fff))
250.         (setq x (car ff))
251.         (setq i nil j nil)
252.         (setq mm (mapcar '(lambda ( r ) (if (null i) (setq i 1 j 0) (setq i (1+ i) j 0)) (mapcar '(lambda ( c ) (setq j (1+ j)) (if (and (= i fi) (= j fj)) x c)) r)) mm))
253.         (setq ff (cdr ff))
254.         (if (equal flll fl)
255.           (progn
256.             (setq fffl (cons fff fffl))
257.             (setq fff nil)
258.           )
259.         )
260.         (foreach f (vl-remove fff flll)
261.           (set (car f) (solve-adv mm (cadr f) (caddr f)))
262.           (if (= (length (eval (car f))) 1)
263.             (progn
264.               (setq i nil j nil)
265.               (setq mm (mapcar '(lambda ( r ) (if (null i) (setq i 1 j 0) (setq i (1+ i) j 0)) (mapcar '(lambda ( c ) (setq j (1+ j)) (if (and (= i (cadr f)) (= j (caddr f))) (car (eval (car f))) c)) r)) mm))
266.             )
267.           )
268.         )
269.       )
270.     )
271.     (setq flll nil)
272.     (setq i 0)
273.     (repeat 9
274.       (setq i (1+ i) j 0)
275.       (repeat 9
276.         (setq j (1+ j))
277.         (if (null (nth (1- j) (nth (1- i) mm)))
278.           (setq flll (cons (list (read (strcat "f" (itoa i) (itoa j))) i j) flll))
279.         )
280.       )
281.     )
282.     (setq flll (reverse flll))
283.     (cond
284.       ( (and (null flll) (check mm))
285.         (setq loop nil)
286.       )
287.       ( (or (equal fllll flll) (null flll))
288.         (setq z (1+ z))
289.         (setq flll fl mm m)
290.         (foreach f fl
291.           (set (car f) (eval (read (strcat "ff" (itoa (cadr f)) (itoa (caddr f))))))
292.         )
293.       )
294.     )
295.   )
296.   (setq i 0)
297.   (repeat 9
298.     (setq i (1+ i) j 0)
299.     (repeat 9
300.       (setq j (1+ j))
301.       (set (read (strcat "f" (itoa i) (itoa j))) nil)
302.       (set (read (strcat "ff" (itoa i) (itoa j))) nil)
303.     )
304.   )
305.   (if (check mm)
306.     (setq m mm)
307.   )
308.   (if (= z 81)
309.     (progn
310.       (prompt "\nSolution can't be found... Quitting...")
311.       (exit)
312.     )
313.   )
314.   (prompt "\n Matrix is stored in variable \"m\" - you can call it with !m")
315.   (prompt "\n")
316.   (prompt "\n ") (princ (nth 0 (nth 0 m))) (prompt " ") (princ (nth 1 (nth 0 m))) (prompt " ") (princ (nth 2 (nth 0 m))) (prompt " | ") (princ (nth 3 (nth 0 m))) (prompt " ") (princ (nth 4 (nth 0 m))) (prompt " ") (princ (nth 5 (nth 0 m))) (prompt " | ") (princ (nth 6 (nth 0 m))) (prompt " ") (princ (nth 7 (nth 0 m))) (prompt " ") (princ (nth 8 (nth 0 m)))
317.   (prompt "\n ") (princ (nth 0 (nth 1 m))) (prompt " ") (princ (nth 1 (nth 1 m))) (prompt " ") (princ (nth 2 (nth 1 m))) (prompt " | ") (princ (nth 3 (nth 1 m))) (prompt " ") (princ (nth 4 (nth 1 m))) (prompt " ") (princ (nth 5 (nth 1 m))) (prompt " | ") (princ (nth 6 (nth 1 m))) (prompt " ") (princ (nth 7 (nth 1 m))) (prompt " ") (princ (nth 8 (nth 1 m)))
318.   (prompt "\n ") (princ (nth 0 (nth 2 m))) (prompt " ") (princ (nth 1 (nth 2 m))) (prompt " ") (princ (nth 2 (nth 2 m))) (prompt " | ") (princ (nth 3 (nth 2 m))) (prompt " ") (princ (nth 4 (nth 2 m))) (prompt " ") (princ (nth 5 (nth 2 m))) (prompt " | ") (princ (nth 6 (nth 2 m))) (prompt " ") (princ (nth 7 (nth 2 m))) (prompt " ") (princ (nth 8 (nth 2 m)))
319.   (prompt "\n ---------------------")
320.   (prompt "\n ") (princ (nth 0 (nth 3 m))) (prompt " ") (princ (nth 1 (nth 3 m))) (prompt " ") (princ (nth 2 (nth 3 m))) (prompt " | ") (princ (nth 3 (nth 3 m))) (prompt " ") (princ (nth 4 (nth 3 m))) (prompt " ") (princ (nth 5 (nth 3 m))) (prompt " | ") (princ (nth 6 (nth 3 m))) (prompt " ") (princ (nth 7 (nth 3 m))) (prompt " ") (princ (nth 8 (nth 3 m)))
321.   (prompt "\n ") (princ (nth 0 (nth 4 m))) (prompt " ") (princ (nth 1 (nth 4 m))) (prompt " ") (princ (nth 2 (nth 4 m))) (prompt " | ") (princ (nth 3 (nth 4 m))) (prompt " ") (princ (nth 4 (nth 4 m))) (prompt " ") (princ (nth 5 (nth 4 m))) (prompt " | ") (princ (nth 6 (nth 4 m))) (prompt " ") (princ (nth 7 (nth 4 m))) (prompt " ") (princ (nth 8 (nth 4 m)))
322.   (prompt "\n ") (princ (nth 0 (nth 5 m))) (prompt " ") (princ (nth 1 (nth 5 m))) (prompt " ") (princ (nth 2 (nth 5 m))) (prompt " | ") (princ (nth 3 (nth 5 m))) (prompt " ") (princ (nth 4 (nth 5 m))) (prompt " ") (princ (nth 5 (nth 5 m))) (prompt " | ") (princ (nth 6 (nth 5 m))) (prompt " ") (princ (nth 7 (nth 5 m))) (prompt " ") (princ (nth 8 (nth 5 m)))
323.   (prompt "\n ---------------------")
324.   (prompt "\n ") (princ (nth 0 (nth 6 m))) (prompt " ") (princ (nth 1 (nth 6 m))) (prompt " ") (princ (nth 2 (nth 6 m))) (prompt " | ") (princ (nth 3 (nth 6 m))) (prompt " ") (princ (nth 4 (nth 6 m))) (prompt " ") (princ (nth 5 (nth 6 m))) (prompt " | ") (princ (nth 6 (nth 6 m))) (prompt " ") (princ (nth 7 (nth 6 m))) (prompt " ") (princ (nth 8 (nth 6 m)))
325.   (prompt "\n ") (princ (nth 0 (nth 7 m))) (prompt " ") (princ (nth 1 (nth 7 m))) (prompt " ") (princ (nth 2 (nth 7 m))) (prompt " | ") (princ (nth 3 (nth 7 m))) (prompt " ") (princ (nth 4 (nth 7 m))) (prompt " ") (princ (nth 5 (nth 7 m))) (prompt " | ") (princ (nth 6 (nth 7 m))) (prompt " ") (princ (nth 7 (nth 7 m))) (prompt " ") (princ (nth 8 (nth 7 m)))
326.   (prompt "\n ") (princ (nth 0 (nth 8 m))) (prompt " ") (princ (nth 1 (nth 8 m))) (prompt " ") (princ (nth 2 (nth 8 m))) (prompt " | ") (princ (nth 3 (nth 8 m))) (prompt " ") (princ (nth 4 (nth 8 m))) (prompt " ") (princ (nth 5 (nth 8 m))) (prompt " | ") (princ (nth 6 (nth 8 m))) (prompt " ") (princ (nth 7 (nth 8 m))) (prompt " ") (princ (nth 8 (nth 8 m)))
327.   (textscr)
328.   (princ)
329. )
330.  

So if someone wants to play, he/she is welcome...
Regards...

[ribarm]

I've updated and improved above posted code with (solution-adv) advanced logic computation... To see that it really steps into it and that it can solve it, try test with this matrix...

Code - Auto/Visual Lisp: [Select]

1.   (setq m '((6 nil nil nil 8 5 1 4 nil)
2.             (nil nil nil nil nil nil nil 5 3)
3.             (4 nil nil nil nil 9 8 nil nil)
4.             (nil nil nil nil nil nil nil 1 nil)
5.             (nil 8 nil 3 2 6 nil 7 nil)
6.             (nil 3 nil 1 nil nil nil nil nil)
7.             (nil nil 7 nil nil nil nil nil 4)
8.             (9 5 nil nil nil nil nil nil nil)
9.             (3 6 1 9 4 nil 5 8 2))) ;;; Remove initial matrix if you want to specify new SUDOKU puzzle
10.   ;|
11.   ;;; Solution ->
12.   '((6 7 3 2 8 5 1 4 9)
13.     (2 9 8 4 7 1 6 5 3)
14.     (4 1 5 6 3 9 8 2 7)
15.     (5 4 2 7 9 8 3 1 6)
16.     (1 8 9 3 2 6 4 7 5)
17.     (7 3 6 1 5 4 2 9 8)
18.     (8 2 7 5 1 3 9 6 4)
19.     (9 5 4 8 6 2 7 3 1)
20.     (3 6 1 9 4 7 5 8 2))
21.   |;
22.  

Still if there are even less numbers specified, it will search and if it doesn't find it, it should exit-quit with message that solution isn't possible (at least with my logic so far...)...

M.R.

[Grrr1337]

Hey Marko,
I saw your thread when you first started it and thought that subfunction like this would be handy:

Code - Auto/Visual Lisp: [Select]

1. (defun IsSudokuSolutionValid ( aL / GroupByN ValidRowColp cols tmpL )
2.  
3.   (defun GroupByN ( n L / r )
4.     (repeat n (and L (setq r (cons (car L) r))) (setq L (cdr L)) r)
5.     (if L (cons (reverse r) (GroupByN n L)) (list (reverse r)))
6.   ); defun GroupByN
7.  
8.  
9.   ; _$ (ValidRowColp '(1 2 3 6 5 4 7 8 9)) -> T
10.   ; _$ (ValidRowColp '(1 2 3 6 9 4 7 8 9)) -> nil
11.   (defun ValidRowColp ( L / nL )
12.     (setq nL '(1 2 3 4 5 6 7 8 9))
13.     (vl-every (function (lambda (x) (if (member x nL) (progn (setq nL (vl-remove x nL)) T)))) L)
14.   ); defun ValidRowColp
15.  
16.   (and
17.     (vl-consp aL) (= 9 (length aL)) (vl-every (function (lambda (x) (and (vl-consp x) (= 9 (length x))))) aL) ; Basic checking
18.     (vl-every (function (lambda (x) (and (eq 'INT (type x)) (<= 1 x 9)))) (apply 'append aL)) ; atom checking
19.     (setq cols (apply 'mapcar (cons 'list aL)))
20.     (vl-every 'ValidRowColp aL) ; Check Rows
21.     (vl-every 'ValidRowColp cols) ; Check Columns
22.     (setq tmpL (mapcar (function (lambda (x) (GroupByN 3 x))) aL))
23.     (vl-every (function (lambda (x) (ValidRowColp (apply 'append x)))) ; Use: (mapcar '(lambda (x) (apply 'append x)) ..) to visualise this
24.       (append ; Check 3x3 Matrix Sublists
25.         (GroupByN 3 (mapcar 'car tmpL))
26.         (GroupByN 3 (mapcar 'cadr tmpL))
27.         (GroupByN 3 (mapcar 'caddr tmpL))
28.       ); append
29.     ); vl-every
30.   ); and
31.  
32. ); defun IsSudokuSolutionValid

Code - Auto/Visual Lisp: [Select]

1. _$ (IsSudokuSolutionValid
2.   '(
3.     (6 7 3 2 8 5 1 4 9)
4.     (2 9 8 4 7 1 6 5 3)
5.     (4 1 5 6 3 9 8 2 7)
6.     (5 4 2 7 9 8 3 1 6)
7.     (1 8 9 3 2 6 4 7 5)
8.     (7 3 6 1 5 4 2 9 8)
9.     (8 2 7 5 1 3 9 6 4)
10.     (9 5 4 8 6 2 7 3 1)
11.     (3 6 1 9 4 7 5 8 2)
12.   )
13. )
14. T
15. _$ (IsSudokuSolutionValid
16.   '(
17.     (7 6 3 2 8 5 1 4 9)
18.     (2 9 8 4 7 1 6 5 3)
19.     (4 1 5 6 3 9 8 2 7)
20.     (5 4 2 7 9 8 3 1 6)
21.     (1 8 9 3 2 6 4 7 5)
22.     (7 3 6 1 5 4 2 9 8)
23.     (8 2 7 5 1 3 9 6 4)
24.     (9 5 4 8 6 2 7 3 1)
25.     (3 6 1 9 4 7 5 8 2)
26.   )
27. )
28. nil

Didn't post earlier because I just wrote that.
But a solver/generator routine is a bit over my head - I hope this one will help you in someway. 

[Lee Mac]

The following should calculate the possible candidate entries for each space in the sudoku -

Code - Auto/Visual Lisp: [Select]

1. (defun sudoku ( l / r )
2.     (cond
3.         (   (vl-some
4.                 (function
5.                     (lambda ( r )
6.                         (vl-some 'null r)
7.                     )
8.                 )
9.                 l
10.             )
11.             (sudoku
12.                 (mapcar
13.                     (function
14.                         (lambda ( r )
15.                             (mapcar
16.                                 (function
17.                                     (lambda ( c )
18.                                         (if c (lsh 1 c) 1023)
19.                                     )
20.                                 )
21.                                 r
22.                             )
23.                         )
24.                     )
25.                     l
26.                 )
27.             )
28.         )
29.         (   (vl-some
30.                 (function
31.                     (lambda ( r )
32.                         (vl-some 'zerop r)
33.                     )
34.                 )
35.                 (setq r
36.                     (mapcar
37.                         (function
38.                             (lambda ( r )
39.                                 (mapcar
40.                                     (function
41.                                         (lambda ( c )
42.                                             (if (pow2 c) c 0)
43.                                         )
44.                                     )
45.                                     r
46.                                 )
47.                             )
48.                         )
49.                         l
50.                     )
51.                 )
52.             )
53.             (setq l
54.                 (mapcar
55.                     (function
56.                         (lambda ( r )
57.                             (apply 'append r)
58.                         )
59.                     )
60.                     (grd->mat
61.                         (mapcar
62.                             (function
63.                                 (lambda ( a b )
64.                                     (mapcar
65.                                         (function
66.                                             (lambda ( c )
67.                                                 (mapcar
68.                                                     (function
69.                                                         (lambda ( d )
70.                                                             (if (pow2 d) d (logand d (~ b)))
71.                                                         )
72.                                                     )
73.                                                     c
74.                                                 )
75.                                             )
76.                                         )
77.                                         a
78.                                     )
79.                                 )
80.                             )
81.                             (apply 'append
82.                                 (mat->grd
83.                                     (mat->grd
84.                                         (apply 'mapcar
85.                                             (cons 'list
86.                                                 (mapcar
87.                                                     (function
88.                                                         (lambda ( a b )
89.                                                             (mapcar
90.                                                                 (function
91.                                                                     (lambda ( c )
92.                                                                         (if (pow2 c) c (logand c (~ b)))
93.                                                                     )
94.                                                                 )
95.                                                                 a
96.                                                             )
97.                                                         )
98.                                                     )
99.                                                     (apply 'mapcar
100.                                                         (cons 'list
101.                                                             (mapcar
102.                                                                 (function
103.                                                                     (lambda ( a b )
104.                                                                         (mapcar
105.                                                                             (function
106.                                                                                 (lambda ( c )
107.                                                                                     (if (pow2 c) c (logand c (~ b)))
108.                                                                                 )
109.                                                                             )
110.                                                                             a
111.                                                                         )
112.                                                                     )
113.                                                                 )
114.                                                                 l
115.                                                                 (mapcar
116.                                                                     (function
117.                                                                         (lambda ( r )
118.                                                                             (apply 'logior r)
119.                                                                         )
120.                                                                     )
121.                                                                     r
122.                                                                 )
123.                                                             )
124.                                                         )
125.                                                     )
126.                                                     (mapcar
127.                                                         (function
128.                                                             (lambda ( c )
129.                                                                 (apply 'logior c)
130.                                                             )
131.                                                         )
132.                                                         (apply 'mapcar (cons 'list r))
133.                                                     )
134.                                                 )
135.                                             )
136.                                         )
137.                                     )
138.                                 )
139.                             )
140.                             (mapcar
141.                                 (function
142.                                     (lambda ( m )
143.                                         (apply 'logior (apply 'append m))
144.                                     )
145.                                 )
146.                                 (apply 'append (mat->grd (mat->grd r)))
147.                             )
148.                         )
149.                     )
150.                 )
151.             )
152.  
153.             ;; ( Recursive call goes here )
154.  
155.             (mapcar
156.                 (function
157.                     (lambda ( r )
158.                         (mapcar
159.                             (function
160.                                 (lambda ( c )
161.                                     (if (pow2 c)
162.                                         (fixn (log2 c))
163.                                         (mapcar
164.                                             (function
165.                                                 (lambda ( d )
166.                                                     (fixn (log2 d))
167.                                                 )
168.                                             )
169.                                             (bits c)
170.                                         )
171.                                     )
172.                                 )
173.                             )
174.                             r
175.                         )
176.                     )
177.                 )
178.                 l
179.             )
180.         )
181.         (   (mapcar
182.                 (function
183.                     (lambda ( r )
184.                         (mapcar
185.                             (function
186.                                 (lambda ( c )
187.                                     (fixn (log2 c))
188.                                 )
189.                             )
190.                             r
191.                         )
192.                     )
193.                 )
194.                 l
195.             )
196.         )
197.     )
198. )
199. (defun mat->grd ( m )
200.     (if (car m)
201.         (cons
202.             (mapcar
203.                 (function
204.                     (lambda ( r )
205.                         (mapcar
206.                             (function
207.                                 (lambda ( a b ) a)
208.                             )
209.                             r '(0 1 2)
210.                         )
211.                     )
212.                 )
213.                 m
214.             )
215.             (mat->grd (mapcar 'cdddr m))
216.         )
217.     )
218. )
219. (defun grd->mat ( g )
220.     (if g
221.         (append
222.             (apply 'mapcar
223.                 (cons 'list
224.                     (mapcar
225.                         (function
226.                             (lambda ( a b ) a)
227.                         )
228.                         g '(0 1 2)
229.                     )
230.                 )
231.             )
232.             (grd->mat (cdddr g))
233.         )
234.     )
235. )
236. (defun log2 ( n ) (/ (log n) (log 2)))
237. (defun fixn ( n ) (fix (+ 1e-8 n)))
238. (defun pow2 ( n ) ((lambda ( r ) (equal r (fixn r) 1e-8)) (log2 n)))
239. (defun bits ( n / b ) (if (< 0 n) (cons (setq b (lsh 1 (fixn (log2 n)))) (bits (- n b)))))

Example:

Code - Auto/Visual Lisp: [Select]

1. (sudoku
2.    '(
3.         (nil nil  4   8  nil nil nil  1   7 )
4.         ( 6   7  nil  9  nil nil nil nil nil)
5.         ( 5  nil  8  nil  3  nil nil nil  4 )
6.         ( 3  nil nil  7   4  nil  1  nil nil)
7.         (nil  6   9  nil nil nil  7   8  nil)
8.         (nil nil  1  nil  6   9  nil nil  5 )
9.         ( 1  nil nil nil  8  nil  3  nil  6 )
10.         (nil nil nil nil nil  6  nil  9   1 )
11.         ( 2   4  nil nil nil  1   5  nil nil)
12.     )
13. )
14.  
15. -->
16. (
17.     (  (9 0)   (9 3 2 0)    4         8          (5 2 0)   (5 2 0)   (9 6 2 0)    1         7     )
18.     (   6         7        (3 2 0)    9        (5 2 1 0)   (5 4 2 0)   (8 2 0) (5 3 2 0) (8 3 2 0))
19.     (   5      (9 2 1 0)    8        (6 2 1 0)    3        (7 2 0)   (9 6 2 0)   (6 2 0)    4     )
20.     (   3      (8 5 2 0)   (5 2 0)    7           4        (8 5 2 0)    1        (6 2 0)   (9 2 0))
21.     (  (4 0)      6         9      (5 3 2 1 0) (5 2 1 0)   (5 3 2 0)    7         8        (3 2 0))
22.     ((8 7 4 0)   (8 2 0)    1        (3 2 0)      6         9          (4 2 0) (4 3 2 0)    5     )
23.     (   1        (9 5 0)   (7 5 0)   (5 4 2 0)    8      (7 5 4 2 0)    3      (7 4 2 0)    6     )
24.     (  (8 7 0) (8 5 3 0) (7 5 3 0) (5 4 3 2 0) (7 5 2 0)    6        (8 4 2 0)    9         1     )
25.     (   2         4      (7 6 3 0)   (3 0)       (9 7 0)    1           5        (7 0)     (8 0)  )
26. )
27.  

It just remains to implement the recursive call to test each candidate, backtracing if it leads to an invalid solution...

[Grrr1337]

The following should calculate the possible candidate entries for each space in the sudoku -

This has to be the one of the most complex functions I've seen from you, insane job!



How do you guys think a sudoku should be generated?
I thought maybe if shifting the items(atoms) in the sublists may work somewhat:

Code - Auto/Visual Lisp: [Select]

1. '(
2.   (1 2 3 4 5 6 7 8 9)
3.   (1 2 3 4 5 6 7 8 9)
4.   (1 2 3 4 5 6 7 8 9)
5.   (1 2 3 4 5 6 7 8 9)
6.   (1 2 3 4 5 6 7 8 9)
7.   (1 2 3 4 5 6 7 8 9)
8.   (1 2 3 4 5 6 7 8 9)
9.   (1 2 3 4 5 6 7 8 9)
10.   (1 2 3 4 5 6 7 8 9)
11. )
12. ->>
13. '(
14.   (1 2 3 4 5 6 7 8 9) ; no shift [straight list]
15.   (9 8 7 1 2 3 4 5 6) ; shift 3 times to the right [straight list]
16.   (6 5 4 9 8 7 1 2 3) ; shift 6 times to the right [straight list]
17.   (7 6 5 4 3 2 1 9 8) ; shift 2 times to the left [reversed list: '(9 8 7 6 5 4 3 2 1)]
18.   (x x x x x x x x x) ; ???
19.   (x x x x x x x x x) ; ???
20.   (x x x x x x x x x) ; ???
21.   (x x x x x x x x x) ; ???
22.   (x x x x x x x x x) ; ???
23. )
24.  

BTW Maybe use 'x' symbol instead of nil, so it would take up space for only 1 character for a better visual formatting:

Code - Auto/Visual Lisp: [Select]

1. (sudoku
2.   '(
3.     (nil nil  4   8  nil nil nil  1   7 )
4.     ( 6   7  nil  9  nil nil nil nil nil)
5.     ( 5  nil  8  nil  3  nil nil nil  4 )
6.     ( 3  nil nil  7   4  nil  1  nil nil)
7.     (nil  6   9  nil nil nil  7   8  nil)
8.     (nil nil  1  nil  6   9  nil nil  5 )
9.     ( 1  nil nil nil  8  nil  3  nil  6 )
10.     (nil nil nil nil nil  6  nil  9   1 )
11.     ( 2   4  nil nil nil  1   5  nil nil)
12.   )
13. )
14.  
15. (sudoku
16.   '(
17.     (x x 4 8 x x x 1 7)
18.     (6 7 x 9 x x x x x)
19.     (5 x 8 x 3 x x x 4)
20.     (3 x x 7 4 x 1 x x)
21.     (x 6 9 x x x 7 8 x)
22.     (x x 1 x 6 9 x x 5)
23.     (1 x x x 8 x 3 x 6)
24.     (x x x x x 6 x 9 1)
25.     (2 4 x x x 1 5 x x)
26.   )
27. )
28.  

'x' is not assigned and would mean that x = nil.

[Lee Mac]

The following should calculate the possible candidate entries for each space in the sudoku -

This has to be the one of the most complex functions I've seen from you, insane job!

Thanks! 

BTW Maybe use 'x' symbol instead of nil, so it would take up space for only 1 character for a better visual formatting:

Code - Auto/Visual Lisp: [Select]

1. (sudoku
2.   '(
3.     (x x 4 8 x x x 1 7)
4.     (6 7 x 9 x x x x x)
5.     (5 x 8 x 3 x x x 4)
6.     (3 x x 7 4 x 1 x x)
7.     (x 6 9 x x x 7 8 x)
8.     (x x 1 x 6 9 x x 5)
9.     (1 x x x 8 x 3 x 6)
10.     (x x x x x 6 x 9 1)
11.     (2 4 x x x 1 5 x x)
12.   )
13. )

'x' is not assigned and would mean that x = nil.

Careful - the unevaluated symbol 'x' will not equal nil...

Code: [Select]

_$ (= nil 'x)
nil

[Grrr1337]

Careful - the unevaluated symbol 'x' will not equal nil...

Code: [Select]

_$ (= nil 'x)
nil

Thanks - I've forgot that the symbol is left unevaluated (as the list is unevaluated aswell). <duh>

Then like this (as its not a question of speed-performance) :

Code - Auto/Visual Lisp: [Select]

1. (sudoku
2.   (mapcar 'eval
3.     '(
4.       (x x 4 8 x x x 1 7)
5.       (6 7 x 9 x x x x x)
6.       (5 x 8 x 3 x x x 4)
7.       (3 x x 7 4 x 1 x x)
8.       (x 6 9 x x x 7 8 x)
9.       (x x 1 x 6 9 x x 5)
10.       (1 x x x 8 x 3 x 6)
11.       (x x x x x 6 x 9 1)
12.       (2 4 x x x 1 5 x x)
13.     )
14.   )
15. )

[Lee Mac]

Somewhat closer...

Code - Auto/Visual Lisp: [Select]

1. (defun sudoku ( l / r )
2.     (cond
3.         (   (vl-some
4.                 (function
5.                     (lambda ( r )
6.                         (vl-some 'null r)
7.                     )
8.                 )
9.                 l
10.             )
11.             (sudoku
12.                 (mapcar
13.                     (function
14.                         (lambda ( r )
15.                             (mapcar
16.                                 (function
17.                                     (lambda ( c )
18.                                         (if c (lsh 1 c) 1022)
19.                                     )
20.                                 )
21.                                 r
22.                             )
23.                         )
24.                     )
25.                     l
26.                 )
27.             )
28.         )
29.         (   (vl-some
30.                 (function
31.                     (lambda ( r )
32.                         (vl-some 'zerop r)
33.                     )
34.                 )
35.                 l
36.             )
37.             nil
38.         )
39.         (   (progn
40.                 (setq r
41.                     (mapcar
42.                         (function
43.                             (lambda ( r )
44.                                 (mapcar
45.                                     (function
46.                                         (lambda ( c )
47.                                             (if (pow2 c) c 0)
48.                                         )
49.                                     )
50.                                     r
51.                                 )
52.                             )
53.                         )
54.                         l
55.                     )
56.                 )
57.                 (not
58.                     (equalm l
59.                         (setq l
60.                             (mapcar
61.                                 (function
62.                                     (lambda ( r )
63.                                         (apply 'append r)
64.                                     )
65.                                 )
66.                                 (grd->mat
67.                                     (mapcar
68.                                         (function
69.                                             (lambda ( a b )
70.                                                 (mapcar
71.                                                     (function
72.                                                         (lambda ( c )
73.                                                             (mapcar
74.                                                                 (function
75.                                                                     (lambda ( d )
76.                                                                         (if (pow2 d) d (logand d (~ b)))
77.                                                                     )
78.                                                                 )
79.                                                                 c
80.                                                             )
81.                                                         )
82.                                                     )
83.                                                     a
84.                                                 )
85.                                             )
86.                                         )
87.                                         (apply 'append
88.                                             (mat->grd
89.                                                 (mat->grd
90.                                                     (apply 'mapcar
91.                                                         (cons 'list
92.                                                             (mapcar
93.                                                                 (function
94.                                                                     (lambda ( a b )
95.                                                                         (mapcar
96.                                                                             (function
97.                                                                                 (lambda ( c )
98.                                                                                     (if (pow2 c) c (logand c (~ b)))
99.                                                                                 )
100.                                                                             )
101.                                                                             a
102.                                                                         )
103.                                                                     )
104.                                                                 )
105.                                                                 (apply 'mapcar
106.                                                                     (cons 'list
107.                                                                         (mapcar
108.                                                                             (function
109.                                                                                 (lambda ( a b )
110.                                                                                     (mapcar
111.                                                                                         (function
112.                                                                                             (lambda ( c )
113.                                                                                                 (if (pow2 c) c (logand c (~ b)))
114.                                                                                             )
115.                                                                                         )
116.                                                                                         a
117.                                                                                     )
118.                                                                                 )
119.                                                                             )
120.                                                                             l
121.                                                                             (mapcar
122.                                                                                 (function
123.                                                                                     (lambda ( r )
124.                                                                                         (apply 'logior r)
125.                                                                                     )
126.                                                                                 )
127.                                                                                 r
128.                                                                             )
129.                                                                         )
130.                                                                     )
131.                                                                 )
132.                                                                 (mapcar
133.                                                                     (function
134.                                                                         (lambda ( c )
135.                                                                             (apply 'logior c)
136.                                                                         )
137.                                                                     )
138.                                                                     (apply 'mapcar (cons 'list r))
139.                                                                 )
140.                                                             )
141.                                                         )
142.                                                     )
143.                                                 )
144.                                             )
145.                                         )
146.                                         (mapcar
147.                                             (function
148.                                                 (lambda ( m )
149.                                                     (apply 'logior (apply 'append m))
150.                                                 )
151.                                             )
152.                                             (apply 'append (mat->grd (mat->grd r)))
153.                                         )
154.                                     )
155.                                 )
156.                             )
157.                         )
158.                     )
159.                 )
160.             )
161.             (sudoku l)
162.         )
163.         (
164.             (
165.                 (lambda ( / i j ) (setq i -1)
166.                     (vl-some
167.                         (function
168.                             (lambda ( r ) (setq i (1+ i) j -1)
169.                                 (vl-some
170.                                     (function
171.                                         (lambda ( c ) (setq j (1+ j))
172.                                             (if (and (< 0 c) (not (pow2 c)))
173.                                                 (vl-some
174.                                                     (function
175.                                                         (lambda ( d )
176.                                                             (sudoku (substij i j d l))
177.                                                         )
178.                                                     )
179.                                                     (bits c)
180.                                                 )
181.                                             )
182.                                         )
183.                                     )
184.                                     r
185.                                 )
186.                             )
187.                         )
188.                         l
189.                     )
190.                 )
191.             )
192.         )
193.         (   (mapcar
194.                 (function
195.                     (lambda ( r )
196.                         (mapcar
197.                             (function
198.                                 (lambda ( c )
199.                                     (fixn (log2 c))
200.                                 )
201.                             )
202.                             r
203.                         )
204.                     )
205.                 )
206.                 l
207.             )
208.         )
209.     )
210. )
211. (defun equalm ( a b )
212.     (vl-every '(lambda ( x y ) (vl-every '= x y)) a b)
213. )
214. (defun substij ( i j n m / a )
215.     (setq a -1)
216.     (mapcar
217.         (function
218.             (lambda ( x / b )
219.                 (if (= i (setq b -1 a (1+ a)))
220.                     (mapcar
221.                         (function
222.                             (lambda ( y )
223.                                 (if (= j (setq b (1+ b))) n y)
224.                             )
225.                         )
226.                         x
227.                     )
228.                     x
229.                 )
230.             )
231.         )
232.         m
233.     )
234. )
235. (defun mat->grd ( m )
236.     (if (car m)
237.         (cons
238.             (mapcar
239.                 (function
240.                     (lambda ( r )
241.                         (mapcar
242.                             (function
243.                                 (lambda ( a b ) a)
244.                             )
245.                             r '(0 1 2)
246.                         )
247.                     )
248.                 )
249.                 m
250.             )
251.             (mat->grd (mapcar 'cdddr m))
252.         )
253.     )
254. )
255. (defun grd->mat ( g )
256.     (if g
257.         (append
258.             (apply 'mapcar
259.                 (cons 'list
260.                     (mapcar
261.                         (function
262.                             (lambda ( a b ) a)
263.                         )
264.                         g '(0 1 2)
265.                     )
266.                 )
267.             )
268.             (grd->mat (cdddr g))
269.         )
270.     )
271. )
272. (defun log2 ( n ) (/ (log n) (log 2)))
273. (defun fixn ( n ) (fix (+ 1e-8 n)))
274. (defun pow2 ( n ) (if (zerop n) 0 ((lambda ( r ) (equal r (fixn r) 1e-8)) (log2 n))))
275. (defun bits ( n / b ) (if (< 0 n) (cons (setq b (lsh 1 (fixn (log2 n)))) (bits (- n b)))))

Now successfully solves this example:

Code - Auto/Visual Lisp: [Select]

1. (sudoku
2.    '(
3.         (nil nil 4 8 nil nil nil 1 7)
4.         (6 7 nil 9 nil nil nil nil nil)
5.         (5 nil 8 nil 3 nil nil nil 4)
6.         (3 nil nil 7 4 nil 1 nil nil)
7.         (nil 6 9 nil nil nil 7 8 nil)
8.         (nil nil 1 nil 6 9 nil nil 5)
9.         (1 nil nil nil 8 nil 3 nil 6)
10.         (nil nil nil nil nil 6 nil 9 1)
11.         (2 4 nil nil nil 1 5 nil nil)
12.     )
13. )
14. -->
15. (
16.     (9 3 4 8 2 5 6 1 7)
17.     (6 7 2 9 1 4 8 5 3)
18.     (5 1 8 6 3 7 9 2 4)
19.     (3 2 5 7 4 8 1 6 9)
20.     (4 6 9 1 5 3 7 8 2)
21.     (7 8 1 2 6 9 4 3 5)
22.     (1 9 7 5 8 2 3 4 6)
23.     (8 5 3 4 7 6 2 9 1)
24.     (2 4 6 3 9 1 5 7 8)
25. )

...But not this example:

Code - Auto/Visual Lisp: [Select]

1. (sudoku
2.    '(
3.         (6 nil nil nil 8 5 1 nil nil)
4.         (nil nil nil nil nil nil nil 5 3)
5.         (4 nil nil nil nil 9 8 nil nil)
6.         (nil nil nil nil nil nil nil 1 nil)
7.         (nil 8 nil 3 2 6 nil 7 nil)
8.         (nil 3 nil 1 nil nil nil nil nil)
9.         (nil nil 7 nil nil nil nil nil 4)
10.         (nil 5 nil nil nil nil nil nil nil)
11.         (nil nil nil 9 4 nil nil nil 2)
12.     )
13. )
14. -->
15. (
16.     (6 9 3 2 8 5 1 4 7)
17.     (8 7 2 4 6 1 9 5 3)
18.     (4 1 5 7 3 9 8 2 6)
19.     (7 4 6 5 9 8 3 1 9)
20.     (1 8 1 3 2 6 4 7 5)
21.     (5 3 9 1 7 4 2 6 8)
22.     (9 2 7 8 5 3 6 9 4)
23.     (3 5 4 6 1 2 7 9 8)
24.     (1 6 8 9 4 7 5 3 2)
25. )

 

[Grrr1337]

Atleast its good to see some progress, Lee! 

A small thing I could help at is to prompt where the sudoku errors:

Code - Auto/Visual Lisp: [Select]

1. (defun IsSudokuValid ( aL / InvalidAt GroupByN ValidRowColp cols tmpL r )
2.  
3.   ; _$ (InvalidAt '(lambda (a) (= a 5)) '(lambda (a b) (print (strcat "Error at item n."  b " :\n" (vl-prin1-to-string a)))) '(1 2 3 4 5 6 7 8 9)) -> "Error at item n.1 :\n1" T
4.   ; _$ (InvalidAt '(lambda (a) (/= a 5)) '(lambda (a b) (print (strcat "Error at item n."  b " :\n" (vl-prin1-to-string a)))) '(1 2 3 4 5 6 7 8 9)) -> "Error at item n.5 :\n5" T
5.   ; _$ (InvalidAt '(lambda (a) (/= a 15)) '(lambda (a b) (print (strcat "Error at item n."  b " :\n" (vl-prin1-to-string a)))) '(1 2 3 4 5 6 7 8 9)) -> nil
6.   (setq InvalidAt
7.     (lambda ( f mf L / i )
8.       (setq i 0) (setq f (eval f)) (setq mf (eval mf))
9.       (vl-some (function (lambda (x) (setq i (1+ i)) (if (not (f x)) (progn (mf x (itoa i)) T)))) L)
10.     )
11.   ); setq InvalidAt
12.  
13.   (defun GroupByN ( n L / r )
14.     (repeat n (and L (setq r (cons (car L) r))) (setq L (cdr L)) r)
15.     (if L (cons (reverse r) (GroupByN n L)) (list (reverse r)))
16.   ); defun GroupByN
17.  
18.   ; _$ (ValidRowColp '(1 2 3 6 5 4 7 8 9)) -> T
19.   ; _$ (ValidRowColp '(1 2 3 6 9 4 7 8 9)) -> nil
20.   (defun ValidRowColp ( L / nL )
21.     (setq nL '(1 2 3 4 5 6 7 8 9))
22.     (vl-every (function (lambda (x) (if (member x nL) (progn (setq nL (vl-remove x nL)) T)))) L)
23.   ); defun ValidRowColp
24.  
25.   (cond
26.     ( (not (vl-consp aL)) (prompt "\n#1. Not vl-consp.") )
27.     ( (/= 9 (length aL)) (prompt "\n#2. Invalid length.") )
28.     ( (InvalidAt '(lambda (x) (and (vl-consp x) (= 9 (length x)))) '(lambda (a b) (print (strcat "\nError[basic] at row n." b " :\n" (vl-prin1-to-string a)))) aL) )
29.     ( (InvalidAt '(lambda (x) (and (eq 'INT (type x)) (<= 1 x 9))) '(lambda (a b) (print (strcat "\nError at atom n." b " :\n" (vl-prin1-to-string a)))) (apply 'append aL)) )
30.     ( (progn (setq cols (apply 'mapcar (cons 'list aL))) nil) )
31.     ( (InvalidAt 'ValidRowColp '(lambda (a b) (print (strcat "\nError at row n." b " :\n" (vl-prin1-to-string a)))) aL) )
32.     ( (InvalidAt 'ValidRowColp '(lambda (a b) (print (strcat "\nError at col n." b " :\n" (vl-prin1-to-string a)))) cols) )
33.     (
34.       (and (setq tmpL (mapcar (function (lambda (x) (GroupByN 3 x))) aL))
35.         (not
36.           (InvalidAt '(lambda (x) (ValidRowColp (apply 'append x))) '(lambda (a b) (print (strcat "\nError at sector n." b " :\n" (vl-prin1-to-string a))))
37.             (append ; Check 3x3 Matrix Sublists
38.               (GroupByN 3 (mapcar 'car tmpL))
39.               (GroupByN 3 (mapcar 'cadr tmpL))
40.               (GroupByN 3 (mapcar 'caddr tmpL))
41.             ); append
42.           )
43.         )
44.         (setq r T)
45.       ); progn
46.     )
47.   ); cond
48.   r
49. ); defun IsSudokuValid

Example:

Code - Auto/Visual Lisp: [Select]

1. _$ (IsSudokuValid
2.   '((6 9 3 2 8 5 1 4 7)
3.     (8 7 2 4 6 1 9 5 3)
4.     (4 1 5 7 3 9 8 2 6)
5.     (7 4 6 5 9 8 3 1 9)
6.     (1 8 1 3 2 6 4 7 5)
7.     (5 3 9 1 7 4 2 6 8)
8.     (9 2 7 8 5 3 6 9 4)
9.     (3 5 4 6 1 2 7 9 8)
10.     (1 6 8 9 4 7 5 3 2)
11.   )
12. )
13.  
14. "\nError at row n.4 :\n(7 4 6 5 9 8 3 1 9)" nil
15. _$ (IsSudokuValid
16.   '((9 3 4 8 2 5 6 1 7)
17.     (6 7 2 9 1 4 8 5 3)
18.     (5 1 8 6 3 7 9 2 4)
19.     (3 2 5 7 4 8 1 6 9)
20.     (4 6 9 1 5 3 7 8 2)
21.     (7 8 1 2 6 9 4 3 5)
22.     (1 9 7 5 8 2 3 4 6)
23.     (8 5 3 4 7 6 2 9 1)
24.     (2 4 6 3 9 1 5 7 8)
25.   )
26. )
27. T

Obviously can't help you with your code (sorry) since is out of my mind.

[Lee Mac]

Nice one Grrr1337 

FWIW, here's another way to write the 'ValidRowColp' function:

Code - Auto/Visual Lisp: [Select]

1. (defun validrowcolp ( l )
2.     (equal (mapcar '(lambda ( n ) (nth n l)) (vl-sort-i l '<)) '(1 2 3 4 5 6 7 8 9))
3. )

[Lee Mac]

Just for fun, here are two more ways to group the matrix into the 3x3 submatrices, depending on the order desired:

Code - Auto/Visual Lisp: [Select]

1. (defun bar ( m )
2.     (mapcar '(lambda ( x ) (apply 'append x))
3.         (apply 'append
4.             (mapcar '(lambda ( x ) (apply 'mapcar (cons 'list (mapcar 'foo x)))) (foo m))
5.         )
6.     )
7. )
8. (defun baz ( m )
9.     (mapcar '(lambda ( x ) (apply 'append x))
10.         (apply 'append
11.             (mapcar 'foo (apply 'mapcar (cons 'list (mapcar 'foo m))))
12.         )
13.     )
14. )
15. (defun foo ( m )
16.     (if m (cons (mapcar '(lambda ( a b ) a) m '(0 1 2)) (foo (cdddr m))))
17. )

Code - Auto/Visual Lisp: [Select]

1. (setq m
2.    '(
3.         (A1 A2 A3 A4 A5 A6 A7 A8 A9)
4.         (B1 B2 B3 B4 B5 B6 B7 B8 B9)
5.         (C1 C2 C3 C4 C5 C6 C7 C8 C9)
6.         (D1 D2 D3 D4 D5 D6 D7 D8 D9)
7.         (E1 E2 E3 E4 E5 E6 E7 E8 E9)
8.         (F1 F2 F3 F4 F5 F6 F7 F8 F9)
9.         (G1 G2 G3 G4 G5 G6 G7 G8 G9)
10.         (H1 H2 H3 H4 H5 H6 H7 H8 H9)
11.         (I1 I2 I3 I4 I5 I6 I7 I8 I9)
12.     )
13. )
14. _$ (bar m)
15. (
16.     (A1 A2 A3 B1 B2 B3 C1 C2 C3)
17.     (A4 A5 A6 B4 B5 B6 C4 C5 C6)
18.     (A7 A8 A9 B7 B8 B9 C7 C8 C9)
19.     (D1 D2 D3 E1 E2 E3 F1 F2 F3)
20.     (D4 D5 D6 E4 E5 E6 F4 F5 F6)
21.     (D7 D8 D9 E7 E8 E9 F7 F8 F9)
22.     (G1 G2 G3 H1 H2 H3 I1 I2 I3)
23.     (G4 G5 G6 H4 H5 H6 I4 I5 I6)
24.     (G7 G8 G9 H7 H8 H9 I7 I8 I9)
25. )
26. _$ (baz m)
27. (
28.     (A1 A2 A3 B1 B2 B3 C1 C2 C3)
29.     (D1 D2 D3 E1 E2 E3 F1 F2 F3)
30.     (G1 G2 G3 H1 H2 H3 I1 I2 I3)
31.     (A4 A5 A6 B4 B5 B6 C4 C5 C6)
32.     (D4 D5 D6 E4 E5 E6 F4 F5 F6)
33.     (G4 G5 G6 H4 H5 H6 I4 I5 I6)
34.     (A7 A8 A9 B7 B8 B9 C7 C8 C9)
35.     (D7 D8 D9 E7 E8 E9 F7 F8 F9)
36.     (G7 G8 G9 H7 H8 H9 I7 I8 I9)
37. )

[Lee Mac]

I think I'm there:

Code - Auto/Visual Lisp: [Select]

1. (defun sudoku ( l / r )
2.     (cond
3.         (   (vl-some
4.                 (function
5.                     (lambda ( r )
6.                         (vl-some 'null r)
7.                     )
8.                 )
9.                 l
10.             )
11.             (sudoku
12.                 (mapcar
13.                     (function
14.                         (lambda ( r )
15.                             (mapcar
16.                                 (function
17.                                     (lambda ( c )
18.                                         (if c (lsh 1 c) 1022)
19.                                     )
20.                                 )
21.                                 r
22.                             )
23.                         )
24.                     )
25.                     l
26.                 )
27.             )
28.         )
29.         (   (vl-some
30.                 (function
31.                     (lambda ( r )
32.                         (vl-some 'zerop r)
33.                     )
34.                 )
35.                 l
36.             )
37.             nil
38.         )
39.         (   (progn
40.                 (setq r
41.                     (mapcar
42.                         (function
43.                             (lambda ( r )
44.                                 (mapcar
45.                                     (function
46.                                         (lambda ( c )
47.                                             (if (pow2 c) c 0)
48.                                         )
49.                                     )
50.                                     r
51.                                 )
52.                             )
53.                         )
54.                         l
55.                     )
56.                 )
57.                 (not
58.                     (equalm l
59.                         (setq l
60.                             (mapcar
61.                                 (function
62.                                     (lambda ( r )
63.                                         (apply 'append r)
64.                                     )
65.                                 )
66.                                 (grd->mat
67.                                     (mapcar
68.                                         (function
69.                                             (lambda ( a b )
70.                                                 (mapcar
71.                                                     (function
72.                                                         (lambda ( c )
73.                                                             (mapcar
74.                                                                 (function
75.                                                                     (lambda ( d )
76.                                                                         (if (pow2 d) d (logand d (~ b)))
77.                                                                     )
78.                                                                 )
79.                                                                 c
80.                                                             )
81.                                                         )
82.                                                     )
83.                                                     a
84.                                                 )
85.                                             )
86.                                         )
87.                                         (apply 'append
88.                                             (mat->grd
89.                                                 (mat->grd
90.                                                     (apply 'mapcar
91.                                                         (cons 'list
92.                                                             (mapcar
93.                                                                 (function
94.                                                                     (lambda ( a b )
95.                                                                         (mapcar
96.                                                                             (function
97.                                                                                 (lambda ( c )
98.                                                                                     (if (pow2 c) c (logand c (~ b)))
99.                                                                                 )
100.                                                                             )
101.                                                                             a
102.                                                                         )
103.                                                                     )
104.                                                                 )
105.                                                                 (apply 'mapcar
106.                                                                     (cons 'list
107.                                                                         (mapcar
108.                                                                             (function
109.                                                                                 (lambda ( a b )
110.                                                                                     (mapcar
111.                                                                                         (function
112.                                                                                             (lambda ( c )
113.                                                                                                 (if (pow2 c) c (logand c (~ b)))
114.                                                                                             )
115.                                                                                         )
116.                                                                                         a
117.                                                                                     )
118.                                                                                 )
119.                                                                             )
120.                                                                             l
121.                                                                             (mapcar
122.                                                                                 (function
123.                                                                                     (lambda ( r )
124.                                                                                         (apply 'logior r)
125.                                                                                     )
126.                                                                                 )
127.                                                                                 r
128.                                                                             )
129.                                                                         )
130.                                                                     )
131.                                                                 )
132.                                                                 (mapcar
133.                                                                     (function
134.                                                                         (lambda ( c )
135.                                                                             (apply 'logior c)
136.                                                                         )
137.                                                                     )
138.                                                                     (apply 'mapcar (cons 'list r))
139.                                                                 )
140.                                                             )
141.                                                         )
142.                                                     )
143.                                                 )
144.                                             )
145.                                         )
146.                                         (mapcar
147.                                             (function
148.                                                 (lambda ( m )
149.                                                     (apply 'logior (apply 'append m))
150.                                                 )
151.                                             )
152.                                             (apply 'append (mat->grd (mat->grd r)))
153.                                         )
154.                                     )
155.                                 )
156.                             )
157.                         )
158.                     )
159.                 )
160.             )
161.             (sudoku l)
162.         )
163.         (
164.             (
165.                 (lambda ( / i j ) (setq i -1)
166.                     (vl-some
167.                         (function
168.                             (lambda ( r ) (setq i (1+ i) j -1)
169.                                 (vl-some
170.                                     (function
171.                                         (lambda ( c ) (setq j (1+ j))
172.                                             (if (and (< 0 c) (not (pow2 c)))
173.                                                 (vl-some
174.                                                     (function
175.                                                         (lambda ( d )
176.                                                             (sudoku (substij i j d l))
177.                                                         )
178.                                                     )
179.                                                     (bits c)
180.                                                 )
181.                                             )
182.                                         )
183.                                     )
184.                                     r
185.                                 )
186.                             )
187.                         )
188.                         l
189.                     )
190.                 )
191.             )
192.         )
193.         (   (or
194.                 (vl-some
195.                     (function
196.                         (lambda ( r )
197.                             (/= 1022 (apply 'logior r))
198.                         )
199.                     )
200.                     r
201.                 )
202.                 (vl-some
203.                     (function
204.                         (lambda ( c )
205.                             (/= 1022 (apply 'logior c))
206.                         )
207.                     )
208.                     (apply 'mapcar (cons 'list r))
209.                 )
210.                 (vl-some
211.                     (function
212.                         (lambda ( m )
213.                             (/= 1022 (apply 'logior (apply 'append m)))
214.                         )
215.                     )
216.                     (apply 'append (mat->grd (mat->grd r)))
217.                 )
218.             )
219.             nil
220.         )
221.         (   (mapcar
222.                 (function
223.                     (lambda ( r )
224.                         (mapcar
225.                             (function
226.                                 (lambda ( c )
227.                                     (fixn (log2 c))
228.                                 )
229.                             )
230.                             r
231.                         )
232.                     )
233.                 )
234.                 l
235.             )
236.         )
237.     )
238. )
239. (defun equalm ( a b )
240.     (vl-every '(lambda ( x y ) (vl-every '= x y)) a b)
241. )
242. (defun substij ( i j n m / a )
243.     (setq a -1)
244.     (mapcar
245.         (function
246.             (lambda ( x / b )
247.                 (if (= i (setq b -1 a (1+ a)))
248.                     (mapcar
249.                         (function
250.                             (lambda ( y )
251.                                 (if (= j (setq b (1+ b))) n y)
252.                             )
253.                         )
254.                         x
255.                     )
256.                     x
257.                 )
258.             )
259.         )
260.         m
261.     )
262. )
263. (defun mat->grd ( m )
264.     (if (car m)
265.         (cons
266.             (mapcar
267.                 (function
268.                     (lambda ( r )
269.                         (mapcar
270.                             (function
271.                                 (lambda ( a b ) a)
272.                             )
273.                             r '(0 1 2)
274.                         )
275.                     )
276.                 )
277.                 m
278.             )
279.             (mat->grd (mapcar 'cdddr m))
280.         )
281.     )
282. )
283. (defun grd->mat ( g )
284.     (if g
285.         (append
286.             (apply 'mapcar
287.                 (cons 'list
288.                     (mapcar
289.                         (function
290.                             (lambda ( a b ) a)
291.                         )
292.                         g '(0 1 2)
293.                     )
294.                 )
295.             )
296.             (grd->mat (cdddr g))
297.         )
298.     )
299. )
300. (defun log2 ( n ) (/ (log n) (log 2)))
301. (defun fixn ( n ) (fix (+ 1e-8 n)))
302. (defun pow2 ( n ) (if (zerop n) 0 ((lambda ( r ) (equal r (fixn r) 1e-8)) (log2 n))))
303. (defun bits ( n / b ) (if (< 0 n) (cons (setq b (lsh 1 (fixn (log2 n)))) (bits (- n b)))))

Though, the algorithm is essentially brute-force, so for sparse inputs be prepared to wait... 

(Now that the code is an utter mess, time for some refactoring)

[Grrr1337]

Nice one Grrr1337 

Thanks!

FWIW, here's another way to write the 'ValidRowColp' function:

Code - Auto/Visual Lisp: [Select]

1. (defun validrowcolp ( l )
2.   (equal (mapcar '(lambda ( n ) (nth n l)) (vl-sort-i l '<)) '(1 2 3 4 5 6 7 8 9))
3. )

Wow, cool - I didn't thought of this!

Lee, is there a reason to use:

Code: [Select]

(mapcar '(lambda ( n ) (nth n l)) (vl-sort-i l '<))rather than:

Code: [Select]

(vl-sort l '<)because now I think that the simpliest way to write it would be:

Code: [Select]

(defun validrowcolp ( l )
  (equal (vl-sort l '<) '(1 2 3 4 5 6 7 8 9))
)wouldn't came up with this, without your suggestion [since I might overthinked my version of ValidRowColp].   

Just for fun, here are two more ways to group the matrix into the 3x3 submatrices, depending on the order desired:
...

Thats very cool!

I think I'm there:
...
Though, the algorithm is essentially brute-force, so for sparse inputs be prepared to wait... 

Lee, are you sure it doesn't get into endless loop? :

Code - Auto/Visual Lisp: [Select]

1. (sudoku
2.   '(
3.     (6 nil nil nil 8 5 1 nil nil)
4.     (nil nil nil nil nil nil nil 5 3)
5.     (4 nil nil nil nil 9 8 nil nil)
6.     (nil nil nil nil nil nil nil 1 nil)
7.     (nil 8 nil 3 2 6 nil 7 nil)
8.     (nil 3 nil 1 nil nil nil nil nil)
9.     (nil nil 7 nil nil nil nil nil 4)
10.     (nil 5 nil nil nil nil nil nil nil)
11.     (nil nil nil 9 4 nil nil nil 2)
12.   )
13. )

BTW, I have an idea about the actual game (which includes DCL) but I must have more free time to write it.
Although it doesn't include sudoku solvers - just initial list of unsolved sudoku, like the above, along with user input and IsSudokuValid checking.

[Stefan]

Hello everyone

Here is my solution. It is very slow, but it can solve even the allegedly hardest sudoku in the world (btw, i couldn't solve it on paper...); the grid is supposed to be fair (no conflicts in the initial grid) and solvable.

Code - Auto/Visual Lisp: [Select]

1. (defun sudoku (ini / *error* o rows cols sqrs l cluster replace solve j)
2.  
3.   (defun *error* (msg) (princ))
4.  
5.   (setq o    '(  0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
6.                 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
7.                 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
8.               )
9.         rows '(( 0  1  2  3  4  5  6  7  8) ( 9 10 11 12 13 14 15 16 17) (18 19 20 21 22 23 24 25 26)
10.                (27 28 29 30 31 32 33 34 35) (36 37 38 39 40 41 42 43 44) (45 46 47 48 49 50 51 52 53)
11.                (54 55 56 57 58 59 60 61 62) (63 64 65 66 67 68 69 70 71) (72 73 74 75 76 77 78 79 80)
12.               )
13.         cols '(( 0  9 18 27 36 45 54 63 72) ( 1 10 19 28 37 46 55 64 73) ( 2 11 20 29 38 47 56 65 74)
14.                ( 3 12 21 30 39 48 57 66 75) ( 4 13 22 31 40 49 58 67 76) ( 5 14 23 32 41 50 59 68 77)
15.                ( 6 15 24 33 42 51 60 69 78) ( 7 16 25 34 43 52 61 70 79) ( 8 17 26 35 44 53 62 71 80)
16.               )
17.         sqrs '(( 0  1  2  9 10 11 18 19 20) ( 3  4  5 12 13 14 21 22 23) ( 6  7  8 15 16 17 24 25 26)
18.                (27 28 29 36 37 38 45 46 47) (30 31 32 39 40 41 48 49 50) (33 34 35 42 43 44 51 52 53)
19.                (54 55 56 63 64 65 72 73 74) (57 58 59 66 67 68 75 76 77) (60 61 62 69 70 71 78 79 80)
20.               )
21.         l     '(1 2 3 4 5 6 7 8 9)
22.         j     0
23.   )
24.  
25.   (defun cluster (m i a)
26.     (mapcar
27.      '(lambda (x) (nth x m))
28.       (vl-some '(lambda (x) (if (vl-position i x) x)) a)
29.     )
30.   )
31.  
32.   (defun replace (q m)
33.     (mapcar
34.       '(lambda (i n)
35.          (cond ((cadr (assoc i q))) (n))
36.        )
37.       o m
38.     )
39.   )
40.  
41.   (defun solve (m f / i x c r u cd1 n q)
42. ;;;    (print m)
43.     (if
44.       (vl-every 'numberp m)
45.       (progn
46.         (princ "\n")
47.         (mapcar
48.          '(lambda (a b)
49.             (princ (if (zerop (rem a 9)) "\n " " ")) (princ b)
50.             (if
51.               (vl-position (rem a 9) '(2 5))
52.               (princ " |")
53.             )
54.             (if
55.               (vl-position a '(26 53))
56.               (princ "\n ---------------------")
57.             )      
58.           )
59.           o m
60.         )
61.         (princ "\n") ;(princ j)
62.         (textscr)
63.         (quit)
64.       )
65.     )
66.  
67.     (setq i 80 j (1+ j))
68.     (while (>= i 0)
69.       (setq x (nth i m))
70.       (if
71.         (not x)
72.         (progn
73.           (setq u (append (cluster m i rows) (cluster m i cols) (cluster m i sqrs)))
74.           (if
75.             (setq c (vl-remove-if '(lambda (n) (member n u)) l))
76.             (setq r (cons (cons i c) r))
77.             (setq r nil i -1)
78.           )
79.         )
80.       )
81.       (setq i (1- i))
82.     )
83.    
84.     (setq q (vl-remove-if '(lambda (a) (cddr a)) r))
85.    
86.     (foreach sect '(rows cols sqrs)
87.       (foreach group (eval sect)
88.         (setq cd1 (vl-remove-if-not '(lambda (a) (vl-position (car a) group)) r))
89.         (foreach a cd1
90.           (setq n (car a))
91.           (foreach e (cdr a)
92.             (or
93.               (vl-some '(lambda (b) (vl-position e (cdr b))) (vl-remove a cd1))
94.               (assoc n q)
95.               (setq q (cons (list n e) q))
96.             )
97.           )
98.         )
99.       )
100.     )
101.    
102.     (cond
103.       (q ;(print q)
104.         (if f
105.           (solve (replace (list (car q)) m) f)
106.           (solve (replace            q   m) f)
107.         )
108.       )
109.       (r
110.         (foreach a (cdar r)
111.           (solve (replace (list (list (caar r) a)) m) t)
112.         )
113.       )
114.     )
115.   )
116.   (solve (cond ((= (length ini) 9) (apply 'append ini)) (ini))  nil)
117. )

Code - Auto/Visual Lisp: [Select]

1. ;hardest sudoku
2. (sudoku '(
3.            (  8 nil nil nil nil nil nil nil nil)
4.            (nil nil   3   6 nil nil nil nil nil)
5.            (nil   7 nil nil   9 nil   2 nil nil)
6.            (nil   5 nil nil nil   7 nil nil nil)
7.            (nil nil nil nil   4   5   7 nil nil)
8.            (nil nil nil   1 nil nil nil   3 nil)
9.            (nil nil   1 nil nil nil nil   6   8)
10.            (nil nil   8   5 nil nil nil   1 nil)
11.            (nil   9 nil nil nil nil   4 nil nil)
12.          )
13. )
14. ;test grid 1
15. (sudoku '(
16.            (  6 nil nil nil   8   5   1 nil nil)
17.            (nil nil nil nil nil nil nil   5   3)
18.            (  4 nil nil nil nil   9   8 nil nil)
19.            (nil nil nil nil nil nil nil   1 nil)
20.            (nil   8 nil   3   2   6 nil   7 nil)
21.            (nil   3 nil   1 nil nil nil nil nil)
22.            (nil nil   7 nil nil nil nil nil   4)
23.            (nil   5 nil nil nil nil nil nil nil)
24.            (nil nil nil   9   4 nil nil nil   2)
25.          )
26. )
27. ;test grid 2
28. (sudoku '(
29.            (nil nil   4   8 nil nil nil  1    7)
30.            (  6   7 nil   9 nil nil nil nil nil)
31.            (  5 nil   8 nil   3 nil nil nil   4)
32.            (  3 nil nil   7   4 nil   1 nil nil)
33.            (nil   6   9 nil nil nil   7   8 nil)
34.            (nil nil   1 nil   6   9 nil nil   5)
35.            (  1 nil nil nil   8 nil   3 nil   6)
36.            (nil nil nil nil nil   6 nil   9   1)
37.            (  2   4 nil nil nil   1   5 nil nil)
38.          )
39. )
40. ;some grid
41. (sudoku '(
42.            (  1 nil nil nil nil   7 nil   9 nil)
43.            (nil   3 nil nil   2 nil nil nil   8)
44.            (nil nil   9   6 nil nil   5 nil nil)
45.            (nil nil   5   3 nil nil   9 nil nil)
46.            (nil   1 nil nil   8 nil nil nil   2)
47.            (  6 nil nil nil nil   4 nil nil nil)
48.            (  3 nil nil nil nil nil nil   1 nil)
49.            (nil   4 nil nil nil nil nil nil   7)
50.            (nil nil   7 nil nil nil   3 nil nil)
51.         )
52. )

[Lee Mac]

I shall certainly be studying your solution Stefan!

On first glance, I really like your much simpler method of selecting the row/column/square entries, rather than the intricate list manipulation involved in my code...

[ronjonp]

Hello everyone

Here is my solution. It is very slow, but it can solve even the allegedly hardest sudoku in the world (btw, i couldn't solve it on paper...); the grid is supposed to be fair (no conflicts in the initial grid) and solvable.
...

That is slick 

Code - Auto/Visual Lisp: [Select]

1. (sudoku '((8 nil nil nil nil nil nil nil nil)
2.           (nil nil 3 6 nil nil nil nil nil)
3.           (nil 7 nil nil 9 nil 2 nil nil)
4.           (nil 5 nil nil nil 7 nil nil nil)
5.           (nil nil nil nil 4 5 7 nil nil)
6.           (nil nil nil 1 nil nil nil 3 nil)
7.           (nil nil 1 nil nil nil nil 6 8)
8.           (nil nil 8 5 nil nil nil 1 nil)
9.           (nil 9 nil nil nil nil nil nil nil)
10.          )
11. )
12. ;;< Elapsed time: 5.968000 seconds. >
13. ;;; 8 1 2 | 7 5 3 | 6 4 9
14. ;;; 9 4 3 | 6 8 2 | 1 7 5
15. ;;; 6 7 5 | 4 9 1 | 2 8 3
16. ;;; ---------------------
17. ;;; 1 5 4 | 2 3 7 | 8 9 6
18. ;;; 3 6 9 | 8 4 5 | 7 2 1
19. ;;; 2 8 7 | 1 6 9 | 5 3 4
20. ;;; ---------------------
21. ;;; 5 2 1 | 9 7 4 | 3 6 8
22. ;;; 4 3 8 | 5 2 6 | 9 1 7
23. ;;; 7 9 6 | 3 1 8 | 4 5 2
24.  
25.  
26. (sudoku '((nil nil 2 nil nil 9 1 nil nil)
27.           (nil nil nil 8 3 6 nil 7 nil)
28.           (nil nil nil nil nil nil nil 8 nil)
29.           (nil nil 1 nil nil nil 2 4 nil)
30.           (3 nil nil 6 5 4 nil nil 7)
31.           (nil 7 9 nil nil nil 6 nil nil)
32.           (nil 5 nil nil nil nil nil nil nil)
33.           (nil 3 nil 4 1 5 nil nil nil)
34.           (nil nil 4 2 nil nil 3 nil nil)
35.          )
36. )
37. ;;< Elapsed time: 0.453000 seconds. >
38. ;;; 7 8 2 | 5 4 9 | 1 6 3
39. ;;; 9 1 5 | 8 3 6 | 4 7 2
40. ;;; 6 4 3 | 7 2 1 | 5 8 9
41. ;;; ---------------------
42. ;;; 5 6 1 | 9 7 3 | 2 4 8
43. ;;; 3 2 8 | 6 5 4 | 9 1 7
44. ;;; 4 7 9 | 1 8 2 | 6 3 5
45. ;;; ---------------------
46. ;;; 1 5 6 | 3 9 8 | 7 2 4
47. ;;; 2 3 7 | 4 1 5 | 8 9 6
48. ;;; 8 9 4 | 2 6 7 | 3 5 1

[Grrr1337]

BTW, I have an idea about the actual game (which includes DCL) but I must have more free time to write it.
Although it doesn't include sudoku solvers - just initial list of unsolved sudoku, like the above, along with user input and IsSudokuValid checking.

Here it is (better to be late than never) :

Code - Auto/Visual Lisp: [Select]

1. ; https://www.theswamp.org/index.php?topic=53547.0
2. (defun PlaySudoku ( aL / _MatrixSubstNth PlaySudoku:IsSudokuValid txt2num *error* dcl des dch dcf deferrmsg nL row col kL rL )
3.   '(87 114 105 116 116 101 110 32 98 121 32 71 114 114 114)
4.   ; _$ (_MatrixSubstNth '(1 2) "K" '(("A" "B" "C")("D" "E" "F")("G" "H" "I"))) -> (("A" "B" "C") ("D" "E" "K") ("G" "H" "I"))
5.   ; _$ (_MatrixSubstNth '(1 8) "K" '(("A" "B" "C")("D" "E" "F")("G" "H" "I"))) -> (("A" "B" "C") ("D" "E" "F") ("G" "H" "I"))
6.   (defun _MatrixSubstNth ( NthL NewItm aL / r c )
7.     (setq r -1) (mapcar (function (lambda (row) (setq r (1+ r)) (setq c -1) (mapcar (function (lambda (itm) (setq c (1+ c)) (if (equal (list r c) NthL 1e-1) NewItm itm))) row))) aL)
8.   ); defun _MatrixSubstNth
9.  
10.   (defun PlaySudoku:IsSudokuValid ( aL / InvalidAt GroupByN ValidRowColp cols tmpL r )
11.    
12.     ; _$ (InvalidAt '(lambda (a) (= a 5)) '(lambda (a b) (print (strcat "Error at item n."  b " :\n" (vl-prin1-to-string a)))) '(1 2 3 4 5 6 7 8 9)) -> "Error at item n.1 :\n1" T
13.     ; _$ (InvalidAt '(lambda (a) (/= a 5)) '(lambda (a b) (print (strcat "Error at item n."  b " :\n" (vl-prin1-to-string a)))) '(1 2 3 4 5 6 7 8 9)) -> "Error at item n.5 :\n5" T
14.     ; _$ (InvalidAt '(lambda (a) (/= a 15)) '(lambda (a b) (print (strcat "Error at item n."  b " :\n" (vl-prin1-to-string a)))) '(1 2 3 4 5 6 7 8 9)) -> nil
15.     (setq InvalidAt
16.       (lambda ( f mf L / i )
17.         (setq i 0) (setq f (eval f)) (setq mf (eval mf))
18.         (vl-some (function (lambda (x) (setq i (1+ i)) (if (not (f x)) (progn (mf x (itoa i)) T)))) L)
19.       )
20.     ); setq InvalidAt
21.    
22.     (defun GroupByN ( n L / r )
23.       (repeat n (and L (setq r (cons (car L) r))) (setq L (cdr L)) r)
24.       (if L (cons (reverse r) (GroupByN n L)) (list (reverse r)))
25.     ); defun GroupByN
26.    
27.     ; _$ (ValidRowColp '(1 2 3 6 5 4 7 8 9)) -> T
28.     ; _$ (ValidRowColp '(1 2 3 6 9 4 7 8 9)) -> nil
29.     (defun ValidRowColp ( L / nL )
30.       (setq nL '(1 2 3 4 5 6 7 8 9))
31.       (vl-every (function (lambda (x) (if (member x nL) (progn (setq nL (vl-remove x nL)) T)))) L)
32.     ); defun ValidRowColp
33.    
34.     (cond
35.       ( (not (vl-consp aL)) (prompt "\n#1. Not vl-consp.") )
36.       ( (/= 9 (length aL)) (prompt "\n#2. Invalid length.") )
37.       ( (InvalidAt '(lambda (x) (and (vl-consp x) (= 9 (length x)))) '(lambda (a b) (print (strcat "\nError[basic] at row n." b " :\n" (vl-prin1-to-string a)))) aL) )
38.       ; ( (InvalidAt '(lambda (x) (and (eq 'INT (type x)) (<= 1 x 9))) '(lambda (a b) (print (strcat "\nError at atom n." b " :\n" (vl-prin1-to-string a)))) (apply 'append aL)) )
39.       ( (progn (setq cols (apply 'mapcar (cons 'list aL))) nil) )
40.       ( (InvalidAt 'ValidRowColp '(lambda (a b) (set_tile "error" (strcat "*Error at row n." b " : " (vl-prin1-to-string a) "*"))) aL) )
41.       ( (InvalidAt 'ValidRowColp '(lambda (a b) (set_tile "error" (strcat "*Error at col n." b " : " (vl-prin1-to-string a) "*"))) cols) )
42.       (
43.         (and (setq tmpL (mapcar (function (lambda (x) (GroupByN 3 x))) aL))
44.           (not
45.             (InvalidAt '(lambda (x) (ValidRowColp (apply 'append x))) '(lambda (a b) (set_tile "error" (strcat "Error at sector n." b " : " (vl-prin1-to-string a) "*")))
46.               (append ; Check 3x3 Matrix Sublists
47.                 (GroupByN 3 (mapcar 'car tmpL))
48.                 (GroupByN 3 (mapcar 'cadr tmpL))
49.                 (GroupByN 3 (mapcar 'caddr tmpL))
50.               ); append
51.             )
52.           )
53.           (setq r T)
54.         ); progn
55.       )
56.     ); cond
57.     r
58.   ); defun IsSudokuValid
59.  
60.   (setq txt2num (lambda ( txt / num ) (if (and txt (numberp (setq num (vl-some '(lambda (x) (distof txt x)) (list (getvar 'lunits) 1 2 3 4 5))))) num)))
61.  
62.   (defun *error* ( msg )
63.     (and (< 0 dch) (unload_dialog dch))
64.     (and (eq 'FILE (type des)) (close des))
65.     (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
66.     (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
67.     (princ)
68.   ); defun *error*
69.  
70.   (cond
71.     ( (not (vl-consp aL)) (princ "\nInvalid input - aL is not a list.") )
72.     ( (or (/= 9 (length aL)) (not (vl-every '(lambda (x) (and (vl-consp x) (= 9 (length x)) (vl-every '(lambda (i) (or (not i) (eq 'INT (type i)))) x))) aL)))
73.       (princ "\nInvalid list, the format must be 9x9 assoc list of integers and nils")
74.     )
75.     ( (progn (setq nL (apply 'mapcar (cons 'list aL))) nil) ) ; Thats right, I'll write it with column-mode, cause of aligning issues
76.     (
77.       (not
78.         (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
79.           (mapcar (function (lambda (x) (princ (strcat "\n" x) des)))
80.             (list
81.               "PlaySudoku : dialog"
82.               "{ label = \"Sudoku\"; children_alignment = centered; spacer;"
83.               (strcat
84.                 "\n: row"
85.                 "{"
86.                 (apply 'strcat
87.                   (progn (setq col -1)
88.                     (mapcar
89.                       (function
90.                         (lambda ( _col ) (setq col (1+ col))
91.                           (strcat
92.                             "\n: column"
93.                             "\n{ children_fixed_width = true; children_alignment = centered; "
94.                             (apply 'strcat
95.                               (progn (setq row -1)
96.                                 (mapcar
97.                                   (function
98.                                     (lambda ( x / k ) (setq row (1+ row))
99.                                       (setq k (apply 'strcat (mapcar 'itoa (list row col))))
100.                                       (setq kL (cons k kL))
101.                                       (cond
102.                                         ( (null x)
103.                                           (strcat
104.                                             "\n: edit_box { key = \"" k "\"; alignment = centered; edit_width = 3; }"
105.                                           ); strcat
106.                                         ) ; (null x)
107.                                         ( (eq 'INT (type x))
108.                                           (strcat
109.                                             "\n: edit_box { value = \"" (strcat "   " (itoa x)) "\"; key = \"" k "\"; alignment = centered; edit_width = 3; is_enabled = false; }"
110.                                             ; "\n: button { label = \"" (itoa x) "\"; key = \"" k "\"; width = 1; height = 1; is_enabled = true; }"  ; button tile just can't align properly along with the edit_box
111.                                           ); strcat
112.                                         )
113.                                       ); cond
114.                                     ); lambda (x)
115.                                   )
116.                                   _col
117.                                 ); mapcar
118.                               ); progn
119.                             ); apply 'strcat
120.                             "\n}"
121.                           ); strcat
122.                         ); lambda ( _col )
123.                       ); function
124.                       nL
125.                     ); mapcar
126.                   ); progn
127.                 ); apply 'strcat
128.                 "}"
129.               ); strcat
130.               (strcat "  spacer; ok_cancel; : text { label = \"" (setq deferrmsg ">> Solve this Sudoku / Use [TAB] and [1-9] keys <<") "\"; key = \"error\"; }") ; deferrmsg = default error message
131.               "}"
132.             ); list
133.           ); mapcar
134.           (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl)))
135.         ); and
136.       ); not
137.       (princ "\nUnable to write or load the DCL file.")
138.     )
139.     ( (not (new_dialog "PlaySudoku" dch)) (princ "\nUnable to display the dialog") )
140.     (
141.       (progn
142.         (setq kL (reverse kL)) ; zero-based matrix string list: "00", "01" ... "88"
143.         (mapcar (function (lambda (x) (client_data_tile x (get_tile x)))) kL)
144.         (setq rL (mapcar 'cons kL (mapcar 'get_tile kL))) ; initially set the return list
145.         (mapcar
146.           (function
147.             (lambda (x)
148.               (action_tile x
149.                 (vl-prin1-to-string
150.                   (quote
151.                     (
152.                       (lambda ( / v r c )
153.                         (mapcar (function (lambda (xx / vi vs) (and (setq vi (txt2num (setq vs (get_tile xx)))) (<= 1 vi 9) (set_tile xx (strcat "   " (itoa (read vs))))))) kL) ; acts like an reactor - prety cool, huh?
154.                         (set_tile "error" deferrmsg)
155.                         (mapcar 'set '(r c) (mapcar 'itoa (mapcar '1+ (mapcar 'read (mapcar 'chr (vl-string->list $key))))))
156.                         (cond
157.                           ( (= $data $value) )
158.                           ( (and (setq v (txt2num $value)) (<= 1 v 9))
159.                             (client_data_tile $key $value)
160.                             (setq rL (subst (cons $key $value) (assoc $key rL) rL))
161.                           )
162.                           ( (progn (set_tile $key $data) (set_tile "error" (strcat "*Error: Invalid input at tile [" r "-" c "].*")) (mode_tile $key 2)) )
163.                         ); cond
164.                         ; (setq keys (subst (cons $key $data) (assoc $key keys) keys)) ; QUOTE/apostrophe ruins the 'strcase' status
165.                       ); lambda ( / v )
166.                     )
167.                   ); quote
168.                 ); vl-prin1-to-string
169.               ); action_tile x
170.             ); lambda
171.           ); function
172.           kL
173.         ); mapcar
174.         (action_tile "accept"
175.           (vl-prin1-to-string
176.             '(
177.               (lambda nil
178.                 (mapcar
179.                   (function
180.                     (lambda (x / k kx ky v ) ; _$ (substr "ab" 1 1) -> "a" ; _$ (substr "ab" 2 2) -> "b"
181.                       (setq k (car x))
182.                       (setq kx (atoi (substr k 1 1)))
183.                       (setq ky (atoi (substr k 2 2)))
184.                       (setq v (read (cdr x)))
185.                       (setq aL (_MatrixSubstNth (list kx ky) v aL))
186.                     )
187.                   )
188.                   rL
189.                 ); mapcar
190.                 (cond
191.                   ; ( (not (IsSudokuValid aL)) (set_tile "error" "*** Error: Invalid sudoku! ***") )
192.                   (
193.                     (vl-some
194.                       (function
195.                         (lambda (x / a b v r c )
196.                           (setq a (car x)) (setq b (cdr x)) (setq v (read b))
197.                           (cond
198.                             ( (and (eq 'INT (type v)) (<= 1 v 9)) nil)
199.                             (
200.                               (progn
201.                                 (mapcar 'set '(r c) (mapcar 'itoa (mapcar '1+ (mapcar 'read (mapcar 'chr (vl-string->list a))))))
202.                                 (set_tile "error" (strcat "*Error, empty item at Row: " r ", Column: " c "*"))
203.                                 (mode_tile a 2) T
204.                               ); progn
205.                             )
206.                             ; ( (progn (set_tile "error" (strcat "*** Error: Invalid item: " a "! ***")) (mode_tile a 3) T) )
207.                           ); cond
208.                         ); lambda
209.                       ); function
210.                       rL
211.                     ); vl-some
212.                   )
213.                   ( (not (PlaySudoku:IsSudokuValid aL))  )
214.                   ( (done_dialog 1) )
215.                 ); cond
216.               ); lambda ( L )
217.             )
218.           )
219.         ); action_tile "accept"
220.         (/= 1 (setq dcf (start_dialog)))
221.       ); progn
222.       (princ "\nUser cancelled the dialog.")
223.     )
224.     ( (progn (alert "You won! Next time I'll put some picture here.") T) )
225.   ); cond
226.   (*error* nil) (princ) aL
227. ); defun PlaySudoku

Example:

Code: [Select]

(PlaySudoku
  '(
    (nil nil  4   8  nil nil nil  1   7 )
    ( 6   7  nil  9  nil nil nil nil nil)
    ( 5  nil  8  nil  3  nil nil nil  4 )
    ( 3  nil nil  7   4  nil  1  nil nil)
    (nil  6   9  nil nil nil  7   8  nil)
    (nil nil  1  nil  6   9  nil nil  5 )
    ( 1  nil nil nil  8  nil  3  nil  6 )
    (nil nil nil nil nil  6  nil  9   1 )
    ( 2   4  nil nil nil  1   5  nil nil)
  )
)

; Answer is:
(
  (9 3 4 8 2 5 6 1 7)
  (6 7 2 9 1 4 8 5 3)
  (5 1 8 6 3 7 9 2 4)
  (3 2 5 7 4 8 1 6 9)
  (4 6 9 1 5 3 7 8 2)
  (7 8 1 2 6 9 4 3 5)
  (1 9 7 5 8 2 3 4 6)
  (8 5 3 4 7 6 2 9 1)
  (2 4 6 3 9 1 5 7 8)
)

The dialog is based on a technique I demonstrated here.
And I'm still thankful to Lee Mac for tutoring me on DCL and other different LISP stuff.

BTW I thought about including "I'm giving up" button - that solves the sudoku, by using a subfunction like Stefan's. But at this point I'm leaving the routine like this.

[ribarm]

Thanks Grrr, you saved us from typing boring DCL... Nice usage of your subs, btw... Now I shell start torturing people with the hardest one posted by Stefan...
 

[Grrr1337]

Thanks Marko, I rather find DCL very interesting

BTW I think it would be handy if someone wrote an UnSolvedSudokuGenerator routine, that will return a sudoku list (like in our inputs) to be solved.
The only way I could figure out to start with is this:

Code - Auto/Visual Lisp: [Select]

1. ; note: 'x' stands for nil symbol (I used it for a better readability)
2. (foo n)
3. ->
4. '( ; argument 'n' will fill for each Sector n amounth of random [1-9] items
5.   (x x x  x x x  x x x)
6.   (x x x  x x x  x x x)
7.   (x x x  x x x  x x x)
8.  
9.   (x x x  x x x  x x x)
10.   (x x x  x x x  x x x)
11.   (x x x  x x x  x x x)
12.  
13.   (x x x  x x x  x x x)
14.   (x x x  x x x  x x x)
15.   (x x x  x x x  x x x)
16. )
17.  
18. ; Examples:
19. (foo 1) -> ; Hard/Impossible ?
20. '( ; argument 'n' will fill for each Sector n amounth of random [1-9] items
21.   (1 x x  x x x  x x x)
22.   (x x x  x 3 x  x x 7)
23.   (x x x  x x x  x x x)
24.  
25.   (x x x  4 x x  x x x)
26.   (x 3 x  x x x  x x x)
27.   (x x x  x x x  x x 2)
28.  
29.   (x x x  x x x  x 5 x)
30.   (2 x x  6 x x  x x x)
31.   (x x x  x x x  x x x)
32. )
33.  
34. (foo 2) -> ; Medium/Hard ?
35. '( ; argument 'n' will fill for each Sector n amounth of random [1-9] items
36.   (x 2 x  x x 5  x x x)
37.   (3 x x  x x x  x x x)
38.   (x x x  4 x x  1 5 x)
39.  
40.   (x x 6  x x 3  x x 1)
41.   (x 1 x  x 7 x  x x x)
42.   (x x x  x x x  9 x x)
43.  
44.   (x x x  2 x x  x x 7)
45.   (x x 2  x x 1  x x x)
46.   (x 6 x  x x x  x 8 x)
47. )
48.  
49. (foo 3) -> ; Easy/Medium
50. '( ; argument 'n' will fill for each Sector n amounth of random [1-9] items
51.   (x 2 x  x x 5  x 4 x)
52.   (3 x x  x 1 x  x x x)
53.   (x x 4  4 x x  1 5 x)
54.  
55.   (x x 6  x x 3  x x 1)
56.   (x 1 x  x 7 x  x x x)
57.   (5 x x  8 x x  9 x 4)
58.  
59.   (1 x x  2 x x  2 x 7)
60.   (x x 2  x x 1  x x x)
61.   (x 6 x  x 3 x  x 8 x)
62. )

To split the above task, maybe just generate a different (1 2 3 4 5 6 7 8 9) lists, say given 'n = 3', generate list with random [1-9] numbers on random positions of the list.
Say 9 list outputs like: (nil nil 2 nil 9 nil 6 nil nil) merged into assoc list.
Then use Lee's bar subfunction he posted in Reply #10 to re-assemble the whole list.
Might be required IsUnSolvedSudokuValid function.
Ofcourse before giving any return, must make sure generator's output to be valid/solvable, hence should be wrapped within a loop and tested if the sudoku is solvable(with a routine like Stefan's).

I know my idea doesn't cover all types unsolved sudoku generators, since 'n' amount is not fixed always for the sectors, but would be a good start.

Then, the future ideas for the DCL work would be:

Initial Dialog Prompt with Buttons (choose difficulty):
[Easy/Medium]
[Medium/Hard]
[Hard/Impossible]

And after all this, the top of the cake would be to make it competitive, where each user collects points for different solved sudoku.
+ wrapping all posted suggestions in this thread will make the overall code better (like including buttons [I'm giving up, show answer] ).

[Lee Mac]

Here it is (better to be late than never)

Nice DCL Grrr1337 - how about we add some gridlines 

[Grrr1337]

Here it is (better to be late than never)

Nice DCL Grrr1337 - how about we add some gridlines 

Thanks, Lee!
Your dialog looks prettier, so I shall rewrite that code, using your suggestion..
Most importantly for me is that I could learn some new stuff from your code, like the custom predefined tiles and using the dialog's key to set a label - so thanks for sharing! 

BTW I think it would look even better with outer borders, but I'm not good with using/visualising the vector_image funciton, so heres something I can be a shame of  :...

[pBe]

excellent codes everyone

[Stefan]

That is slick 

Code - Auto/Visual Lisp: [Select]

1. (sudoku '((8 nil nil nil nil nil nil nil nil)
2.           (nil nil 3 6 nil nil nil nil nil)
3.           (nil 7 nil nil 9 nil 2 nil nil)
4.           (nil 5 nil nil nil 7 nil nil nil)
5.           (nil nil nil nil 4 5 7 nil nil)
6.           (nil nil nil 1 nil nil nil 3 nil)
7.           (nil nil 1 nil nil nil nil 6 8)
8.           (nil nil 8 5 nil nil nil 1 nil)
9.           (nil 9 nil nil nil nil nil nil nil)
10.          )
11. )
12. ;;< Elapsed time: 5.968000 seconds. >
13. ...

Thanks for the test ronjonp. On my computer it takes 20sec and 700+ iterations.
I do have another version that takes only 5 sec in my computer and 161 iterations, but at a closer look, it is just by chance. For the reverse matrix, it would take 3000+ iterations and a very long time.


And this is my unfinished sudoku dialog.

[ronjonp]

I compiled your code and optimized the '(lambda  to (function (lambda ...  it solved that puzzle in about 1/2 a second. Nice work 

[Lee Mac]

Great dialog Stefan - a shame that the colours invert when an image button is clicked... 

[Stefan]

Great dialog Stefan - a shame that the colours invert when an image button is clicked... 

Yes, exactly my thoughts... That's why I used 252 for the background. It's very close to its complementary color. What you see flickering is the text and the grid.

[Stefan]

New dialog.

[Grrr1337]

New dialog.

Wow, this one looks insane! 
Did you use standard DCL or Open/Object DCL to code it?

[Lee Mac]

Awesome work Stefan, I'm impressed.

[MP]

Impressive work Stefan, kudos.

[HasanCAD]

WOW
I belive that it is better than Sudoku on Android

[Stefan]

Thanks guys

You might expect some code but right now it is a mess and I cannot publish it like this.
All I can tell you, it is really nothing special, just an ordinary DCL made entirely of image tiles, with different background colors.
If I ever finish it, I'll publish the code.