DouKaku? 4821 kozima: 和が N*(N^2+1)/2 になる組み...(魔方分割数)

Comment detail

和が N*(N^2+1)/2 になる組み合わせを昇順に列挙して交わらないものを探す。nido さんの #4819 と同じ方針かな？

5 のときは 20 分かかって答えが出ました。 3245664 だそうです。

(* list solutions of
     x1+...+xn=m
     1<=x1<...<xn<=l *)
let list_solutions m n k =
  let rec loop m n lbd tail =
    if m < n || m < lbd then []
    else if n = 1 then
      if lbd <= m && m <= k then [m::tail] else []
    else
      let acc = ref [] in
        for i = lbd to (min (m-n+1) k) do
          acc :=
            List.map (fun sols -> i::sols)
              (loop (m-i) (n-1) (i+1) tail) :: !acc
        done;
        List.concat !acc
  in loop m n 1

let rec disjoint xs ys =
  match xs, ys with
    | [], _ | _, [] -> true
    | x::xs', y::ys' ->
        if x > y then disjoint xs ys'
        else if x < y then disjoint xs' ys
        else false

let (@<) = List.merge compare

let rec count_choices n lists ex =
  if n = 1 then
    List.fold_left (fun i x -> if disjoint x ex then i+1 else i) 0 lists
  else
    match lists with
      | [] -> 0
      | x::rest ->
          let b = count_choices n rest ex in
            if disjoint x ex then
              b + count_choices (n-1) rest (x@<ex)
            else
              b

let count_partitions n =
  count_choices n (list_solutions (n * (n*n + 1) / 2) n (n*n) []) []

let _ = print_int (count_partitions 5); exit 0

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

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

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

(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)) ()))

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

(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))))))))

DouKaku?

Comment detail

Index

Feed

Other

Link

Pathtraq