day7.scm

(define node-expand
  (lambda (n lst)
    (if (zero? n) '()
	(cons (cons n lst) (node-expand (- n 1) lst)))))

(define safe?
  (lambda (lst)
    (let ((new (car lst))
	  (hlst (cdr lst)))
      (if (null? hlst) #t
	  (safe-aux? new (+ new 1) (- new 1) hlst)))))

(define safe-aux?
  (lambda (new up down hlst)
    (if (null? hlst) #t
	(let ((pos (car hlst)))
	  (and (not (= pos new))
	       (not (= pos up))
	       (not (= pos down))
	       (safe-aux? new (+ up 1) (- down 1)
			  (cdr hlst)))))))

(define goal?
  (lambda (x n)
    (= (length x) n)))

(define depth-first-search
  (lambda (n)
    (letrec
	((lst (node-expand n '()))
	 (solution '())
	 (x '())
	 (pop
	  (lambda ()
	    (let ((y (car lst)))
	      (set! lst (cdr lst)) y)))
	 (push
	  (lambda (y)
	    (set! lst (append y lst))))
	 (search
	  (lambda ()
	    (if (null? lst)
		solution
		(begin
		  (set! x (pop))
		  (if (safe? x)
		      (if (goal? x n)
			  (set! solution (cons x solution))
			  (push (node-expand n x))))
		  (search))))))
      (search))))

(define mapping
  (lambda (f x)
    (if (null? x)
	'()
	(cons (f (car x)) (mapping f (cdr x))))))

(define queen-ox (lambda (n x) (if (= n x) 'o 'x)))

(define queenline
  (lambda (num len pos)
    (if (>= pos len)
	'()
	(cons (queen-ox num (+ pos 1))
	      (queenline num len (+ pos 1))))))

(define queen-draw
  (lambda (data size)
    (if (null? data) '()
	(cons (queenline (car data) size 0)
	      (queen-draw (cdr data) size)))))

(define queen (lambda (data) (queen-draw data (length data))))

(define queen-print
  (lambda (n)
    (let ((printy
	   (lambda (line)
	     (write line)
	     (newline))))
      (mapping printy (queen (car (depth-first-search n)))))))

(queen-print 8)