База данных успеваемости студентов

;;; STUDYDB.lsp
 
;; база студентов
(setq db '((db
            (sidorov satisf)
            (ivanov excellent)
            (petrov excellent)
 
           )
           (math
            (ivanov excellent)
            (sidorov excellent)
            (petrov good)
           )
          )
)
;; шкала оценок
(setq gr '(bad satisf good excellent))
 
(defun intersection (l1 l2)
;;; Возвращает пересечение двух списков
  (if l1
    (if (member (car l1) l2)
      (cons (car l1) (intersection (cdr l1) l2))
      (intersection (cdr l1) l2)
    )
  )
)
 
;; как узнать какую оценку получил студент по предмету
(defun q1 (s d)
  ;; (q1 'IVANOV 'DB)
  (cadr (assoc s (cdr (assoc d db))))
)
 
;; как узнать успеваемость студента
(defun q2 (s)
  ;; (q2 'IVANOV)
  (mapcar '(lambda (x)
             (list (car x) (cadr (assoc s (cdr x))))
           )
          db
  )
)
 
;; как узнать кто из студентов получил конкретную оценку по конкретному предмету
(defun q3 (d g)
 
  ;; (q3 'Math 'excellent)
 
  (apply 'append
         (mapcar '(lambda (x)
                    (if (eq (cadr x) g)
                      (list (car x))
                      nil
                    )
                  )
                 (cdr (assoc d db))
         )
  )
)
 
;; как узнать какие студенты уже получили оценки
(defun q4 ()
  ;; (q4)
  (apply 'intersection
         (mapcar '(lambda (x) (mapcar 'car x)) (mapcar 'cdr db))
  )
)
 
;; как составить рейтинг студентов
(defun q5 ()
  ;;(q5)
  (vl-sort
    (mapcar '(lambda (x)
               (list x
                     (apply '+
                            (mapcar '(lambda (x) (vl-position x gr))
                                    (apply 'append (mapcar 'cdr (q2 x)))
                            )
                     )
               )
             )
            (q4)
    )
    '(lambda (x y) (> (cadr x) (cadr y)))
  )
)

(defstruct p-list math phys chem)
 
==> (STRUCTURE)
 
(defstruct student fa im ot pl)
 
==> (STRUCTURE)
 
(setq *db* (list
              (make-student :fa 'Иванов :im 'Олег :ot 'Петрович :pl (make-p-list :math 5 :phys 4 :chem 5))
              (make-student :fa 'Кошкин :im 'Аркадий :ot 'Васильевич :pl (make-p-list :math 3 :phys 3 :chem 5))
              (make-student :fa 'Мышкин :im 'Григорий :ot 'Андреевич :pl (make-p-list :math 3 :phys 3 :chem 4))
              (make-student :fa 'Жучкина :im 'Ольга :ot 'Сергеевна :pl (make-p-list :math 5 :phys 5 :chem 5))))
 
 
==> ((student :fa Иванов :im Олег :oT Петрович :pL (p-list :maTh 5 :phys 4 :chem 5)) 
     (student :fa Кошкин :im Аркадий :oT Васильевич :pL (p-list :maTh 3 :phys 3 :chem 5))
     (student :fa Мышкин :im Григорий :oT Андреевич :pL (p-list :maTh 3 :phys 3 :chem 4)) 
     (student :fa Жучкина :im Ольга :oT Сергеевна :pL (p-list :maTh 5 :phys 5 :chem 5)))
 
;; Создана глобальная переменная *db*
 
(defun get-data (stru fld)
  (let ((a (explode stru))
        (b (explode fld)))
   (implode (append a (list '-) b))))
 
(defun avg-val (db p)
  (let ((f (get-data 'p-list p))
        (s 0)
        (n 0))
   (iter (for st in db)
     (summing (funcall f (student-pl st)) into s)
     (counting s into n))
   (* 1.0 (/ s n))))
 
==> avg-val
 
(avg-val *db* 'phys)
 
==> 3.75
 
(avg-val *db* 'chem)
 
==> 4.75
 
(avg-val *db* 'math)
 
==> 4.0