A throwback from my first semester in college.

sudokuSolver.scm

(#%require racket/date)
;KEVAN AHLQUIST

;first test list
(define test '((9 . 3)(4 . 5)
                      (3 . 10)(2 . 13)(1 . 14)(9 . 18)
                      (1 . 20)(6 . 22)(9 . 24)
                      (6 . 28)(2 . 30)(9 . 34)(3 . 35)
                      (7 . 37)(9 . 41)(8 . 44)
                      (1 . 46)(4 . 48)(6 . 52)(7 . 53)
                      (5 . 58)(1 . 60)(7 . 63)
                      (3 . 65)(2 . 68)(7 . 69)(9 . 71)
                      (8 . 77)(5 . 79)))
;Near worst case for brute force solver
(define brute-test '(
                     (3 . 15)(8 . 17)(5 . 18)
                             (1 . 21)(2 . 23)
                             (5 . 31)(7 . 33)
                             (4 . 39)(1 . 43)
                             (9 . 47)
                             (5 . 55)(7 . 62)(3 . 63)
                             (2 . 66)(1 . 68)
                             (4 . 77)(9 . 81)))
; Another test list
(define test2 '((5 . 1)(3 . 2)(7 . 5)
                       (6 . 10)(1 . 13)(9 . 14)(5 . 15)
                       (9 . 20)(8 . 21)(6 . 26)
                       (8 . 28)(6 . 32)(1 . 33)(3 . 36)
                       (4 . 37)(8 . 40)(3 . 42)(1 . 45)
                       (7 . 46)(2 . 50)(6 . 54)
                       (6 . 56)(2 . 61)(8 . 62)
                       (4 . 67)(1 . 68)(9 . 69)(5 . 72)
                       (5 . 75)(8 . 77)(7 . 80)(9 . 81)))
;Al Escargot, created by Finnish mathematician Arto Inkala
(define al-escargot '((1 . 1)(7 . 6)(9 . 8)
                      (3 . 11)(2 . 14)(8 . 18)
                      (9 . 21)(6 . 22)(5 . 25)
                      (5 . 30)(3 . 31)(9 . 34)
                      (1 . 38)(8 . 41)(2 . 45)
                      (6 . 46)(4 . 51)
                      (3 . 55)(1 . 62)
                      (4 . 65)(7 . 72)
                      (7 . 75)(3 . 79)))
;======================================

(define (display+ . args)
  (for-each
   (lambda (x) (display x))
   args)
  (newline))
; exists-in-list?: returns true if item is in list, false otherwise
(define (exists-in-list? lst item)
  (if (null? (filter (lambda (x) (equal? x item)) lst))
      #f
      #t
      )
  )
;removes item from list WORKING
(define (remove-item lst item)
  (filter (lambda (x) (not (equal? x item))) lst))
;removes items from potential list that are in reference list
(define (remove-from-pot-list pot-list ref-list)
  (map (lambda (x) (set! pot-list (remove-item pot-list x))) ref-list)
  pot-list)
;does-spot-have-value? WORKING
(define (does-spot-have-value? lst item)
  (if (null? (filter (lambda (x) (equal? (cdr x) item)) lst))
      #f
      #t
      )
  )
;retrieves value from answer-list for position
(define (get-value-at-position position answer-list)
  (let ((pairs-list (filter (lambda (x) (equal? (cdr x) position)) answer-list)))
    (if (null? pairs-list)
        (display "get-value-at-position error: No value for position.")
        (caar pairs-list))))
