Code Red > AutoLISP (Vanilla / Visual)
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: ---(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 ) (defun rcs ( m i j / r c s ) (setq r (nth (1- i) m)) (setq c (nth (1- j) (apply 'mapcar (cons 'list m)))) (setq s (cond ( (and (<= 1 i 3) (<= 1 j 3)) (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))) ) ( (and (<= 1 i 3) (<= 4 j 6)) (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))) ) ( (and (<= 1 i 3) (<= 7 j 9)) (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))) ) ( (and (<= 4 i 6) (<= 1 j 3)) (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))) ) ( (and (<= 4 i 6) (<= 4 j 6)) (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))) ) ( (and (<= 4 i 6) (<= 7 j 9)) (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))) ) ( (and (<= 7 i 9) (<= 1 j 3)) (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))) ) ( (and (<= 7 i 9) (<= 4 j 6)) (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))) ) ( (and (<= 7 i 9) (<= 7 j 9)) (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))) ) ) ) (list r c s) ) (defun solve ( m i j / v r c s rn cn sn nn ) (setq v '(1 2 3 4 5 6 7 8 9)) (mapcar 'set '(r c s) (rcs m i j)) (setq nn (vl-remove-if '(lambda ( x ) (vl-position x s)) v)) (setq nn (vl-remove-if '(lambda ( x ) (vl-position x r)) nn)) (setq nn (vl-remove-if '(lambda ( x ) (vl-position x c)) nn)) (vl-sort nn '<) ) (defun solve-adv ( m i j / nn ii jj x gx rfs cfs sfs rfsg cfsg sfsg ) (setq nn (solve m i j)) (setq jj 0) (setq rfs (vl-remove nil (mapcar '(lambda ( x ) (setq jj (1+ jj)) (if (null x) (read (strcat "f" (itoa i) (itoa jj))))) r))) (setq ii 0) (setq cfs (vl-remove nil (mapcar '(lambda ( x ) (setq ii (1+ ii)) (if (null x) (read (strcat "f" (itoa ii) (itoa j))))) c))) (setq sfs (vl-remove nil (cond ( (and (<= 1 i 3) (<= 1 j 3)) (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"))) ) ( (and (<= 1 i 3) (<= 4 j 6)) (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"))) ) ( (and (<= 1 i 3) (<= 7 j 9)) (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"))) ) ( (and (<= 4 i 6) (<= 1 j 3)) (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"))) ) ( (and (<= 4 i 6) (<= 4 j 6)) (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"))) ) ( (and (<= 4 i 6) (<= 7 j 9)) (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"))) ) ( (and (<= 7 i 9) (<= 1 j 3)) (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"))) ) ( (and (<= 7 i 9) (<= 4 j 6)) (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"))) ) ( (and (<= 7 i 9) (<= 7 j 9)) (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"))) ) ) )) (setq rfs (vl-remove (read (strcat "f" (itoa i) (itoa j))) rfs)) (setq cfs (vl-remove (read (strcat "f" (itoa i) (itoa j))) cfs)) (setq sfs (vl-remove (read (strcat "f" (itoa i) (itoa j))) sfs)) (setq rfs (mapcar '(lambda ( x ) (eval x)) rfs)) (setq cfs (mapcar '(lambda ( x ) (eval x)) cfs)) (setq sfs (mapcar '(lambda ( x ) (eval x)) sfs)) (while (setq x (car rfs)) (setq gx (vl-remove-if-not '(lambda ( a ) (equal x a)) rfs)) (setq rfs (vl-remove-if '(lambda ( a ) (vl-position a gx)) rfs)) (setq rfsg (cons gx rfsg)) ) (while (setq x (car cfs)) (setq gx (vl-remove-if-not '(lambda ( a ) (equal x a)) cfs)) (setq cfs (vl-remove-if '(lambda ( a ) (vl-position a gx)) cfs)) (setq cfsg (cons gx cfsg)) ) (while (setq x (car sfs)) (setq gx (vl-remove-if-not '(lambda ( a ) (equal x a)) sfs)) (setq sfs (vl-remove-if '(lambda ( a ) (vl-position a gx)) sfs)) (setq sfsg (cons gx sfsg)) ) (foreach g rfsg (if (and (> (length g) 1) (= (length g) (length (car g)))) (setq nn (vl-remove-if '(lambda ( x ) (vl-position x (car g))) nn)) ) ) (foreach g cfsg (if (and (> (length g) 1) (= (length g) (length (car g)))) (setq nn (vl-remove-if '(lambda ( x ) (vl-position x (car g))) nn)) ) ) (foreach g sfsg (if (and (> (length g) 1) (= (length g) (length (car g)))) (setq nn (vl-remove-if '(lambda ( x ) (vl-position x (car g))) nn)) ) ) (vl-sort nn '<) ) (defun check ( m / v i j r c s rtn ) (setq v '(1 2 3 4 5 6 7 8 9)) (setq i 0) (repeat 9 (setq i (1+ i) j 0) (repeat 9 (setq j (1+ j)) (mapcar 'set '(r c s) (rcs m i j)) (if (and (null (vl-remove-if '(lambda ( x ) (vl-position x s)) v)) (null (vl-remove-if '(lambda ( x ) (vl-position x r)) v)) (null (vl-remove-if '(lambda ( x ) (vl-position x c)) v)) ) (setq rtn (cons t rtn)) (setq rtn (cons nil rtn)) ) ) ) (apply 'and rtn) ) (setq m '((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))) ;;; Remove initial matrix if you want to specify new SUDOKU puzzle ;;; This one works - John's link example ;| (setq m '((6 nil nil nil 8 5 1 nil nil) (nil nil nil nil nil nil nil 5 3) (4 nil nil nil nil 9 8 nil nil) (nil nil nil nil nil nil nil 1 nil) (nil 8 nil 3 2 6 nil 7 nil) (nil 3 nil 1 nil nil nil nil nil) (nil nil 7 nil nil nil nil nil 4) (nil 5 nil nil nil nil nil nil nil) (nil nil nil 9 4 nil nil nil 2))) ;;; Remove initial matrix if you want to specify new SUDOKU puzzle ;;; This one won't work ;;; ;;; Solution -> '((6 7 3 2 8 5 1 4 9) (2 9 8 4 7 1 6 5 3) (4 1 5 6 3 9 8 2 7) (5 4 2 7 9 8 3 1 6) (1 8 9 3 2 6 4 7 5) (7 3 6 1 5 4 2 9 8) (8 2 7 5 1 3 9 6 4) (9 5 4 8 6 2 7 3 1) (3 6 1 9 4 7 5 8 2)) |; (if (null m) (progn (prompt "\nSpecify values of SUDOKU 9x9 matrix - PRESS ENTER for empty field...") (setq i 0) (repeat 9 (setq i (1+ i) j 0) (repeat 9 (setq j (1+ j)) (setq v (getint (strcat "\nRow : " (itoa i) " Column : " (itoa j) " = "))) (setq r (cons v r)) ) (setq r (reverse r)) (setq m (cons r m)) (setq r nil) ) (setq m (reverse m)) ) ) (setq i 0) (repeat 9 (setq i (1+ i) j 0 r (nth (1- i) m)) (repeat 9 (setq j (1+ j)) (set (read (strcat "f" (itoa i) (itoa j))) (nth (1- j) r)) ) ) (setq i 0) (repeat 9 (setq i (1+ i) j 0) (repeat 9 (setq j (1+ j)) (if (null (eval (read (strcat "f" (itoa i) (itoa j))))) (setq fl (cons (list (read (strcat "f" (itoa i) (itoa j))) i j) fl)) ) ) ) (setq fl (reverse fl) flll fl mm m z 0 loop t) (while (and loop (or fl flll) (not (check mm)) (< z 81)) (setq fll fl fllll flll) (if (equal m mm) (progn (foreach f fl (set (car f) (solve-adv m (cadr f) (caddr f))) (set (read (strcat "ff" (itoa (cadr f)) (itoa (caddr f)))) (eval (car f))) (if (= (length (eval (car f))) 1) (progn (setq i nil j nil) (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)) (setq fl (vl-remove f fl)) ) ) ) (setq mm m) ) ) (if (or (null fl) (null flll)) (setq mm m) ) (if (equal fll fl) (progn (if (null fff) (setq fff (car (vl-remove-if '(lambda ( x ) (vl-position x fffl)) flll))) ) (if (null ff) (setq ff (eval (car fff))) ) (setq fi (cadr fff) fj (caddr fff)) (setq x (car ff)) (setq i nil j nil) (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)) (setq ff (cdr ff)) (if (equal flll fl) (progn (setq fffl (cons fff fffl)) (setq fff nil) ) ) (foreach f (vl-remove fff flll) (set (car f) (solve-adv mm (cadr f) (caddr f))) (if (= (length (eval (car f))) 1) (progn (setq i nil j nil) (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)) ) ) ) ) ) (setq flll nil) (setq i 0) (repeat 9 (setq i (1+ i) j 0) (repeat 9 (setq j (1+ j)) (if (null (nth (1- j) (nth (1- i) mm))) (setq flll (cons (list (read (strcat "f" (itoa i) (itoa j))) i j) flll)) ) ) ) (setq flll (reverse flll)) (cond ( (and (null flll) (check mm)) (setq loop nil) ) ( (or (equal fllll flll) (null flll)) (setq z (1+ z)) (setq flll fl mm m) (foreach f fl (set (car f) (eval (read (strcat "ff" (itoa (cadr f)) (itoa (caddr f)))))) ) ) ) ) (setq i 0) (repeat 9 (setq i (1+ i) j 0) (repeat 9 (setq j (1+ j)) (set (read (strcat "f" (itoa i) (itoa j))) nil) (set (read (strcat "ff" (itoa i) (itoa j))) nil) ) ) (if (check mm) (setq m mm) ) (if (= z 81) (progn (prompt "\nSolution can't be found... Quitting...") (exit) ) ) (prompt "\n Matrix is stored in variable \"m\" - you can call it with !m") (prompt "\n") (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))) (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))) (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))) (prompt "\n ---------------------") (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))) (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))) (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))) (prompt "\n ---------------------") (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))) (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))) (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))) (textscr) (princ))
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: --- (setq m '((6 nil nil nil 8 5 1 4 nil) (nil nil nil nil nil nil nil 5 3) (4 nil nil nil nil 9 8 nil nil) (nil nil nil nil nil nil nil 1 nil) (nil 8 nil 3 2 6 nil 7 nil) (nil 3 nil 1 nil nil nil nil nil) (nil nil 7 nil nil nil nil nil 4) (9 5 nil nil nil nil nil nil nil) (3 6 1 9 4 nil 5 8 2))) ;;; Remove initial matrix if you want to specify new SUDOKU puzzle ;| ;;; Solution -> '((6 7 3 2 8 5 1 4 9) (2 9 8 4 7 1 6 5 3) (4 1 5 6 3 9 8 2 7) (5 4 2 7 9 8 3 1 6) (1 8 9 3 2 6 4 7 5) (7 3 6 1 5 4 2 9 8) (8 2 7 5 1 3 9 6 4) (9 5 4 8 6 2 7 3 1) (3 6 1 9 4 7 5 8 2)) |;
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: ---(defun IsSudokuSolutionValid ( aL / GroupByN ValidRowColp cols tmpL ) (defun GroupByN ( n L / r ) (repeat n (and L (setq r (cons (car L) r))) (setq L (cdr L)) r) (if L (cons (reverse r) (GroupByN n L)) (list (reverse r))) ); defun GroupByN ; _$ (ValidRowColp '(1 2 3 6 5 4 7 8 9)) -> T ; _$ (ValidRowColp '(1 2 3 6 9 4 7 8 9)) -> nil (defun ValidRowColp ( L / nL ) (setq nL '(1 2 3 4 5 6 7 8 9)) (vl-every (function (lambda (x) (if (member x nL) (progn (setq nL (vl-remove x nL)) T)))) L) ); defun ValidRowColp (and (vl-consp aL) (= 9 (length aL)) (vl-every (function (lambda (x) (and (vl-consp x) (= 9 (length x))))) aL) ; Basic checking (vl-every (function (lambda (x) (and (eq 'INT (type x)) (<= 1 x 9)))) (apply 'append aL)) ; atom checking (setq cols (apply 'mapcar (cons 'list aL))) (vl-every 'ValidRowColp aL) ; Check Rows (vl-every 'ValidRowColp cols) ; Check Columns (setq tmpL (mapcar (function (lambda (x) (GroupByN 3 x))) aL)) (vl-every (function (lambda (x) (ValidRowColp (apply 'append x)))) ; Use: (mapcar '(lambda (x) (apply 'append x)) ..) to visualise this (append ; Check 3x3 Matrix Sublists (GroupByN 3 (mapcar 'car tmpL)) (GroupByN 3 (mapcar 'cadr tmpL)) (GroupByN 3 (mapcar 'caddr tmpL)) ); append ); vl-every ); and ); defun IsSudokuSolutionValid
--- Code - Auto/Visual Lisp: ---_$ (IsSudokuSolutionValid '( (6 7 3 2 8 5 1 4 9) (2 9 8 4 7 1 6 5 3) (4 1 5 6 3 9 8 2 7) (5 4 2 7 9 8 3 1 6) (1 8 9 3 2 6 4 7 5) (7 3 6 1 5 4 2 9 8) (8 2 7 5 1 3 9 6 4) (9 5 4 8 6 2 7 3 1) (3 6 1 9 4 7 5 8 2) ))T_$ (IsSudokuSolutionValid '( (7 6 3 2 8 5 1 4 9) (2 9 8 4 7 1 6 5 3) (4 1 5 6 3 9 8 2 7) (5 4 2 7 9 8 3 1 6) (1 8 9 3 2 6 4 7 5) (7 3 6 1 5 4 2 9 8) (8 2 7 5 1 3 9 6 4) (9 5 4 8 6 2 7 3 1) (3 6 1 9 4 7 5 8 2) ))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. :thinking:
Lee Mac:
The following should calculate the possible candidate entries for each space in the sudoku -
--- Code - Auto/Visual Lisp: ---(defun sudoku ( l / r ) (cond ( (vl-some (function (lambda ( r ) (vl-some 'null r) ) ) l ) (sudoku (mapcar (function (lambda ( r ) (mapcar (function (lambda ( c ) (if c (lsh 1 c) 1023) ) ) r ) ) ) l ) ) ) ( (vl-some (function (lambda ( r ) (vl-some 'zerop r) ) ) (setq r (mapcar (function (lambda ( r ) (mapcar (function (lambda ( c ) (if (pow2 c) c 0) ) ) r ) ) ) l ) ) ) (setq l (mapcar (function (lambda ( r ) (apply 'append r) ) ) (grd->mat (mapcar (function (lambda ( a b ) (mapcar (function (lambda ( c ) (mapcar (function (lambda ( d ) (if (pow2 d) d (logand d (~ b))) ) ) c ) ) ) a ) ) ) (apply 'append (mat->grd (mat->grd (apply 'mapcar (cons 'list (mapcar (function (lambda ( a b ) (mapcar (function (lambda ( c ) (if (pow2 c) c (logand c (~ b))) ) ) a ) ) ) (apply 'mapcar (cons 'list (mapcar (function (lambda ( a b ) (mapcar (function (lambda ( c ) (if (pow2 c) c (logand c (~ b))) ) ) a ) ) ) l (mapcar (function (lambda ( r ) (apply 'logior r) ) ) r ) ) ) ) (mapcar (function (lambda ( c ) (apply 'logior c) ) ) (apply 'mapcar (cons 'list r)) ) ) ) ) ) ) ) (mapcar (function (lambda ( m ) (apply 'logior (apply 'append m)) ) ) (apply 'append (mat->grd (mat->grd r))) ) ) ) ) ) ;; ( Recursive call goes here ) (mapcar (function (lambda ( r ) (mapcar (function (lambda ( c ) (if (pow2 c) (fixn (log2 c)) (mapcar (function (lambda ( d ) (fixn (log2 d)) ) ) (bits c) ) ) ) ) r ) ) ) l ) ) ( (mapcar (function (lambda ( r ) (mapcar (function (lambda ( c ) (fixn (log2 c)) ) ) r ) ) ) l ) ) ))(defun mat->grd ( m ) (if (car m) (cons (mapcar (function (lambda ( r ) (mapcar (function (lambda ( a b ) a) ) r '(0 1 2) ) ) ) m ) (mat->grd (mapcar 'cdddr m)) ) ))(defun grd->mat ( g ) (if g (append (apply 'mapcar (cons 'list (mapcar (function (lambda ( a b ) a) ) g '(0 1 2) ) ) ) (grd->mat (cdddr g)) ) ))(defun log2 ( n ) (/ (log n) (log 2)))(defun fixn ( n ) (fix (+ 1e-8 n)))(defun pow2 ( n ) ((lambda ( r ) (equal r (fixn r) 1e-8)) (log2 n)))(defun bits ( n / b ) (if (< 0 n) (cons (setq b (lsh 1 (fixn (log2 n)))) (bits (- n b)))))
Example:
--- Code - Auto/Visual Lisp: ---(sudoku '( (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) )) -->( ( (9 0) (9 3 2 0) 4 8 (5 2 0) (5 2 0) (9 6 2 0) 1 7 ) ( 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)) ( 5 (9 2 1 0) 8 (6 2 1 0) 3 (7 2 0) (9 6 2 0) (6 2 0) 4 ) ( 3 (8 5 2 0) (5 2 0) 7 4 (8 5 2 0) 1 (6 2 0) (9 2 0)) ( (4 0) 6 9 (5 3 2 1 0) (5 2 1 0) (5 3 2 0) 7 8 (3 2 0)) ((8 7 4 0) (8 2 0) 1 (3 2 0) 6 9 (4 2 0) (4 3 2 0) 5 ) ( 1 (9 5 0) (7 5 0) (5 4 2 0) 8 (7 5 4 2 0) 3 (7 4 2 0) 6 ) ( (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 ) ( 2 4 (7 6 3 0) (3 0) (9 7 0) 1 5 (7 0) (8 0) ))
It just remains to implement the recursive call to test each candidate, backtracing if it leads to an invalid solution...
Grrr1337:
--- Quote from: Lee Mac on October 23, 2017, 05:47:28 PM ---The following should calculate the possible candidate entries for each space in the sudoku -
--- End quote ---
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: ---'( (1 2 3 4 5 6 7 8 9) (1 2 3 4 5 6 7 8 9) (1 2 3 4 5 6 7 8 9) (1 2 3 4 5 6 7 8 9) (1 2 3 4 5 6 7 8 9) (1 2 3 4 5 6 7 8 9) (1 2 3 4 5 6 7 8 9) (1 2 3 4 5 6 7 8 9) (1 2 3 4 5 6 7 8 9))->>'( (1 2 3 4 5 6 7 8 9) ; no shift [straight list] (9 8 7 1 2 3 4 5 6) ; shift 3 times to the right [straight list] (6 5 4 9 8 7 1 2 3) ; shift 6 times to the right [straight list] (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)] (x x x x x x x x x) ; ??? (x x x x x x x x x) ; ??? (x x x x x x x x x) ; ??? (x x x x x x x x x) ; ??? (x x x x x x x x x) ; ???)
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: ---(sudoku '( (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) )) (sudoku '( (x x 4 8 x x x 1 7) (6 7 x 9 x x x x x) (5 x 8 x 3 x x x 4) (3 x x 7 4 x 1 x x) (x 6 9 x x x 7 8 x) (x x 1 x 6 9 x x 5) (1 x x x 8 x 3 x 6) (x x x x x 6 x 9 1) (2 4 x x x 1 5 x x) ))
'x' is not assigned and would mean that x = nil.
Navigation
[0] Message Index
[#] Next page
Go to full version