約数の組み合わせっぽいのの列挙。

どもです。
とりあえず，なんかしらんが不安がつのってきたので，
手回し充電器搭載LEDライト嫌ラジオ兼携帯充電器の充電をしておきました。
ワタシは値段が高いときに購入したので3000円くらいしましたが，今は，同程度の機能，
もしくはちょっこす上の機能付きで2000円くらいで買えるようです。
スマホも充電できるやつもあるようですな。
てか，もいっこ買おうかしら。
とりあえず，良さそうなの。うーん，欲しくなってきたぞ。
てか，実際，昨年3月の震災の時に，こういったのが役に立ったという人は
どのくらいいるのだろう・・・。

手動 手回し充電 も出来る 持ち運びに便利 キャンプ アウトドア スポーツ中継 地震 災害 震災対... 価格：1,480円（税込、送料別）

懐中電灯 多機能防災ラジオ LEDライト 手力発電 災害用 緊急充電式 ラジオライト ランタン の代... 価格：2,480円（税込、送料込）

まじで緊急のときに中国製に頼るのは心許ないですが，ないよりましかなーと。
心配な人は，ヨドバシとかで，国内メーカー製のを買った方がいいと思います。はい。

話をそらしたので，戻します。

Project Euler 88

数日かけて，やっとこさでけたと思って，でてきた答えが，異様にでかい。
一応と submit するも，やはり不正解。
んで，バグってた所を発見。約数の積とかの組み合わせを列挙する部分。

んで，直った関数たち。ほんまは labels 使って書きたいが，
trace できなくなるので，別個の関数にしています。
なんとか綺麗にならんもんかなーと思案中。
あと，最初，accum に setf してなかったんだが，それでわけわかめになった。
引数で渡して，関数内で accum に push すれば，呼び出しもとにも，
accum の変更が伝わるもんだと思っていたのに，覆された。うーん，悩ましい。

(defun collect-factors (n)
  (loop for i from 2 to (floor (sqrt n))
        with accum = nil
        when (zerop (mod n i))
          do (progn (push (list i (/ n i)) accum)
                    (setf accum (collect-factors-aux (/ n i) (list i) accum)))
        finally (return accum)))

(defun collect-factors-aux (n prevs accum)
  (loop for i from (car prevs) to (floor (sqrt n))
        when (zerop (mod n i))
          do (progn (push (append prevs (list i (/ n i))) accum)
                    (setf accum (collect-factors-aux (/ n i)
                                                     (cons i prevs)
                                                     accum)))
        finally (return accum)))

• 追記 at 2012/01/24 (Tue) 06:35

いろいろ凡ミスしていたところをカット。

(defun collect-factors (n)
  (loop for i from 2 to (floor (sqrt n))
        with accum = nil
        when (zerop (mod n i))
          nconc (collect-factors-aux
                 (/ n i)
                 (list i)
                 (cons (list i (/ n i)) accum))))

(use-package 'cl-test-more)

(defun test-collect-factors ()
  (cl-test-more:plan nil)
  (cl-test-more:is (length (collect-factors 12)) 3)
  (cl-test-more:is (length (collect-factors 100)) 8)
  (cl-test-more:finalize))

(defun collect-factors-aux (n prevs accum)
  (loop for i from (car prevs) to (floor (sqrt n))
        when (zerop (mod n i))
          do (setf accum (collect-factors-aux (/ n i)
                                              (cons i prevs)
                                              (cons (append prevs (list i (/ n i)))
                                                    accum)))
        finally (return accum)))

実行結果。たぶんあってる。はず。

CL-USER> (collect-factors 24)
((4 6) (3 8) (2 3 4) (2 2 2 3) (2 2 6) (2 12))
CL-USER> (collect-factors 100)
((10 10) (5 20) (4 5 5) (4 25) (2 5 10) (2 2 5 5) (2 2 25) (2 50))