Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2009-06-13

10分でコーディング 続・破壊的操作

| 21:41 | 10分でコーディング 続・破壊的操作 - わだばLisperになる を含むブックマーク はてなブックマーク - 10分でコーディング 続・破壊的操作 - わだばLisperになる

正方行列の転置を破壊的に

kozimaさんの 10分でコーディング 続・破壊的操作編 - kozima の日記 - cadr groupを見て、10分どころでなく散々試行錯誤したんですが、そうか、carを書き換えれば良いのか!、こんとんじょのいこ!! ということで

(defun transpose% (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (rotatef (nth x (nth y list))
                         (nth y (nth x list)))))))

という風に書いてみました。

(transpose% (make-matrix 4))
;=> ((1 5 9 13) (2 6 10 14) (3 7 11 15) (4 8 12 16))

;; SBCL
(prog ((u (make-matrix 5)))
   (transpose% u))
;=> NIL
----------
Evaluation took:
  0.000 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  100.00% CPU
  15,687 processor cycles
  0 bytes consed

ほうほう、0bytes。

ちょっと大きくしてみよう

;; SBCL
(prog ((u (make-matrix 300)))
   (transpose% u))
;=> NIL
----------
Evaluation took:
  0.129 seconds of real time
  0.130000 seconds of total run time (0.130000 user, 0.000000 system)
  100.78% CPU
  309,236,580 processor cycles
  1,467,424 bytes consed
  ^^^^^^^^^

あれ…。carの書き換え(rplaca)だとコンシングが発生するの?

rplaca抜きで

(defun no-transpose (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (progn (nth x (nth y list))
                     #|(nth y (nth x list))|#)))))
;; SBCL
(prog ((u (make-matrix 600)))
   (no-transpose u))
;=> NIL
----------
Evaluation took:
  0.745 seconds of real time
  0.750000 seconds of total run time (0.750000 user, 0.000000 system)
  100.67% CPU
  1,786,044,609 processor cycles
  46,352 bytes consed

あれ…、rlpacaが原因かどうか以前に、nthでアクセスするとコンシングが発生するの?

うーん、

;; 中身あり
(defun transpose (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (let ((a (nth x (nth y list)))
                      (b (nth y (nth x list))))
                  (rotatef a b))))))

;; 中身なし
(defun no-transpose (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (let ((a (nth x (nth y list)))
                      (b (nth y (nth x list))))
                  () )))))

;; なにもなし
(defun no-transpose-complete (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (progn)))))
;; 中身あり
;; SBCL
(prog ((u (make-matrix 600)))
   (time (transpose u)))
;=> NIL
----------
Evaluation took:
  1.119 seconds of real time
  1.120000 seconds of total run time (1.120000 user, 0.000000 system)
  100.09% CPU
  2,679,908,625 processor cycles
  79,328 bytes consed

;; 中身なし
;; SBCL
(prog ((u (make-matrix 600)))
   (time (no-transpose u)))
;=> NIL
----------
Evaluation took:
  0.604 seconds of real time
  0.610000 seconds of total run time (0.610000 user, 0.000000 system)
  100.99% CPU
  1,447,224,714 processor cycles
  44,848 bytes consed

;; なにもなし
;; SBCL
(prog ((u (make-matrix 600)))
   (time (no-transpose-complete u)))
;=>
----------
Evaluation took:
  0.000 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  100.00% CPU
  292,959 processor cycles
  0 bytes consed

おやー、SBCLのnthが変なのかしらん…。

ちなみに、CLISPだとコンシングは0でした。

探索はつづく…。