Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=264141&view=findpost&p=2189206 Fri, 06 Feb 2009 17:49:11 +0000 из Pascal в XLisp https://forum.sources.ru/index.php?showtopic=264141&view=findpost&p=2189206
Матрицу можно хранить в виде списка
( (1 2 23) (1 3 12) (2 3 25) (2 5 22) (2 8 35) (3 4 18) (4 6 20) и т.д.)
а вот как вводить...]]> amk Lisp https://forum.sources.ru/index.php?showtopic=264141&view=findpost&p=2189145 Fri, 06 Feb 2009 15:44:38 +0000 из Pascal в XLisp https://forum.sources.ru/index.php?showtopic=264141&view=findpost&p=2189145
алгоритм я то понимаю(примерно :) ), и возможно сделал бы данную задачку на процедурном языке, но на функциональном, я не совсем понимаю как это сделать...
массивы заменить списками, циклы - рекурсией(хз как), как вводить матрицу растояний.
вообщем, я в ступоре...
:huh:]]> Stari Lisp https://forum.sources.ru/index.php?showtopic=264141&view=findpost&p=2189089 Fri, 06 Feb 2009 14:26:04 +0000 из Pascal в XLisp https://forum.sources.ru/index.php?showtopic=264141&view=findpost&p=2189089
Насколько я понял из приведенного текста, это жадный алгоритм, который строит минимальное остовное дерево, соединяющее все точки.
Там ошибка в функции Findmin в условии If, д.б.
    If (Matrix[i,j] < min) and (Color[i] <> Color[j]) then


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

цикл продолжается, пока не будут соединены все точки (проходов на один меньше, чем число точек).

Куски дерева можно отслеживать и другими способами (использованный здесь не самый эффективный).

Это сжатое изложение алгоритма, не знаю, пригодится ли.
С лиспом (Common LISP, кажется) не работал уже слишком давно, а что такое xlisp даже не знаю.]]> amk Lisp https://forum.sources.ru/index.php?showtopic=264141&view=findpost&p=2187601 Wed, 04 Feb 2009 16:47:12 +0000 из Pascal в XLisp https://forum.sources.ru/index.php?showtopic=264141&view=findpost&p=2187601
Возникла необходимость реализовать на xlisp программу реализующюю решение алгоритма Прима–Краскала

У меня есть исходник программы на паскале, но так как познания лиспа ограничиваются решением нескольких задач, данная задача мне затруднительна

Я не прошу у вас готового решения(хотя если есть возможность его сделать, то пожалуйста ;) ), а прошу подсказать,как это реализовывать, принципы программирования абсолютно разные, может проще новую написать, а может и паскалевскую переделать возможно

вот задача на паскале

Для реализации алгоритма понадобятся:
Matrix – матрица расстояний, значение пересечении i-ой строки и j-го
столбца равно расстоянию между i-ой и j-ой вершинами. Если такого ребра
нет то значение равно Infinity – просто большому числу (машинная
бесконечность);
Color – массив цветов вершин;
Ribs – в этом массиве запоминаются найденные ребра;
a, b – вершины, соединяемые очередным минимальным ребром
len – длина дерева.
Матрицу расстояний будем хранить в текстовом файле INPUT.MTR, где число на
первой строке – количество вершин n, а остальные n строк по n чисел в
каждой – матрица расстояний. Если расстояние равно 1000 (Infinity), то
такого ребра нет.

Program Algorithm_PrimaKrascala;
Uses Crt;
Const MaxSize =100;
Infinity =1000;
Var Matrix: array[1..MaxSize, 1..MaxSize] of integer;
Color: array[1..MaxSize] of integer;
Ribs: array[1..MaxSize] of record
a, b: integer;
end;
n, a, b, k, col, i, len: integer;

Procedure Init;
Var f: text;
i, j: integer;
Begin
Assign(f, 'INPUT.MTR');
Reset(f);
Readln(f, n);
For i:=1 to n do
Begin
For j:=1 to n do read(f, matrix[i, j]);
Readln(f)
End;
For i:=1 to n do color[i]:=i;
len:=0
End;

Procedure Findmin(var a, b: integer);
Var min, i, j: integer;
Begin
min:=infinity;
For i:=1 to n-1 do
For j:=i+1 to n do
If (Matrix[i, j]color[j]) then
Begin
min:=Matrix[i, j];
a:=i;
b:=j
End;
len:=len+min
end;

Begin
Clrscr;
Init;
For k:=1 to n-1 do
Begin
Findmin(a, b);
Ribs[k].a:=a;
Ribs[k].b:=b;
col:=Color[b];
For i:=1 to n do
If color[i]=col then color[i]:=color[a];
End;
For i:=1 to n-1 do
Writeln(ribs[i].a, ' –', ribs[i].b);
Writeln('Length= ', len);
Readkey
End.

Для такого входного файла
8
0 23 12 1000 1000 1000 1000 1000
23 0 25 1000 22 1000 1000 35
12 25 0 18 1000 1000 1000 1000
1000 1000 18 0 1000 20 1000 1000
1000 22 1000 1000 0 23 14 1000
1000 1000 1000 20 23 0 24 1000
1000 1000 1000 1000 14 24 0 16
1000 35 1000 1000 1000 1000 16 0
программа напечатает:
1–3
5–7
7–8
3–4
4–6
2–5
1–2
Length= 125.
]]> Stari Lisp