mapcarを実装してみた

common-lispによる人工知能を学んでおります。

PAIP補助関数いろいろ : セマンティックウェブ・ダイアリー

mapcan は破壊的なのでほかにこのリストを使っているところはない，という場合しか安心して使えません．そこで一般には mapcan の代わりにこの mappend を使います．

mappend...マップ系もいろいろあるんですが、区別がなかなか難しいと感じます。

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

hyperspecではMAPC, MAPCAR, MAPCAN, MAPL, MAPLIST, MAPCONがまとめて紹介されています。実装すれば理解が深まるのではないかということで、取り敢えずmapcarを実装してみます。役に立つかわかりませんが、手順がわかるように書いてみます。

簡単じゃん！って思ったら。。。

リストをもらって、ひとつずつ関数を適用すればいいよね？っということで、取り敢えず実装してみます。

(defun %my-mapcar (fn list acc)
  (cond ((null list) acc)
        (t (%my-mapcar fn
                       (cdr list)
                       (append acc `(,(funcall fn (car list))))))))

(defun my-mapcar (fn list)
  (%my-mapcar fn list nil))

hyperspecのexsamplesに以下の記述があるのでテストケースとして使います。

Examples:
(mapcar #'car '((1 a) (2 b) (3 c))) => (1 2 3)
(mapcar #'abs '(3 -4 2 -5 -6)) => (3 4 2 5 6)
(mapcar #'cons '(a b c) '(1 2 3)) => ((A . 1) (B . 2) (C . 3))

(format t "~%~A" (my-mapcar (lambda (x) (* 2 x)) '(1 2 3)))
;;; (2 4 6)
(format t "~%~A" (my-mapcar #'car '((1 a) (2 b) (3 c))))
;;; (1 2 3)
(format t "~%~A" (my-mapcar #'abs '(3 -4 2 -5 -6)))
;;; (3 4 2 5 6)
(format t "~%~A" (my-mapcar #'cons '(a b c) '(1 2 3)))
;;; ERROR: invalid number of arguments: 3

hyperspecによるとMAPCARのsyntaxは、

mapcar function &rest lists+ => result-list

となっており、(defun my-mapcar (fn list)) では駄目でした。。。

&restにどう対処しましょう...

&restでもらったリスト達を順繰りにcarで取り出しつつ、リスト化する。それのリストに対して関数を適用する。またそれとは別に&restでもらったリスト達を順繰りにcdrで取り出しつつ、次の再帰に渡す。。。そういうことかと見当をつけました。

関数を適用する対象のリストを取り出してみる

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

(defun aaa (lists)
  (cond ((null (car lists)) nil)
        (t (cons (car (car lists)) (aaa (cdr lists))))))

(defun my-mapcar-aaa (fn &rest lists)
  (aaa lists))

(format t "~%~A" (my-mapcar-aaa nil *list1* *list2* *list3*))
;;; (1 2 3)

欲しいリストが取り出せました。折角なので末尾再帰に変更します。

末尾再帰に書き換える

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

(defun my-mapcar-bbb (fn &rest lists)
  (bbb lists nil))

(format t "~%~A" (my-mapcar-bbb nil *list1* *list2* *list3*))
;;; (1 2 3)

末尾再帰になりました。

次の再帰に渡すリストを取り出してみる

bbbと同じようなパターンでやってみます。

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

(defun my-mapcar-ccc (fn &rest lists)
  (ccc lists nil))

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

結果が正しく、すでに末尾再帰になっています。

2つの関数を統合する

bbbとcccをdddに統合します。蓄積変数(acc)を2つにします。

(defun ddd (lists acc-car acc-cdr)
  (cond ((null (car lists)) `(,acc-car . ,acc-cdr))
        (t (ddd (cdr lists)
                (append acc-car `(,(car (car lists))))
                (append acc-cdr `(,(cdr (car lists))))))))

(defun my-mapcar-ddd (fn &rest lists)
  (ddd lists nil nil))

(let ((rtn (my-mapcar-ddd nil *list1* *list2* *list3*)))
  (format t "~%car:~A" (car rtn))
  (format t "~%cdr:~A" (cdr rtn)))
;;; car:(1 2 3)
;;; cdr:((11 111) (22 222) (33 333))

結果は良いようです。

「関数適用対象のリストのリスト」を取得する

(defun eee (lists acc-car acc-cdr)
  (cond ((null (car lists)) `(,acc-car . ,acc-cdr))
        (t (eee (cdr lists)
                (append acc-car `(,(car (car lists))))
                (append acc-cdr `(,(cdr (car lists))))))))

(defun my-mapcar-eee (fn &rest lists)
  (labels ((%my-mapcar (fn lists acc)
             (cond ((null (car lists)) acc)
                   (t
                    (let ((tmp (eee lists nil nil)))
                      (%my-mapcar fn
                                  (cdr tmp)
                                  (append acc `(,(car tmp)))))))))
    (%my-mapcar fn lists nil)))

