Yet Another Common Lisp Problems #3 longerp

●問題３

リスト xs はリスト ys よりも長いか調べる述語 longerp xs ys を定義してください。

> (longerp '(a b c) '(a b))
t
> (longerp '(a b) '(a b))
nil
> (longerp '(a) '(a b))
nil

解答

ホームページ移転のお知らせ - Yahoo!ジオシティーズ

これも On Lisp にあったな（ネタバレ）。両方の cdr を見ていってどちらかのケツまで到達したらその時点で判断できるから length する必要はない、という。

(defun longerp (xs ys)
  (if (null xs) nil
    (if (null ys) t
      (longerp (cdr xs) (cdr ys)))))

余談: xyzzy の場合

Common Lisp では再帰で書いておしまいなんだけど、xyzzy では末尾再帰最適化が無いので再帰するより length を使った方が速いという身も蓋もない結果に（ベンチは下の方参照）。でも do がもっと速いので lisper の皆さんが末尾再帰でヒャッホウしてる時は xyzzy では歯を食いしばって do で書くべし。

(defun longerp (xs ys)
  (do ((x xs (cdr x))
       (y ys (cdr y)))
      ((null x) nil)
    (if (null y) (return t))))

(defmacro bench (form)
  `(let ((#1=#:start)
         (#2=#:thunk (lambda ()
                       (dotimes (#:i 100000)
                         ,form))))
     (setf #2# (compile nil #2#))
     (setf #1# (get-internal-real-time))
     (funcall #2#)
     (- (get-internal-real-time) #1#)))
=> bench

(require "cmu_loop")
=> t

(setq l1 '(1 2 3 4 5)
      l2 (loop for x from 0 to 1000 collect x)) ; ちょっと時間かかる
=> (0 1 2 3 4 5 6 7 8 9 10 11 12 ...)

(defun test (fn)
  (and
   (funcall fn '(a b c) '(a b))
   (not (funcall fn '(a b) '(a b)))
   (not (funcall fn '(a) '(a b)))
   (not (funcall fn l1 l2))
   (funcall fn l2 l1)))
=> test

;; 再帰で途中まで
(defun longerp-rec (xs ys)
  (if (null xs) nil
    (if (null ys) t
      (longerp-rec (cdr xs) (cdr ys)))))
=> longerp-rec

(test 'longerp-rec)
=> t

(compile 'longerp-rec)
=> longerp-rec

(bench (longerp-rec l1 l2))
=> 2172

(bench (longerp-rec l2 l1))
=> 2141

;; length を使う
(defun longerp-length (xs ys)
  (> (length xs) (length ys)))
=> longerp-length

(test 'longerp-length)
=> t

(compile 'longerp-length)
=> longerp-length

(bench (longerp-length l1 l2))
=> 1422

(bench (longerp-length l2 l1))
=> 1422


;; do で途中まで
(defun longerp-do (xs ys)
  (do ((x xs (cdr x))
       (y ys (cdr y)))
      ((null x) nil)
    (if (null y) (return t))))
=> longerp-do

(test 'longerp-do)
=> t

(compile 'longerp-do)
=> longerp-do

(bench (longerp-do l1 l2))
=> 469

(bench (longerp-do l2 l1))
=> 468