Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 31.05.2009, 21:59   #1
ZVEREV
 
Аватар для ZVEREV
 
Регистрация: 19.01.2009
Сообщений: 3
По умолчанию задача коммивояжера

написал программу решения задачи коммивояжера методом ветвей и границ, посмотрите кто нибудь, правильно ли?


Uses CRT;

Const FileName = 'Kommi1.tab';
N = 7;

Type My = Array [1..N] Of Byte;

Var P : My;
F : Text;
A,R : Array [1..N,1..N] of Word;
I,J,Pb,Max : Byte;
code,Sum : Word;
S,Ts : String;

Procedure Path(M:My);
Var I,J : Byte;
S : Word;
Begin
S := 0;
For I := 1 To N-1 Do S := S + A[M[I],M[I+1]];
S := S + A[M[N],M[1]];
If S <= Sum Then Begin
For J := 1 To N Do R[J,Max] := M[J];
Sum := S;
Inc(Max);
End;
End;

Procedure Reverse(K:Byte);
Var J,I,Temp : Byte;
Begin
J := 1;
While J < K Do Begin
Temp := P[J];
P[J] := P[K];
P[K] := Temp;
J := J + 1;
K := K - 1;
End;
End;

Procedure PerestArray(M:Byte);
Var I,Temp : Byte;
Begin
If M = 1 Then Path(P)
Else For I := 1 To M Do Begin
PerestArray(M-1);
If I < M Then Begin
Temp := P[I];
P[I] := P[M];
P[M] := Temp;
Reverse(M-1);
End;
End;
End;

Function Summ:Integer;
Var I : Byte;
T : Integer;
Begin
T := 0;
For I := 1 To N Do Begin
T := T + A[I,P[I]];
End;
Summ := T;
End;

Begin
ClrScr;

Assign(F,FileName);
Reset(F);
For I := 1 To N Do Begin
ReadLn(F,S);
J := 1;
While Pos(' ',S) <> 0 Do Begin
Pb := Pos(' ',S);
Ts := Copy(S,1,Pb-1);
Val(Ts, A[I,J], code);
Delete(S,1,Pb);
Inc(J);
End;
Val(S, A[I,J], code);
End;
Close(F);

WriteLn;
For I := 1 To N Do Begin
For J := 1 To N Do Write(A[I,J]:3);
WriteLn;
End;

WriteLn;
WriteLn('Ќ*©¤Ґ*л б«Ґ¤гойЁҐ ў*аЁ**вл:');

For I:=1 To N Do P[I]:=I;
Max := 0;
Sum := Maxint;
PerestArray(N);

For I:=1 To Max Do Begin
For J := 1 To N Do Write(R[J,I]:3);
WriteLn(Sum:5);
End;
WriteLn;
End.
ZVEREV вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Задача коммивояжера Detka Общие вопросы Delphi 5 30.07.2008 15:47
Задача коммивояжера в Excel Lioness Microsoft Office Excel 3 14.01.2008 11:48
Задача коммивояжера Mihanya Помощь студентам 3 16.12.2007 17:31
HELP! задача Коммивояжера Roman Паскаль, Turbo Pascal, PascalABC.NET 3 28.01.2007 11:27