challenge 魔方分割数

1 .. N^2までの数をN個の数字の和が等しいN個のグループに分けたいと思います。

たとえば、N=3のときは、
(1) { 1, 5, 9 }, { 2, 6, 7 }, { 3, 4, 8 } 
(2) { 1, 6, 8 }, { 2, 4, 9 }, { 3, 5, 7 }
の2通りの方法があります。

ここで指定されたNに対して、何通りのグループ分けの方法があるかを数えるプログラムを作ってください。
(何通りかという値だけが出力されればよいのですが、予め計算してある結果を返すのはダメですよ。)
また、N=5を指定したときの実行時間もあわせて教えてください。

なお、数え上げるときの注意として、

・{ 1, 5, 9 } と { 1, 9, 5 }は同じもの

・{ 1, 5, 9 }, { 2, 6, 7 }, { 3, 4, 8 }と
 { 1, 5, 9 }, { 3, 4, 8 }, { 2, 6, 7 }は同じもの
とすることに注意してください。

Posted feedbacks - Common Lisp

枝刈りしようとしたらわけがわからなくなったので Common Lisp で書き直し。

最初に組み合わせを求めた後で「1を含む組」「1を含まなくて2を含む組」「1, 2を含まなくて3を含む組」……と分類します。こうすると、グループごとに探索の対象とするかしないかを決めることができてかなり範囲が狭まるようです。

disjoint がボトルネックになるようなのでここだけ最適化をかけています。実行時間は SBCL で 28 秒でした。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
(defun list-solutions (m n lbd ubd)
  (cond ((not (<= (* lbd n) m (* ubd n))) ())
        ((= n 1) `((,m)))
        (t
         (loop for i from lbd to ubd nconc
           (mapl (lambda (l) (push i (car l)))
                 (list-solutions (- m i) (1- n) (1+ i) ubd))))))

(defun group-solutions (m n lbd ubd)
  (loop with sols = (list-solutions m n lbd ubd)
    for i from 1
    for s1 = sols then s2
    for s2 = (member i s1 :key #'car :test #'/=)
    while s1 collect (cons i (ldiff s1 s2))))

(defun disjoint (l1 l2) ; l1, l2 must be sorted
  (declare (optimize (speed 3) (safety 0)))
  (or (null l1)
      (null l2)
      (let ((a (car l1)) (b (car l2)))
        (declare (fixnum a b))
        (cond ((> a b) (disjoint l1 (cdr l2)))
              ((< a b) (disjoint (cdr l1) l2))
              (t nil)))))

(defun merge-list (l1 l2) ; l1, l2 must be sorted
  (do* ((head (cons () ()))
        (tail head (cdr tail)))
      (())
    (cond ((endp l1) (setf (cdr tail) l2) (return (cdr head)))
          ((endp l2) (setf (cdr tail) l1) (return (cdr head)))
          (t
           (let ((a (car l1)) (b (car l2)))
             (cond ((> a b)
                    (setf (cdr tail) (list b)
                          l2 (cdr l2)))
                   ((< a b)
                    (setf (cdr tail) (list a)
                          l1 (cdr l1)))
                   (t
                    (setf (cdr tail) (list a)
                          l1 (cdr l1)
                          l2 (cdr l2)))))))))

(defun count-choices (n lists ex)
  (if (= n 1)
      (loop for x in (cdar lists) count (disjoint x ex))
    (loop for x in (cdar lists) if (disjoint x ex) sum
      (count-choices (1- n)
                     (remove-if (lambda (a) (member (car a) x)) (cdr lists))
                     (merge-list x ex)))))

(defun count-partitions (n)
  (count-choices n (group-solutions (/ (* n (1+ (* n n))) 2) n 1 (* n n)) ()))

無駄に読みにくい書き方をしてました。こっちのほうが普通でしょう。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
(defun merge-list (l1 l2)
  (let (acc)
    (loop
      (if (endp l1) (return (nreconc acc l2)))
      (if (endp l2) (return (nreconc acc l1)))
      (let ((a (car l1)) (b (car l2)))
        (cond ((> a b)
               (push b acc)
               (setf l2 (cdr l2)))
              ((< a b)
               (push a acc)
               (setf l1 (cdr l1)))
              (t
               (push a acc)
               (setf l1 (cdr l1) l2 (cdr l2))))))))

Index

Feed

Other

Link

Pathtraq

loading...