
Re: 4 colors problem
Posted:
Mar 13, 2014 9:41 AM


\* begin comment
This is a program in Shen from shenlanguage.org. (fourcolors 16) (makearray 8 (fourcolors 64))
end comment *\
(define pairs > [0 1 0 2 0 3 1 0 2 0 3 0 1 2 1 3 2 1 3 1 2 3 3 2])
(define fourcolors0 0 _ M > M N L M > (let b ((protect RANDOM) 12) (if (or (and (< (length M) 8) (= L (hd (pickcolor b))) ) (and (>= (length M) 8) (not (integer? (/ (length M) 8))) (or (= L (hd (pickcolor b))) (not (columnok? (pickcolor b) M)))) (and (>= (length M) 8) (integer? (/ (length M) 8)) (not (columnok? (pickcolor b) M)))) (fourcolors0 N L M) (fourcolors0 ( N 1) (hd (tl (pickcolor b))) (append M (pickcolor b))) )))
(define fourcolors N > (fourcolors0 N 1 []))
(define columnok? L M > (if (or (= (from ( (length M) 8) M) (hd L)) (= (from ( (length M) 7) M) (hd (tl L))) ) false true))
(define pickcolor N > [(from (* 2 N) (pairs)) (from (+ (* 2 N) 1) (pairs))])
(define from 0 L > (head L) N [XY] > (from ( N 1) Y))
(define makearray1 0 N L > (append (reverse N) [L]) M N L > (if (< M (length L)) (makearray1 M (cons (take M L) N) (drop M L)) (makearray1 0 N L))) (define makearray M _ > [] where (= M 0) M L > (makearray1 M [] L))
(define take0 0 M _ > (reverse M) N M [XY] > (take0 ( N 1) (cons X M) Y))
(define take N L > (if (< N 0) (drop ( (length L) (abs N)) L) (take0 N [] L)))
(define drop 0 L > L N L > (if (< N 0) (take ( (length L) (abs N)) L) (drop ( N 1) (tl L))))
(define abs N > (* N 1) where (< N 0) N > N)

