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

So if someone wants to play, he/she is welcome...
Regards...
« Last Edit: October 28, 2017, 09:04:49 am by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

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

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

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

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

Code - Auto/Visual Lisp: [Select]
  1. _$ (IsSudokuSolutionValid
  2.  '(
  3.    (6 7 3 2 8 5 1 4 9)
  4.    (2 9 8 4 7 1 6 5 3)
  5.    (4 1 5 6 3 9 8 2 7)
  6.    (5 4 2 7 9 8 3 1 6)
  7.    (1 8 9 3 2 6 4 7 5)
  8.    (7 3 6 1 5 4 2 9 8)
  9.    (8 2 7 5 1 3 9 6 4)
  10.    (9 5 4 8 6 2 7 3 1)
  11.    (3 6 1 9 4 7 5 8 2)
  12.  )
  13. )
  14. T
  15. _$ (IsSudokuSolutionValid
  16.  '(
  17.    (7 6 3 2 8 5 1 4 9)
  18.    (2 9 8 4 7 1 6 5 3)
  19.    (4 1 5 6 3 9 8 2 7)
  20.    (5 4 2 7 9 8 3 1 6)
  21.    (1 8 9 3 2 6 4 7 5)
  22.    (7 3 6 1 5 4 2 9 8)
  23.    (8 2 7 5 1 3 9 6 4)
  24.    (9 5 4 8 6 2 7 3 1)
  25.    (3 6 1 9 4 7 5 8 2)
  26.  )
  27. )
  28. nil

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

Lee Mac

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

Example:
Code - Auto/Visual Lisp: [Select]
  1. (sudoku
  2.   '(
  3.        (nil nil  4   8  nil nil nil  1   7 )
  4.        ( 6   7  nil  9  nil nil nil nil nil)
  5.        ( 5  nil  8  nil  3  nil nil nil  4 )
  6.        ( 3  nil nil  7   4  nil  1  nil nil)
  7.        (nil  6   9  nil nil nil  7   8  nil)
  8.        (nil nil  1  nil  6   9  nil nil  5 )
  9.        ( 1  nil nil nil  8  nil  3  nil  6 )
  10.        (nil nil nil nil nil  6  nil  9   1 )
  11.        ( 2   4  nil nil nil  1   5  nil nil)
  12.    )
  13. )
  14.  
  15. -->
  16. (
  17.    (  (9 0)   (9 3 2 0)    4         8          (5 2 0)   (5 2 0)   (9 6 2 0)    1         7     )
  18.    (   6         7        (3 2 0)    9        (5 2 1 0)   (5 4 2 0)   (8 2 0) (5 3 2 0) (8 3 2 0))
  19.    (   5      (9 2 1 0)    8        (6 2 1 0)    3        (7 2 0)   (9 6 2 0)   (6 2 0)    4     )
  20.    (   3      (8 5 2 0)   (5 2 0)    7           4        (8 5 2 0)    1        (6 2 0)   (9 2 0))
  21.    (  (4 0)      6         9      (5 3 2 1 0) (5 2 1 0)   (5 3 2 0)    7         8        (3 2 0))
  22.    ((8 7 4 0)   (8 2 0)    1        (3 2 0)      6         9          (4 2 0) (4 3 2 0)    5     )
  23.    (   1        (9 5 0)   (7 5 0)   (5 4 2 0)    8      (7 5 4 2 0)    3      (7 4 2 0)    6     )
  24.    (  (8 7 0) (8 5 3 0) (7 5 3 0) (5 4 3 2 0) (7 5 2 0)    6        (8 4 2 0)    9         1     )
  25.    (   2         4      (7 6 3 0)   (3 0)       (9 7 0)    1           5        (7 0)     (8 0)  )
  26. )
  27.  

