麻雀プログラムの基本 あがりの形を得る

Gaucheの例。append-map による深さ優先探索。

(use srfi-1)

(define (delete-elt x l)
  (let ([index (list-index (lambda (p) (eq? p x)) l)])
    (and index (call-with-values
		   (lambda () (split-at l index))
		 (lambda (x xs) (append x (cdr xs)))))))

(define (delete-elts x l)
  (cond 
    ((null? x) l)
    ((delete-elt (car x) l) => (lambda (y) (delete-elts (cdr x) y)))
    (else #f)))

(define (pi-l->mentu-lol pi-l)
  (let loop ((l pi-l)
	     (res '()))
    (if (null? l)
        (list (reverse res))
	(append-map (lambda (mentu)
		      (let ([new-l (delete-elts mentu l)])
			(if new-l
			    (loop new-l (cons mentu res))
			    '())))
		    (let ([pi (car l)])
		      (list (list pi (+ pi 1) (+ pi 2)) (list pi pi pi) (list pi pi)))))))

(for-each print (pi-l->mentu-lol '(2 2 2 3 3 3 3 4 4 4 4 5 5 5)))

問題は、(2 2 2 3 3 3 3 4 4 4 4 5 5 5)
出力は、

((2 3 4) (2 3 4) (2 3 4) (3 4 5) (5 5))
((2 3 4) (2 2) (3 4 5) (3 4 5) (3 4 5))
((2 3 4) (2 2) (3 4 5) (3 3) (4 4) (5 5))
((2 3 4) (2 2) (3 3 3) (4 4 4) (5 5 5))
((2 3 4) (2 2) (3 3) (3 4 5) (4 4) (5 5))
((2 2 2) (3 4 5) (3 3 3) (4 4 4) (5 5))
((2 2 2) (3 3 3) (3 4 5) (4 4 4) (5 5))
((2 2 2) (3 3) (3 3) (4 4) (4 4) (5 5 5))
((2 2) (2 3 4) (3 4 5) (3 4 5) (3 4 5))
((2 2) (2 3 4) (3 4 5) (3 3) (4 4) (5 5))
((2 2) (2 3 4) (3 3 3) (4 4 4) (5 5 5))
((2 2) (2 3 4) (3 3) (3 4 5) (4 4) (5 5))

重複があるが、容易に取り除けるだろう。コードの見やすさのためにその処理は省略した。

昨日のを入力してみると、こうなる。

((1 2 3) (1 2 3) (1 2 3) (1 2 3) (9 9))
((1 2 3) (1 2 3) (1 1) (2 2) (3 3) (9 9))
((1 2 3) (1 1 1) (2 2 2) (3 3 3) (9 9))
((1 2 3) (1 1) (1 2 3) (2 2) (3 3) (9 9))
((1 1 1) (1 2 3) (2 2 2) (3 3 3) (9 9))
((1 1) (1 2 3) (1 2 3) (2 2) (3 3) (9 9))
((1 1) (1 1) (2 2) (2 2) (3 3) (3 3) (9 9))