165 lines
6.0 KiB
Plaintext
165 lines
6.0 KiB
Plaintext
;; Function To Be Tested: some
|
|
;;
|
|
;; 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-some.test
|
|
;;
|
|
;;
|
|
;; Syntax: some PREDICATE SEQUENCE &REST MORE-SEQUENCES
|
|
;;
|
|
;; Function Description: some returns as soon as any invocation of PREDICATE returns a non-nil value; some returns
|
|
;; that value. If the end of a sequence is reached, some returns 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 some - If the end of a sequence is reached, nil is returned"
|
|
(and (eq (some #'+ '(2 4 6) '(1 3 5) '()) nil)
|
|
(eq (some #'* '(1 2) '(2 3) '(3 4) '(4 5) '(5 6) '(6 7) '(7 8) '(8 9) '(9 0) '()) ())
|
|
(eq (some #'list "abc" "cde" "" "efr") nil)
|
|
(eq (some #'- '#() "" (make-array 3 :initial-element nil)) nil)
|
|
)
|
|
)
|
|
|
|
(do-test "test some 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 )
|
|
(some #'(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) ))
|
|
nil
|
|
)
|
|
'(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 some - with 100 sequences"
|
|
(= (some #'+ '(1) '(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) ) (/ (* (+ 1 100) 100) 2) ))
|
|
|
|
(do-test "test some 1"
|
|
(and (eq (some #'identity '#(nil nil nil nil nil nil nil nil nil nil)) nil)
|
|
(eq (some #'identity '(nil nil nil nil nil 3 nil nil)) 3)
|
|
)
|
|
)
|
|
|
|
(do-test "test some 2"
|
|
(and (eq (some #'upper-case-p "twinkle twinkle little star !") nil)
|
|
(equal (some #'upper-case-p "twinkle twinkle lIttle star !") t)
|
|
(eq (some #'evenp '#(1 3 5 7 17 35 17 39 97 77 91 -2)) t)
|
|
(eq (some #'complexp '#(1 3 5 7 17 35 17 39 97 77 91 -2)) nil)
|
|
)
|
|
)
|
|
|
|
(do-test "test some 3"
|
|
(and ( eq (some #'(lambda (x y) (member x y :test #'equal))
|
|
'(2 6 7 a)
|
|
'( (1 4 (3)) (4 5 (6)) (88 77 99) ((a) ((a)) 'a) (2 6 7 a) )) nil)
|
|
|
|
( equal (some #'(lambda (x y) (member x y :test #'equal))
|
|
'(2 6 7 a)
|
|
'( (1 4 (3)) (4 5 (6)) (88 7 99) ((a) ((a)) 'a) (2 6 7 a) ))
|
|
'(7 99))
|
|
|
|
( equal (some #'(lambda (x y) (member x y :test #'equal))
|
|
'(2 6 7 a)
|
|
'( (1 4 (3)) (4 5 (6)) (88 77 99) ((a) ((a)) a 'a) (2 6 7 a) ))
|
|
'(a 'a))
|
|
)
|
|
)
|
|
|
|
(do-test "test some 4"
|
|
(and (eq (some #'<= '(100 90 60 50 40 1 2)
|
|
'(95 87 43 20 35 8 11)
|
|
'(5 9 40 25 3)) nil)
|
|
|
|
(equal (some #'<= '(100 90 60 50 40 1 2)
|
|
'(95 87 83 20 35 8 11)
|
|
'(5 9 90 25 3)) t)
|
|
|
|
(equal (some #'<= '(100 90 60 50 40 1 2)
|
|
'(95 90 43 20 35 8 11)
|
|
'(5 90 40 25 3)) t)
|
|
)
|
|
)
|
|
|
|
(do-test "test some 5"
|
|
(and (eq (some #'(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)) nil)
|
|
|
|
(equal (some #'(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)
|
|
"sian"
|
|
(make-array 4 :initial-element 'character)) #\a)
|
|
|
|
(equal (some #'(lambda (w x y z) (if (and (equal (elt w x) y) (typep y z)) y nil))
|
|
'#("summer" "winter" "fall" "spring")
|
|
'(3 1 1 5)
|
|
"sian"
|
|
(make-array 4 :initial-element 'character)) #\i)
|
|
)
|
|
)
|
|
STOP
|
|
|
|
|