;set-value, puts value position pair into list WORKING
(define (add-answer-value answer-list value position)
  (define (helper answer-list)
    (if (null? answer-list)
        (cons (cons value position) '())
        (if (does-spot-have-value? answer-list position)
            answer-list
            (if (< position (cdar answer-list))
                (cons (cons value position) answer-list)
                (cons (car answer-list) (helper (cdr answer-list)))))))
  (helper answer-list))
;checks for first open spot in list to start trying the brute force method.
(define (first-empty lst)
  ;(display+ "\nfirst-empty running\nlst: " lst)
  (define (helper spot lst)
    (if (= spot (cdar lst))
        (begin ;(display+ "spot equal to spot in list, recurse\n lst:" lst)
               (helper (+ 1 spot) (cdr lst)))
        spot))
  (helper 1 lst))
;; Filter: keep each element of a list where filter returns true WORKING
(define (filter f l)
  (if (null? l) '()
      (if (f (car l)) (cons (car l) (filter f (cdr l))) (filter f (cdr l)))))
;makes list with numbers, x is interval, start is starting place WORKING
(define (maker x start)
  (define (helper current list)
    (if (or (< current 1) (= (length list) 9))
        list
        (helper (- current x) (cons current list))
        ))
  (helper start '()))
;============================
(define square-1 '(1 2 3 10 11 12 19 20 21))
(define square-2 '(4 5 6 13 14 15 22 23 24))
(define square-3 '(7 8 9 16 17 18 25 26 27))
(define square-4 '(28 29 30 37 38 39 46 47 48))
(define square-5 '(31 32 33 40 41 42 49 50 51))
(define square-6 '(34 35 36 43 44 45 52 53 54))
(define square-7 '(55 56 57 64 65 66 73 74 75))
(define square-8 '(58 59 60 67 68 69 76 77 78))
(define square-9 '(61 62 63 70 71 72 79 80 81))
(define list-of-boxes `(,square-1 ,square-2 ,square-3 ,square-4 ,square-5 ,square-6 ,square-7 ,square-8 ,square-9))
;============================
(define row-1 (maker 1 9))
(define row-2 (maker 1 18))
(define row-3 (maker 1 27))
(define row-4 (maker 1 36))
(define row-5 (maker 1 45))
(define row-6 (maker 1 54))
(define row-7 (maker 1 63))
(define row-8 (maker 1 72))
(define row-9 (maker 1 81))
(define list-of-rows `(,row-1 ,row-2 ,row-3 ,row-4 ,row-5 ,row-6 ,row-7 ,row-8 ,row-9))
;============================
(define column-1 (maker 9 73))
(define column-2 (maker 9 74))
(define column-3 (maker 9 75))
(define column-4 (maker 9 76))
(define column-5 (maker 9 77))
(define column-6 (maker 9 78))
(define column-7 (maker 9 79))
(define column-8 (maker 9 80))
(define column-9 (maker 9 81))
(define list-of-cols `(,column-1 ,column-2 ,column-3 ,column-4 ,column-5 ,column-6 ,column-7 ,column-8 ,column-9))

(define full-pot-list row-1)
;==============================
;==============================
;FILTER FUNCTIONS 
;Primitive, starts with full possible numbers list and whittles it down, subtractive filtering
(define (row-function spot potential-list answer-matrix)
  ;(display+ "spot: " spot)
  
  (let* ((full-row-positions-list (car (filter (lambda (x) (exists-in-list? x spot)) list-of-rows)))
         (available-positions-list (filter (lambda (x) (not (= spot x))) full-row-positions-list))
         (positions-with-values-list (filter (lambda (x) (does-spot-have-value? answer-matrix x)) available-positions-list))
         (values-list (map (lambda (x) (get-value-at-position x answer-matrix)) positions-with-values-list))
         (new-potential-list (remove-from-pot-list potential-list values-list)))
    (if (> d 2)(display+ "\nrow-function:"
                         "\nvalues-list: " values-list
                         "\nold potential list: " potential-list
                         "\nnew-potential-list: " new-potential-list))
    
    new-potential-list
    ))
;-------------------------------------------------------------
;same design as row-function
(define (col-function spot potential-list answer-matrix)
  (let* ((full-col-positions-list (car (filter (lambda (x) (exists-in-list? x spot)) list-of-cols)))
         (available-positions-list (filter (lambda (x) (not (= spot x))) full-col-positions-list))
         (positions-with-values-list (filter (lambda (x) (does-spot-have-value? answer-matrix x)) available-positions-list))
         (values-list (map (lambda (x) (get-value-at-position x answer-matrix)) positions-with-values-list))
         (new-potential-list (remove-from-pot-list potential-list values-list)))
    (if (> d 5)
        (display+ "\ncol-function:"
                  "\nvalues-list: " values-list
                  "\nold potential list: " potential-list
                  "\nnew-potential-list: " new-potential-list))
    
    new-potential-list)
  )
;===============================================================
;Same as row-function
(define (box-function spot potential-list answer-matrix)
  (let* ((full-box-positions-list (car (filter (lambda (x) (exists-in-list? x spot)) list-of-boxes)))
         (available-positions-list (filter (lambda (x) (not (= spot x))) full-box-positions-list))
         (positions-with-values-list (filter (lambda (x) (does-spot-have-value? answer-matrix x)) available-positions-list))
         (values-list (map (lambda (x) (get-value-at-position x answer-matrix)) positions-with-values-list))
         (new-potential-list (remove-from-pot-list potential-list values-list)))
    (if (> d 5)
        (display+ "\nbox-function:"
                  "\nvalues-list: " values-list
                  "\nold potential list: " potential-list
                  "\nnew-potential-list: " new-potential-list))
    
    new-potential-list))
;================================================
;Next filter: At spot, check other rows/cols in box for elimination. If spot is only possible place to add value, put it in.
;After that: for cases where 2 possible values can go in two pairs of boxes, split computation and try solving with both combinations  
;===============================================================
;===============================================================
;inner helper, runs filters
(define (inner-helper spot answer-matrix outer-iteration old-matrix)
  (if (> spot 81); check to see if spot is out of range, if so, kick back to outer helper
      (outer-helper (+ 1 outer-iteration) answer-matrix old-matrix)
      (if (does-spot-have-value? answer-matrix spot)
          ;if spot already has value, skip over spot, if spot>81, run outer helper
          (inner-helper (+ 1 spot) answer-matrix outer-iteration old-matrix)
          (if (> spot 81) 
              (outer-helper (+ 1 outer-iteration) answer-matrix old-matrix)
              (let* ((potential-list full-pot-list)); filter out list with row,col,box functions
                (set! potential-list (row-function spot potential-list answer-matrix))
                ;(display+ "after-row-in-inner-helper potential-list: " potential-list)
                (set! potential-list (col-function spot potential-list answer-matrix))
                (set! potential-list (box-function spot potential-list answer-matrix));run filters on pot-list, set! 
                (if (= 1 (length potential-list));if only one is left, put it in
                    (begin (set! answer-matrix (add-answer-value answer-matrix (car potential-list) spot))
                           (inner-helper (+ 1 spot) answer-matrix outer-iteration old-matrix))
                    (inner-helper (+ 1 spot) answer-matrix outer-iteration old-matrix)))
              )))
  )
;===============================================================
;Runs inner helper to start each iteration, checks if solution is full.
(define (outer-helper iteration current-answer-matrix old-matrix)
  (if (or (= (length current-answer-matrix) (length old-matrix)) (= 81 (length current-answer-matrix)))
      (begin current-answer-matrix); fix to just display values, neatly
      (inner-helper 1 current-answer-matrix iteration current-answer-matrix)))
;===============================================
(define (solve-sudoku number-matrix)
  (let ((answer '()))
    (set! answer (outer-helper 1 number-matrix '()))
    ;(display A)
    ;(display+ "\nSolution Length: " (length A))
    answer))
;================================================================
;Alternative relatively brute force method
(define (first-not-null function lst) ; primitive try loop
  (define (helper lst)
    (if (null? lst) '()
        (let* ((func-of-car (function (car lst))))
          (cond ((not (pair? lst)) '() )
                ((null? func-of-car) (helper (cdr lst)) )
                (else func-of-car )))))
  (helper lst))
;----------------------------------------------------
(define (solve-sudoku-brute number-matrix)
  (define start-date (date->seconds (current-date)))
  (display "\nPlease wait, calculating... . . .  .  .  .   .   .   .")
  (define (helper spot answer-matrix)
    ;(display answer-matrix)(newline)(newline)
    ;(display+ "Length: " (length answer-matrix))(newline)
    (if (> spot 81)
        (set! spot 1))
    (if (<= 81 (length answer-matrix))
        answer-matrix
        (begin ;(display answer-matrix)
          (if (does-spot-have-value? answer-matrix spot)
              (first-not-null (lambda (x) (helper (+ 1 spot) answer-matrix)) '(1))
              (let ((potentials (let ((potential-list full-pot-list))
                                  (set! potential-list (row-function spot potential-list answer-matrix))
                                  (set! potential-list (col-function spot potential-list answer-matrix))
                                  (set! potential-list (box-function spot potential-list answer-matrix))
                                  potential-list))); end variables in let
                ;(display (cadr answer-matrix))(newline)
                (first-not-null (lambda (x) (helper (+ 1 spot) (add-answer-value answer-matrix  x  spot))) potentials))))))
  ;Run smart version first to help filter faster
  (define partial (solve-sudoku number-matrix))
  ; Initiate brute solver
  ;(display+ "partial: " partial)
  (if (= (length partial) 81)
      (let* ((answer partial)
            (end-date (date->seconds (current-date)))
            (time-elapsed (- end-date start-date)))
        (display "\nTime Elapsed (s): ")(display time-elapsed)(newline)
        (print answer))
      (let* ((start-spot (first-empty partial))
            (answer (first-not-null (lambda (x) (begin (display+ "outer-number: " x)
                                                  (helper 1 (add-answer-value partial x start-spot)))) full-pot-list))
            (end-date (date->seconds (current-date)))
            (time-elapsed (- end-date start-date)))
  (display "\nTime Elapsed (s): ")(display time-elapsed)(newline)
  (print answer))))
;answer)
;================
;Function to print sudokus nicely, not quite working
(define (print sudoku)
  (define (helper lst main-count row-count)
    (if (null? lst)
        (display "")
        (if (= 9 row-count)
            (begin (newline) (display (caar lst))(display " ") (helper (cdr lst) (+ 1 main-count) 1))
            (begin (display (caar lst))(display " ") (helper (cdr lst) (+ 1 main-count) (+ 1 row-count))))))
  (helper sudoku 1 0))
;========
;TEST CASES
(define d 0)
(display "test:\n")
(solve-sudoku-brute test)
(display "\n\ntest2:\n")
(solve-sudoku-brute test2)
(display "\n\nal-escargot:\n")
(solve-sudoku-brute al-escargot)
(display "brute-test:\n") ;<== Takes longer than 12 hours, not done.
(solve-sudoku-brute brute-test)