(format t "~%~A" (my-mapcar-eee nil *list1* *list2* *list3*))
;;; ((1 2 3) (11 22 33) (111 222 333))

ここで%my-mapcarという補助関数が登場します。&restな引数を持つ関数を末尾再帰で呼び出すことが難しかったため利用しています。

関数を適用する

%my-mapcarの蓄積変数accに「関数適用前のリスト」が入っていますが、関数を要した結果を入れてしまいます。

(defun fff (lists acc-car acc-cdr)
  (cond ((null (car lists)) `(,acc-car . ,acc-cdr))
        (t (fff (cdr lists)
                (append acc-car `(,(car (car lists))))
                (append acc-cdr `(,(cdr (car lists))))))))

(defun my-mapcar-fff (fn &rest lists)
  (labels ((%my-mapcar (fn lists acc)
             (cond ((null (car lists)) acc)
                   (t
                    (let ((tmp (fff lists nil nil)))
                      (%my-mapcar fn
                                  (cdr tmp)
                                  (append acc `(,(apply fn (car tmp))))))))))
    (%my-mapcar fn lists nil)))

(format t "~%~A" (my-mapcar-fff #'+ *list1* *list2* *list3*))
;;; (6 66 666)

うまく関数が適用されました。念の為引数に与えたリストたちが破壊されていないことを確認します。

(format t "~%~A" *list1*) ;;; (1 11 111)
(format t "~%~A" *list2*) ;;; (2 22 222)
(format t "~%~A" *list3*) ;;; (3 33 333)

冒頭のhyperspecのexampleもテストしてみます。

(format t "~%~A" (my-mapcar-fff #'car '((1 a) (2 b) (3 c))))
;;; (1 2 3)
(format t "~%~A" (my-mapcar-fff #'abs '(3 -4 2 -5 -6)))
;;; (3 4 2 5 6)
(format t "~%~A" (my-mapcar-fff #'cons '(a b c) '(1 2 3)))
;;; ((A . 1) (B . 2) (C . 3))

特に最後のテストが通りましたのでOKです。

整えます

(defun my-mapcar (fn &rest lists)
  (labels ((%%my-mapcar (lists acc-car acc-cdr)
             (cond ((null (car lists)) `(,acc-car . ,acc-cdr))
                   (t (%%my-mapcar (cdr lists)
                                   (append acc-car `(,(car (car lists))))
                                   (append acc-cdr `(,(cdr (car lists))))))))
           (%my-mapcar (fn lists acc)
             (cond ((null (car lists)) acc)
                   (t
                    (let ((tmp (%%my-mapcar lists nil nil)))
                      (%my-mapcar fn
                                  (cdr tmp)
                                  (append acc `(,(apply fn (car tmp))))))))))
    (%my-mapcar fn lists nil)))

(format t "~%~A" (my-mapcar #'+ *list1* *list2* *list3*))
;;; (6 66 666)

できあがり！

可変長引数の場合、少し複雑だと感じましたが、なんとかなりました。次回はmaplistを実装してみようと思います。

いやほんと、組み込みの関数やライブラリはありがたいです。

最後までお付き合いいただきありがとうございます！