fixedpoint.jp - Colored Cubes (2008-07-22)

ACM/ICPC 2005 Tokyo の Problem C: Colored Cubes を解いてみました。アルゴリズムを記述するならやはり Scheme ということで、Gauche で動くコードを書きました。基本となるアイディアは、与えられたデータセットに含まれる立方体の1つを固定し、残りを回転させ総当たりで比較するというものです。

colored-cubes.scm

#!/usr/bin/env gosh

(use gauche.collection)
(use srfi-1)
(use util.match)
(use util.combinations)

(define (read-dataset)
  (let ((n (read)))
    (if (= n 0)
        (exit 0)
        (let lp ((n n)
                 (r '()))
          (if (= n 0)
              (reverse r)
              (let* ((c1 (read))
                     (c2 (read))
                     (c3 (read))
                     (c4 (read))
                     (c5 (read))
                     (c6 (read)))
                (lp (- n 1) (cons (list c1 c2 c3 c4 c5 c6) r))))))))

(define (rotate cube face k)
  (match cube
    ((c1 c2 c3 c4 c5 c6)
     (case k
       ((0)
        (case face
          ((1) cube)
          ((2) (list c2 c6 c3 c4 c1 c5))
          ((3) (list c3 c2 c6 c1 c5 c4))
          ((4) (list c4 c2 c1 c6 c5 c3))
          ((5) (list c5 c1 c3 c4 c6 c2))
          ((6) (list c6 c5 c3 c4 c2 c1))))
       ((1 2 3)
        (rotate (list c1 c4 c2 c5 c3 c6) face (- k 1)))
       (else
        (error "unexpected k:" k))))))

(define (rotations cube)
  (map
   (cut apply rotate cube <>)
   (cartesian-product (list (iota 6 1) (iota 4)))))

(define (num-of-repainting cube cubes)
  (let ((n (+ (length cubes) 1)))
    (let lp ((d 0)
             (cube cube)
             (cubes cubes))
      (if (null? cube)
          d
          (let* ((x (cons (car cube) (map car cubes)))
                 (y (group-collection x)))
            (lp (case (length y)
                  ((1) d)
                  ((2)
                   (case n
                     ((2 3) (+ d 1))
                     (else
                      (match y
                         (((y0 y1) (y2 y3))
                          (+ d 2))
                         (else
                          (+ d 1))))))
                  ((3)
                   (+ d 2))
                  (else
                   (+ d 3)))
                (cdr cube)
                (map cdr cubes)))))))

(define (calculate dataset)
  (case (length dataset)
    ((1)
     0)
    ((2 3 4)
     (call/cc
      (lambda (cont)
        (let ((m 18))
          (cartesian-product-for-each
           (lambda (tuple)
             (let ((d (num-of-repainting (car dataset) tuple)))
               (cond ((= d 0) (cont 0))
                     ((< d m) (set! m d)))))
           (map rotations (cdr dataset)))
          m))))
    (else
     (error "unexpected n:" (length dataset)))))

(define (main args)
  (let lp ((d (read-dataset)))
    (print (calculate d))
    (lp (read-dataset)))
  1)