gistfile1.scm

(define (element-by-index index lis)
  (define (iter i rest-lis)
    (if (< i index)
        (iter (+ i 1) (cdr rest-lis))
        (car rest-lis)))
  (if (> index (length lis))
      (begin (print "error element-by-index")
             0)  
      (iter 1 lis)))

(define (replace-by-index el index lis)
  (define (iter i result rest-lis)
    (if (< i index)
        (iter (+ i 1)  
              (append result (list (car rest-lis))) 
              (cdr rest-lis))
        (append (append result (list el)) (cdr rest-lis))))
  (if (> index (length lis))
      (begin (print "error replace-by-index")
             0)
      (iter 1 (list) lis)))



(define (queens board-size)
  (define empty-board (map (lambda (i) (map (lambda (j) (list j 0))
                                            (enumerate 1 board-size)))
                           (enumerate 1 board-size)))
  (define empty-col (map (lambda (x) (list x 0)) (enumerate 1 board-size)))

  (define (safe? k positions)
    (define (queen-row col)
      (fold-right
        (lambda (x y) (+ y (if (= 1 (cadr x))
                               (car x)
                               0)))
        0
        (element-by-index col positions)))

    (define (safe-row?)
      (if (< 1 (fold-right
                 (lambda (x y) (+ y (cadr x)))
                 0
                 (element-by-index
                   (queen-row k)
                   (transpose positions))))
          #f
          #t))

    (define (safe-diag-top?)
      (define (iter row col)
        (cond ((or (< row 1)
                   (< col 1))
               #t)
              ((= 1 (cadr (element-by-index
                            row
                            (element-by-index
                              col
                              positions))))
               #f)
              ((or (<= col 1)
                   (<= row 1))
               #t)
              (else (iter (- row 1) (- col 1)))))
      (iter (- (queen-row k) 1) (- k 1)))

    (define (safe-diag-bot?)
      (define (iter row col)
        (cond ((or (> row board-size)
                   (< col 1))
               #t)
              ((= 1 (cadr (element-by-index
                            row
                            (element-by-index
                              col
                              positions))))
               #f)
              ((or (<= col 1)
                   (>= row board-size))
               #t)
              (else (iter (+ row 1) (- col 1)))))
      (iter (+ (queen-row k) 1) (- k 1)))

    (and (safe-row?)
         (safe-diag-top?)
         (safe-diag-bot?)))

  (define (adjoin-position nr c q)
    (replace-by-index
      (replace-by-index (list nr 1) nr empty-col)
      c
      q))

  (define (queen-cols k)
    (if (= 0 k)
        (list empty-board)
        (filter (lambda (positions) (safe? k positions))
          (flatmap (lambda (rest-of-queens)
                     (map (lambda (new-row)
                            (adjoin-position new-row k rest-of-queens))
                          (enumerate 1 board-size)))
                   (queen-cols (- k 1))))))
  (queen-cols board-size))

(define (print-board b)
  (map (lambda (row) (print (map (lambda (col) (cadr col)) row)))
       (transpose b))
  (newline))

(time (map print-board (queens 8)))