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 |

2010-04-14

KMRCLを眺める(139) REMOVE-CHAR-STRING

| 13:56 | KMRCLを眺める(139) REMOVE-CHAR-STRING - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(139) REMOVE-CHAR-STRING - わだばLisperになる

今回はKMRCLのstrings.lispから、REMOVE-CHAR-STRINGです。

動作は、文字列から指定した文字を取り除くもののようで

(KL:REMOVE-CHAR-STRING #\o "looooooooooooooooooooooooooooop")
⇒ "lp"

というところ。

定義は、

(defun remove-char-string (char str)
  (declare (character char)
           (string str))
  (do* ((len (length str))
        (out (make-string len))
        (pos 0 (1+ pos))
        (opos 0))
       ((= pos len) (subseq out 0 opos))
    (declare (fixnum pos opos len)
             (simple-string out))
    (let ((c (char str pos)))
      (declare (character c))
      (when (char/= c char)
        (setf (schar out opos) c)
        (incf opos)))))

となっています。

元の文字列と同じ長さで文字列を作成して、後は指定した文字と一致していない文字を順に埋めていき、最後に必要な部分だけ返す、という方式です。

文字列の余ったところが、なんだか余っいてもったいなく感じたので、単純に文字列ストリームを使ったり、リストにして集めたのを変換したのと比べてどうなのかということで計測してみましたが、KMRCLの方式の方が効率が良いみたいです。

(DEFVAR *WORDS*
  (KL:READ-FILE-TO-STRING "/usr/share/dict/words"))

(LENGTH *WORDS*)
⇒ 931467

;; KMRCL
(PROG () (KL:REMOVE-CHAR-STRING #\o *WORDS*))
;⇒ NIL
----------
Evaluation took:
  0.029 seconds of real time
  0.030000 seconds of total run time (0.030000 user, 0.000000 system)
  [ Run times consist of 0.010 seconds GC time, and 0.020 seconds non-GC time. ]
  103.45% CPU
  70,205,436 processor cycles
  7,258,080 bytes consed
  
Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz

;; 文字列ストリーム
(DEFUN MY-REMOVE-CHAR-STRING (CHAR STR)
  (DECLARE (CHARACTER CHAR)
           (STRING STR))
  (WITH-OUTPUT-TO-STRING (OUT)
    (LOOP :FOR C :ACROSS STR 
          :IF (CHAR/= CHAR C) :DO (PRINC C OUT))))

(PROG () (MY-REMOVE-CHAR-STRING #\o *WORDS*))
;⇒ NIL
----------
Evaluation took:
  0.166 seconds of real time
  0.170000 seconds of total run time (0.150000 user, 0.020000 system)
  102.41% CPU
  397,283,913 processor cycles
  7,737,024 bytes consed
  
Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz

;; リストで集めて文字列に変換
(DEFUN MY-REMOVE-CHAR-STRING-2 (CHAR STR)
  (DECLARE (CHARACTER CHAR)
           (STRING STR))
  (COERCE 
   (LOOP :FOR C :ACROSS STR 
         :IF (CHAR/= CHAR C) :COLLECT C)
   'STRING))

(PROG () (MY-REMOVE-CHAR-STRING-2 #\o *WORDS*))
;⇒ NIL
----------
Evaluation took:
  0.087 seconds of real time
  0.080000 seconds of total run time (0.080000 user, 0.000000 system)
  [ Run times consist of 0.030 seconds GC time, and 0.050 seconds non-GC time. ]
  91.95% CPU
  209,846,160 processor cycles
  17,674,400 bytes consed
  
Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz

ゲスト



トラックバック - http://cadr.g.hatena.ne.jp/g000001/20100414