It just remains to implement the recursive call to test each candidate, backtracing if it leads to an invalid solution...
« 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.  (1 2 3 4 5 6 7 8 9)
  3.  (1 2 3 4 5 6 7 8 9)
  4.  (1 2 3 4 5 6 7 8 9)
  5.  (1 2 3 4 5 6 7 8 9)
  6.  (1 2 3 4 5 6 7 8 9)
  7.  (1 2 3 4 5 6 7 8 9)
  8.  (1 2 3 4 5 6 7 8 9)
  9.  (1 2 3 4 5 6 7 8 9)
  10.  (1 2 3 4 5 6 7 8 9)
  11. )
  12. ->>
  13. '(
  14.  (1 2 3 4 5 6 7 8 9) ; no shift [straight list]
  15.  (9 8 7 1 2 3 4 5 6) ; shift 3 times to the right [straight list]
  16.  (6 5 4 9 8 7 1 2 3) ; shift 6 times to the right [straight list]
  17.  (7 6 5 4 3 2 1 9 8) ; shift 2 times to the left [reversed list: '(9 8 7 6 5 4 3 2 1)]
  18.  (x x x x x x x x x) ; ???
  19.  (x x x x x x x x x) ; ???
  20.  (x x x x x x x x x) ; ???
  21.  (x x x x x x x x x) ; ???
  22.  (x x x x x x x x x) ; ???
  23. )
  24.  



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

Code - Auto/Visual Lisp: [Select]
  1. (sudoku
  2.  '(
  3.    (nil nil  4   8  nil nil nil  1   7 )
  4.    ( 6   7  nil  9  nil nil nil nil nil)
  5.    ( 5  nil  8  nil  3  nil nil nil  4 )
  6.    ( 3  nil nil  7   4  nil  1  nil nil)
  7.    (nil  6   9  nil nil nil  7   8  nil)
  8.    (nil nil  1  nil  6   9  nil nil  5 )
  9.    ( 1  nil nil nil  8  nil  3  nil  6 )
  10.    (nil nil nil nil nil  6  nil  9   1 )
  11.    ( 2   4  nil nil nil  1   5  nil nil)
  12.  )
  13. )
  14.  
  15. (sudoku
  16.  '(
  17.    (x x 4 8 x x x 1 7)
  18.    (6 7 x 9 x x x x x)
  19.    (5 x 8 x 3 x x x 4)
  20.    (3 x x 7 4 x 1 x x)
  21.    (x 6 9 x x x 7 8 x)
  22.    (x x 1 x 6 9 x x 5)
  23.    (1 x x x 8 x 3 x 6)
  24.    (x x x x x 6 x 9 1)
  25.    (2 4 x x x 1 5 x x)
  26.  )
  27. )
  28.  

'x' is not assigned and would mean that x = nil.
« Last Edit: October 24, 2017, 04:53:50 am by Grrr1337 »

Lee Mac

  • Seagull
  • Posts: 11831
  • 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]
  1. (sudoku
  2.  '(
  3.    (x x 4 8 x x x 1 7)
  4.    (6 7 x 9 x x x x x)
  5.    (5 x 8 x 3 x x x 4)
  6.    (3 x x 7 4 x 1 x x)
  7.    (x 6 9 x x x 7 8 x)
  8.    (x x 1 x 6 9 x x 5)
  9.    (1 x x x 8 x 3 x 6)
  10.    (x x x x x 6 x 9 1)
  11.    (2 4 x x x 1 5 x x)
  12.  )
  13. )

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

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

Grrr1337

  • 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]
  1. (sudoku
  2.    '(
  3.      (x x 4 8 x x x 1 7)
  4.      (6 7 x 9 x x x x x)
  5.      (5 x 8 x 3 x x x 4)
  6.      (3 x x 7 4 x 1 x x)
  7.      (x 6 9 x x x 7 8 x)
  8.      (x x 1 x 6 9 x x 5)
  9.      (1 x x x 8 x 3 x 6)
  10.      (x x x x x 6 x 9 1)
  11.      (2 4 x x x 1 5 x x)
  12.    )
  13.  )
  14. )

Lee Mac

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

