Author Topic: SUDOKU Challenge  (Read 1385 times)

0 Members and 1 Guest are viewing this topic.

ribarm

• Water Moccasin
• Posts: 1690
• Marko Ribar, architect
SUDOKU Challenge
« on: October 20, 2017, 11:29:06 am »
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]
`(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...
« Last Edit: October 28, 2017, 09:04:49 am by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

ribarm

• Water Moccasin
• Posts: 1690
• Marko Ribar, architect
Re: SUDOKU Challenge
« Reply #1 on: October 23, 2017, 12:17:00 pm »
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]
`  (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.
Marko Ribar, d.i.a. (graduated engineer of architecture)

Grrr1337

• Bull Frog
• Posts: 416
Re: SUDOKU Challenge
« Reply #2 on: October 23, 2017, 01:19:26 pm »
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]
`(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: [Select]
`_\$ (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.

Lee Mac

• Seagull
• Posts: 11834
• AutoCAD 2015 Windows 7 London, England
Re: SUDOKU Challenge
« Reply #3 on: October 23, 2017, 05:47:28 pm »
The following should calculate the possible candidate entries for each space in the sudoku -

Code - Auto/Visual Lisp: [Select]
`(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: [Select]
`(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...
« Last Edit: October 23, 2017, 06:42:27 pm by Lee Mac »

Grrr1337

• Bull Frog
• Posts: 416
Re: SUDOKU Challenge
« Reply #4 on: October 24, 2017, 04:50:28 am »
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 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: [Select]
`(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.
« Last Edit: October 24, 2017, 04:53:50 am by Grrr1337 »

Lee Mac

• Seagull
• Posts: 11834
• AutoCAD 2015 Windows 7 London, England
Re: SUDOKU Challenge
« Reply #5 on: October 24, 2017, 12:23:22 pm »
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]
`(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.

Careful - the unevaluated symbol 'x' will not equal nil...
Code: [Select]
`_\$ (= nil 'x)nil`

Grrr1337

• Bull Frog
• Posts: 416
Re: SUDOKU Challenge
« Reply #6 on: October 24, 2017, 02:38:07 pm »

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]
`(sudoku  (mapcar 'eval    '(      (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)    )  ))`

Lee Mac

• Seagull
• Posts: 11834
• AutoCAD 2015 Windows 7 London, England
Re: SUDOKU Challenge
« Reply #7 on: October 25, 2017, 06:49:50 pm »
Somewhat closer...
Code - Auto/Visual Lisp: [Select]
`(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) 1022)                                    )                                )                                r                            )                        )                    )                    l                )            )        )        (   (vl-some                (function                    (lambda ( r )                        (vl-some 'zerop r)                    )                )                l            )            nil        )        (   (progn                (setq r                    (mapcar                        (function                            (lambda ( r )                                (mapcar                                    (function                                        (lambda ( c )                                            (if (pow2 c) c 0)                                        )                                    )                                    r                                )                            )                        )                        l                    )                )                (not                    (equalm 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)))                                        )                                    )                                )                            )                        )                    )                )            )            (sudoku l)        )        (            (                (lambda ( / i j ) (setq i -1)                    (vl-some                        (function                            (lambda ( r ) (setq i (1+ i) j -1)                                (vl-some                                    (function                                        (lambda ( c ) (setq j (1+ j))                                            (if (and (< 0 c) (not (pow2 c)))                                                (vl-some                                                    (function                                                        (lambda ( d )                                                            (sudoku (substij i j d l))                                                        )                                                    )                                                    (bits c)                                                )                                            )                                        )                                    )                                    r                                )                            )                        )                        l                    )                )            )        )        (   (mapcar                (function                    (lambda ( r )                        (mapcar                            (function                                (lambda ( c )                                    (fixn (log2 c))                                )                            )                            r                        )                    )                )                l            )        )    ))(defun equalm ( a b )    (vl-every '(lambda ( x y ) (vl-every '= x y)) a b))(defun substij ( i j n m / a )    (setq a -1)    (mapcar        (function            (lambda ( x / b )                (if (= i (setq b -1 a (1+ a)))                    (mapcar                        (function                            (lambda ( y )                                (if (= j (setq b (1+ b))) n y)                            )                        )                        x                    )                    x                )            )        )        m    ))(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 ) (if (zerop n) 0 ((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)))))`

Now successfully solves this example:
Code - Auto/Visual Lisp: [Select]
`(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 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))`

...But not this example:
Code - Auto/Visual Lisp: [Select]
`(sudoku   '(        (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)    ))-->(    (6 9 3 2 8 5 1 4 7)    (8 7 2 4 6 1 9 5 3)    (4 1 5 7 3 9 8 2 6)    (7 4 6 5 9 8 3 1 9)    (1 8 1 3 2 6 4 7 5)    (5 3 9 1 7 4 2 6 8)    (9 2 7 8 5 3 6 9 4)    (3 5 4 6 1 2 7 9 8)    (1 6 8 9 4 7 5 3 2))`

Grrr1337

• Bull Frog
• Posts: 416
Re: SUDOKU Challenge
« Reply #8 on: October 26, 2017, 04:16:50 am »
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]
`(defun IsSudokuValid ( aL / InvalidAt GroupByN ValidRowColp cols tmpL r )   ; _\$ (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  ; _\$ (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  ; _\$ (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  (setq InvalidAt    (lambda ( f mf L / i )       (setq i 0) (setq f (eval f)) (setq mf (eval mf))      (vl-some (function (lambda (x) (setq i (1+ i)) (if (not (f x)) (progn (mf x (itoa i)) T)))) L)    )  ); setq InvalidAt   (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   (cond     ( (not (vl-consp aL)) (prompt "\n#1. Not vl-consp.") )    ( (/= 9 (length aL)) (prompt "\n#2. Invalid length.") )    ( (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) )    ( (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)) )    ( (progn (setq cols (apply 'mapcar (cons 'list aL))) nil) )    ( (InvalidAt 'ValidRowColp '(lambda (a b) (print (strcat "\nError at row n." b " :\n" (vl-prin1-to-string a)))) aL) )     ( (InvalidAt 'ValidRowColp '(lambda (a b) (print (strcat "\nError at col n." b " :\n" (vl-prin1-to-string a)))) cols) )     (       (and (setq tmpL (mapcar (function (lambda (x) (GroupByN 3 x))) aL))        (not          (InvalidAt '(lambda (x) (ValidRowColp (apply 'append x))) '(lambda (a b) (print (strcat "\nError at sector n." b " :\n" (vl-prin1-to-string a))))            (append ; Check 3x3 Matrix Sublists              (GroupByN 3 (mapcar 'car tmpL))              (GroupByN 3 (mapcar 'cadr tmpL))              (GroupByN 3 (mapcar 'caddr tmpL))            ); append          )        )        (setq r T)      ); progn    )  ); cond  r); defun IsSudokuValid`

Example:
Code - Auto/Visual Lisp: [Select]
`_\$ (IsSudokuValid  '((6 9 3 2 8 5 1 4 7)    (8 7 2 4 6 1 9 5 3)    (4 1 5 7 3 9 8 2 6)    (7 4 6 5 9 8 3 1 9)    (1 8 1 3 2 6 4 7 5)    (5 3 9 1 7 4 2 6 8)    (9 2 7 8 5 3 6 9 4)    (3 5 4 6 1 2 7 9 8)    (1 6 8 9 4 7 5 3 2)  )) "\nError at row n.4 :\n(7 4 6 5 9 8 3 1 9)" nil_\$ (IsSudokuValid  '((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)  ))T`

Lee Mac

• Seagull
• Posts: 11834
• AutoCAD 2015 Windows 7 London, England
Re: SUDOKU Challenge
« Reply #9 on: October 26, 2017, 12:35:51 pm »
Nice one Grrr1337

FWIW, here's another way to write the 'ValidRowColp' function:
Code - Auto/Visual Lisp: [Select]
`(defun validrowcolp ( l )    (equal (mapcar '(lambda ( n ) (nth n l)) (vl-sort-i l '<)) '(1 2 3 4 5 6 7 8 9)))`

Lee Mac

• Seagull
• Posts: 11834
• AutoCAD 2015 Windows 7 London, England
Re: SUDOKU Challenge
« Reply #10 on: October 26, 2017, 02:02:02 pm »
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]
`(defun bar ( m )    (mapcar '(lambda ( x ) (apply 'append x))        (apply 'append            (mapcar '(lambda ( x ) (apply 'mapcar (cons 'list (mapcar 'foo x)))) (foo m))        )    ))(defun baz ( m )    (mapcar '(lambda ( x ) (apply 'append x))        (apply 'append            (mapcar 'foo (apply 'mapcar (cons 'list (mapcar 'foo m))))        )    ))(defun foo ( m )    (if m (cons (mapcar '(lambda ( a b ) a) m '(0 1 2)) (foo (cdddr m)))))`

