Взаимные преобразования "Матрица смежности" <-> "Матрица инцидентности"

;; Транспонирование матрицу
 
(defun transp-matr (matr)
  (apply 'mapcar (cons 'list matr)))
 
;; Установить единицы в позиции (i,j) и (j,i)
;; матрицы смежности
 
(defun setij (matr lst)
  (let* ((i (car lst))
         (j (cadr lst))
         (irow (nth i matr))
         (jrow (nth j matr)))
        (setf (nth j irow) 1)
        (setf (nth i jrow) 1)))
       
;; Построить нулевую марицу n*n
 
(defun make-zero-matr (n)
  (let ((matr nil)
        (zrow (iter (for i from 1 to n) (collecting 0))))
       (iter (for i from 1 to n) (collecting (copy zrow) into matr))
       matr))
      
;; Дать номера ненулевых элементов
 
(defun get-num (row)
  (list (position 1 row) (+ 1 (position 1 (removef 1 row)))))
      
;; Из матрицы инцидентности получить матрицу смежности
 
(defun inc2sm (matr)
  (let* ((n (length matr))
         (z (make-zero-matr n)))
        (iter (for col in (transp-matr matr))
              (setij z (get-num col)))
        z))
 
(inc2sm '((1 1 0 0 0) (1 0 1 0 0) (0 0 0 0 1) (0 1 1 1 0) (0 0 0 1 1)))
 
==> ((0 1 0 1 0) (1 0 0 1 0) (0 0 0 0 1) (1 1 0 0 1) (0 0 1 1 0))

;Если вершины помечены числами.
(defun List->Adj/Matr (lst)
  (let* ((row (remove-duplicates (reduce #'append lst)))
         (ver (sort (copy-list row) #'<)))
    (mapcar (lambda (i)
      (list i
            (mapcar (lambda (x)  
                      (if  (member x (cdr (assoc i lst))) 1 0))
                    ver)))
    ver)))
 
;Ориентированный.
> (List->Adj/Matr '((1 2 3 6) (2 3) (3 4) (4 5) (6 5)))
((1 (0 1 1 0 0 1))
 (2 (0 0 1 0 0 0))
 (3 (0 0 0 1 0 0))
 (4 (0 0 0 0 1 0))
 (5 (0 0 0 0 0 0))
 (6 (0 0 0 0 1 0)))
 
;Неориентированный.
> (List->Adj/Matr '((1 2 5) (2 1 3 4) (3 2 5) (4 2 5) (5 1 4)))
((1 (0 1 0 0 1))
 (2 (1 0 1 1 0))
 (3 (0 1 0 0 1))
 (4 (0 1 0 0 1))
 (5 (1 0 0 1 0)))