; word search solver
(define (make-matrix rows columns)
(do ((m (make-vector rows)) (i 0 (+ i 1)))
((= i rows) m)
(vector-set! m i (make-vector columns))))
(define (matrix-rows x) (vector-length x))
(define (matrix-cols x) (vector-length (vector-ref x 0)))
(define (matrix-ref m i j) (vector-ref (vector-ref m i) j))
(define (matrix-set! m i j x) (vector-set! (vector-ref m i) j x))
(define-syntax for
(syntax-rules ()
((for (var first past step) body ...)
(let ((ge? (if (< first past) >= <=)))
(do ((var first (+ var step)))
((ge? var past))
body ...)))
((for (var first past) body ...)
(let* ((f first) (p past) (s (if (< first past) 1 -1)))
(for (var f p s) body ...)))
((for (var past) body ...)
(let* ((p past)) (for (var 0 p) body ...)))))
(define puzzle
#( #( #\F #\Y #\Y #\H #\N #\R #\D )
#( #\R #\L #\J #\C #\I #\N #\U )
#( #\A #\A #\W #\A #\A #\H #\R )
#( #\N #\T #\K #\L #\P #\N #\E )
#( #\C #\I #\L #\F #\S #\A #\P )
#( #\E #\O #\G #\O #\T #\P #\N )
#( #\H #\P #\O #\L #\A #\N #\D )))
(define words '("ITALY" "HOLLAND" "POLAND" "SPAIN" "FRANCE" "JAPAN" "TOGO" "PERU"))
(define (search-list puzzle words)
(do ((words words (cdr words)))
((null? words))
(search puzzle (car words))))
(define (search puzzle word)
(for (r 0 (matrix-rows puzzle))
(for (c 0 (matrix-cols puzzle))
(or (search-place puzzle word r c -1 0)
(search-place puzzle word r c -1 1)
(search-place puzzle word r c 0 1)
(search-place puzzle word r c 1 1)
(search-place puzzle word r c 1 0)
(search-place puzzle word r c 1 -1)
(search-place puzzle word r c 0 -1)
(search-place puzzle word r c -1 -1)))))
(define (search-place puzzle word r c r-diff c-diff)
(let loop ((i r) (j c) (ws (string->list word)))
(cond ((null? ws) (found word r c r-diff c-diff))
((not (and (< -1 i (matrix-rows puzzle))
(< -1 j (matrix-cols puzzle)))) #f)
((char=? (car ws) (matrix-ref puzzle i j))
(loop (+ i r-diff) (+ j c-diff) (cdr ws)))
(else #f))))
(define (found word r c r-diff c-diff)
(display word)
(display " row ")
(display (+ r 1))
(display " column ")
(display (+ c 1))
(if (= r-diff 1) (display " down"))
(if (= r-diff -1) (display " up"))
(if (= c-diff 1) (display " right"))
(if (= c-diff -1) (display " left"))
(newline)
#t)
(search-list puzzle words)