Site in Common Lisp, partea 2

Acum avem functii ca sa adaugam atribute si vehicule, ne trebuie o functie
care sa seteze atribute pe vehicule (set-attribute-on-vehicle) si una care sa
caute vehicule in functie de atribute (adica query-vehicles).



La momentul asta fiecare obiect de tip vehicle are un slot numit attributes,
initializat cu nil. Vom pune acolo o lista de asociere (association list).

Pe scurt despre liste in Lisp:
- sunt alcatuite la baza din perechi de elemente, celulele cons (cons cells).
Sunt numite asa pentru ca sunt rezultatul apelarii functiei CONS:

(setf a (cons 1 2)) ==> (1 . 2)

- primul element din pereche se obtine cu functia CAR, iar al doilea cu CDR:

(car a) ==> 1
(cdr a) ==> 2

- daca al doilea element dintr-o pereche este nil (= lista vida)
atunci el nu este printat, altfel este despartit de primul prin punct

(cons 1 2) ==> (1 . 2)
(cons 1 nil) ==> (1)

- in fiecare element din pereche putem stoca orice dorim, inclusiv referinte
catre alte liste, putand astfel sa construim arbori destul de usor
- exista multe functii care lucreaza cu liste realizand diverse operatii
gen filtrare, ordonare, reductie
- o lista cu primele patru numere naturale ar putea fi construita in felul urmator:

(cons 1 (cons 2 (cons 3 (cons 4 nil)))) ==> (1 2 3 4)

Fiecare pereche cons are o valoare din lista in CAR si o referinta catre celula
urmatoare in CDR; CDR-ul ultimei perechi refera nil, deci acolo se termina lista
- functia LIST construieste o lista din parametri
- functia APPEND adauga liste la alte liste; cel mai din dreapta argument
poate fi non-lista, dar ceilalti pot fi liste

Unul din tipurile de liste este ALIST, adica association list. Alist-urile pot fi
construite si manipulate prin simple apeluri catre CONS, CAR si CDR, pentru ca
formatul e simplu - o lista de referinte catre celule ale caror elemente sunt
o cheie si valoarea asociata ei:

((cheie1 . valoare1) (cheie2 . valoare2) (cheie3 . valoare3))

Dar exista si cateva functii speciale care ajuta la folosirea acestui tip de lista.

ACONS cheie valoare alist - returneaza un alist la capatul caruia a fost adaugata
perechea (cheie . valoare)

(setf a (acons 1 "unu" nil)) ==> ((1 . "unu"))
(setf a (acons 2 "doi" a)) ==> ((2 . "doi") (1 . "unu"))

ASSOC element lista ... - returneaza prima pereche a carei cheie se potriveste
cu primul parametru. Poate primi parametri suplimentari care sa modifice modul
de comparare a cheilor cu cheia dorita.

(assoc 1 a) ==> (1 . "unu")
(assoc 2 a :test #'(lambda (arg item) (= arg (* 2 item)))) ==> (1 . "unu")

La a doua expresie am specificat ca doresc sa se compare cheia data ca argument
cu dublul cheii din lista.

PAIRLIS chei date ... - creeaza un alist folosind primul argument ca sursa de
chei si al doilea ca date asociate cheilor. Optional poate sa primeasca un alist
existent, la care sa adauge celelalte chei si valori.

Merita mentionat faptul ca ACONS adauga elemente la capatul listei, indiferent
daca exista deja elemente cu cheia respectiva sau nu, iar ASSOC returneaza prima
pereche care satisface cheia, indiferent cate alte perechi ar mai fi in alist.

OK, deci vreau sa folosesc alist-uri pentru listele de atribute de la masini.
Datele vor fi de forma ( . ).

(defun set-attribute-on-vehicle (vehicle att-name att-value)
  (if (find-attribute-by-name att-name)
      (setf 
       (slot-value vehicle 'attributes)
       (acons att-name att-value (slot-value vehicle 'attributes)))
      (error "Nu exista acest atribut!")))

(defun get-attribute-on-vehicle (vehicle att-name)
  (let ((att (assoc att-name (slot-value vehicle 'attributes) :test #'string-equal)))
    (if att
      (cdr att)
      nil)))

Daca exista atributul cu numele respectiv, il adaug in ALIST-ul vehiculului
dat, altfel - eroare.

Dupa cum ne putem lesne da seama, formatul acesta nu este cel mai avantajos,
atat din punct de vedere al accesului la elemente - pentru fiecare apel ASSOC
parcurgandu-se lista pana la prima potrivire, cat si din punct de vedere
al spatiului ocupat, deoarece nici un element vechi nu se sterge, cele noi
sunt adaugate in fata.
La fel, erorile aruncate cu ERROR apar in debugger, lucru care nu este de dorit
intr-un site de productie, dar vom vedea mai tarziu ce putem face pentru a
imbunatati aceste aspecte (si altele).

Am definit si functia get-attribute-on-vehicle care returneaza valoarea unui
atribut al unui vehicul, sau NIL daca nu gaseste atributul respectiv.

Pentru asa structuri de date, asa functie de cautare:

(defun query-vehicles (criteria) 
  (let ((result (copy-seq *all-vehicles*)))
    (loop
       for crit-pair in criteria
       do 
  (setf result 
        (remove-if-not 
  #'(lambda (vehicle) 
      (equalp 
       (get-attribute-on-vehicle vehicle (car crit-pair))
       (cdr crit-pair)))
  result)))
    result))

Intai copiaza lista de vehicule disponibile intr-o variabila temporara.
Apoi foloseste macroul LOOP pentru a cicla intre criteriile date ca argument
si a face potrivirea dintre valoarea din criteriu si valoarea atributului
corespunzator de pe vehicul.

Am si initializat vehiculele cu niste valori:

(set-attribute-on-vehicle (nth 0 *all-vehicles*) "Forma" "SUV")
(set-attribute-on-vehicle (nth 0 *all-vehicles*) "Tip combustibil" "Motorina")
(set-attribute-on-vehicle (nth 0 *all-vehicles*) "Capacitate cilindrica" "1495")
(set-attribute-on-vehicle (nth 0 *all-vehicles*) "Numar usi" "5")
(set-attribute-on-vehicle (nth 0 *all-vehicles*) "Culoare" "Beige special")

(set-attribute-on-vehicle (nth 1 *all-vehicles*) "Forma" "Hatchback")
(set-attribute-on-vehicle (nth 1 *all-vehicles*) "Tip combustibil" "Benzina")
(set-attribute-on-vehicle (nth 1 *all-vehicles*) "Capacitate cilindrica" "1595")
(set-attribute-on-vehicle (nth 1 *all-vehicles*) "Numar usi" "3")
(set-attribute-on-vehicle (nth 1 *all-vehicles*) "Culoare" "Blue beton")

(set-attribute-on-vehicle (nth 2 *all-vehicles*) "Forma" "Break")
(set-attribute-on-vehicle (nth 2 *all-vehicles*) "Tip combustibil" "Motorina")
(set-attribute-on-vehicle (nth 2 *all-vehicles*) "Capacitate cilindrica" "1896")
(set-attribute-on-vehicle (nth 2 *all-vehicles*) "Numar usi" "5")
(set-attribute-on-vehicle (nth 2 *all-vehicles*) "Culoare" "Bleumarin plictisitor")