Code - Auto/Visual Lisp: [Select]
`(setq m   '(        (A1 A2 A3 A4 A5 A6 A7 A8 A9)        (B1 B2 B3 B4 B5 B6 B7 B8 B9)        (C1 C2 C3 C4 C5 C6 C7 C8 C9)        (D1 D2 D3 D4 D5 D6 D7 D8 D9)        (E1 E2 E3 E4 E5 E6 E7 E8 E9)        (F1 F2 F3 F4 F5 F6 F7 F8 F9)        (G1 G2 G3 G4 G5 G6 G7 G8 G9)        (H1 H2 H3 H4 H5 H6 H7 H8 H9)        (I1 I2 I3 I4 I5 I6 I7 I8 I9)    ))_\$ (bar m)(    (A1 A2 A3 B1 B2 B3 C1 C2 C3)    (A4 A5 A6 B4 B5 B6 C4 C5 C6)    (A7 A8 A9 B7 B8 B9 C7 C8 C9)    (D1 D2 D3 E1 E2 E3 F1 F2 F3)    (D4 D5 D6 E4 E5 E6 F4 F5 F6)    (D7 D8 D9 E7 E8 E9 F7 F8 F9)    (G1 G2 G3 H1 H2 H3 I1 I2 I3)    (G4 G5 G6 H4 H5 H6 I4 I5 I6)    (G7 G8 G9 H7 H8 H9 I7 I8 I9))_\$ (baz m)(    (A1 A2 A3 B1 B2 B3 C1 C2 C3)    (D1 D2 D3 E1 E2 E3 F1 F2 F3)    (G1 G2 G3 H1 H2 H3 I1 I2 I3)    (A4 A5 A6 B4 B5 B6 C4 C5 C6)    (D4 D5 D6 E4 E5 E6 F4 F5 F6)    (G4 G5 G6 H4 H5 H6 I4 I5 I6)    (A7 A8 A9 B7 B8 B9 C7 C8 C9)    (D7 D8 D9 E7 E8 E9 F7 F8 F9)    (G7 G8 G9 H7 H8 H9 I7 I8 I9))`

