1 singlep
(defun singlep (l)
(when (consp l)
(null (cdr l))))
(5am:test p-1
(5am:is (equal
(singlep '(a))
t
))
(5am:is (equal
(singlep '(a b))
nil
))
(5am:is (equal
(singlep '())
nil
))
)
(5am:run! 'p-1)
2. doublep
;; 空リストなら (cdr l) が nil を返す
;; 要素が1つのリストも (cdr l) が nil を返す
;; 要素が2つのリストは (cdr l) で2つめの要素を取得し、singlep 関数で t を返す
;; 要素が3つ以上のリストは (cdr l) で2つめ以後の要素を取得し、singlep 関数で nil を返す
(defun doublep (l)
(singlep (cdr l)))
(5am:test p-2
(5am:is (equal
(doublep '(a b))
t
))
(5am:is (equal
(doublep '(a b c))
nil
))
(5am:is (equal
(doublep '(a))
nil
))
)
(5am:run! 'p-2)
3. longerp
(defun longerp (xs ys)
(loop
for x on xs
for y on ys
finally (return (consp x))
))
(5am:test p-3
(5am:is (equal
(longerp '(a b c) '(a b))
t
))
(5am:is (equal
(longerp '(a b) '(a b))
nil
))
(5am:is (equal
(longerp '(a) '(a b))
nil
))
)
(5am:run! 'p-3)
4 my-last / my-butlast
(defun my-last (xs)
(loop
for x on xs
when (singlep x)
return x))
(defun my-butlast (xs)
(loop
for x on xs
unless (singlep x)
collect (car x)))
(5am:test p-4
(5am:is (equal
(my-last '(a b c))
'(c)
))
(5am:is (equal
(my-last '(a))
'(a)
))
(5am:is (equal
(my-butlast '(a b c))
'(a b)
))
(5am:is (equal
(my-butlast '(a))
'()
))
)
(5am:run! 'p-4)
5 take
(defun take (xs n)
(loop
for x in xs
for i = 0 then (incf i)
when (< i n)
collect x))
(5am:test p-5
(5am:is (equal
(take '(a b c d e) 3)
'(a b c)
))
(5am:is (equal
(take '(a b c d e) 0)
'()
))
(5am:is (equal
(take '(a b c d e) 6)
'(a b c d e)
))
)
(5am:run! 'p-5)
6 drop
(defun drop (xs n)
(loop
for x on xs
for i = 0 then (incf i)
when (= i n)
return x))
(5am:test p-6
(5am:is (equal
(drop '(a b c d e) 3)
'(d e)
))
(5am:is (equal
(drop '(a b c d e) 0)
'(a b c d e)
))
(5am:is (equal
(drop '(a b c d e) 6)
'()
))
)
(5am:run! 'p-6)
7 my-subseq
(defun my-subseq (xs n m)
(take (drop xs n) (- m n)))
(5am:test p-7
(5am:is (equal
(my-subseq '(a b c d e) 2 4)
'(c d)
))
(5am:is (equal
(my-subseq '(a b c d e) 0 5)
'(a b c d e)
))
(5am:is (equal
(my-subseq '(a b c d e) 0 0)
'()
))
)
(5am:run! 'p-7)
8 my-butlast2
(defun my-butlast2 (ls &optional (n 1))
(take ls (- (length ls) n)))
(5am:test p-8
(5am:is (equal
(my-butlast2 '(a b c d e) 3)
'(a b)
))
(5am:is (equal
(my-butlast2 '(a b c d e) 0)
'(a b c d e)
))
(5am:is (equal
(my-butlast2 '(a b c d e) 5)
'()
))
)
(5am:run! 'p-8)
9 group
(defun group (xs n)
(loop
for i from 0 to (- (length xs) 1) by n
collect (my-subseq xs i (+ i n))))
(5am:test p-9
(5am:is (equal
(group '(a b c d e f) 2)
'((a b) (c d) (e f))
))
(5am:is (equal
(group '(a b c d e f) 3)
'((a b c) (d e f))
))
(5am:is (equal
(group '(a b c d e f) 4)
'((a b c d) (e f))
))
)
(5am:run! 'p-9)
10 my-position
(defun my-position (x ls)
(loop
for item in ls
for i = 0 then (incf i)
when (equal item x)
return i))
(5am:test p-10
(5am:is (equal
(my-position 'a '(a b c d e))
0
))
(5am:is (equal
(my-position 'c '(a b c d e))
2
))
(5am:is (equal
(my-position 'e '(a b c d e))
4
))
(5am:is (equal
(my-position 'f '(a b c d e))
nil
))
)
(5am:run! 'p-10)
11 my-count
(defun my-count (x ls)
(loop
for item in ls
when (equal item x)
sum 1))
(5am:test p-11
(5am:is (equal
(my-count 'a '(a b a b c a b c d))
3
))
(5am:is (equal
(my-count 'c '(a b a b c a b c d))
2
))
(5am:is (equal
(my-count 'd '(a b a b c a b c d))
1
))
(5am:is (equal
(my-count 'e '(a b a b c a b c d))
0
))
)
(5am:run! 'p-11)
12 sum-list
(defun sum-list (ls)
(loop
for item in ls
sum item))
(5am:test p-12
(5am:is (equal
(sum-list '(1 2 3 4 5))
15
))
)
(5am:run! 'p-12)
13 max-list / min-list
(defun max-list (ls)
(loop
for item in ls
maximize item))
(defun min-list (ls)
(loop
for item in ls
minimize item))
(5am:test p-13
(5am:is (equal
(max-list '(5 6 4 7 3 8 2 9 1))
9
))
(5am:is (equal
(min-list '(5 6 4 7 3 8 2 9 1))
1
))
)
(5am:run! 'p-13)
14 adjacent
(defun adjacent (x y ls)
(loop
for item on ls
thereis (and (equal x (car item))
(equal y (cadr item)))))
(5am:test p-14
(5am:is (equal
(adjacent 'a 'b '(a b c d e f))
t
))
(5am:is (equal
(adjacent 'e 'f '(a b c d e f))
t
))
(5am:is (equal
(adjacent 'f 'e '(a b c d e f))
nil
))
)
(5am:run! 'p-14)
15 before
(defun before (x y ls)
(member y (member x ls)))
(5am:test p-15
(5am:is (equal
(before 'a 'b '(a b c d e f))
'(b c d e f)
))
(5am:is (equal
(before 'c 'b '(a b c d e f))
nil
))
)
(5am:run! 'p-15)
16 iota
(defun iota (n m)
(loop
for i from n to m
collect i))
(5am:test p-16
(5am:is (equal
(iota 1 5)
'(1 2 3 4 5)
))
)
(5am:run! 'p-16)
17 set-of-list
(defun set-of-list (ls)
(remove-duplicates ls))
(5am:test p-17
(5am:is (equal
(set-of-list '(a b c d e f a b c))
'(d e f a b c)
))
)
(5am:run! 'p-17)
18 my-union
(defun my-union (xs ys)
(append xs
(loop
for y in ys
unless (my-position y xs)
collect y)))
(5am:test p-18
(5am:is (equal
(my-union '(a b c d) '(c d e f))
'(a b c d e f)
))
)
(5am:run! 'p-18)
19 my-intersection
(defun my-intersection (xs ys)
(set-of-list
(loop
for x in xs
when (member x ys)
collect x)))
(5am:test p-19
(5am:is (equal
(my-intersection '(a b c d) '(c d e f))
'(c d)
))
)
(5am:run! 'p-19)
20 difference
(defun difference (xs ys)
(set-of-list
(loop
for x in xs
unless (member x ys)
collect x)))
(5am:test p-20
(5am:is (equal
(difference '(a b c d) '(c d e f))
'(a b)
))
)
(5am:run! 'p-20)
21 merge-list
(defun merge-list (pred xs ys)
(cond
((null xs) ys)
((null ys) xs)
((aux-merge-list-p pred xs ys)
(cons (car xs) (merge-list pred (cdr xs) ys)))
(t
(cons (car ys) (merge-list pred xs (cdr ys))))
))
(defun aux-merge-list-p (pred xs ys)
(loop
for x in xs
for y in ys
return (funcall pred x y)))
(5am:test p-21
(5am:is (equal
(merge-list #'< '(1 3 5 7) '(2 4 6 8))
'(1 2 3 4 5 6 7 8)
))
)
(5am:run! 'p-21)
22 merge-sort
(defun merge-sort (pred len ls)
(take (aux-merge-sort pred ls) len))
(defun aux-merge-sort (pred ls)
(let ((mid (floor (length ls) 2)))
(if (zerop mid)
ls
(merge-list pred
(aux-merge-sort pred (take ls mid))
(aux-merge-sort pred (drop ls mid))
))))
(5am:test p-22
(5am:is (equal
(merge-sort #'< 9 '(5 6 4 7 8 3 2 9 1 10))
'(1 2 3 4 5 6 7 8 9)
))
(5am:is (equal
(merge-sort #'< 10 '(5 6 4 7 8 3 2 9 1 10))
'(1 2 3 4 5 6 7 8 9 10)
))
(5am:is (equal
(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)
))
)
(5am:run! 'p-22)
23 prefix
(defun prefix (xs ys)
(loop
for x in xs
for y in ys
always (equal x y)))
(5am:test p-23
(5am:is (equal
(prefix '(a b c d e f) '(a b c))
t
))
(5am:is (equal
(prefix '(a b c d e f) '(a b c e))
nil
))
(5am:is (equal
(prefix '(a b c d e f) '())
t
))
)
(5am:run! 'p-23)
24 suffix
(defun suffix (xs ys)
(prefix (drop xs (- (length xs) (length ys))) ys))
(5am:test p-24
(5am:is (equal
(suffix '(a b c d e f) '(d e f))
t
))
(5am:is (equal
(suffix '(a b c d e f) '())
t
))
(5am:is (equal
(suffix '(a b c d e f) '(f g))
nil
))
)
(5am:run! 'p-24)
25 sublistp
(defun sublistp (xs ls)
(loop
for l on ls
thereis (prefix l xs)))
(5am:test p-25
(5am:is (equal
(sublistp '(c d e) '(a b c d e f))
t
))
(5am:is (equal
(sublistp '(d e) '(a b c d e f))
t
))
(5am:is (equal
(sublistp '(d e g) '(a b c d e f))
nil
))
(5am:is (equal
(sublistp '() '(a b c d e f))
t
))
)
(5am:run! 'p-25)
Last modified : 2014/07/05 18:39:54 JST
blechmusik (blechmusik@gmail.com)