今回はちょっと便利な関数を問題形式で紹介します。問題は拙作のページ Prolog Programming: Yet Anotehr Prolog Problems や Scheme Programming: Yet Another Scheme Problems と同じですが、あしからずご了承くださいませ。
なお、解答では Common Lisp のループ機能 (いわゆるループマクロ) は使っておりません。ループマクロを使ったほうが簡単に解ける問題もあるかと思います。興味のある方はループマクロでプログラムを作ってみてください。
リストの要素がただひとつか調べる述語 singlep を定義してください。
> (singlep '(a)) t > (singlep '(a b)) nil > (singlep '()) nil
リストの要素が二つあるか調べる述語 doublep を定義してください。
> (doublep '(a b)) t > (doublep '(a b c)) nil > (doublep '(a)) nil
リスト xs はリスト ys よりも長いか調べる述語 longerp xs ys を定義してください。
> (longerp '(a b c) '(a b)) t > (longerp '(a b) '(a b)) nil > (longerp '(a) '(a b)) nil
リスト xs の最後尾を求める関数 last と、最後尾の要素を取り除く関数 butlast を定義してください。Common Lisp には同等の機能を持つ関数 last と butlast がありますので、ここでは関数名を my-last と my-butlast としました。
> (my-last '(a b c)) (c) > (my-last '(a)) (a) > (my-butlast '(a b c)) (a b) > (my-butlast '(a)) ()
リスト xs の先頭から n 個の要素を取り出す関数 take xs n を定義してください。
> (take '(a b c d e) 3) (a b c) > (take '(a b c d e) 0) () > (take '(a b c d e) 6) (a b c d e)
リスト xs の先頭から n 個の要素を取り除く関数 drop xs n を定義してください。なお、Common Lisp には同等の機能を持つ関数 nthcdr があります。
> (drop '(a b c d e) 3) (d e) > (drop '(a b c d e) 0) (a b c d e) > (drop '(a b c d e) 6) ()
リスト xs の n 番目から m - 1 番目までの要素を部分リストとして取り出す関数 subseq xs n m を定義してください。なお、リストの要素は 0 から数え始めるものとします。Common Lisp には同等の機能を持つ関数 subseq がありますので、ここでは関数名を my-subseq としました。
> (my-subseq '(a b c d e) 2 4) (c d) > (my-subseq '(a b c d e) 0 5) (a b c d e) > (my-subseq '(a b c d e) 0 0) ()
リスト xs の末尾から n 個の要素を取り除くことができるように関数 butlast を拡張してください。
butlast ls &optional (n 1)
> (my-butlast '(a b c d e) 3) (a b) > (my-butlast '(a b c d e) 0) (a b c d e) > (my-butlast '(a b c d e) 5) ()
リスト xs を長さ n の部分リストに分割する関数 group xs n を定義してください。
> (group '(a b c d e f) 2) ((a b) (c d) (e f)) > (group '(a b c d e f) 3) ((a b c) (d e f)) > (group '(a b c d e f) 4) ((a b c d) (e f))
リスト ls の中から x と等しい要素の位置 n を求める関数 position x ls を定義してください。なお、リストの要素は 0 から数え始めるものとします。Common Lisp には同等の機能を持つ関数 position があるので、ここでは関数名を my-position としました。
> (my-position 'a '(a b c d e)) 0 > (my-position 'c '(a b c d e)) 2 > (my-position 'e '(a b c d e)) 4 > (my-position 'f '(a b c d e)) nil
リスト ls から x と等しい要素の個数 n を求める関数 count x ls を定義してください。Common Lisp には同等の機能を持つ関数 count があるので、ここでは関数名を my-count としました。
> (my-count 'a '(a b a b c a b c d)) 3 > (my-count 'c '(a b a b c a b c d)) 2 > (my-count 'd '(a b a b c a b c d)) 1 > (my-count 'e '(a b a b c a b c d)) 0
リストの要素の合計値を求める関数 sum-list を定義してください。
> (sum-list '(1 2 3 4 5)) 15
リストの中から最大値を求める関数 max-list と最小値を求める関数 min-list を定義してください。
> (max-list '(5 6 4 7 3 8 2 9 1)) 9 > (min-list '(5 6 4 7 3 8 2 9 1)) 1
リスト ls の中で要素 x の右隣に要素 y があるかチェックする述語 adjacent x y ls を定義してください。
> (adjacent 'a 'b '(a b c d e f)) t > (adjacent 'e 'f '(a b c d e f)) t > (adjacent 'f 'e '(a b c d e f)) nil
リスト ls の中で要素 x が 要素 y よりも前に出現しているか調べる述語 before x y ls を定義してください。
> (before 'a 'b '(a b c d e f)) (b c d e f) > (before 'c 'b '(a b c d e f)) nil
整数 n から m までを格納したリストを作る関数 iota n m を定義してください。
> (iota 1 5) (1 2 3 4 5)
リストから重複要素を取り除いて集合を生成する関数 set-of-list を定義してください。
> (set-of-list '(a b c d e f a b c)) (d e f a b c)
2 つの集合の和を求める関数 union を定義してください。なお、Common Lisp には同等の機能を持つ関数 union があるので、ここでは関数名を my-union としました。
> (my-union '(a b c d) '(c d e f)) (a b c d e f)
2 つの集合の積を求める関数 intersection を定義してください。なお、Common Lisp には同等の機能を持つ関数 intersection があるので、ここでは関数名を my-intersection としました。
> (my-intersection '(a b c d) '(c d e f)) (c d)
2 つの集合の差を求める関数 difference を定義してください。なお、Common Lisp には同等の機能を持つ関数 set-difference があります。
> (difference '(a b c d) '(c d e f)) (a b)
2 つのソート済みのリストをひとつのソート済みのリストにまとめる関数 merge-list を定義してください。なお、Common Lisp には同等の機能を持つ関数 merge があります。
> (merge-list #'< '(1 3 5 7) '(2 4 6 8)) (1 2 3 4 5 6 7 8)
関数 merge-list を使ってリストをソートする merge-sort を定義してください。なお、Common Lisp には列 (リスト、ベクタ、文字列) をソートする関数 sort があります。
> (merge-sort #'< 9 '(5 6 4 7 8 3 2 9 1 10)) (1 2 3 4 5 6 7 8 9) > (merge-sort #'< 10 '(5 6 4 7 8 3 2 9 1 10)) (1 2 3 4 5 6 7 8 9 10) > (merge-sort #'< 11 '(5 6 4 7 8 3 2 9 1 10 0)) (0 1 2 3 4 5 6 7 8 9 10)
リスト ps がリスト ls の「接頭辞 (prefix) 」か判定する関数 prefix ls ps を定義してください。接頭辞とは、列の先頭からある位置までの部分列のことです。リスト [a, b, c, d] の接頭辞は [ ], [a], [a, b], [a, b, c], [a, b, c, d] の 5 つになります。
> (prefix '(a b c d e f) '(a b c)) t > (prefix '(a b c d e f) '(a b c e)) nil > (prefix '(a b c d e f) '()) t
リスト ss がリスト ls の「接尾辞 (suffix) 」か判定する関数 suffix ls ss を定義してください。接尾辞とは、列のある位置から末尾までの部分列のことです。リスト [a, b, c, d] の接尾辞は [a, b, c, d], [b, c, d], [c, d], [d], [ ] の 5 つになります。
> (suffix '(a b c d e f) '(d e f)) t > (suffix '(a b c d e f) '()) t > (suffix '(a b c d e f) '(f g)) nil
リスト xs がリスト ls の部分リストか判定する関数 sublistp xs ls を定義してください。なお、Common Lisp には同等の機能を持つ関数 subsetp があります。
> (sublistp '(c d e) '(a b c d e f)) t > (sublistp '(d e) '(a b c d e f)) t > (sublistp '(d e g) '(a b c d e f)) nil > (sublistp '() '(a b c d e f)) t
リスト : 要素がただひとつか (defun singlep (ls) (and (consp ls) (null (cdr ls))))
Common Lisp の場合、引数 ls がリストで、かつ (cdr ls) が空リストであれば、そのリストの要素は一つしかないことがわかります。length でリストの長さを求める必要はありません。
リスト : 要素が二つあるか (defun doublep (ls) (and (consp ls) (singlep (cdr ls))))
Common Lisp の場合、述語 consp が真であればリストに一つ以上の要素があることがわかります。あとは (cdr ls) が一つしか要素がないことを述語 singlep で確認します。length でリストの長さを求める必要はありません。
リスト : リスト xs は ys よりも長いか
(defun longerp (xs ys)
(cond ((null xs) nil)
((null ys) t)
(t (longerp (cdr xs) (cdr ys)))))
; 別解
(defun longerp1 (xs ys)
(and (consp xs)
(or (null ys)
(longerp1 (cdr xs) (cdr ys)))))
リストの先頭から順番にたどり、途中で ys が空リストになれば ys の方が長いことがわかります。length でリストの長さを求めて比較するよりも、このプログラムの方が効率的だと思います。
リスト : リストの最後尾を求める
(defun my-last (ls)
(if (null (cdr ls))
ls
(my-last (cdr ls))))
; 別解
(defun my-last1 (ls)
(do ((ls ls (cdr ls)))
((null (cdr ls)) ls)))
関数 my-last は単純な再帰定義で、my-last1 は繰り返し do を使ってリストの最後尾を求めています。
リスト : 最後尾の要素を取り除く
(defun my-butlast (ls)
(if (null (cdr ls))
nil
(cons (car ls) (my-butlast (cdr ls)))))
; 別解
(defun my-butlast1 (ls)
(do ((ls ls (cdr ls))
(a nil))
((null (cdr ls)) (nreverse a))
(push (car ls) a)))
my-butlast は引数のリスト ls の要素が一つになるまで再帰呼び出しをします。要素が一つになったら空リストを返します。あとは、再帰呼び出しからの返り値に cons で要素を追加していくだけです。
別解は do を使った繰り返しバージョンです。累積変数 a に要素を格納し、引数 ls の要素がひとつになったならば、nreverse でリスト a を破壊的に反転して返します。reverse を使うよりも効率的です。
リスト : リストの先頭から n 個の要素を取り出す
(defun take (ls n)
(if (or (<= n 0) (null ls))
nil
(cons (car ls) (take (cdr ls) (1- n)))))
; 別解
(defun take1 (ls n)
(do ((n n (1- n))
(ls ls (cdr ls))
(a nil))
((or (<= n 0) (null ls)) (nreverse a))
(push (car ls) a)))
引数 n が 0 以下または引数 ls が空リストの場合は空リストを返します。そうでなければ take を再帰呼び出しして、その返り値にリストの先頭要素 (car ls) を追加します。別解は do による繰り返しバージョンです。累積変数 a に要素を格納して、n が 0 以下または ls が空リストになったら、nreverse でリスト a を破壊的に反転して返します。
リスト : リストの先頭から n 個の要素を削除する
(defun drop (ls n)
(if (or (<= n 0) (null ls))
ls
(drop (cdr ls) (1- n))))
; 別解
(defun drop1 (ls n)
(do ((n n (1- n))
(ls ls (cdr ls)))
((or (<= n 0) (null ls)) ls)))
drop は簡単です。引数 n が 0 以下または引数 ls が空リストになるまで drop を再帰呼び出しするだけです。別解は do による繰り返しバージョンです。
リスト : 部分リストを取り出す (defun my-subseq (ls s e) (take (drop ls s) (- e s)))
my-subseq は drop と take を使うと簡単です。drop で ls から s 個の要素を取り除き、そのリストから e - s 個の要素を take で取り出すだけです。
リスト : リストの末尾から n 個の要素を取り除く (defun my-butlast2 (ls &optional (n 1)) (take ls (- (length ls) n)))
リスト ls の長さを m とすると、リストの末尾から n 個の要素を取り除くことは、リストの先頭から m - n 個の要素を取り出すことと同じになります。取り出す要素の個数を (- (length ls) n)) で求めて take で要素を取り出します。
リスト : リストの分割
(defun group (ls n)
(if (null ls)
nil
(cons (take ls n) (group (drop ls n) n))))
; 別解
(defun group1 (ls n)
(do ((ls ls (drop ls n))
(a nil))
((null ls) (nreverse a))
(push (take ls n) a)))
関数 group は take と drop を使うと簡単に定義できます。ls が空リストの場合は分割できないので空リストを返します。これが再帰の停止条件になります。ls が空リストでない場合、まず take で n 個の要素を格納したリストを求めます。次に、n 個の要素を取り除いたリストを drop で求めて group を再帰呼び出しします。その返り値に take で取り出したリストを cons で追加すればいいわけです。
別解は do による繰り返しバージョンです。take で取り出したリストを累積変数 a に格納し、ls が空リストになったら nreverse でリスト a を破壊的に反転して返します。
リスト : 要素の位置を求める
(defun my-position (x ls)
(labels ((position-sub (ls n)
(cond ((null ls) nil)
((eql x (car ls)) n)
(t (position-sub (cdr ls) (1+ n))))))
(position-sub ls 0)))
; 別解
(defun my-position1 (x ls)
(do ((n 0 (1+ n))
(ls ls (cdr ls)))
((null ls) nil)
(when (eql x (car ls))
(return n))))
my-position は局所関数 position-sub を呼び出します。position-sub の引数 n が位置を表します。ls が空リストの場合は nil を返します。x と等しい要素を見つけた場合は n を返します。そうでなければ、position-sub を再帰呼び出しして次の要素を調べます。別解は do を使った繰り返しバージョンです。
リスト : 要素の個数を求める
(defun my-count (x ls)
(cond ((null ls) 0)
((eql (car ls) x)
(1+ (my-count x (cdr ls))))
(t (my-count x (cdr ls)))))
; 別解
(defun my-count0 (x ls)
(labels ((count-sub (ls a)
(cond ((null ls) a)
((eql (car ls) x)
(count-sub (cdr ls) (1+ a)))
(t (count-sub (cdr ls) a)))))
(count-sub ls 0)))
(defun my-count1 (x ls)
(do ((c 0)
(ls ls (cdr ls)))
((null ls) c)
(when (eql (car ls) x)
(incf c))))
(defun my-count2 (x ls)
(reduce #'(lambda (a y) (if (eql x y) (1+ a) a)) ls :initial-value 0))
my-count は再帰呼び出しで x と等しい要素を数えます。my-count0 は my-count の末尾再帰バージョン、my-count1 は do による繰り返しバージョン、my-count2 は reduce を使ったバージョンです。
リスト : 要素の合計値を求める
(defun sum-list (ls)
(apply #'+ ls))
(defun sum-list0 (ls)
(reduce #'+ ls))
(defun sum-list1 (ls)
(if (null ls)
0
(+ (car ls) (sum-list1 (cdr ls)))))
(defun sum-list2 (ls)
(labels ((sum-list-sub (ls a)
(if (null ls)
a
(sum-list-sub (cdr ls) (+ (car ls) a)))))
(sum-list-sub ls 0)))
(defun sum-list3 (ls)
(do ((sum 0)
(ls ls (cdr ls)))
((null ls) sum)
(incf sum (car ls))))
Common Lisp の場合、一番簡単なプログラムは apply または reduce を使う方法でしょう。sum-list1 は再帰定義でリストの和を求めています。これを末尾再帰にしたものが sum-list2 です。sum-list3 は do を使った繰り返しバージョンです。
リスト : リストから最大値と最小値を求める
; 最大値を求める
(defun max-list (ls) (apply #'max ls))
(defun max-list0 (ls) (reduce #'max ls))
(defun max-list1 (ls)
(labels ((max-list-sub (ls m)
(cond ((null ls) m)
((< m (car ls))
(max-list-sub (cdr ls) (car ls)))
(t
(max-list-sub (cdr ls) m)))))
(max-list-sub (cdr ls) (car ls))))
(defun max-list2 (ls)
(do ((ls (cdr ls) (cdr ls))
(m (car ls)))
((null ls) m)
(when (< m (car ls))
(setf m (car ls)))))
(defun max-list3 (ls)
(let ((m (car ls)))
(dolist (x (cdr ls) m)
(when (< m x) (setf m x)))))
; 最小値を求める
(defun min-list (ls) (apply #'min ls))
(defun min-list0 (ls) (reduce #'min ls))
(defun min-list1 (ls)
(labels ((min-list-sub (ls m)
(cond ((null ls) m)
((> m (car ls))
(min-list-sub (cdr ls) (car ls)))
(t
(min-list-sub (cdr ls) m)))))
(min-list-sub (cdr ls) (car ls))))
(defun min-list2 (ls)
(do ((ls (cdr ls) (cdr ls))
(m (car ls)))
((null ls) m)
(when (> m (car ls))
(setf m (car ls)))))
(defun min-list3 (ls)
(let ((m (car ls)))
(dolist (x (cdr ls) m)
(when (> m x) (setf m x)))))
max-list と min-list は apply を使って関数 max, min を呼び出します。reduce を使っても簡単にプログラムすることができます。max-list1 と min-list1 は末尾再帰でプログラムしています。あとのプログラムは do と dolist を使った繰り返しバージョンです。
リスト : x と y は隣り合っているか
(defun adjacent (x y ls)
(unless (null (cdr ls))
(if (and (eql (car ls) x) (eql (cadr ls) y))
t
(adjacent x y (cdr ls)))))
; 別解
(defun adjacent1 (x y ls)
(do ((ls ls (cdr ls)))
((null (cdr ls)))
(when (and (eql (car ls) x) (eql (cadr ls) y))
(return t))))
最初にリストの要素が二つ以上あることをチェックします。次に、先頭の要素が x と等しくて、次の要素が y と等しいことをチェックします。そうであれば t を返し、そうでなければ adjacent を再帰呼び出しして、次の要素を調べます。別解は do を使った繰り返しバージョンです。
リスト : x は y よりも前に出現しているか
(defun before (x y ls)
(let ((xs (member x ls)))
(and xs (member y (cdr xs)))))
関数 before は関数 member を使うと簡単にプログラムすることができます。ls から x を member で探します。x を見つけた場合、xs の先頭要素は x になります。それを取り除いたリストから member で y を探せばいいわけです。
リスト : 数列の生成
(defun iota (n m)
(if (> n m)
nil
(cons n (iota (1+ n) m))))
; 別解
(defun iota1 (n m)
(do ((m m (1- m))
(a nil))
((< m n) a)
(push m a)))
(defun iota2 (n m)
(labels ((iota-sub (m a)
(if (< m n)
a
(iota-sub (1- m) (cons m a)))))
(iota-sub m nil)))
関数 iota は簡単です。n が m より大きい場合は空リストになります。n が m 以下の場合、iota を再帰呼び出しして n + 1 から m までのリストを生成し、その先頭に n を追加するだけです。別解は do を使った繰り返しバージョンと末尾再帰バージョンです。この場合、後ろから数値を生成していることに注意してください。m が n よりも小さくなったならばリスト a を返します。
リスト : 集合の生成
(defun set-of-list (ls)
(cond ((null ls) nil)
((member (car ls) (cdr ls))
(set-of-list (cdr ls)))
(t
(cons (car ls) (set-of-list (cdr ls))))))
; 別解
(defun set-of-list1 (ls)
(do ((ls ls (cdr ls))
(a nil))
((null ls) (nreverse a))
(pushnew (car ls) a)))
(defun set-of-list2 (ls)
(reduce #'(lambda (a x) (if (member x a) a (cons x a)))
ls
:initial-value nil))
述語 set-of-list はリストから重複要素を取り除きます。空リストは重複要素がないので空リストのままです。次の節で、リストの先頭要素 (car ls) が残りのリスト (cdr ls) にあるか memv で調べ、同じ要素があれば集合に加えません。else 節で同じ要素がない場合はそれを集合に加えます。別解は do を使った繰り返しバージョンと reduce を使ったバージョンです。
リスト : 集合の和
(defun my-union (xs ys)
(cond ((null xs) ys)
((member (car xs) ys)
(my-union (cdr xs) ys))
(t
(cons (car xs) (my-union (cdr xs) ys)))))
; 別解
(defun my-union1 (xs ys)
(do ((xs xs (cdr xs))
(a ys))
((null xs) a)
(pushnew (car xs) a)))
(defun my-union2 (xs ys)
(reduce #'(lambda (a x) (if (member x ys) a (cons x a)))
xs
:initial-value ys))
最初の節は空集合 (空リスト) と集合 ys の和は ys であることを表しています。次の節で、要素 (car xs) が集合 ys に含まれていれば、それを新しい集合に加えません。(car xs) が ys に含まれていなければ、それを集合に追加します。別解は do と reduce を使ったバージョンです。
リスト : 集合の積
(defun my-intersection (xs ys)
(cond ((null xs) nil)
((member (car xs) ys)
(cons (car xs) (my-intersection (cdr xs) ys)))
(t (my-intersection (cdr xs) ys))))
; 別解 1
(defun my-intersection1 (xs ys)
(do ((xs xs (cdr xs))
(a nil))
((null xs) a)
(when (member (car xs) ys)
(push (car xs) a))))
(defun my-intersection2 (xs ys)
(reduce #'(lambda (a x) (if (member x ys) (cons x a) a))
xs
:initial-value nil))
最初の節は空集合 (空リスト) と集合 ys の積は空集合であることを表しています。次の節で、要素 (car xs) が集合 ys に含まれていれば、それを新しい集合に追加します。そうでなければ、最後の節で要素 (car xs) を集合に追加しません。別解は do と reduce を使ったバージョンです。
リスト : 集合の差
(defun difference (xs ys)
(cond ((null xs) nil)
((member (car xs) ys)
(difference (cdr xs) ys))
(t
(cons (car xs) (difference (cdr xs) ys)))))
; 別解
(defun difference1 (xs ys)
(do ((xs xs (cdr xs))
(a nil))
((null xs) a)
(unless (member (car xs) ys)
(push (car xs) a))))
(defun difference2 (xs ys)
(reduce #'(lambda (a x) (if (member x ys) a (cons x a)))
xs
:initial-value nil))
最初の節は、空集合と集合 ys の差は空集合であることを表しています。次の節で、要素 (car xs) が ys に含まれいる場合は集合にそれを追加しません。そうでなければ、最後の節で要素 (car xs) を集合に追加します。別解は do と reduce を使ったバージョンです。
リスト : リストのマージ
(defun merge-list (pred xs ys)
(cond ((null xs) ys)
((null ys) xs)
((funcall pred (car xs) (car ys))
(cons (car xs) (merge-list pred (cdr xs) ys)))
(t (cons (car ys) (merge-list pred xs (cdr ys))))))
最初の節は、空リストとリスト ys をマージすると ys になることを表しています。次の節は、リスト xs と空リストをマージすると xs になることを表しています。この 2 つの節が、再帰呼び出しの停止条件になります。
3 番目の節で、それぞれのリストの先頭要素を述語 pred で比較し、pred が真を返す場合は (car xs) をマージしたリストの先頭に追加し、そうでなければ最後の節で (car ys) をマージしたリストの先頭に追加します。merge-list を再帰呼び出しするときは、xs または ys の先頭要素を取り除いて呼び出すことに注意してください。
マージソートはリストの長さを 1, 2, 4, 8, ... と増やしていくよりも、再帰的に考えた方が簡単です。まず、ソートするリストを 2 つに分割して、前半部分をソートします。次に、後半部分をソートして、その結果をマージすればいいわけです。
再帰呼び出しするたびにリストは 2 つに分割されるので、最後にリストの要素はひとつとなります。これはソート済みのリストなので、ここで再帰呼び出しを終了してマージ処理を行えばいいわけです。プログラムは次のようになります。
リスト : マージソート
(defun merge-sort (pred n ls)
(if (= n 1)
(list (car ls))
(let ((m (floor n 2)))
(merge-list pred
(merge-sort pred m ls)
(merge-sort pred (- n m) (drop ls m))))))
関数 merge-sort の引数 pred が要素を比較する述語、引数 ls がソートするリスト、引数 n がリストの長さを表します。merge-sort はリストを分割する処理で、新しいリストを作らないことに注意してください。merge-sort はソートするリストの範囲を開始位置と長さで表しています。リストを二分割する場合、前半部分は ls と m (= n / 2) で表し、後半部分を (drop ls m) と (- n m) で表します。
あとは merge-sort を再帰呼び出しでリストを分割していき、リストの長さが 1 になったならば新しいリストを返します。そして、merge-sort でソートしたリストを merge-list でマージすればいいわけです。
リスト : 接頭辞の判定
(defun prefix (ls ps)
(cond ((null ps) t)
((eql (car ls) (car ps))
(prefix (cdr ls) (cdr ps)))
(t nil)))
接頭辞の判定は簡単です。最初の節は、空リストは接頭辞であることを表しています。次の節で、リストの先頭要素が等しい場合は、残りのリスト (cdr ps) が (cdr ls) の接頭辞であることを確かめます。
リスト : 接尾辞の判定 (defun suffix (ls ss) (prefix (drop ls (- (length ls) (length ss))) ss))
接尾辞の判定も簡単です。リスト ls と ss の長さの差分を求め、ls の先頭から差分の個数だけ要素を取り除きます。これで ls と ss の長さが等しくなるので、あとは prefix で比較するだけです。
リスト : 部分リストの判定
(defun sublist (ks ls)
(cond ((null ls) nil)
((prefix ls ks) t)
(t (sublist ks (cdr ls)))))
sublist は prefix を使うと簡単です。最初の節で ls が空リストの場合、ks は部分リストではないので nil を返します。次の節で、ks が ls の接頭辞であれば部分リストなので t を返します。それ以外の場合は ls の先頭要素を取り除いて、sublist を再帰呼び出しするだけです。