ペントミノ パズル(明治ミルクチョコパズル)をGaucheで解く

athosの日記 - チョコレートパズルを継続渡しで経由

明治ミルクチョコパズル
大雑把には、6×10の長方形の枠に12個の異なる形のペントミノを隙間なく敷き詰めるパズル。他にも、6×11にヘキソミノを詰めるのとかいろんなバリエーションがあるらしい。

  • 2339個の解答があるらしいですが、1時間まわしても終わりませんでした。解答の回転と反転の重複分を枝刈りしていないのが原因と思われます。改良の余地がおおいにあり。
  • ペントミノのデータ作りが面倒でした。回転と対称のデータはプログラムで生成してその出力を貼り付けましたが。テトリス作ったときもやはり面倒だったのを思い出します。
  • すべての解答(ただし回転と反転の重複がある)をプリントします。
(use srfi-1)
(use srfi-43)

(define (solve board remain-kind)
  (let1 i (vector-index not board)
    (if i
      (receive (row col) (quotient&remainder i 10)
	(for-each (lambda (kind)
		    (for-each (lambda (mino)
				(when (every (lambda (xy)
					       (let ((r (+ (car xy) row))
						     (c (+ (cdr xy) col)))
						 (and (>= r 0) (< r 6) (>= c 0) (< c 10)
						      (not (vector-ref board (+ (* r 10) c))))))
					     mino)
				  (for-each (lambda (xy)
					      (vector-set! board (+ i (* (car xy) 10) (cdr xy)) kind))
					    mino)
				  (solve board (delete kind remain-kind))
				  (for-each (lambda (xy)
					      (vector-set! board (+ i (* (car xy) 10) (cdr xy)) #f))
					    mino)))
			      (list-ref pentominos kind)))
		  remain-kind))
      ;; found answer
      (print-board board))))
	
(define (main args)
  (solve (make-vector 60 #f) (iota 12)))

(define (print-board board)
  (vector-for-each (lambda (i x)
		     (display (vector-ref '#(0 1 2 3 4 5 6 7 8 9 A B) x))
		     (when (= 9 (modulo i 10)) (newline)))
		   board)
  (newline))

(define (to-data mino)
  (let ((offset (string-scan (car mino) "#")))
    (append-map (lambda (line row)
		  (filter-map (lambda (x col)
				(if (char=? x #\space)
				  #f
				  (cons row (- col offset))))
			      (string->list line) (iota 5)))
		mino (iota 5))))

(define pentominos
  (map (cut map to-data <>)
       '(((" #"
	   "###"
	   "  #")
	  
	  (" ##"
	   "##"
	   " #")
	  
	  ("#"
	   "###"
	   " #")
	  
	  (" #"
	   " ##"
	   "##")
	  
	  (" #"
	   "###"
	   "#")
	  
	  (" #"
	   "##"
	   " ##")
	  
	  ("  #"
	   "###"
	   " #")
	  
	  ("##"
	   " ##"
	   " #"))
	 
	 (("####"
	   "#")
	  
	  ("#"
	   "#"
	   "#"
	   "##")
	  
	  ("   #"
	   "####")
	  
	  ("##"
	   " #"
	   " #"
	   " #")
	  
	  ("####"
	   "   #")
	  
	  ("##"
	   "#"
	   "#"
	   "#")
	  
	  ("#"
	   "####")
	  
	  (" #"
	   " #"
	   " #"
	   "##"))
	 
	 ((" #"
	   "##"
	   "#"
	   "#")
	  
	  ("##"
	   " ###")
	  
	  (" #"
	   " #"
	   "##"
	   "#")

	  ("###"
	   "  ##")
	  
	  ("#"
	   "##"
	   " #"
	   " #")
	  
	  (" ###"
	   "##")

	  ("#"
	   "#"
	   "##"
	   " #")
	  
	  ("  ##"
	   "###"))
	 
	 (("##"
	   "##"
	   "#")
	  
	  ("##"
	   "###")
	  
	  (" #"
	   "##"
	   "##")
	  
	  ("###"
	   " ##")
	  
	  ("##"
	   "##"
	   " #")
	  
	  ("###"
	   "##")

	  ("#"
	   "##"
	   "##")

	  (" ##"
	   "###"))

	 ((" #"
	   "##"
	   " #"
	   " #")
	  
	  ("####"
	   " #")
	  
	  ("  #"
	   "####")
	  
	  ("#"
	   "##"
	   "#"
	   "#")

	  (" #"
	   "####")

	  ("#"
	   "#"
	   "##"
	   "#")

	  (" #"
	   " #"
	   "##"
	   " #")
	  
	  ("####"
	   "  #"))
	 
	 (("##"
	   " #"
	   " ##")
	  
	  ("  #"
	   "###"
	   "#")
	  
	  ("#"
	   "###"
	   "  #")
	  
	  (" ##"
	   " #"
	   "##"))
	 
	 (("#"
	   "###"
	   "#")
	  
	  (" #"
	   " #"
	   "###")
	  
	  ("  #"
	   "###"
	   "  #")
	  
	  ("###"
	   " #"
	   " #"))
	 
	 (("# #"
	   "###")
	  
	  ("##"
	   " #"
	   "##")
	  
	  ("###"
	   "# #")
	  
	  ("##"
	   "#"
	   "##"))
	 
	 (("#"
	   "#"
	   "###")
	  
	  ("  #"
	   "  #"
	   "###")
	  
	  ("###"
	   "  #"
	   "  #")
	  
	  ("###"
	   "#"
	   "#"))
	 
	 (("#"
	   "##"
	   " ##")
	  
	  ("  #"
	   " ##"
	   "##")
	  
	  ("##"
	   " ##"
	   "  #")
	  
	  (" ##"
	   "##"
	   "#"))
	 
	 ((" #"
	   "###"
	   " #"))
	 
	 (("#"
	   "#"
	   "#"
	   "#"
	   "#")
	  
	  ("#####")))))