Нахождение центральной вершины орграфа - Lisp

Узнай цену своей работы

Формулировка задачи:

Дан некоторый связный ориентированный граф. Необходимо найти в нём центральную вершину (наиболее равноудалённую ото всех остальных). Наиболее равноудалённая вершина может быть получена как вершина, среднее расстояние от которой до других вершин наиболее близко к среднему значению этой величины для всех вершин графа. Если таких вершин несколько, вывести их все.

Решение задачи: «Нахождение центральной вершины орграфа»

textual
Листинг программы 
  1. (defun F (Net)
  2.  ((lambda (enum counter)
  3.    ((lambda (averages)
  4.      ((lambda (mid)
  5.        ((lambda (deviations)
  6.          (EXTRACT_MIN (apply 'min deviations) deviations enum))
  7.         (mapcar
  8.         #'(lambda (dist)
  9.           (abs (- dist mid)))
  10.          averages)))
  11.       (/ (apply '+ averages) counter)))
  12.     (mapcar
  13.     #'(lambda (node)
  14.       (/
  15.        (apply '+
  16.         (mapcar
  17.         #'(lambda (other)
  18.           (DIJKSTRA Net node other))
  19.          (remove node enum :test 'EQUAL)))
  20.        (1- counter)))
  21.      enum)))
  22.   (mapcar 'car Net)
  23.   (length Net)))
  24. (defun EXTRACT_MIN (minimal deviations enum)
  25.  (if deviations
  26.   ((lambda (test result)
  27.     (if test (cons (car enum) result) result))
  28.    (equal (car deviations) minimal)
  29.    (EXTRACT_MIN minimal (cdr deviations) (cdr enum)))))
  30. (defun DIJKSTRA (Net Init Term
  31.  &optional (Tmp nil) (Fix (list (cons Init 0))))
  32.  ((lambda (fix_label fix_value)
  33.    (if (equal fix_label Term) fix_value
  34.     (apply 
  35.      #'(lambda (newTmp newFix)
  36.       (DIJKSTRA Net Init Term newTmp newFix))
  37.      (TRANSFER_MIN
  38.       (UPDATE_Tmp Tmp Fix (cdr (assoc fix_label Net)))
  39.       Fix))))
  40.   (caar Fix)
  41.   (cdar Fix)))
  42. (defun UPDATE_Tmp (Tmp Fix Links)
  43.  (if Links
  44.   ((lambda (link_label link_value)
  45.     (UPDATE_Tmp
  46.      (if (assoc link_label Fix :test 'EQUAL) Tmp
  47.       ((lambda (link mark)
  48.         (if link
  49.          (subst
  50.           (cons link_label (min mark (cdr link)))
  51.           link
  52.           Tmp
  53.           :test 'EQUAL)
  54.          (cons (cons link_label mark) Tmp)))
  55.        (assoc link_label Tmp :test 'EQUAL)
  56.        (+ link_value (cdar Fix))))
  57.      Fix
  58.      (cdr Links)))
  59.    (caar Links)
  60.    (cdar Links))
  61.   Tmp))
  62. (defun TRANSFER_MIN (Tmp Fix)
  63.  (if Tmp
  64.   (if (cdr Tmp)
  65.    (apply
  66.     #'(lambda (elem newTmp newFix)
  67.      (if (< (cdr elem) (cdar newFix))
  68.       (list
  69.        (cons (car newFix) newTmp)
  70.        (cons elem (cdr newFix)))
  71.       (list
  72.        (cons elem newTmp)
  73.        newFix)))
  74.     (cons (car Tmp) (TRANSFER_MIN (cdr Tmp) Fix)))
  75.    (list
  76.     (cdr Tmp)
  77.     (cons (car Tmp) Fix)))
  78.   (list Tmp Fix)))

ИИ поможет Вам:

  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

9   голосов , оценка 4.111 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы