maplistを実装してみた

23309 ワード
lambda SBCL common-lisp 高階関数 lisp common-lisp テキストリンク

いつもお世話になるmap系の関数たち。

MAP関数 : セマンティックウェブ・ダイアリー

基本的なmap系関数を実装して、理解してしまおうというのがこの記事の趣旨です。

mapcarを実装してみた - Qiita
に引き続いてmaplistを実装してみます。

maplistの動作を確認する

(defvar *list1* '(1 11 111))
(defvar *list2* '(2 22 222))
(defvar *list3* '(3 33 333))

(format t "~%~A" (maplist (lambda (x y z)
                            (format t "~%x:~A y:~A z:~A" x y z))
                          *list1* *list2* *list3*))
;;; x:(1 11 111) y:(2 22 222) z:(3 33 333)
;;; x:(11 111) y:(22 222) z:(33 333)
;;; x:(111) y:(222) z:(333)
;;; (NIL NIL NIL)

リストのCDRをlambda引数として再帰的に高階関数を呼び出す。次の再帰に渡すCDRのリストが生成できれば、それに関数適用するだけなのでmapcarと比べると単純です。

次の再帰に渡すリストを生成する

(defun aaa (list acc)
  (cond ((null (car list)) acc)
        (t (aaa (cdr list)
                (append acc `(,(cdr (car list))))))))

(defun my-maplist-aaa (fn &rest lists)
  (aaa lists nil))

(format t "~%~A" (my-maplist-aaa nil *list1* *list2* *list3*))
 ;;; ((11 111) (22 222) (33 333))

最初の呼び出し時点で、次の呼び出しの引数となるリストが取得できています。

関数適用の対象となるリストを蓄積してみる

(defun bbb (list acc)
  (cond ((null (car list)) acc)
        (t (bbb (cdr list)
                (append acc `(,(cdr (car list))))))))

(defun %my-maplist (fn lists acc)
  (cond ((null (car lists)) acc)
        (t (%my-maplist fn
                        (bbb lists nil)
                        (append acc `(,lists))))))

(defun my-maplist-bbb (fn &rest lists)
  (%my-maplist fn lists nil))

(format t "~%~A" (my-maplist-bbb nil *list1* *list2* *list3*))

;;; (((1 11 111)
;;;   (2 22 222)
;;;   (3 33 333))
;;;  ((11 111)
;;;   (22 222)
;;;   (33 333))
;;;  ((111)
;;;   (222)
;;;   (333)))

%my-maplistが呼び出された際、引数として渡ってきたリストに関数を適用するため、リストをそのまま蓄積しているだけです。

関数を適用してみる

(defun ccc (list acc)
  (cond ((null (car list)) acc)
        (t (ccc (cdr list)
                (append acc `(,(cdr (car list))))))))

(defun %my-maplist (fn lists acc)
  (cond ((null (car lists)) acc)
        (t (%my-maplist fn
                        (ccc lists nil)
                        (append acc `(,(apply fn lists)))))))

(defun my-maplist-ccc (fn &rest lists)
  (%my-maplist fn lists nil))

(format t "~%~A" (my-maplist-ccc (lambda (x y z)
                                   (format t "~%x:~A y:~A z:~A" x y z))
                                 *list1* *list2* *list3*))
;;; x:(1 11 111) y:(2 22 222) z:(3 33 333)
;;; x:(11 111) y:(22 222) z:(33 333)
;;; x:(111) y:(222) z:(333)
;;; (NIL NIL NIL)

hyperspecのsampleを適用してみる

CLHS: Function MAPC, MAPCAR, MAPCAN, MAPL...

(maplist #'append '(1 2 3 4) '(1 2) '(1 2 3))
=> ((1 2 3 4 1 2 1 2 3) (2 3 4 2 2 3))
(maplist #'(lambda (x) (cons 'foo x)) '(a b c d))
=> ((FOO A B C D) (FOO B C D) (FOO C D) (FOO D))
(maplist #'(lambda (x) (if (member (car x) (cdr x)) 0 1)) '(a b a c d b c))
=> (0 0 1 0 1 1 1)
;An entry is 1 if the corresponding element of the input
; list was the last instance of that element in the input list.

(format t "~%~A" (my-maplist-ccc #'append '(1 2 3 4) '(1 2) '(1 2 3)))
;;; ((1 2 3 4 1 2 1 2 3) (2 3 4 2 2 3) (3 4 3) (4))
(format t "~%~A" (my-maplist-ccc #'(lambda (x)
                                     (cons 'foo x))
                                 '(a b c d)))
;;; ((FOO A B C D) (FOO B C D) (FOO C D) (FOO D))
(format t "~%~A" (my-maplist-ccc #'(lambda (x)
                                     (if (member (car x) (cdr x)) 0 1))
                                 '(a b a c d b c)))
;;; (0 0 1 0 1 1 1)

最初のテストの結果が一致しません。それ以外は一致しました。

不具合を修正する

%my-maplistが呼び出された際、listsにNILが見つかった時点で停止してしまえば良いようです。memberでNILを探します。ちなみに、findではNILの検出ができないようです。

(defun ddd (list acc)
  (cond ((null (car list)) acc)
        (t (ddd (cdr list)
                (append acc `(,(cdr (car list))))))))

(defun %my-maplist (fn lists acc)
  (cond ;;;((null (car lists)) acc)
        ((member nil lists) acc)
        (t (%my-maplist fn
                        (ddd lists nil)
                        (append acc `(,(apply fn lists)))))))

(defun my-maplist-ddd (fn &rest lists)
  (%my-maplist fn lists nil))

(format t "~%~A" (my-maplist-ddd (lambda (x y z)
                                   (format t "~%x:~A y:~A z:~A" x y z))
                                 *list1* *list2* '(3 33)))
;;; x:(1 11 111) y:(2 22 222) z:(3 33)
;;; x:(11 111) y:(22 222) z:(33)
;;; (NIL NIL)

(format t "~%~A" (my-maplist-ddd #'append '(1 2 3 4) '(1 2) '(1 2 3)))
;;; ((1 2 3 4 1 2 1 2 3) (2 3 4 2 2 3))

整える

(defun my-maplist (fn &rest lists)
  (labels ((%%my-maplist (list acc)
             (cond ((null (car list)) acc)
                   (t (%%my-maplist (cdr list)
                                    (append acc `(,(cdr (car list))))))))
           (%my-maplist (fn lists acc)
             (cond ((member nil lists) acc)
                   (t (%my-maplist fn
                                   (%%my-maplist lists nil)
                                   (append acc `(,(apply fn lists))))))))
  (%my-maplist fn lists nil)))

(format t "~%~A" (my-maplist (lambda (x y z)
                               (format t "~%x:~A y:~A z:~A" x y z))
                             *list1* *list2* '(3 33)))
;;; x:(1 11 111) y:(2 22 222) z:(3 33)
;;; x:(11 111) y:(22 222) z:(33)
;;; (NIL NIL)

maplistが出来上がりました。次回は、mapcをやりましょうかね。