xref: /OpenGrok/opengrok-indexer/src/test/resources/analysis/lisp/sample.lsp (revision eeb7e5b33d1bcc524fcc9d1d560447b044e286a4)
1*eeb7e5b3SAdam Hornáček;;   Copyright 2013 Google Inc.
2*eeb7e5b3SAdam Hornáček;;
3*eeb7e5b3SAdam Hornáček;;   Licensed under the Apache License, Version 2.0 (the "License");
4*eeb7e5b3SAdam Hornáček;;   you may not use this file except in compliance with the License.
5*eeb7e5b3SAdam Hornáček;;   You may obtain a copy of the License at
6*eeb7e5b3SAdam Hornáček;;
7*eeb7e5b3SAdam Hornáček;;       http://www.apache.org/licenses/LICENSE-2.0
8*eeb7e5b3SAdam Hornáček;;
9*eeb7e5b3SAdam Hornáček;;   Unless required by applicable law or agreed to in writing, software
10*eeb7e5b3SAdam Hornáček;;   distributed under the License is distributed on an "AS IS" BASIS,
11*eeb7e5b3SAdam Hornáček;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12*eeb7e5b3SAdam Hornáček;;   See the License for the specific language governing permissions and
13*eeb7e5b3SAdam Hornáček;;   limitations under the License.
14*eeb7e5b3SAdam Hornáček
15*eeb7e5b3SAdam Hornáček(define-test test-mapcar-basics
16*eeb7e5b3SAdam Hornáček    "We can apply a function to each member
17*eeb7e5b3SAdam Hornáček     of a list using mapcar."
18*eeb7e5b3SAdam Hornáček  (defun times-two (x) (* x 2))
19*eeb7e5b3SAdam Hornáček  (assert-equal ____ (mapcar #'times-two '(1 2 3)))
20*eeb7e5b3SAdam Hornáček  (assert-equal ____ (mapcar #'first '((3 2 1)
21*eeb7e5b3SAdam Hornáček                                      ("little" "small" "tiny")
22*eeb7e5b3SAdam Hornáček                                      ("pigs" "hogs" "swine")))))
23*eeb7e5b3SAdam Hornáček
24*eeb7e5b3SAdam Hornáček
25*eeb7e5b3SAdam Hornáček(define-test test-mapcar-multiple-lists
26*eeb7e5b3SAdam Hornáček    "The mapcar function can be applied to
27*eeb7e5b3SAdam Hornáček     more than one list. It applies a function
28*eeb7e5b3SAdam Hornáček     to successive elements of the lists."
29*eeb7e5b3SAdam Hornáček  (assert-equal ____ (mapcar #'* '(1 2 3) '(4 5 6)))
30*eeb7e5b3SAdam Hornáček  (assert-equal ____ (mapcar #'list '("lisp" "are") '("koans" "fun"))))
31*eeb7e5b3SAdam Hornáček
32*eeb7e5b3SAdam Hornáček
33*eeb7e5b3SAdam Hornáček(define-test test-transpose-using-mapcar
34*eeb7e5b3SAdam Hornáček    "Replace the usage of WRONG-FUNCTION in 'transpose' with the
35*eeb7e5b3SAdam Hornáček     correct lisp function (don't forget the #')."
36*eeb7e5b3SAdam Hornáček  (defun WRONG-FUNCTION-1 (&rest rest) '())
37*eeb7e5b3SAdam Hornáček  (defun transpose (L) (apply #'mapcar (cons #'WRONG-FUNCTION-1 L)))
38*eeb7e5b3SAdam Hornáček  (assert-equal '((1 4 7)
39*eeb7e5b3SAdam Hornáček                  (2 5 8)
40*eeb7e5b3SAdam Hornáček                  (3 6 9))
41*eeb7e5b3SAdam Hornáček                (transpose '((1 2 3)
42*eeb7e5b3SAdam Hornáček                             (4 5 6)
43*eeb7e5b3SAdam Hornáček                             (7 8 9))))
44*eeb7e5b3SAdam Hornáček  (assert-equal '(("these" "pretzels" "are")
45*eeb7e5b3SAdam Hornáček                  ("making" "me" "thirsty"))
46*eeb7e5b3SAdam Hornáček                (transpose '(("these" "making")
47*eeb7e5b3SAdam Hornáček                             ("pretzels" "me")
48*eeb7e5b3SAdam Hornáček                             ("are" "thirsty")))))
49*eeb7e5b3SAdam Hornáček
50*eeb7e5b3SAdam Hornáček
51*eeb7e5b3SAdam Hornáček(define-test test-reduce-basics
52*eeb7e5b3SAdam Hornáček    "The reduce function combines the elements
53*eeb7e5b3SAdam Hornáček     of a list, from left to right, by applying
54*eeb7e5b3SAdam Hornáček     a binary function to the list elements."
55*eeb7e5b3SAdam Hornáček  (assert-equal ___  (reduce #'+ '(1 2 3 4)))
56*eeb7e5b3SAdam Hornáček  (assert-equal ___ (reduce #'expt '(2 3 2))))
57*eeb7e5b3SAdam Hornáček
58*eeb7e5b3SAdam Hornáček
59*eeb7e5b3SAdam Hornáček(define-test test-reduce-right-to-left
60*eeb7e5b3SAdam Hornáček    "The keyword :from-end allows us to apply
61*eeb7e5b3SAdam Hornáček     reduce from right to left."
62*eeb7e5b3SAdam Hornáček  (assert-equal ___ (reduce #'+ '(1 2 3 4) :from-end t))
63*eeb7e5b3SAdam Hornáček  (assert-equal ___ (reduce #'expt '(2 3 2) :from-end t)))
64*eeb7e5b3SAdam Hornáček
65*eeb7e5b3SAdam Hornáček
66*eeb7e5b3SAdam Hornáček(define-test test-reduce-with-initial-value
67*eeb7e5b3SAdam Hornáček    "We can supply an initial value to reduce."
68*eeb7e5b3SAdam Hornáček  (assert-equal ___ (reduce #'expt '(10 21 34 43) :initial-value 1))
69*eeb7e5b3SAdam Hornáček  (assert-equal ___ (reduce #'expt '(10 21 34 43) :initial-value 0)))
70*eeb7e5b3SAdam Hornáček
71*eeb7e5b3SAdam Hornáček
72*eeb7e5b3SAdam Hornáček(defun WRONG-FUNCTION-2 (a b) (a))
73*eeb7e5b3SAdam Hornáček(defun WRONG-FUNCTION-3 (a b) (a))
74*eeb7e5b3SAdam Hornáček
75*eeb7e5b3SAdam Hornáček(define-test test-mapcar-and-reduce
76*eeb7e5b3SAdam Hornáček    "mapcar and reduce are a powerful combination.
77*eeb7e5b3SAdam Hornáček     insert the correct function names, instead of WRONG-FUNCTION-X
78*eeb7e5b3SAdam Hornáček     to define an inner product."
79*eeb7e5b3SAdam Hornáček  (defun inner (x y)
80*eeb7e5b3SAdam Hornáček    (reduce #'WRONG-FUNCTION-2 (mapcar #'WRONG-FUNCTION-3 x y)))
81*eeb7e5b3SAdam Hornáček  (assert-equal 32 (inner '(1 2 3) '(4 5 6)))
82*eeb7e5b3SAdam Hornáček  (assert-equal 310 (inner '(10 20 30) '(4 3 7))))
83