Now successfully solves this example:
Code - Auto/Visual Lisp: [Select]
  1. (sudoku
  2.   '(
  3.        (nil nil 4 8 nil nil nil 1 7)
  4.        (6 7 nil 9 nil nil nil nil nil)
  5.        (5 nil 8 nil 3 nil nil nil 4)
  6.        (3 nil nil 7 4 nil 1 nil nil)
  7.        (nil 6 9 nil nil nil 7 8 nil)
  8.        (nil nil 1 nil 6 9 nil nil 5)
  9.        (1 nil nil nil 8 nil 3 nil 6)
  10.        (nil nil nil nil nil 6 nil 9 1)
  11.        (2 4 nil nil nil 1 5 nil nil)
  12.    )
  13. )
  14. -->
  15. (
  16.    (9 3 4 8 2 5 6 1 7)
  17.    (6 7 2 9 1 4 8 5 3)
  18.    (5 1 8 6 3 7 9 2 4)
  19.    (3 2 5 7 4 8 1 6 9)
  20.    (4 6 9 1 5 3 7 8 2)
  21.    (7 8 1 2 6 9 4 3 5)
  22.    (1 9 7 5 8 2 3 4 6)
  23.    (8 5 3 4 7 6 2 9 1)
  24.    (2 4 6 3 9 1 5 7 8)
  25. )

...But not this example:
Code - Auto/Visual Lisp: [Select]
  1. (sudoku
  2.   '(
  3.        (6 nil nil nil 8 5 1 nil nil)
  4.        (nil nil nil nil nil nil nil 5 3)
  5.        (4 nil nil nil nil 9 8 nil nil)
  6.        (nil nil nil nil nil nil nil 1 nil)
  7.        (nil 8 nil 3 2 6 nil 7 nil)
  8.        (nil 3 nil 1 nil nil nil nil nil)
  9.        (nil nil 7 nil nil nil nil nil 4)
  10.        (nil 5 nil nil nil nil nil nil nil)
  11.        (nil nil nil 9 4 nil nil nil 2)
  12.    )
  13. )
  14. -->
  15. (
  16.    (6 9 3 2 8 5 1 4 7)
  17.    (8 7 2 4 6 1 9 5 3)
  18.    (4 1 5 7 3 9 8 2 6)
  19.    (7 4 6 5 9 8 3 1 9)
  20.    (1 8 1 3 2 6 4 7 5)
  21.    (5 3 9 1 7 4 2 6 8)
  22.    (9 2 7 8 5 3 6 9 4)
  23.    (3 5 4 6 1 2 7 9 8)
  24.    (1 6 8 9 4 7 5 3 2)
  25. )

 :-(

Grrr1337

  • 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!  :rolleyes2:

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

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

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

Lee Mac

  • Seagull
  • Posts: 11831
  • 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]
  1. (defun validrowcolp ( l )
  2.    (equal (mapcar '(lambda ( n ) (nth n l)) (vl-sort-i l '<)) '(1 2 3 4 5 6 7 8 9))
  3. )

Lee Mac

  • Seagull
  • Posts: 11831
  • 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]
  1. (defun bar ( m )
  2.    (mapcar '(lambda ( x ) (apply 'append x))
  3.        (apply 'append
  4.            (mapcar '(lambda ( x ) (apply 'mapcar (cons 'list (mapcar 'foo x)))) (foo m))
  5.        )
  6.    )
  7. )
  8. (defun baz ( m )
  9.    (mapcar '(lambda ( x ) (apply 'append x))
  10.        (apply 'append
  11.            (mapcar 'foo (apply 'mapcar (cons 'list (mapcar 'foo m))))
  12.        )
  13.    )
  14. )
  15. (defun foo ( m )
  16.    (if m (cons (mapcar '(lambda ( a b ) a) m '(0 1 2)) (foo (cdddr m))))
  17. )

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


Lee Mac

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

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

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

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

