RosettaCodeData/Task/Generate-Chess960-starting-position/Racket/generate-chess960-starting-position.rkt
2015-02-20 09:02:09 -05:00

32 lines
1.1 KiB
Racket

#lang racket
(define white (match-lambda ['P #\♙] ['R #\♖] ['B #\♗] ['N #\♘] ['Q #\♕] ['K #\♔]))
(define black (match-lambda ['P #\♟] ['R #\♜] ['B #\♝] ['N #\♞] ['Q #\♛] ['K #\♚]))
(define (piece->unicode piece colour)
(match colour ('w white) ('b black)) piece)
(define (find/set!-random-slot vec val k (f values))
(define r (f (random k)))
(cond
[(vector-ref vec r)
(find/set!-random-slot vec val k f)]
[else
(vector-set! vec r val)
r]))
(define (chess960-start-position)
(define v (make-vector 8 #f))
;; Kings and Rooks
(let ((k (find/set!-random-slot v (white 'K) 6 add1)))
(find/set!-random-slot v (white 'R) k)
(find/set!-random-slot v (white 'R) (- 7 k) (curry + k 1)))
;; Bishops -- so far only three squares allocated, so there is at least one of each colour left
(find/set!-random-slot v (white 'B) 4 (curry * 2))
(find/set!-random-slot v (white 'B) 4 (compose add1 (curry * 2)))
;; Everyone else
(find/set!-random-slot v (white 'Q) 8)
(find/set!-random-slot v (white 'N) 8)
(find/set!-random-slot v (white 'N) 8)
(list->string (vector->list v)))
(chess960-start-position)