Scheme N皇后

时间:2022-06-11 10:20:44
(define (range n)
(define (recur n)
(if (= n -)
'()
(cons n (recur (- n )))))
(recur (- n ))) (define (flatten a)
(if (null? a)
'()
(append (car a) (flatten (cdr a))))) (define (safe? x y sln)
(if (null? sln)
#t
(let ((px (car (car sln))) (py (cadr (car sln))))
(if (or (= y py) (= (- py y) (- px x)) (= (- py y) (- x px)))
#f
(safe? x y (cdr sln)))))) (define (nqueen n)
(define (recur x)
(if (= x -)
(list '())
(flatten (map (lambda (y) (map (lambda (sln) (cons (list x y) sln)) (filter (lambda (sln) (safe? x y sln)) (recur (- x ))))) (range n)))))
(recur (- n ))) (define (pl a)
(if (null? a)
'()
(begin (display (car a)) (display "\n") (pl (cdr a))))) (pl (nqueen ))

流 版本:

#lang racket
(require racket/stream) (define-syntax-rule (scons a b) (stream-cons a b))
(define-syntax-rule (scar a) (stream-first a))
(define-syntax-rule (scdr a) (stream-rest a))
(define-syntax-rule (smap f s) (stream-map f s))
(define-syntax-rule (sfilter f s) (stream-filter f s))
(define-syntax-rule (sreduce f i s) (stream-fold f i s))
(define-syntax-rule (snull? s) (stream-empty? s))
(define-syntax-rule (sappend s ...) (stream-append s ...))
(define-syntax-rule (sfor f s) (stream-for-each f s)) (define (sflatten a)
(if (snull? a)
empty-stream
(sappend (scar a) (sflatten (scdr a))))) (define (srange n)
(let recur ((x ))
(if (= x n)
empty-stream
(scons x (recur (+ x )))))) (define (dis x)
(begin (display x)(newline))) (define (sd s)
(sfor dis s)) (define (safe? x y sln)
(if (snull? sln)
#t
(let ((px (scar (scar sln))) (py (scar (scdr (scar sln)))))
(if (or (= y py) (= (- py y) (- px x)) (= (- py y) (- x px)))
#f
(safe? x y (scdr sln)))))) (define (nqueen n)
(define (recur x)
(if (= x -)
(stream empty-stream)
(sflatten (smap (lambda (y) (smap (lambda (sln) (scons (stream x y) sln)) (sfilter (lambda (sln) (safe? x y sln)) (recur (- x ))))) (srange n)))))
(recur (- n ))) (define ass (sflatten (stream (srange ) (srange ))))
;(define ass (stream (srange ) (srange )))
(sfor (lambda (x) (sfor (lambda (y) (sfor display y)(display ",")) x)(newline)) (nqueen ))