HOWTO - Lisp

http://service.felk.cvut.cz/courses/36JUI/Travnik/index.html

apt-get install clisp

; toto je komentář

(setf x 3)
(setf x '(1 2 3))

(defun secti (x y)
	(+ x y)
)

T, cokoli - true
NIL, () - false

(defun vetsi (x y)
	(if (> x y)
		x
		y
)	)


(defun pridej (pr in se)
	(cond
		((null se) (list pr))
		((= in 0) (cons pr se))
		(T (cons (car se) (pridej pr (- in 1) (cdr se))))
)	)

> (list 1 2 3)
(1 2 3) - vytvoří seznam

> (car '(1 2 3))
1 - vrátí první prvek

> (cdr '(1 2 3))
(2 3) - vrátí seznam bez prvního prvku

> (last '(1 2 3))
(3) - vrátí poslední prvek

> (butlast '(1 2 3))
(1 2) - vrátí seznam bez posledního prvku

> (append '(1 2 3) '(4 5 6))
(1 2 3 4 5 6) - spojí seznamy do jednoho seznamu

> (cons 0 '(1 2 3))
(0 1 2 3) - přidá prvek na začátek seznamu

> (null '(1 2 3))
NIL
> (null '())
T - je seznam prázdný?

>
(defun ctvrty (s)
	(car (cdr (cdr (cdr s))))
)
CTVRTY
> (ctvrty '(1 2 3 4 5 6))
4

>
(defun vs (x y)
	(cond
		((zerop y) (list x))
		(T (cons x (vs (1+ x) (1- y))))
)	)
VS
> (vs 12 5)
(12 13 14 15 16 17)

>
(defun otoc (s)
	(if (null s)
		s
		(append (last s) (otoc (butlast s)))
)	)

> (otoc '(1 2 3 4 5))
(5 4 3 2 1)

(function jmeno) - vrátí adresu funkce
#'jmeno - ekvivaletní zápis
(apply adresafunkce (seznam argumentů)) - zavolá funkci
(funcall adresafunkce argumenty) - zavolá funkci
(lambda (argumenty) (tělo)) - nepojmenovaná funkce

> (defun secti (a b) (+ a b))
SECTI
> (secti 1 2)
3

> (function test)
#<FUNCTION SECTI (A B) (DECLARE (SYSTEM::IN-DEFUN SECTI)) (BLOCK SECTI (+ A B))>
> #'secti
#<FUNCTION SECTI (A B) (DECLARE (SYSTEM::IN-DEFUN SECTI)) (BLOCK SECTI (+ A B))>

> (apply #'secti '(1 2))
3
> (funcall #'secti 1 2)
3
> (funcall #'(lambda (a b) (+ a b)) 1 2)
3

mapcar - operace nad prvky se stejným indexem, vrátí nový seznam o min. počtu prvků
mapcan - aplikuje fci na prvky se stejným indexem, výsledky jsou sloučeny do listu
mapc - výstup se neakumuluje, ale vrací se původní seznam
maplist
mapl
...

> (mapcar #'list '(1 2 3) '(7 9 12) '(4 6 5))
((1 7 4) (2 9 6) (3 12 5))

> (mapcar #'list '(1 2 3) '(7 9 12) '(4 6))
((1 7 4) (2 9 6))

> (mapcan (lambda (x) (list (+ x 10) 'x)) '(1 2 3 4))
(11 X 12 X 13 X 14 X)

> (mapcan (lambda (x) (if (> x 0) (list x) nil)) '(-4 6 -23 1 0 12 ))
(6 1 12)

>
(defun prumery (a b)
	(mapcar #'(lambda (x y) (/ (+ x y) 2)) a b)
)

> (prumery '(1 3 5) '(3 5 7))
(2 4 6)

> (defun funkce (x y &rest z) (list x y z))
FUNKCE
> (funkce 1 2 3 4 5)
(1 2 (3 4 5))

> (defun funkce (x &optional y z) (list x y z))
FUNKCE
> (funkce 1 2)
(1 2 NIL)

> (defun funkce (x &optional (y 10) (z 20)) (list x y z))
FUNKCE
> (funkce 1 2)
(1 2 20)

>
(defun maax (a &rest s)
	(cond
		((null (car s)) a)
		((< a (apply #'maax s)) (apply #'maax s))
		(T a)
)	)

> (maax 1 9 5 7 11 3)
11

> (defun maax (a &rest s)
	(setf tmp a)
	(mapc #'(lambda (z)
			(if (> z tmp)
				(setf tmp z)
			)
		)
	s)

	tmp
)

> (maax 1 9 5 7 11 3)
11

> (eval '(+ 1 2))
3

> (format t "~A mínus ~A je ~A ~%" 3 2 (- 3 2))
3 mínus 2 je 1
NIL

~A - tiskne příkazem princ
~S - tiskne příkazem prin1
~F - tiskne jako reálné číslo
~% - nový řádek

> (princ "ahoj")
ahoj
"ahoj"

> (prin1 "ahoj")
"ahoj"
"ahoj"

> (print "ahoj")

"ahoj"
"ahoj"


read - přečte token (tohle používá interpret
read-line - přečte řádku
read-char - přečte znak

> (read-line)
radka textu
"radka textu" ;
NIL

> (read-char)
a
#\a

> (read)
( 1   2 a b)
(1 2 A B)

(defun interpret ()
	(print "hlaska>")
	(print (eval (read)))
	(interpret)
)

>
(defun chcicislo ()
	(format t "zadej: ")
	(setf nacteno (read))
	(if (numberp nacteno)
		(format t "~A ~%" nacteno)
		(chcicislo)
)	)

> (chcicislo)
zadej: a
zadej: a
zadej: b
zadej: 25
25
NIL

>
(defun nkratx (n)
	(format t "X")
	(if (= n 1)
		()
		(nkratx (1- n))
	)
)

> (nkratx 5)
XXXXX

>
(defun spoj ()
	(format t "prvni: ")
	(setf prvni (read))
	(format t "druhy: ")
	(setf druhy (read))
	(append prvni druhy)
)

>(spoj)
prvni: (1 2 3)
druhy: (4 5 6)
(1 2 3 4 5 6)

>
(defun pridej (pr in se)
	(cond
		((null se) (list pr))
		((= in 0) (cons pr se))
		(T (cons (car se) (pridej pr (1- in) (cdr se))))
	)
)

> (pridej 'a 2 '(1 2 3 4 5))
(1 2 A 3 4 5)

; Pole, indexy jsou od nuly
> (setf x (make-array '(2 3)))
#2A((NIL NIL NIL) (NIL NIL NIL))
> (aref x 0 1)
NIL
> (setf (aref x 0 1) '(1 3))
(1 3)
> (aref x 0 1)
(1 3)

> (defstruct zaznam
	(pol1 (progn (princ "Zadej cislo: ")(read)))
	(pol2 nil)
	pol3
)
ZAZNAM
> (setf x (make-zaznam))
Zadej cislo: 23
#S(ZAZNAM :POL1 23 :POL2 NIL :POL3 NIL)
> x
#S(ZAZNAM :POL1 23 :POL2 NIL :POL3 NIL)
> (zaznam-pol1 x)
23
> (setf (zaznam-pol1 x) 50)
50
> (zaznam-pol1 x)
50

> (setf ht (make-hash-table))
#S(HASH-TABLE :TEST FASTHASH-EQL)

> (gethash 'klic ht)
NIL ;
NIL
> (setf (gethash 'klic ht) 10)
10
> (gethash 'klic ht)
10 ;
T
> (setf (gethash 'klic2 ht) 2)
2

> (maphash #'(lambda (k h) (format t "Klic: ~A, hodnota: ~A ~%" k h)) ht)
Klic: KLIC2, hodnota: 2
Klic: KLIC, hodnota: 10
NIL

>
(defun cetnost (s)
	(setf ht (make-hash-table))
	(mapcar #'(lambda (x)
		(if (gethash x ht)
			(setf (gethash x ht) (1+ (gethash x ht)))
			(setf (gethash x ht) 1)
		)

	) s)

	(maphash #'(lambda (x y) (print (list x y))) ht)
)
CETNOST

> (cetnost '(a c b c d a a b))
(D 1)
(B 2)
(C 2)
(A 3)
NIL

> (prog1 (+ 1 2) (+ 5 9) (+ 3 4))
3

> (prog2 (+ 1 2) (+ 5 9) (+ 3 4))
14

> (progn (+ 1 2) (+ 5 9) (+ 3 4))
7

>
(block prvni
	(+ 1 2)
	(+ 3 4)
	(block druhy
		(+ 5 6)
		(return-from prvni 10)
	)
)
10

>
(defun fn ()
	(format t "test")
	(return-from fn 10)
)
FN

> (fn)
test
10

>
(dolist (i '(1 2 3) 'OK)
	(format t "~A ~%" (* i 2))
)
2
4
6
OK

>
(dotimes (i 3 'OK)
	(format t "~A ~%" (* i 2))
)
0
2
4
OK

>
(do
	(
		(i 1 (1+ i))
		(j 1 i)
		(k 1 j)
	)
	(
		(> i 5) 'OK
	)
	(format t "~A ~A ~A ~%" i j k)
)
1 1 1
2 1 1
3 2 1
4 3 2
5 4 3
OK

>
(do*
	(
		(i 1 (1+ i))
		(j 1 i)
		(k 1 j)
	)
	(
		(> i 5) 'OK
	)
	(format t "~A ~A ~A ~%" i j k)
)
1 1 1
2 2 2
3 3 3
4 4 4
5 5 5
OK

>
(defun rozdily (x s)
	(cond
		((and s (cdr s))
			(if (< (abs (- (first s) (second s))) x)
				(rozdily x (cdr s))
			)
		)
		(T)
	)
)
ROZDILY

> (rozdily 3 '(1 3 4 6 7))
T
> (rozdily 3 '(1 3 4 8 9))
NIL


>
(defun rozdily (x s)
	(setf j (car s))
	(dolist (i s)
		(if (> (abs (- j i)) x)
			(return-from rozdily nil)
		)
		(setf j i)
	)

	T
)
ROZDILY

> (rozdily 3 '(1 3 4 6 7))
T
> (rozdily 3 '(1 3 4 8 9))
NIL

>
(defun vloz (x s)
	(setf tmp ())

	(dolist (i s)
		(setf tmp (append tmp (list i)))
		(setf tmp (append tmp (list x)))
	)

	(butlast tmp)
)
VLOZ

> (vloz '* '(1 2 3 4))
(1 * 2 * 3 * 4)

- výsledkem makra je seznam příkazů, ten se vykoná a vrátí se hodnota
- za zpětný apostrof se píší příkazy s parametry makra
- ,x - se nahradí hodnotou předanou za x
- ,@x - pokud je x seznam, nahradí se svými prvky

> (setf tmp '(1 2 3 4))
(1 2 3 4)
> `(tmp - ,tmp - ,@tmp)
(TMP - (1 2 3 4) - 1 2 3 4)

>
(defmacro nastav3 (x)
	`(setf ,x 3)
)
NASTAV3

> (macroexpand-1 '(nastav3 y))
(SETF Y 3) ;
T

> (nastav3 y)
3
> y
3

>
(let ((x 2) (y 3))
	(print x)
	(print y)
	(print (+ x y))
	'OK
)
2
3
5
OK

>
(let ((x (gensym)))
	; x obsahuje unikátní jméno pro pomocnou proměnnou v makru
)

>
(defmacro vypis (vyraz)
	`(pprint (macroexpand-1 ',vyraz))
)
VYPIS

> (vypis '(+ 1 2))
'(+ 1 2)

>
(defmacro nkrat (n &rest a)
	(let ((i (gensym)))
		`(dotimes (,i ,n) ,@a)
	)
)
NKRAT

> (nkrat 5 (princ "x"))
xxxxx

>
(defmacro for ((x y z) &rest body)
	(let ((it (gensym)) (kroku (1+ (- z y))))
		`(dotimes (,it ,kroku) (setf ,x (+ ,y ,it)) ,@body)
	)
)
FOR

> (macroexpand-1 '(for (x 5 9) (princ x)))
(DOTIMES (#:G8115 5) (SETF X (+ 5 #:G8115)) (PRINC X)) ;
T

>(for (x 5 9) (princ x))
56789
NIL

>
(defun mensi (a b)
	(mapcar
		#'(lambda (x y)
			(if (< x y)
				x
				y
			)
		)
		a b
	)
)
MENSI

> (mensi '(1 8 9 4) '(7 2 3 10))
(1 2 3 4)

; Pozn.: Predpokládá, že vstupní seznamy jsou opravdu množiny
;       (tj. seznam obsahuje daný prvek vždy právě jednou)

>
(defun inters (a b)
	(setf ret ())

	(mapcar
		#'(lambda (x)
			(mapcar
				#'(lambda (y)
					(if (= x y)
						(setf ret (cons x ret))
					)
				)
				b
			)
		)
		a
	)

	ret
)
INTERS

> (inters '(1 2 3) '(2 3 4))
(3 2)

>
; Najde sousedy uzlu
(defun najdisousedy (uzel graf)
	(mapcar
		#'(lambda (i)
			(if (eq uzel (car i))
				(return-from najdisousedy i)
			)
		)
		graf
	)
)
NAJDISOUSEDY

>
; Počítá dosažitelné uzly v grafu (předpokládá, že je graf acyklický)
(defun dosazitelnost-acykl (uzel graf)
	(setf ret ())

	(mapcar
		#'(lambda (i)
			(setf ret (union ret (list i)))
			(setf ret (union ret (dosazitelnost-acykl i graf)))
		)

		(cdr (najdisousedy uzel graf))
	)

	ret
)
DOSAZITELNOST-ACYKL

; Acyklický orientovaný graf
; a -> b, c, d
; b -> c
; c -> d
; d
> (setf graf '((a b c d) (b c) (c d) (d)))
((A B C D) (B C) (C D) (D))

> (dosazitelnost-acykl 'a graf)
(B C D)
> (dosazitelnost-acykl 'b graf)
(C D)
> (dosazitelnost-acykl 'c graf)
(D)
> (dosazitelnost-acykl 'd graf)
NIL

>
(defun best-of (S fn test)
	(setf tmp (car S))
	(mapc #'(lambda (z)
			(if (funcall test (funcall fn z) (funcall fn tmp))
				(setf tmp z)
			)
		)
	s)

	(list (funcall fn tmp) tmp)
)

> (best-of '(1 -2 -4 3) #'abs #'>)
(4 -4)