Lee Mac

• Seagull
• Posts: 11834
• AutoCAD 2015 Windows 7 London, England
Re: SUDOKU Challenge
« Reply #11 on: October 26, 2017, 03:08:48 pm »
I think I'm there:
Code - Auto/Visual Lisp: [Select]
`(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) 1022)                                    )                                )                                r                            )                        )                    )                    l                )            )        )        (   (vl-some                (function                    (lambda ( r )                        (vl-some 'zerop r)                    )                )                l            )            nil        )        (   (progn                (setq r                    (mapcar                        (function                            (lambda ( r )                                (mapcar                                    (function                                        (lambda ( c )                                            (if (pow2 c) c 0)                                        )                                    )                                    r                                )                            )                        )                        l                    )                )                (not                    (equalm 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)))                                        )                                    )                                )                            )                        )                    )                )            )            (sudoku l)        )        (            (                (lambda ( / i j ) (setq i -1)                    (vl-some                        (function                            (lambda ( r ) (setq i (1+ i) j -1)                                (vl-some                                    (function                                        (lambda ( c ) (setq j (1+ j))                                            (if (and (< 0 c) (not (pow2 c)))                                                (vl-some                                                    (function                                                        (lambda ( d )                                                            (sudoku (substij i j d l))                                                        )                                                    )                                                    (bits c)                                                )                                            )                                        )                                    )                                    r                                )                            )                        )                        l                    )                )            )        )        (   (or                (vl-some                    (function                        (lambda ( r )                            (/= 1022 (apply 'logior r))                        )                    )                    r                )                (vl-some                    (function                        (lambda ( c )                            (/= 1022 (apply 'logior c))                        )                    )                    (apply 'mapcar (cons 'list r))                )                (vl-some                    (function                        (lambda ( m )                            (/= 1022 (apply 'logior (apply 'append m)))                        )                    )                    (apply 'append (mat->grd (mat->grd r)))                )            )            nil        )        (   (mapcar                (function                    (lambda ( r )                        (mapcar                            (function                                (lambda ( c )                                    (fixn (log2 c))                                )                            )                            r                        )                    )                )                l            )        )    ))(defun equalm ( a b )    (vl-every '(lambda ( x y ) (vl-every '= x y)) a b))(defun substij ( i j n m / a )    (setq a -1)    (mapcar        (function            (lambda ( x / b )                (if (= i (setq b -1 a (1+ a)))                    (mapcar                        (function                            (lambda ( y )                                (if (= j (setq b (1+ b))) n y)                            )                        )                        x                    )                    x                )            )        )        m    ))(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 ) (if (zerop n) 0 ((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)))))`

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

