Welcome to the CHICKEN Scheme pasting service

(use amb amb-extras)

(define colors '(gelb orange rot lila blau gruen tuerkies))

;from SICP Sec 4.3.1. Thanks Mr Sussman.
(define (require p)
  (when (not p) (amb)))

(define (an-element-of items)
  (require (not (null? items)))
  (amb/random (car items) (an-element-of (cdr items))))

; Log cabin tiles are represented as their colors on
; top bottom left right
(define (new-log)
  (let ((top (an-element-of colors))
	(bottom (an-element-of colors))
	(left (an-element-of colors))
	(right (an-element-of colors)))
    (require (distinct? (list top bottom left right)))
    (list top bottom left right)))

; Logs are different if they don't have the same colored edges adjacent to each other

(define (pair-wise pred lst)
  (cond ((null? lst) #t)
	((null? (cdr lst)) #t)
	(else (and (pred (car lst) (cadr lst))
		   (pair-wise pred (cdr lst))))))

(define (different-neighbours? row #!key prev next)
  (pair-wise (lambda (a b)
	       (not (equal? (next a) (prev b))))
	     row))

(define (diff-n-cols rows)
  (pair-wise (lambda (a b)
	       (every (lambda (f s)
			(not (equal? (second f)
				     (first s))))
		      a b))
	     rows))

(define (row-of n generator)
  (let ((row (map (lambda (i) (generator))
		  (iota n))))
    (require (distinct? row))
    (require (lset= eq? colors (flatten row)))
    (require (distinct? (map car row)))
    (require (different-neighbours? row prev: fourth next: third))
    row))

(define (quilt-of x y)
  (let ((rows (map (lambda (i) (row-of y new-log))
		    (iota y))))
    (require (distinct? rows))
    (require (distinct? (map caar rows)))
    (require (diff-n-cols rows))
    rows))

(print (quilt-of 6 4))