Lee, is there a reason to use:
Code: [Select]
(mapcar '(lambda ( n ) (nth n l)) (vl-sort-i l '<))rather than:
Code: [Select]
(vl-sort l '<)because now I think that the simpliest way to write it would be:
Code: [Select]
(defun validrowcolp ( l )
  (equal (vl-sort l '<) '(1 2 3 4 5 6 7 8 9))
)
wouldn't came up with this, without your suggestion :) [since I might overthinked my version of ValidRowColp].   


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

Thats very cool! :lol:


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

Lee, are you sure it doesn't get into endless loop? :
Code - Auto/Visual Lisp: [Select]
  1. (sudoku
  2.  '(
  3.    (6 nil nil nil 8 5 1 nil nil)
  4.    (nil nil nil nil nil nil nil 5 3)
  5.    (4 nil nil nil nil 9 8 nil nil)
  6.    (nil nil nil nil nil nil nil 1 nil)
  7.    (nil 8 nil 3 2 6 nil 7 nil)
  8.    (nil 3 nil 1 nil nil nil nil nil)
  9.    (nil nil 7 nil nil nil nil nil 4)
  10.    (nil 5 nil nil nil nil nil nil nil)
  11.    (nil nil nil 9 4 nil nil nil 2)
  12.  )
  13. )


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

Code - Auto/Visual Lisp: [Select]
  1. ;hardest sudoku
  2. (sudoku '(
  3.           (  8 nil nil nil nil nil nil nil nil)
  4.           (nil nil   3   6 nil nil nil nil nil)
  5.           (nil   7 nil nil   9 nil   2 nil nil)
  6.           (nil   5 nil nil nil   7 nil nil nil)
  7.           (nil nil nil nil   4   5   7 nil nil)
  8.           (nil nil nil   1 nil nil nil   3 nil)
  9.           (nil nil   1 nil nil nil nil   6   8)
  10.           (nil nil   8   5 nil nil nil   1 nil)
  11.           (nil   9 nil nil nil nil   4 nil nil)
  12.         )
  13. )
  14. ;test grid 1
  15. (sudoku '(
  16.           (  6 nil nil nil   8   5   1 nil nil)
  17.           (nil nil nil nil nil nil nil   5   3)
  18.           (  4 nil nil nil nil   9   8 nil nil)
  19.           (nil nil nil nil nil nil nil   1 nil)
  20.           (nil   8 nil   3   2   6 nil   7 nil)
  21.           (nil   3 nil   1 nil nil nil nil nil)
  22.           (nil nil   7 nil nil nil nil nil   4)
  23.           (nil   5 nil nil nil nil nil nil nil)
  24.           (nil nil nil   9   4 nil nil nil   2)
  25.         )
  26. )
  27. ;test grid 2
  28. (sudoku '(
  29.           (nil nil   4   8 nil nil nil  1    7)
  30.           (  6   7 nil   9 nil nil nil nil nil)
  31.           (  5 nil   8 nil   3 nil nil nil   4)
  32.           (  3 nil nil   7   4 nil   1 nil nil)
  33.           (nil   6   9 nil nil nil   7   8 nil)
  34.           (nil nil   1 nil   6   9 nil nil   5)
  35.           (  1 nil nil nil   8 nil   3 nil   6)
  36.           (nil nil nil nil nil   6 nil   9   1)
  37.           (  2   4 nil nil nil   1   5 nil nil)
  38.         )
  39. )
  40. ;some grid
  41. (sudoku '(
  42.           (  1 nil nil nil nil   7 nil   9 nil)
  43.           (nil   3 nil nil   2 nil nil nil   8)
  44.           (nil nil   9   6 nil nil   5 nil nil)
  45.           (nil nil   5   3 nil nil   9 nil nil)
  46.           (nil   1 nil nil   8 nil nil nil   2)
  47.           (  6 nil nil nil nil   4 nil nil nil)
  48.           (  3 nil nil nil nil nil nil   1 nil)
  49.           (nil   4 nil nil nil nil nil nil   7)
  50.           (nil nil   7 nil nil nil   3 nil nil)
  51.        )
  52. )
« Last Edit: October 26, 2017, 07:51:19 pm by Stefan »

Lee Mac

  • Seagull
  • Posts: 11831
  • 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...