• Bull Frog
• Posts: 416
Re: SUDOKU Challenge
« Reply #12 on: October 26, 2017, 05:08:18 pm »
Nice one Grrr1337

Thanks!

FWIW, here's another way to write the 'ValidRowColp' function:
Code - Auto/Visual Lisp: [Select]
`(defun validrowcolp ( l )  (equal (mapcar '(lambda ( n ) (nth n l)) (vl-sort-i l '<)) '(1 2 3 4 5 6 7 8 9)))`

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]
`(sudoku  '(    (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)  ))`

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

• Bull Frog
• Posts: 205
Re: SUDOKU Challenge
« Reply #13 on: October 26, 2017, 07:21:44 pm »
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]
`(defun sudoku (ini / *error* o rows cols sqrs l cluster replace solve j)   (defun *error* (msg) (princ))   (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                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                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              )        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)               (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)               (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)              )        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)               ( 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)               ( 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)              )        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)               (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)               (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)              )        l     '(1 2 3 4 5 6 7 8 9)        j     0  )   (defun cluster (m i a)    (mapcar     '(lambda (x) (nth x m))      (vl-some '(lambda (x) (if (vl-position i x) x)) a)    )  )   (defun replace (q m)    (mapcar      '(lambda (i n)         (cond ((cadr (assoc i q))) (n))       )      o m    )  )   (defun solve (m f / i x c r u cd1 n q);;;    (print m)    (if      (vl-every 'numberp m)      (progn        (princ "\n")        (mapcar         '(lambda (a b)            (princ (if (zerop (rem a 9)) "\n " " ")) (princ b)            (if              (vl-position (rem a 9) '(2 5))              (princ " |")            )            (if              (vl-position a '(26 53))              (princ "\n ---------------------")            )                )          o m        )        (princ "\n") ;(princ j)        (textscr)        (quit)      )    )     (setq i 80 j (1+ j))    (while (>= i 0)      (setq x (nth i m))      (if        (not x)        (progn          (setq u (append (cluster m i rows) (cluster m i cols) (cluster m i sqrs)))          (if            (setq c (vl-remove-if '(lambda (n) (member n u)) l))            (setq r (cons (cons i c) r))            (setq r nil i -1)          )        )       )      (setq i (1- i))    )     (setq q (vl-remove-if '(lambda (a) (cddr a)) r))     (foreach sect '(rows cols sqrs)      (foreach group (eval sect)        (setq cd1 (vl-remove-if-not '(lambda (a) (vl-position (car a) group)) r))        (foreach a cd1          (setq n (car a))          (foreach e (cdr a)            (or              (vl-some '(lambda (b) (vl-position e (cdr b))) (vl-remove a cd1))              (assoc n q)              (setq q (cons (list n e) q))            )          )        )      )    )     (cond      (q ;(print q)        (if f          (solve (replace (list (car q)) m) f)          (solve (replace            q   m) f)        )      )      (r        (foreach a (cdar r)          (solve (replace (list (list (caar r) a)) m) t)        )      )    )  )  (solve (cond ((= (length ini) 9) (apply 'append ini)) (ini))  nil))`

Code - Auto/Visual Lisp: [Select]
`;hardest sudoku(sudoku '(           (  8 nil nil nil nil nil nil nil nil)           (nil nil   3   6 nil nil nil nil nil)           (nil   7 nil nil   9 nil   2 nil nil)           (nil   5 nil nil nil   7 nil nil nil)           (nil nil nil nil   4   5   7 nil nil)           (nil nil nil   1 nil nil nil   3 nil)           (nil nil   1 nil nil nil nil   6   8)           (nil nil   8   5 nil nil nil   1 nil)           (nil   9 nil nil nil nil   4 nil nil)         ));test grid 1(sudoku '(           (  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)         ));test grid 2(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)         ));some grid(sudoku '(           (  1 nil nil nil nil   7 nil   9 nil)           (nil   3 nil nil   2 nil nil nil   8)           (nil nil   9   6 nil nil   5 nil nil)           (nil nil   5   3 nil nil   9 nil nil)           (nil   1 nil nil   8 nil nil nil   2)           (  6 nil nil nil nil   4 nil nil nil)           (  3 nil nil nil nil nil nil   1 nil)           (nil   4 nil nil nil nil nil nil   7)           (nil nil   7 nil nil nil   3 nil nil)        ))`
« Last Edit: October 26, 2017, 07:51:19 pm by Stefan »

