Hatena::Groupcadr

kozima の日記

2010-02-26

union-find 書いてみた

| 00:06

書いてみました。わりと簡単。

解説を書こうかと思ったけど遅くなったので保留。

(defun make-dsets (size)
  (make-array size :initial-element -1))

(defun dsets-size (s e)
  (the (satisfies plusp)
    (- (aref s (dsets-root s e)))))

(defun dsets-root (s e)
  (let ((p (aref s e)))
    (if (minusp p)
        e
        (let ((r (dsets-root s p)))
          (setf (aref s e) r)))))

(defun dsets-root-p (s e)
  (minusp (aref s e)))

(defun dsets-union (s e1 e2)
  (let ((r1 (dsets-root s e1))
        (r2 (dsets-root s e2)))
    (if (= r1 r2)
        ;; already belong to the same component
        r1
        ;; belong to different components
        (setf (aref s r1) (+ (aref s r1) (aref s r2))
              (aref s e2) r1
              (aref s r2) r1))))

;;; test
(flet ((do-test (n k)
         (let ((s (make-dsets n)))
           (time (loop repeat k do (dsets-union s (random n) (random n)))))))
  (do-test 1000000 1000)
  (do-test 1000000 10000)
  (do-test 1000000 100000)
  (do-test 1000000 1000000))

実行結果。CLISP で。

Real time: 0.015625 sec.

Run time: 0.015625 sec.

Space: 0 Bytes

Real time: 0.03125 sec.

Run time: 0.03125 sec.

Space: 0 Bytes

Real time: 0.390625 sec.

Run time: 0.390625 sec.

Space: 0 Bytes

Real time: 5.828125 sec.

Run time: 5.828125 sec.

Space: 0 Bytes

2010-01-11

話題の試験問題

| 23:12

人材獲得作戦・4 試験問題ほか: 人生を書き換える者すらいた。 やってみた。75 分ぐらい。途中で皿洗いしたり twitter 見てたりしたので,コードを書いてる時間はその半分くらい。

出来上がったコードと出力。データの読み込みと関連するパラメータの取得部分は酷くアドホックで汚いし,探索部分も「あーあれもいる,これもいる」って感じで引数をどんどん増やしていったのであまりきれいに書けてません。

(defmacro lookup (m x y)
  `(aref (aref ,m ,y) ,x))

(defun solve-maze (file)
  (let* ((m (read-maze file))
         (height (length m))
         (width (length (aref m 0)))
         (start (find-point m #\S))
         (goal (find-point m #\G))
         (path (bfs m height width start goal)))
    (loop for (x y) in path do
      (setf (lookup m x y) #\$))
    (loop for row across m do
      (map nil 'princ row)
      (terpri))))

(defun read-maze (file)
  (with-open-file (s file :direction :input)
    (loop while (listen s)
      collect (read-line s) into lines
      finally (return (coerce lines '(vector t))))))

(defun find-point (m c)
  (loop for l across m for y from 0
    if (position c l) return (list (position c l) y)))

(defun bfs (maze height width start goal)
  (loop with seen = (make-hash-table :test 'equal)
    for paths = (list (list start)) then (extend maze paths width height seen)
    as path = (find goal paths :key #'car :test #'equal)
    if path return path
    do (assert paths)
    ))

(defun extend (maze paths width height seen)
  (loop for path in paths as (x y) = (car path) nconc
    (loop for (dx dy) in '((1 0) (-1 0) (0 1) (0 -1))
      as x1 = (+ x dx) and y1 = (+ y dy)
      as z = (list x1 y1)
      if (and (<= 0 x1 width) (<= 0 y1 height)
              (not (eql (lookup maze x1 y1) #\*))
              (not (gethash z seen)))
      collect (cons z path)
      and do (setf (gethash z seen) t))))

(time (solve-maze "maze.txt"))

;; **************************
;; *$* * $$$$               *
;; *$* *$$* $*************  *
;; *$* $$*  $$************  *
;; *$$$$*    $$$$$          *
;; **************$***********
;; * $$$$$$$$$$$$$          *
;; **$***********************
;; * $$$$$* $$$$$$$$$$$$$$  *
;; *  *  $$$$*********** *  *
;; *    *        ******* *  *
;; *       *                *
;; **************************
;; Real time: 0.015625 sec.
;; Run time: 0.015625 sec.
;; Space: 170944 Bytes

これくらいはいちいち頭の中で考えなくてもすらすらと書けるようになりたいものです。

2009-01-02

エラトステネスの篩

| 21:33

有名なエラトステネスの篩を CL で作ったことがないことに気がついたので、作りました。loop の練習っぽいコード。

(defun sieve (n)
  (let ((bs (make-array n :element-type 'bit)))
    (loop for i from 2 below n
      if (zerop (aref bs i)) collect i
      and do (loop for j from i below n by i do
               (setf (aref bs j) 1)))))

せっかくなので素朴なやり方で列挙するものと速度を比較してみる。

(defun naive-primes (n)
  (loop with d = #(2 4)
    for i = 0 then (- 1 i)
    and p = 5 then (+ p (svref d i))
    while (>= n p)
    if (loop for q in ps until (< p (* q q)) never (zerop (mod p q)))
    collect p into ps
    finally (return (list* 2 3 ps))))

(defun test (n)
  (format t "~%n = ~A..." n)
  (time (naive-primes n))
  (time (sieve n))
  (terpri))

(loop for i from 3 to 6 do (test (expt 10 i)))

結果。ちゃんと線形時間になってます。ナイーブなほうは O(n\sqrt n) ぐらいなんでしょうか。

n = 1000...
Real time: 0.015625 sec.
Run time: 0.015625 sec.
Space: 1344 Bytes
Real time: 0.0 sec.
Run time: 0.0 sec.
Space: 1480 Bytes

n = 10000...
Real time: 0.0 sec.
Run time: 0.0 sec.
Space: 9832 Bytes
Real time: 0.015625 sec.
Run time: 0.015625 sec.
Space: 11092 Bytes

n = 100000...
Real time: 0.265625 sec.
Run time: 0.265625 sec.
Space: 76736 Bytes
Real time: 0.125 sec.
Run time: 0.125 sec.
Space: 89244 Bytes

n = 1000000...
Real time: 5.328125 sec.
Run time: 5.328125 sec.
Space: 627984 Bytes
GC: 1, GC time: 0.015625 sec.
Real time: 1.125 sec.
Run time: 1.125 sec.
Space: 831104 Bytes
GC: 2, GC time: 0.03125 sec.

エラトステネスの篩って、高校生のときに聞いて何が嬉しいのかさっぱりわからなかった記憶があります。効率よさそうにはとても見えなかったんですよね。