172 lines
6.5 KiB
Plaintext
172 lines
6.5 KiB
Plaintext
;; Function To Be Tested: notevery
|
|
;;
|
|
;; Source: CLtL Section 14.2: Concatenating, Mapping, and Reducing Sequences Page: 250
|
|
;;
|
|
;; Created By: Karin M. Sye
|
|
;;
|
|
;; Creation Date: Sept. 5 ,1986
|
|
;;
|
|
;; Last Update: Nov. 5 ,1986
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>14-2-notevery.test
|
|
;;
|
|
;;
|
|
;; Syntax: notevery PREDICATE SEQUENCE &REST MORE-SEQUENCES
|
|
;;
|
|
;; Function Description: notevery returns a non-nil as soon as any invocation of PRIDICATE returns a nil.
|
|
;; If the end of a sequence is reached, notevery returns a nil.
|
|
;;
|
|
;; Argument(s): PREDICATE - a function which produces a Boolean value, and should take as many arguments
|
|
;; as there are sequences provided.
|
|
;; SEQUENCE -
|
|
;;
|
|
;; Returns: nil or non-nil
|
|
;;
|
|
(do-test "test notevery - If the end of a sequence is reached, nil is returned"
|
|
(and (eq (notevery #'+ '(2 4 6) '(1 3 5) '()) nil)
|
|
(eq (notevery #'* '(1 2) '(2 3) '(3 4) '(4 5) '(5 6) '(6 7) '(7 8) '(8 9) '(9 0) '()) nil)
|
|
(eq (notevery #'list "abc" "cde" "" "efr") nil)
|
|
(eq (notevery #'- (vector) "" (make-array 3 :initial-element nil :fill-pointer 2)) nil)
|
|
)
|
|
)
|
|
|
|
(do-test "test notevery 0"
|
|
;; the predicate is first applied to the elements with index 0 in each of the sequences,
|
|
;; and possibly then to the elements with index 1, and so on, until a termination criterion is
|
|
;; met or the end of the shortest of the sequences is reached.
|
|
|
|
(let ( buf )
|
|
(notevery #'(lambda (x1 x2 x3 x4 x5 x6 x7 x8 x9 x10
|
|
x11 x12 x13 x14 x15 x16 x17 x18 x19 x20
|
|
x21 x22 x23 x24 x25)
|
|
(setq buf (append buf (list x25 x24 x23 x22 x21 x20 x19 x18 x17 x16
|
|
x15 x14 x13 x12 x11 x10 x9 x8 x7 x6 x5 x4 x3 x2 x1) ))
|
|
)
|
|
'(elm11 elm12 elm13 elm14)
|
|
'(elm21 elm22 elm23 elm24)
|
|
'(elm31 elm32 elm33 elm34)
|
|
'(elm41 elm42 elm43 elm44)
|
|
'(elm51 elm52 elm53 elm54 elm55)
|
|
'(elm61 elm62 elm63 elm64 elm65 elm66)
|
|
'(elm71 elm72 elm73 elm74)
|
|
'(elm81 elm82 elm83)
|
|
'(elm91 elm92 elm93 elm94)
|
|
'(elm101 elm102 elm103 elm104 elm105)
|
|
'(elm111 elm112 elm113 elm114 elm115)
|
|
`(elm121 elm122 elm123 elm124)
|
|
'(elm131 elm132 elm133 elm134)
|
|
'(elm141 elm142 elm143 elm144)
|
|
'(elm151 elm152 elm153 elm154 elm155)
|
|
'(elm161 elm162 elm163 elm164 elm165)
|
|
'(elm171 elm172 elm173 elm174)
|
|
'(elm181 elm182 elm183 elm184 elm185)
|
|
'(elm191 elm192 elm193 elm194)
|
|
'(elm201 elm202 elm203 elm204 elm205)
|
|
'(elm211 elm212 elm213 elm214 elm215 elm216 elm217)
|
|
'(elm221 elm222 elm223 elm224 elm225)
|
|
'(elm231 elm232 elm233 elm234 elm235)
|
|
'(elm241 elm242 elm243 elm244)
|
|
'(elm251 elm252 elm253 elm254)
|
|
)
|
|
(equal buf '(elm251 elm241 elm231 elm221 elm211 elm201 elm191 elm181 elm171 elm161
|
|
elm151 elm141 elm131 elm121 elm111 elm101 elm91 elm81 elm71 elm61
|
|
elm51 elm41 elm31 elm21 elm11
|
|
elm252 elm242 elm232 elm222 elm212 elm202 elm192 elm182 elm172 elm162
|
|
elm152 elm142 elm132 elm122 elm112 elm102 elm92 elm82 elm72 elm62
|
|
elm52 elm42 elm32 elm22 elm12
|
|
elm253 elm243 elm233 elm223 elm213 elm203 elm193 elm183 elm173 elm163
|
|
elm153 elm143 elm133 elm123 elm113 elm103 elm93 elm83 elm73 elm63
|
|
elm53 elm43 elm33 elm23 elm13 ))
|
|
)
|
|
)
|
|
|
|
(do-test "test notevery - with 110 sequences"
|
|
(let ((a '(1)) )
|
|
(and (eq (notevery #'nconc (list a) '((2)) '((3)) '((4)) '((5)) '((6)) '((7)) '((8)) '((9)) '((10))
|
|
'((11)) '((12)) '((13)) '((14)) '((15)) '((16)) '((17)) '((18)) '((19)) '((20))
|
|
'((21)) '((22)) '((23)) '((24)) '((25)) '((26)) '((27)) '((28)) '((29)) '((30))
|
|
'((31)) '((32)) '((33)) '((34)) '((35)) '((36)) '((37)) '((38)) '((39)) '((40))
|
|
'((41)) '((42)) '((43)) '((44)) '((45)) '((46)) '((47)) '((48)) '((49)) '((50))
|
|
'((51)) '((52)) '((53)) '((54)) '((55)) '((56)) '((57)) '((58)) '((59)) '((60))
|
|
'((61)) '((62)) '((63)) '((64)) '((65)) '((66)) '((67)) '((68)) '((69)) '((70))
|
|
'((71)) '((72)) '((73)) '((74)) '((75)) '((76)) '((77)) '((78)) '((79)) '((80))
|
|
'((81)) '((82)) '((83)) '((84)) '((85)) '((86)) '((87)) '((88)) '((89)) '((90))
|
|
'((91)) '((92)) '((93)) '((94)) '((95)) '((96)) '((97)) '((98)) '((99)) '((100))
|
|
'((101)) '((102)) '((103)) '((104)) '((105)) '((106)) '((107)) '((108)) '((109)) '((110))) nil)
|
|
(equal a (do
|
|
((n 1 (1+ n)) (buf nil (append buf (list n))))
|
|
((= n 111) buf) ))
|
|
)
|
|
)
|
|
)
|
|
|
|
(do-test "test notevery 1"
|
|
(and (not (notevery #'identity '#(t t 3 t 2 t t 5 t 9)))
|
|
(notevery #'identity '(t t 3 t 2 t t 5 nil t 9))
|
|
)
|
|
)
|
|
|
|
(do-test "test notevery 2"
|
|
(and (eq (notevery #'lower-case-p "twinkle twinkle little star !") t)
|
|
(eq (notevery #'lower-case-p "twinkletwinklelittlestar") nil)
|
|
(eq (notevery #'oddp '#(1 3 5 7 17 35 17 39 97 77 91 -2)) t)
|
|
(eq (notevery #'oddp '#(1 3 5 7 17 35 17 39 97 77 91 -3)) nil)
|
|
)
|
|
)
|
|
|
|
(do-test "test notevery 3"
|
|
(and ( eq (notevery #'(lambda (x y) (member x y :test #'eq))
|
|
'(2 6 7 a)
|
|
'( (1 4 (3)) (4 5 (6)) (88 77 99) ((a) ((a)) 'a) (2 6 7 a) ))
|
|
t)
|
|
|
|
( eq (notevery #'(lambda (x y) (member x y :test #'eq))
|
|
'(2 6 7 a)
|
|
'( (1 2 (3)) (4 5 (6) 6) (88 7 99) ((a) ((a)) a 'a) (2 6 7 a) ))
|
|
nil)
|
|
|
|
( eq (notevery #'(lambda (x y) (member x y :test #'eq))
|
|
'(2 6 7 a)
|
|
'( (1 2 (3)) (4 5 (6) 6) (88 17 99) ((a) ((a)) a 'a) (2 6 7 a) ))
|
|
t)
|
|
)
|
|
)
|
|
|
|
(do-test "test notevery 4"
|
|
(and (eq (notevery #'>= '(100 90 60 50 40 1 2)
|
|
'(95 87 43 30 35 8 11)
|
|
'(5 9 40 25 3)) nil)
|
|
|
|
(equal (notevery #'>= '(100 90 60 50 40 1 2)
|
|
'(95 87 83 20 35 8 11)
|
|
'(5 9 90 25 3)) t)
|
|
|
|
(equal (notevery #'>= '(100 90 60 50 40 1 2)
|
|
'(95 90 43 20 35 8 11)
|
|
'(5 90 40 20 3)) nil)
|
|
)
|
|
)
|
|
|
|
(do-test "test notevery 5"
|
|
(and (eq (notevery #'(lambda (w x y z) (if (and (equal (elt w x) y) (typep y z)) y nil))
|
|
'#("summer" "winter" "fall" "spring")
|
|
'(3 4 1 5)
|
|
"sifn"
|
|
'(number bit list array)) t)
|
|
|
|
(eq (notevery #'(lambda (w x y z) (if (and (equal (elt w x) y) (typep y z)) y nil))
|
|
'#("summer" "winter" "fall" "spring")
|
|
'(4 4 1 5)
|
|
"eeag"
|
|
(make-array 4 :initial-element 'character :fill-pointer 1)) nil)
|
|
|
|
(eq (notevery #'(lambda (w x y z) (if (and (equal (elt w x) y) (typep y z)) y nil))
|
|
'#("summer" "winter" "fall" "spring")
|
|
'(4 3 1 5)
|
|
"eeag"
|
|
(make-array 4 :initial-element 'character)) t)
|
|
|
|
)
|
|
)
|
|
STOP
|