Lee Mac

• Seagull
• Posts: 11834
• AutoCAD 2015 Windows 7 London, England
Re: SUDOKU Challenge
« Reply #14 on: October 27, 2017, 12:36:44 pm »
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

• Needs a day job
• Posts: 6401
Re: SUDOKU Challenge
« Reply #15 on: October 27, 2017, 02:40:19 pm »
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]
`(sudoku	'((8 nil nil nil nil nil nil nil nil)	  (nil nil 3 6 nil nil nil nil nil)	  (nil 7 nil nil 9 nil 2 nil nil)	  (nil 5 nil nil nil 7 nil nil nil)	  (nil nil nil nil 4 5 7 nil nil)	  (nil nil nil 1 nil nil nil 3 nil)	  (nil nil 1 nil nil nil nil 6 8)	  (nil nil 8 5 nil nil nil 1 nil)	  (nil 9 nil nil nil nil nil nil nil)	 ));;< Elapsed time: 5.968000 seconds. > ;;; 8 1 2 | 7 5 3 | 6 4 9;;; 9 4 3 | 6 8 2 | 1 7 5;;; 6 7 5 | 4 9 1 | 2 8 3;;; ---------------------;;; 1 5 4 | 2 3 7 | 8 9 6;;; 3 6 9 | 8 4 5 | 7 2 1;;; 2 8 7 | 1 6 9 | 5 3 4;;; ---------------------;;; 5 2 1 | 9 7 4 | 3 6 8;;; 4 3 8 | 5 2 6 | 9 1 7;;; 7 9 6 | 3 1 8 | 4 5 2  (sudoku	'((nil nil 2 nil nil 9 1 nil nil)	  (nil nil nil 8 3 6 nil 7 nil)	  (nil nil nil nil nil nil nil 8 nil)	  (nil nil 1 nil nil nil 2 4 nil)	  (3 nil nil 6 5 4 nil nil 7)	  (nil 7 9 nil nil nil 6 nil nil)	  (nil 5 nil nil nil nil nil nil nil)	  (nil 3 nil 4 1 5 nil nil nil)	  (nil nil 4 2 nil nil 3 nil nil)	 ));;< Elapsed time: 0.453000 seconds. >;;; 7 8 2 | 5 4 9 | 1 6 3;;; 9 1 5 | 8 3 6 | 4 7 2;;; 6 4 3 | 7 2 1 | 5 8 9;;; ---------------------;;; 5 6 1 | 9 7 3 | 2 4 8;;; 3 2 8 | 6 5 4 | 9 1 7;;; 4 7 9 | 1 8 2 | 6 3 5;;; ---------------------;;; 1 5 6 | 3 9 8 | 7 2 4;;; 2 3 7 | 4 1 5 | 8 9 6;;; 8 9 4 | 2 6 7 | 3 5 1`
« Last Edit: October 27, 2017, 03:18:12 pm by ronjonp »

Windows 10 x64 - AutoCAD /C3D 2018

Custom Build PC

Grrr1337

• Bull Frog
• Posts: 416
Re: SUDOKU Challenge
« Reply #16 on: November 02, 2017, 06:18:51 pm »
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]
`; https://www.theswamp.org/index.php?topic=53547.0(defun PlaySudoku ( aL / _MatrixSubstNth PlaySudoku:IsSudokuValid txt2num *error* dcl des dch dcf deferrmsg nL row col kL rL )  '(87 114 105 116 116 101 110 32 98 121 32 71 114 114 114)  ; _\$ (_MatrixSubstNth '(1 2) "K" '(("A" "B" "C")("D" "E" "F")("G" "H" "I"))) -> (("A" "B" "C") ("D" "E" "K") ("G" "H" "I"))  ; _\$ (_MatrixSubstNth '(1 8) "K" '(("A" "B" "C")("D" "E" "F")("G" "H" "I"))) -> (("A" "B" "C") ("D" "E" "F") ("G" "H" "I"))  (defun _MatrixSubstNth ( NthL NewItm aL / r c )    (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)  ); defun _MatrixSubstNth   (defun PlaySudoku:IsSudokuValid ( aL / InvalidAt GroupByN ValidRowColp cols tmpL r )     ; _\$ (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    ; _\$ (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    ; _\$ (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    (setq InvalidAt      (`