Нахождение центральной вершины орграфа - Lisp
Формулировка задачи:
Дан некоторый связный ориентированный граф. Необходимо найти в нём центральную вершину (наиболее равноудалённую ото всех остальных). Наиболее равноудалённая вершина может быть получена как вершина, среднее расстояние от которой до других вершин наиболее близко к среднему значению этой величины для всех вершин графа. Если таких вершин несколько, вывести их все.
Решение задачи: «Нахождение центральной вершины орграфа»
textual
Листинг программы
(defun F (Net) ((lambda (enum counter) ((lambda (averages) ((lambda (mid) ((lambda (deviations) (EXTRACT_MIN (apply 'min deviations) deviations enum)) (mapcar #'(lambda (dist) (abs (- dist mid))) averages))) (/ (apply '+ averages) counter))) (mapcar #'(lambda (node) (/ (apply '+ (mapcar #'(lambda (other) (DIJKSTRA Net node other)) (remove node enum :test 'EQUAL))) (1- counter))) enum))) (mapcar 'car Net) (length Net))) (defun EXTRACT_MIN (minimal deviations enum) (if deviations ((lambda (test result) (if test (cons (car enum) result) result)) (equal (car deviations) minimal) (EXTRACT_MIN minimal (cdr deviations) (cdr enum))))) (defun DIJKSTRA (Net Init Term &optional (Tmp nil) (Fix (list (cons Init 0)))) ((lambda (fix_label fix_value) (if (equal fix_label Term) fix_value (apply #'(lambda (newTmp newFix) (DIJKSTRA Net Init Term newTmp newFix)) (TRANSFER_MIN (UPDATE_Tmp Tmp Fix (cdr (assoc fix_label Net))) Fix)))) (caar Fix) (cdar Fix))) (defun UPDATE_Tmp (Tmp Fix Links) (if Links ((lambda (link_label link_value) (UPDATE_Tmp (if (assoc link_label Fix :test 'EQUAL) Tmp ((lambda (link mark) (if link (subst (cons link_label (min mark (cdr link))) link Tmp :test 'EQUAL) (cons (cons link_label mark) Tmp))) (assoc link_label Tmp :test 'EQUAL) (+ link_value (cdar Fix)))) Fix (cdr Links))) (caar Links) (cdar Links)) Tmp)) (defun TRANSFER_MIN (Tmp Fix) (if Tmp (if (cdr Tmp) (apply #'(lambda (elem newTmp newFix) (if (< (cdr elem) (cdar newFix)) (list (cons (car newFix) newTmp) (cons elem (cdr newFix))) (list (cons elem newTmp) newFix))) (cons (car Tmp) (TRANSFER_MIN (cdr Tmp) Fix))) (list (cdr Tmp) (cons (car Tmp) Fix))) (list Tmp Fix)))
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д