Advertisement
saltycracker

Sudoku(9x9).el

Dec 7th, 2020
1,041
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 2.61 KB | None | 0 0
  1. (require 'seq)
  2.  
  3. (setq sudokuRow 9)
  4. (setq sudokuBox 3)
  5. (setq sudokuValidCharacters '(1 2 3 4 5 6 7 8 9))
  6.  
  7. (setq sudokuStr "000008000200059000100000250008001460300000100904083000000500084000004900023000000")
  8.  
  9. (setq
  10.  arr
  11.  (vconcat (seq-map (lambda (c) (- c ?0)) (string-to-vector sudokuStr)))
  12.  )
  13.  
  14. (defun buildRow (p)
  15.   "Build sudoku row from position(p)"
  16.   (let (
  17.     (r (mod p sudokuRow))
  18.     (rp (/ p sudokuRow))
  19.     (count 0)
  20.     (row '())
  21.     )
  22.     (while (< count sudokuRow)
  23.       (if
  24.       (not(= count r))
  25.       (setq row (cons (+ count (* rp sudokuRow)) row))
  26.     )
  27.       (setq count (+ count 1))
  28.       )
  29.     row
  30.     )
  31.   )
  32.  
  33. (defun buildCol (p)
  34.   "Build sudoku column from position(p)"
  35.   (let (
  36.     (r (mod p sudokuRow))
  37.     (rp (/ p sudokuRow))
  38.     (count 0)
  39.     (col '())
  40.     )
  41.     (while (< count sudokuRow)
  42.       (if
  43.       (not(= count rp))
  44.       (setq col (cons (+ r (* count sudokuRow)) col))
  45.       )
  46.       (setq count (+ count 1))
  47.       )
  48.     col
  49.     )
  50.   )
  51.  
  52. (defun buildBoxLst (p)
  53.   "Build sudoku box list from position(p)"
  54.   (cond
  55.    ((= p 0) '(1 2))
  56.    ((= p 1) '(-1 1))
  57.    ((= p 2) '(-2 -1))
  58.    )
  59.   )
  60.  
  61. (defun buildBox (p)
  62.   "Build sudoku box from position(p)"
  63.   (let* (
  64.     (r (mod (/ p sudokuRow) sudokuBox))
  65.     (c (mod p sudokuBox))
  66.     (rl (buildBoxLst r))
  67.     (cl (buildBoxLst c))
  68.     )
  69.     (seq-reduce
  70.      (lambda (ar dr)
  71.        (seq-reduce
  72.     (lambda (ac dc) (cons (+ p dc (* dr sudokuRow)) ac))
  73.     cl
  74.     ar)
  75.        )
  76.      rl
  77.      '()
  78.      )
  79.     )
  80.   )
  81.  
  82. (defun buildStartingCharacters (e)
  83.   "Build sudoku starting characters from edges(e)"
  84.   (seq-reduce
  85.    (
  86.     lambda
  87.     (a d)
  88.     (
  89.      seq-filter
  90.      (lambda (elt)
  91.        (not(= (aref arr d) elt))
  92.        )
  93.      a
  94.      )
  95.     )
  96.    e
  97.    sudokuValidCharacters
  98.    )
  99.   )
  100.  
  101. (defun chatToInt (c p)
  102.   "Convert ascii character to integer"
  103.   (let* (
  104.     (edges (append (buildRow p) (buildCol p) (buildBox p)))
  105.     (startingValues (buildStartingCharacters edges))
  106.     )
  107.     (
  108.      vector
  109.      p
  110.      c
  111.      (if (zerop c) nil t)
  112.      edges
  113.      startingValues
  114.      )
  115.     )
  116.   )
  117.  
  118. (setq sudokuLst (seq-map-indexed 'chatToInt arr))
  119.  
  120. (defun solveIt (l)
  121.   "Solve sudoku puzzle"
  122.   (if
  123.       l
  124.       (let* (
  125.          (elem (car l))
  126.          (p (aref elem 0))
  127.          (v (aref elem 1))
  128.          (f (aref elem 2))
  129.          (ed (aref elem 3))
  130.          (sv (aref elem 4))
  131.          )
  132.     (if f
  133.         (solveIt (cdr l))
  134.       (
  135.        seq-do
  136.        (lambda (s)
  137.          (if (seq-find (lambda (e) (= (aref arr e) s)) ed)
  138.          ()
  139.            (progn
  140.          (aset arr p s)
  141.          (solveIt (cdr l))
  142.          (aset arr p 0)
  143.          )
  144.            )
  145.          )
  146.        sv
  147.        )
  148.       )
  149.     )
  150.     (pp arr)
  151.     )
  152.   )
  153.  
  154. (solveIt sudokuLst)
  155.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement