> 1 <

Автор Сообщение

Zemalax

Members


Статус

3 сообщений

Где: Russia
Род занятий: hack&prog
Возраст: 31

#4208   2011-04-21 12:07 GMT+3 часа(ов)      
Здраствуйте) Нужно решить лабораторную работу, условие -
Дана схема метрополитена, найти кратчайший путь между станциями.
Схема метрополитена задаётся с помощью матрицы смежности или матрицы инциденций. Каждому перегону соответствует некоторый вес (длительность перегона). Каждой пересадке также соответствует некоторый вес (длительность пересадки). Необходимо для заданной преподавателем схемы вывести самый короткий путь или все такие пути, если их несколько.

Нельзя использовать циклы. Использовать нужно clisp. Изучаю его не так давно, еще не вошел во вкус функционального программирования). Но времени дали на выполнение лабораторной работы немного, пытался сам, но завис на стадии придумывании рекурсивного алгоритма)
Who is there?

VH

Members


Статус

289 сообщений

Где: ---
Род занятий:
Возраст:

#4210   2011-04-21 20:41 GMT+3 часа(ов)      

Zemalax

Members


Статус

3 сообщений

Где: Russia
Род занятий: hack&prog
Возраст: 31

#4211   2011-04-22 10:12 GMT+3 часа(ов)      
в примере -

(defun F (Net Init Term &optional (Routes (list (list Init))))
(apply
'(lambda (result next)
(if result
(mapcar 'reverse result)
(F
(UPDATE_NET Net Routes)
Init
Term
(UPDATE_ROUTES Net next))))
(EXTRACT_RESULT Term Routes)))
(defun EXTRACT_RESULT (Term Routes)
(if Routes
(apply
'(lambda (route result next)
(if (equal (car route) Term)
(list (cons route result) next)
(list result (cons route next))))
(cons
(car Routes)
(EXTRACT_RESULT Term (cdr Routes))))
'(nil nil)))
(defun UPDATE_ROUTES (Net Routes)
(apply 'append
(mapcar
'(lambda (route)
(mapcar
'(lambda (link)
(cons link route))
(cdr (assoc (car route) Net :test 'EQUAL)))) ; здесь
Routes)))
(defun UPDATE_NET (Net Routes)
(if Routes
((lambda (curr_term)
((lambda (links)
(UPDATE_NET
(UPDATE_LINKS Net curr_term links)
(cdr Routes)))
(cdr (assoc curr_term Net :test 'EQUAL)))) ; здксь
(caar Routes))
Net))
(defun UPDATE_LINKS (Net Term Links)
(if Links
((lambda (link)
(UPDATE_LINKS
(subst (remove Term link :test 'EQUAL) link Net :test 'EQUAL) ; здесь
Term
(cdr Links)))
(assoc (car Links) Net :test 'EQUAL)) ; здесь
Net))
(setq sampleNet
'((A B)(B A C)(C B D)(D C E X)(E D F O)(F E J)(G H)(H G I W)(I H J)
(J I K F)(K J T Z)(L M)(M L N)(N M O Y)(O N P E)(P O Q)(Q P R U)
(R P S)(S R)(T K U)(U T V Q)(V U W)(W V X H)(X W Y D)(Y X Z N)
(Z Y K)))
(F sampleNet 'B 'T)
 


Выдает ошибку-
*** - APPLY: аргумент
(LAMBDA (ROUTE RESULT NEXT)
(IF (EQUAL (CAR ROUTE) TERM) (LIST (CONS ROUTE RESULT) NEXT) (LIST RESULT (CONS ROUTE NEXT))))
- не функция.
Получить функцию как объект в текущем окружении - пишите (FUNCTION ...).
В глобальном окружении - (COERCE '... 'FUNCTION).

Не понимаю как это возможно исправить

отредактировал(а) Zemalax: 2011-04-27 04:03 GMT+3 часа(ов)
Who is there?

VH

Members


Статус

289 сообщений

Где: ---
Род занятий:
Возраст:

#4212   2011-04-22 10:41 GMT+3 часа(ов)      
Это в зависимости от диалекта - в некоторых и так действует.

Zemalax

Members


Статус

3 сообщений

Где: Russia
Род занятий: hack&prog
Возраст: 31

#4213   2011-04-22 10:51 GMT+3 часа(ов)      
Ну диалект Common LISP, единственный момент я программирую на ОС Arch Linux, более легкие лабораторные работы писал - они работали отлично, но когда передавал однокурсникам которые работали под ОС Windows - у них лабораторные не работали. Если заработает все равно нужно будет доделывать) Потому-что там еще и вес связи имеется, а как я понял алгоритм Дейкстры - у него вес связи равен 1
Who is there?

VH

Members


Статус

289 сообщений

Где: ---
Род занятий:
Возраст:

#4214   2011-04-22 11:07 GMT+3 часа(ов)      
Если используемый Вами диалект требует применения (function) - пишите.
Про алгоритм Дейкстры <в данном случае> мне ничего неизвестно.

Kir_b

Members


Статус

4 сообщений

Где: Russia
Род занятий:
Возраст:

#6209   2012-06-11 01:56 GMT+3 часа(ов)      
Граф задается матрицей смежности, цифра вместе с вершиной - вес перехода на станции.
 
(setq net '(
( A B C D E F G)
((A 0) 00 08 05 00 01 00 00)
((B 0) 08 00 05 00 00 03 03)
((C 0) 05 05 00 03 02 06 00)
((D 0) 00 00 03 00 04 04 00)
((E 0) 01 00 02 04 00 00 00)
((F 0) 00 03 06 04 00 00 02)
((G 0) 00 03 00 00 00 02 00)
)
)
 
(setq infinity 1000)
 
(defun createListOfUnxploredNodes (net start) ;Функция создает список неиследованных вершин вида:((A <infinity> 0 0) (B <infinity> 0 0) .. )
(cond
(
(eq (car net) nil) ;Если просмотрели все вершины в сети, то выходим из рекурсии
nil
)
(T
(cons
(append
(append
(append
(cons
(append
nil (caar net)
)
nil
)
(cond
(
(eq(caar net) start)
(cons
`0
nil
)
)
(T
(cons
infinity
nil
)
)
)
)
`(((0)))
)
`(0)
)
(createListOfUnxploredNodes
(cons
(cdar net)
nil
)
start
)
)
)
)
)
 
(defun deleteVisitedNode(nodesList nodeToDelete) ;Возвращает список nodesList без элемента nodeToDelete, не модифицируя исходный список.
(cond
(
(eq(caar nodesList) nodeToDelete)
(cdr nodesList)
)
(T
(cons
(car nodesList)
(deleteVisitedNode (cdr nodesList) nodeToDelete)
)
)
)
)
 
 
(defun findConnectedNodes (net nodeToProcess listOfAllNodes avaibleNodes) ;Функция выводит список соединненых с вершиной nodeToProcess из net, если вершина в net есть в avaibleNodes
(cond
(
(eq (caaadr net) nodeToProcess) ;Если нашли вершину в нужной строке, то
( ;Просмариваем все ячейки в найденной строке и если втретиься ячейка в которой не 0, то добавляем ее в списко выходных праметров
extendResult (exploreConnectionsOfNode (cdadr net) listOfAllNodes) avaibleNodes
)
 
)
(T ;Если не нашли, то просматриваем следующую строку
(findConnectedNodes (cdr net) nodeToProcess listOfAllNodes avaibleNodes)
)
)
)
 
(defun exploreConnectionsOfNode (lineToExplore listOfAllNodes) ;Функция просмотра всех ячейки в найденной строке и если втретиься ячейка в которой не 0, то добавляем ее в списко выходных праметров
(cond
(
(eq (car lineToExplore) nil) ;Если просмотрели весь список, то выходим из рекурсии
nil
)
(T
(cond
(
(> (car lineToExplore) 0)
(cons
(append
(cons(car listOfAllNodes) nil)
(cons(car lineToExplore) nil)
)
(exploreConnectionsOfNode (cdr lineToExplore) (cdr listOfAllNodes))
)
)
(T
(exploreConnectionsOfNode (cdr lineToExplore) (cdr listOfAllNodes))
)
)
)
)
 
)
 
(defun findListWithNodeInHead (searchingNode nodesList)
(cond
(
(eq (car nodesList) nil)
nil
)
(T
(cond
(
(eq(caar nodesList) searchingNode)
(car nodesList)
)
(T
(findListWithNodeInHead searchingNode (cdr nodesList))
)
)
)
)
)
 
(defun extendResult(listOfConnectedNodes avaibleNodes) ;Расширяет полученный список вершин вида: ((A 3) (B 7)) до вида: ((A 1000 ((0)) 3) (B 1000 ((0)) 7))
(cond ;При этом просматривая avaibleNodes, если какой-то вершины там нет, то она не попадет в результирующий список
(
(eq (car listOfConnectedNodes) nil) ;Если просмотрели весь список, то выходим из рекурсии
nil
)
(T
(cond
(
(eq
(setq obtainedList (findListWithNodeInHead (caar listOfConnectedNodes) avaibleNodes )) ;Находит в списке доступных вершин список искомой вершины
nil
)
(cond
(
(eq (car listOfConnectedNodes) nil) ;Если просмотрели весь список, то выходим из рекурсии
nil
)
(T
(extendResult (cdr listOfConnectedNodes) avaibleNodes)
)
)
)
(T
(append
(cons
(append
(append
(append
(cons
(car obtainedList)
nil
)
(cons
(cadr obtainedList)
nil
)
)
(cons
(caddr obtainedList)
nil
)
)
(cons
(+
(cadddr obtainedList)
(cadar listOfConnectedNodes)
)
nil
)
)
nil
)
(extendResult (cdr listOfConnectedNodes) avaibleNodes)
)
)
)
)
)
)
 
 
 
 
(defun findDistanceToConnectedNodes (net connectedNodes currentNode) ;Функция просматриваем список соединненых вершин и либо заменяет расстояние, если оно меньше, либо оставляет так как есть
(cond ;При этом просматривая avaibleNodes, если какой-то вершины там нет, то она не попадет в результирующий список
(
(eq (setq processingNode (car connectedNodes)) nil) ;Если просмотрели весь список, то выходим из рекурсии
nil
)
(T
(cons
(findDistanceToNode net currentNode processingNode)
(findDistanceToConnectedNodes net (cdr connectedNodes) currentNode)
)
)
)
)
 
 
(defun findDistanceToNode (net currentNode observingNode)
(append
(cons
(car observingNode) ;Получаем имя вершины observingNode
nil
)
(cons
(+ ;Складываем distance observingNode с value currentNode и с весом перехода на observingNode и помещаем все это в distance observingNode
(cadddr observingNode)
(+
(cadr currentNode)
(findTransferCost net observingNode) ;Находим сколько "весит" пересадка на станции observingNode
)
)
nil
)
)
)
 
(defun findTransferCost (net observingNode)
(cond
(
(eq (caaadr net) (car observingNode))
(car(cdaadr net))
)
(T
(findTransferCost (cdr net) observingNode)
)
)
)
(defun createOuputMessage (outPut)
(append
(cons
"Minimum distance is:"
nil
)
(append
(cons
(cadr outPut)
nil
)
(append
(cons
"and shortest way(s) is:"
nil
)
(addGoalToListOfWays (car outPut) (caddr outPut))
)
)
)
)
(defun addGoalToListOfWays (finalNode listOfWays)
(cond
(
(eq (car listOfWays) nil)
nil
)
(T
(cons
(append
(car listOfWays)
(cons finalNode nil)
)
(addGoalToListOfWays finalNode (cdr listOfWays))
)
)
)
)
 
(defun graphSearch (net start goal &optional listOfUnexploredNodes )
(cond
(
(eq start goal)
(createOuputMessage outPut)
)
(T
(graphSearch net
(car
(setq outPut (findNodeWithSmallestValue ;Функция находит вершусу с минимльным value и возвращает ее в виде (D 10 ((B C) (A F)) X)
;функция replaceValueAndListOfNodesIfNeeded вернет список вершин, среди которых находим вершину с минимальным value
(setq listOfUnexploredNodes (replaceValueAndListOfNodesIfNeeded ;1 аргемент - findDistanceToConnectedNodes
;findDistanceToConnectedNodes Вернет список вершин и расстояния до них. Далее нужно просмотреть этот список и список неиследованных вершин и где надо установить новое значение.
(findDistanceToConnectedNodes
net ;Первый входнйо параметр - исходная схема, для определения задержек при пересадках на станциях
;Второй входящий парамет - соединенные вершины
(findConnectedNodes net ;Находим связанные вершины с текущей
(cond
(
(eq listOfUnexploredNodes nil)
(car
(setq currentNode ;Получили текущую вершину в виде (A 0 (0) 0)
(car(extendResult (cons(append (cons start nil) `(0)) nil)
(setq unexploredNodes (createListOfUnxploredNodes net start))
)
)
)
)
)
(T
(car
(setq currentNode ;Получили текущую вершину в виде (A 0 (0) 0)
(car(extendResult (cons(append (cons start nil) `(0)) nil) listOfUnexploredNodes))
)
)
)
)
(car net)
(cond
( (eq listOfUnexploredNodes nil)
(setq listOfUnexploredNodes ;Сохраняем полученный списко в unexloredNodes
(deleteVisitedNode (setq unexploredNodes (createListOfUnxploredNodes net start)) ;deleteVisitedNode вернет список неисследованных вершин без модификации исходного
(car
currentNode
)
)
)
)
(T
(setq listOfUnexploredNodes ;Сохраняем полученный списко в unexloredNodes
(deleteVisitedNode listOfUnexploredNodes ;deleteVisitedNode вернет список неисследованных вершин без модификации исходного
(car
currentNode
)
)
)
)
)
 
)
currentNode ;Третий - текущая рассматриваемая вершина
)
;2ой - список непосещенных вершин
listOfUnexploredNodes
;3й - список вершин текущей вершины + имя текущей вершины
(createOutputListOfNodesForCurrentNode ;У текущей вершины B есть список вида: ((A E) (C D)), функция возвращает список вида ((A E B) (C D B))
;Если список вершщин у текущей вершины имеет вид: ((A E)), то функция вернет список ((A E B))
;Если список вершин у текущей вершины имеет вид: (0), то функция вернет ((B))
(car currentNode) ;1 аргумент имя вершины
(caddr currentNode) ;2 аргумент список вершин
)
)
)
)
)
)
goal
listOfUnexploredNodes
)
)
)
)
 
(defun findNodeWithSmallestValue (lisOfNodes &optional currentMin)
(cond
(
(eq (car lisOfNodes) nil)
currentMin
)
(
(eq currentMin nil)
(findNodeWithSmallestValue (cdr lisOfNodes)
(setq currentMin (car lisOfNodes))
)
)
(T
(findNodeWithSmallestValue (cdr lisOfNodes)
(minOfTwoNodes currentMin (car lisOfNodes))
)
)
)
)
 
(defun minOfTwoNodes (node1 node2)
(cond
(
(<
(cadr node1)
(cadr node2)
)
node1
)
(T
node2
)
)
)
 
(defun createOutputListOfNodesForCurrentNode (nodeName listOfNodeForCurrentNode)
(cond
(
(eq (car listOfNodeForCurrentNode) nil)
nil
)
(T
(cons
(cond
(
(eq(caar listOfNodeForCurrentNode) `0)
(cons
nodeName
nil
)
)
(T
(append
(car listOfNodeForCurrentNode)
(cons
nodeName
nil
)
)
)
)
(createOutputListOfNodesForCurrentNode nodeName (cdr listOfNodeForCurrentNode))
)
)
)
)
 
(defun replaceValueAndListOfNodesIfNeeded (listOfConnectedNode listOfUnexploredNodes listOfNodeToReplacePath)
;Тут имеем на месте listOfConnectedNode список вида: ((B 7) (D 14) ..)
;Находим в списке listOfUnexploredNodes вершину с похожим названием, например (D 1000 0 0)
;И если второй параметр (1000) > второго параметра 1ого списка (14), то заменяем 1000 на 14
;и заменяем список вершин от текущей вершины
;Формат listOfConnectedNode ((B 4) (D 7))
;Формат listOfUnexploredNodes ((B 1000 (0) 0) (C 1000 (0) 0) (D 1000 (0) 0) (E 1000 (0) 0))
(cond
(
(eq (car listOfUnexploredNodes) nil)
nil
)
(T
(cond
(
(eq(setq foundedNode (getConnectedNodeByCurrentUnxploredNode (caar listOfUnexploredNodes)
listOfConnectedNode
)
)
nil ;Если в соединенных вершинах, такой нет
)
(cons ;то оставляем текущую не исследованную вершину без изменения
(car listOfUnexploredNodes)
(replaceValueAndListOfNodesIfNeeded listOfConnectedNode (cdr listOfUnexploredNodes) listOfNodeToReplacePath)
)
)
(T ;Попадаем сюда, если нашли в списке listOfConnectedNode нужную вершину
(cond ;Сравниваем значение X из (D X) и Y из ((D Y 0 0))
(
(< ;Если X < Y, то заменяем Y на X и
(cadr foundedNode)
(cadar listOfUnexploredNodes)
)
(cons
(append
(append
(append
(cons
(car foundedNode) ;Имя вершины
nil
)
(cons
(cadr foundedNode) ;X
nil
)
)
(cons
listOfNodeToReplacePath
nil
)
 
)
(cdddar listOfUnexploredNodes)
)
(replaceValueAndListOfNodesIfNeeded (cdr listOfConnectedNode)
(cdr listOfUnexploredNodes)
listOfNodeToReplacePath
)
)
)
(
(= ;Если X = Y, то X не изменяем, а в список вершин добавляем listOfNodeToReplacePath, который в формате
;((A B C D) (A C E)..)
(cadr foundedNode)
(cadar listOfUnexploredNodes)
)
(cons
(append
(append
(append
(cons
(car foundedNode) ;Имя вершины
nil
)
(cons
(cadar listOfUnexploredNodes) ;X
nil
)
)
(cons
(append
(caddar listOfUnexploredNodes)
listOfNodeToReplacePath
 
)
nil
)
 
)
(cdddar listOfUnexploredNodes)
)
(replaceValueAndListOfNodesIfNeeded (cdr listOfConnectedNode)
(cdr listOfUnexploredNodes)
listOfNodeToReplacePath
)
)
)
(T
;Попадаем сюда, если X > Y, в этом случае оставляем все без изменения
(cons
(append
(append
(append
(cons
(caar listOfUnexploredNodes) ;Имя вершины
nil
)
(cons
(cadar listOfUnexploredNodes) ;X
nil
)
)
(cons
(caddar listOfUnexploredNodes)
nil
)
)
(cdddar listOfUnexploredNodes)
)
(replaceValueAndListOfNodesIfNeeded (cdr listOfConnectedNode)
(cdr listOfUnexploredNodes)
listOfNodeToReplacePath
)
)
)
)
)
)
)
)
)
(defun getConnectedNodeByCurrentUnxploredNode (nodeToSeach listOfNodes)
(cond
(
(eq (car listOfNodes) nil)
nil
)
(T
(cond
(
(eq (caar listOfNodes) nodeToSeach)
(car listOfNodes)
)
(T
(getConnectedNodeByCurrentUnxploredNode nodeToSeach (cdr listOfNodes))
)
)
)
)
)
 
(graphSearch net `A `G)
 
 
> 1 <


Онлайн :

0 пользователь(ей), 23 гость(ей) :