Консультация № 160125
10.02.2009, 19:34
0.00 руб.
0 0 0
Здравствуйте.
Подскажите, как можно переделать программу написанную на Pascal в XLisp

программа должна реализовывать Алгоритм Прима-Краскала (Жадный алгоритм) (код программы в приложении)

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

описание программы

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

Для такого входного файла
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.


Приложение:
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] < min) and (Color[i] <> 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.

Обсуждение

Форма ответа