(SETQ SUDOKU4 '((0 3 0 0) (2 4 0 0) (0 0 3 1) (0 0 4 0))) (SETQ SUDOKU9 '((0 9 0 4 3 0 0 0 6) (4 0 0 0 0 2 9 0 0) (0 0 0 0 0 9 3 0 0) (0 0 0 0 7 0 4 8 5) (0 7 0 3 8 5 0 9 0) (1 8 5 0 4 0 0 0 0) (0 0 8 5 0 0 0 0 0) (0 0 1 6 0 0 0 0 4) (3 0 0 0 2 8 0 5 0))) (DEFUN FULL (MATRIX) (LET ((RET T)) (DOLIST (ROW MATRIX RET) (DOLIST (COL ROW RET) (IF (= COL 0) (SETQ RET NIL)))))) (DEFUN VALIDGROUP (GROUP) (LET ((RET T)) (DOLIST (ITEM GROUP RET) (IF (AND (> (COUNT ITEM GROUP) 1) (NOT (= ITEM 0))) (SETQ RET NIL))))) (DEFUN INT-SQRT (NUM) (LET ((VAL 0)) (SETQ VAL (FLOOR (SQRT NUM))))) (DEFUN CHECKROWS (SUDOKU) (LET ((RET T)) (DOLIST (ROW SUDOKU RET) (IF (NOT (VALIDGROUP ROW)) (SETQ RET NIL))))) (DEFUN CHECKCOLS (SUDOKU) (LET ((RET T)) (DOTIMES (COL (LENGTH SUDOKU) RET) (LET ((TEMP '(0 0))) (DOLIST (ROW SUDOKU RET) (SETQ TEMP (APPEND TEMP (LIST (NTH COL ROW))))) (IF (NOT (VALIDGROUP (REST (REST TEMP)))) (SETQ RET NIL)) (SETQ TEMP '(0 0)))))) (DEFUN CHECKBOXES (SUDOKU) (LET ((RET T) (BASELEN (INT-SQRT (LENGTH SUDOKU)))) (DOTIMES (ROWBASE BASELEN RET) (DOTIMES (COLBASE BASELEN RET) (LET ((TEMP '(-1 -1))) (DOTIMES (I BASELEN RET) (SETQ TEMP (APPEND TEMP (SUBSEQ (NTH (+ I (* BASELEN ROWBASE)) SUDOKU) (* BASELEN COLBASE) (+ (* BASELEN COLBASE) BASELEN))))) (IF (NOT (VALIDGROUP (REST (REST TEMP)))) (SETQ RET NIL))))))) (DEFUN VALIDSUDOKU (SUDOKU) (AND (AND (FULL SUDOKU) (CHECKROWS SUDOKU)) (AND (CHECKCOLS SUDOKU) (CHECKROWS SUDOKU)))) (DEFUN SETELEM (LIST INDEX VAL) (IF (= INDEX 0) (CONS VAL (REST LIST)) (CONS (FIRST LIST) (SETELEM (REST LIST) (- INDEX 1) VAL)))) (DEFUN SETMATRIXELEM (MATRIX ROW COL VAL) (IF (= ROW 0) (APPEND (LIST (SETELEM (FIRST MATRIX) COL VAL)) (REST MATRIX)) (APPEND (LIST (FIRST MATRIX)) (SETMATRIXELEM (REST MATRIX) (- ROW 1) COL VAL)))) (DEFUN EXPAND (SUDOKU ROW COL) (LET ((STATES 'NIL)) (DOTIMES (I (LENGTH SUDOKU) STATES) (SETQ STATES (APPEND STATES (LIST (SETMATRIXELEM SUDOKU ROW COL (+ 1 I)))))))) (DEFUN EXPAND-FIRST (SUDOKU) (LET ((LIST NIL)) (DOTIMES (ROW (LENGTH SUDOKU) LIST) (DOTIMES (COL (LENGTH SUDOKU) LIST) (IF (= 0 (NTH COL (NTH ROW SUDOKU))) (PROGN (SETQ LIST (EXPAND SUDOKU ROW COL)) (RETURN))))))) (DEFUN BFSOLVER (PROBLEM &OPTIONAL (FRINGE '())) (SETQ FRINGE (APPEND FRINGE (LIST PROBLEM))) (DO ((J 0 (+ J 1))) (NIL) (IF (NULL FRINGE) (RETURN NIL)) (LET ((CUR (FIRST FRINGE))) (IF (VALIDSUDOKU CUR) (RETURN CUR)) (SETQ FRINGE (APPEND FRINGE (EXPAND-FIRST CUR))) (SETQ FRINGE (REST FRINGE))))) (DEFUN DFSOLVER (PROBLEM &OPTIONAL (FRINGE '())) (SETQ FRINGE (APPEND FRINGE (LIST PROBLEM))) (DO ((J 0 (+ J 1))) (NIL) (IF (NULL FRINGE) (RETURN NIL)) (LET ((CUR (FIRST FRINGE))) (IF (VALIDSUDOKU CUR) (RETURN CUR)) (SETQ FRINGE (REST FRINGE)) (SETQ FRINGE (APPEND (EXPAND-FIRST CUR) FRINGE))))) (DEFUN CHECKCOL (SUDOKU COL) (LET ((RET T) (TEMP '(0 0))) (DOLIST (ROW SUDOKU RET) (SETQ TEMP (APPEND TEMP (LIST (NTH COL ROW))))) (IF (NOT (VALIDGROUP (REST (REST TEMP)))) (SETQ RET NIL)) RET)) (DEFUN CHECKBOX (SUDOKU ROW COL) (LET ((BASELEN (INT-SQRT (LENGTH SUDOKU))) (RET T) (TEMP '(0 0))) (LET ((ROWBASE (FLOOR (/ ROW BASELEN))) (COLBASE (FLOOR (/ COL BASELEN)))) (DOTIMES (I BASELEN RET) (SETQ TEMP (APPEND TEMP (SUBSEQ (NTH (+ I (* BASELEN ROWBASE)) SUDOKU) (* BASELEN COLBASE) (+ (* BASELEN COLBASE) BASELEN))))) (IF (NOT (VALIDGROUP (REST (REST TEMP)))) (SETQ RET NIL)) RET))) (DEFUN GETALLOWEDVALUES (SUDOKU ROW COL) (LET ((VALS '(0 0))) (DOTIMES (I (LENGTH SUDOKU) (REST (REST VALS))) (LET ((TEMP (SETMATRIXELEM SUDOKU ROW COL (+ 1 I)))) (IF (AND (AND (VALIDGROUP (NTH ROW TEMP)) (CHECKCOL TEMP COL)) (CHECKBOX TEMP ROW COL)) (SETQ VALS (APPEND VALS (LIST (+ 1 I))))))))) (DEFUN EXPAND-ALLOWED (SUDOKU ROW COL) (LET ((STATES 'NIL)) (DOLIST (I (GETALLOWEDVALUES SUDOKU ROW COL) STATES) (SETQ STATES (APPEND STATES (LIST (SETMATRIXELEM SUDOKU ROW COL I))))))) (DEFUN EXPAND-BEST (SUDOKU) (LET ((LIST 'NIL) (BESTROW -1) (BESTCOL -1) (BESTVALS 'NIL)) (DOTIMES (I (+ 1 (LENGTH SUDOKU))) (SETQ BESTVALS (APPEND BESTVALS (LIST I)))) (DOTIMES (ROW (LENGTH SUDOKU) LIST) (DOTIMES (COL (LENGTH SUDOKU) LIST) (IF (= 0 (NTH COL (NTH ROW SUDOKU))) (LET ((TEMPVALS (GETALLOWEDVALUES SUDOKU ROW COL))) (IF (< (LENGTH TEMPVALS) (LENGTH BESTVALS)) (PROGN (PROGN (SETQ BESTROW ROW) (SETQ BESTCOL COL)) (SETQ BESTVALS TEMPVALS))))))) (SETQ LIST (EXPAND-ALLOWED SUDOKU BESTROW BESTCOL)) LIST)) (DEFUN SMARTBFSOLVER (PROBLEM &OPTIONAL (FRINGE '())) (SETQ FRINGE (APPEND FRINGE (LIST PROBLEM))) (DO ((J 0 (+ J 1))) (NIL) (IF (NULL FRINGE) (RETURN NIL)) (LET ((CUR (FIRST FRINGE))) (IF (VALIDSUDOKU CUR) (RETURN CUR)) (SETQ FRINGE (APPEND FRINGE (EXPAND-BEST CUR))) (SETQ FRINGE (REST FRINGE))))) (DEFUN SMARTDFSOLVER (PROBLEM &OPTIONAL (FRINGE '())) (SETQ FRINGE (APPEND FRINGE (LIST PROBLEM))) (DO ((J 0 (+ J 1))) (NIL) (IF (NULL FRINGE) (RETURN NIL)) (LET ((CUR (FIRST FRINGE))) (IF (VALIDSUDOKU CUR) (RETURN CUR)) (SETQ FRINGE (REST FRINGE)) (SETQ FRINGE (APPEND (EXPAND-BEST CUR) FRINGE)))))