Gráf bejárása
A program szemlélteti egy gráf bejárását mélységi és szélességi bejárás algoritmusokkal. A gráf tárolása éllisták segítségével történik. Mindkét algoritmus rekurzív formában került implementálásra. Mivel a Lisp fő adatszerkezete a lista, ezért minden adat listák segítségével van tárolva.
;grafot tarolo lista definialasa
(setq lista())
;bejarasi sorrend
(setq bejaras(list 1))
;csucs hozzaadasa a grafhoz
(defun graph_addnode(a &rest value)
(setq lista(cons (concatenate 'list (list a) value) lista)))
;csucsok bevitele a grafba
(graph_addnode 1 2 3 4)
(graph_addnode 2 5 6)
(graph_addnode 3)
(graph_addnode 4 7 8)
(graph_addnode 5 9 10)
(graph_addnode 6)
(graph_addnode 7 11 12)
(graph_addnode 8)
(graph_addnode 9)
(graph_addnode 10)
(graph_addnode 11)
(graph_addnode 12)
;graf pontok sorrendbe tetele
(setq lista(reverse lista))
(setq listaorig lista)
;graf kiiratasa
(format t "Gráf: ")
(format t "~S~%" lista)
;szelessegi bejaras
(defun szelessegi_bejaras(lista bejaras kezdet)
(if (= kezdet 1)
(progn
(format t "~%")
(format t "Szélességi bejárás: ")))
;megallasi feltetel
(if (not (atom bejaras))
;minta egyezes vizsgalat a lista fejeleme es a bejarasi sorrend kozott
(if (= (car bejaras) (car (car lista)))
(progn
(format t (concatenate 'string (write-to-string (car bejaras)) " "))
(setq bejaras(append bejaras (cdr (car lista))))
;ha egyezik a minta es a lista es bejaras sem ures
(if (and (not(atom (cdr lista))) (not(atom (cdr bejaras))))
(szelessegi_bejaras (cdr lista) (cdr bejaras) (incf kezdet))
;ha a bejaras nem ures de a lista mar a vegen van
(if (not (atom (cdr bejaras)))
(szelessegi_bejaras listaorig (cdr bejaras) (incf kezdet))
)
)
)
;ha nem egyezett a minta es a lista es bejaras sem uresek
(if (and (not(atom (cdr lista))) (not(atom bejaras)))
(szelessegi_bejaras (cdr lista) bejaras (incf kezdet))
;ha a bejaras nem ures de a lista mar a vegen van
(if (and (not(atom bejaras)) (atom (cdr lista)))
(szelessegi_bejaras listaorig bejaras (incf kezdet))
)
)
)
)
)
;melysegi bejaras
(defun melysegi_bejaras(lista bejaras kezdet)
(if (= kezdet 1)
(progn
(format t "~%")
(format t "Mélységi bejárás: ")))
;megallasi feltetel
(if (not (atom bejaras))
;minta egyezes vizsgalat a lista fejeleme es a bejarasi sorrend kozott
(if (= (car bejaras) (car (car lista)))
(progn
(setq bejaras(append (list (car bejaras)) (cdr (car lista)) (cdr bejaras) ))
(format t (concatenate 'string (write-to-string (car bejaras)) " "))
;ha egyezik a minta es a lista es bejaras sem ures
(if (and (not(atom (cdr lista))) (not(atom (cdr bejaras))))
(progn
(melysegi_bejaras (cdr lista) (cdr bejaras) (incf kezdet))
)
;ha a bejaras nem ures de a lista mar a vegen van
(if (not (atom (cdr bejaras)))
(melysegi_bejaras listaorig (cdr bejaras) (incf kezdet))
)
)
)
;ha nem egyezett a minta es a lista es bejaras sem uresek
(if (and (not(atom (cdr lista))) (not(atom bejaras)))
(melysegi_bejaras (cdr lista) bejaras (incf kezdet))
;ha a bejaras nem ures de a lista mar a vegen van
(if (and (not(atom bejaras)) (atom (cdr lista)))
(melysegi_bejaras listaorig bejaras (incf kezdet))
)
)
)
)
)
(szelessegi_bejaras lista bejaras 1)
(melysegi_bejaras lista bejaras 1)
Beolvasás fájlból
Az alábbi példa bemutatja, hogyan lehet sorokat beolvasni egy fájlból.
(setq in)
(let ((in (open "/path/teszt" :if-does-not-exist nil)))
(when in
(loop for line = (read-line in nil)
while line do (format t "~a~%" line))
(close in)))
Példa programok
Az alábbi programok Common Lisp alatt íródtak és gcl fordítóval lettek tesztelve.
//lista letrehozasa
(list 1 2 "abc")
//elem befuzese a lista elejere
(cons 1 (list 2 3 4))
//a megadott argumentumokbol listat epit
(appends (list 1 2) (list 3 4))
//lista madosik eleme
(SECOND (list 1 2 3 4 5))
//list1 letrehozasa
(setq list1 (list 1 2 3))
//kozos szakasz list1-el
(setq list2 (cons 0 (cdr list1)))
//list 2. elemetol az osszes
(nthcdr 2 (list 1 2 3 4 5))
//string osszefuzes
(concatenate 'string "a" "b")
//string to char
(coerce "a" 'character)
//char to string
(string #\c)
//4 elemu tomb
(make-array 4)
//2 dimenzisa tomb
(make-array '(2 1))
//1 dimenzios 3 elemu tomb
#(1 2 3)
//3 elemu tomb
(setq tomb (make-array 3))
//tomb elso eleme
(aref tomb 1)
//tomb elso eleme 3 lesz
(setf (aref tomb 1) 3)
//tomb 0. eleme 5 lesz
(push 5 (aref tomb 0))
//10 elemu bit tomb
(make-array 10 :element-type 'bit)
//bit tomb
#*100000
//bit tomb and
(bit-and #*1000 #*1010)
//bit tomb xor
(bit-xor #*1100 #*1010)
//bit tomb not
(bit-not #*1111)
//aritmetikai fuggveny
(+ (* 2 3) (- 10 5))
//sajat double fuggveny
(defun double (x) (* x 2))
(double 10)
//sajat + fuggveny
(defun + (a b &rest c) (* a b (apply '* c))))
(+ 1 2 3 4 5)
//if elagazas
(if (< 2 3) (print 'true) (print 'false))
//case elagazas
(case 'egy ('egy 1) ('ketto 2))
//cond utasitas IF- THEN - ELSE IF
(COND ((ATOM '(X Y)) (PRINT "lista")) ((ATOM 4) (PRINT "atom")) (T (print 'TRUE)))
//while ciklus
(let ((x 1)) (while (< x 4) (print (setq x (* x 2)))))
//loop ciklus
(loop for x from 2 to 6 by 2 do (print x))
//loop ciklus listan
(loop for (item) on '(1 2 3) do (print item))
//osztaly definialas es peldanyositasa
(defclass Submarine () ((Depth :accessor Depth :initform 100)))
(setq Sub (make-instance 'Submarine))
(describe Sub)
(depth Sub)
(setf (depth Sub) 200)
//struktura letrehozasa es peldanyositasa
(defstruct person name age)
(setq dave (make-person :name "Dave" :age 22))
(person-name dave)
(person-age dave)
//generikus metodus
(defmethod Square ((X number)) (* X X))
(Square 10)
(Square 10.0)
Néhány Project Euler feladat megoldása Lisp-ben
Készítette: Gévay Gábor, 2013.
Common Lisp alatt íródtak és clisp fordítóval lettek tesztelve.
Források