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-09-27

map-accum

| 20:12 | map-accum - わだばLisperになる を含むブックマーク はてなブックマーク - map-accum - わだばLisperになる

map-accumって何者だということで、動作を理解すべくmap-accumを作ってみました。

名前そのまんまで説明になってないですが、mapにアキュムレータが付いたものなんですね。

たまに使いたくなる時がありそう。

ちなみにここ数日、electric-shift-lockモードを導入してコードを大文字で書いてみています。

大文字で書くと何か面白い発見があるかと思いましたが、今のところ何の発見もありません…。

;; 再帰でLIST版
(DEFUN MAP-ACCUM (F SEED &REST LISTS)
  (LABELS ((FROB (F SEED ANS LISTS)
             (IF (SOME #'ENDP LISTS)
                 (VALUES ANS SEED)
                 (MULTIPLE-VALUE-BIND (A ACC)
                     (APPLY F (APPEND (MAPCAR #'CAR LISTS) (LIST SEED)))
                   (MULTIPLE-VALUE-BIND (RES ACC) 
                       (FROB F ACC (APPEND ANS (LIST A)) (MAPCAR #'CDR LISTS))
                     (VALUES RES ACC))))))
    (FROB F SEED () LISTS)))
;; 総称関数版
(DEFGENERIC MAP-ACCUM (F SEED SEQUENCE &REST REST))
(DEFMETHOD MAP-ACCUM ((F FUNCTION) SEED (SEQUENCE SEQUENCE) &REST REST)
  (LET ((MIN-LEN (APPLY #'MIN (LENGTH SEQUENCE) (MAPCAR #'LENGTH REST))))
    (DO ((ACC SEED)
         TEM
         (IDX 0 (1+ IDX))
         (SEQS (CONS SEQUENCE REST))
         (RES (MAKE-SEQUENCE (CLASS-OF SEQUENCE) MIN-LEN)))
        ((= IDX MIN-LEN) (VALUES RES ACC))
      (SETF (VALUES TEM ACC)
            (APPLY F (NCONC (MAPCAR (LAMBDA (A) (ELT A IDX))
                                    SEQS)
                            (LIST ACC))))
      (SETF (ELT RES IDX) TEM))))
(MAP-ACCUM (LAMBDA (X Y Z ACC) 
             (VALUES (LIST ACC X Y Z) (1+ ACC)))
           0
           '(A B C E E)
           '(F G H I)
           '(J K L))
;⇒ ((0 A F J) (1 B G K) (2 C H L)),
;   3

(MAP-ACCUM (LAMBDA (X Y ACC) 
             (VALUES (IF (CHAR< X Y) X Y)
                     (1+ ACC)))
           0
           "abCd"
           "ABcD")
;⇒ "ABCD",
;   4

ゲスト



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