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-12-26

KMRCLを眺める (49) ALISTP

| 00:40 | KMRCLを眺める (49) ALISTP - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (49) ALISTP - わだばLisperになる

今回は、KMRCLのlists.lisp中からALISTPです。

alistかどうかを判別するというのは名前からわかりますが、実装は、

(defun alistp (alist)
  (when (listp alist)
    (dolist (elem alist)
      (unless (alist-elem-p elem)
        (return-from alistp nil)))
    t))

という風に前回定義したALIST-ELEM-Pを利用しています。

動作は、

(alistp '(a b c d))
;⇒ NIL

(alistp '((a a) (b) (c) (d)))
;⇒ NIL

(alistp '((a) (b) (c) (d)))
;⇒ T

(alistp '((a . a) (b . b) (c . c) (d . d)))
;⇒ T

です。

無駄なものを調べないように途中で判定を打ち切るようにしてありますが、標準関数のEVERYも無駄な調査はしないようなので

(DEFUN MY-ALISTP (ALIST)
  (AND (LISTP ALIST)
       (EVERY #'ALIST-ELEM-P ALIST)))

で良いんじゃないかなあと。

速度もどっこいどっこいです。

(DEFVAR *NOT-ALIST*
  (LET ((U (LIST '(D D))))
    (DOTIMES (I (* 100000))
      (PUSH (CONS I I) U))
    U))

;; KL:ALISTP
(LOOP :REPEAT (* 100 100)
      :DO (KL:ALISTP *NOT-ALIST*))
;⇒ NIL
----------
Evaluation took:
  9.675 seconds of real time
  9.680000 seconds of total run time (9.680000 user, 0.000000 system)
  100.05% CPU
  23,162,850,045 processor cycles
  1,443,888 bytes consed
  
Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz

;; MY-ALISTP
(LOOP :REPEAT (* 100 100)
      :DO (MY-ALISTP *NOT-ALIST*))
;⇒ NIL
----------
Evaluation took:
  9.239 seconds of real time
  9.240000 seconds of total run time (9.210000 user, 0.030000 system)
  100.01% CPU
  22,119,721,731 processor cycles
  1,483,040 bytes consed
  
Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz
(DEFVAR *NOT-ALIST2*
  (LET (U)
    (DOTIMES (I (* 100000))
      (PUSH (CONS I I) U))
    (PUSH '(D D) U)
    U))

;; KL:ALISTP
(LOOP :REPEAT (* 100 100)
      :DO (KL:ALISTP *NOT-ALIST2*))
;⇒ 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
  1,030,212 processor cycles
  0 bytes consed
  
Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz

;; MY-ALISTP
(LOOP :REPEAT (* 100 100)
      :DO (MY-ALISTP *NOT-ALIST2*))
;⇒ NIL
----------
Evaluation took:
  0.001 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  0.00% CPU
  1,036,746 processor cycles
  0 bytes consed
  
Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz