紧急求助：关于Delphi 模拟退火算法

模拟退火算法：
procedure T_TSPSA_RUN;
const maxn=500;alpha=0.95;
type
  arr1=array of array of item;
  arr2=array of item;
var
  n,i,j,ii,jj,count,xx,yy,t,temp:item;
  datatype:byte;
  temperature,delta,t0,repetition,ratio:real;
  w:arr1;route,rtemp:arr2;x,y:array of real;function TWeight(route:arr2):item;
var
  k,s:item;
begin
  s:=0;
  for k:=1 to n-1 do
    s:=s+W[route[k],route[k+1]];
    s:=s+w[route[n],route[1]];
    tweight:=s;
end;begin
 AssignFile(f,FN);
 Reset(f);
 {$I-}Readln(f,n,datatype,count);{$I+}
 if(IOResult<>0)or(n<4)or(n>maxn)or(datatype<1)or(datatype>2)or(count<1)then
   begin
    ShowMessage('数据有错误！');
    System.Close(f); exit;
   end;
 t0:=count;
 SetLength(x,n+1,n+1);
 if datatype=1 then
   begin
    SetLength(x,n+1);
    SetLength(y,n+1);
    for i:=1 to n do
      begin
       {$I-}readln(f,ii,x[i],y[i]);{$I+}
       if (IOResult<>0)or(ii<>i) then
         begin ShowMessage('数据错误');
         System.Close(f);exit;
         end;
      end;
    for i:=1 to n-1 do
    for j:=i+1 to n do
      begin
       w[i,j]:=trunc(sqrt(sqr(x[i]-x[j])+sqr(y[i]-y[j]))+0.5);
       w[j,i]:=w[i,j];
      end;
    for i:=1 to n do
      w[i,j]:= inf;
    SetLength(x,0);
    SetLength(y,0);
 end
 else
 begin
   for i:=1 to n-1 do
   for j:=i+1 to n do
    begin
     {$I-}readln(f,ii,jj,w[i,j]);{$I+}
     if (IOResult<>0)or(ii<>i)or(jj<>j)or(w[i,j]<1)then
      begin ShowMessage('数据错误');
       System.Close(f); exit;
      end;
      w[j,i]:=w[i,j];
    end;
    for i:=1 to do n
     w[i,j]:=inf;
 end;
 SetLength(route,n+1);
 SetLength(rtemp,n+1);
 System.Close(f);
 FN:=Copy(FN,1,Length(FN)-4)+'.OUT';
 ShowMessage('输出结果存入文件:'+FN);
 AssignFile(f,FN);
 Rewrite(f);
 for i:=1 to n do
   route[i]:=i;
 writeln(f,'初始回路总长=',TWeight(route));
 repetition:=count;
 temperature:=t0;
 randomize;
 t:=0;
 repeat
   i:=0;
   repeat
     repeat
       xx:=random(n)+1;
       yy:=random(n)+1;
     until xx<>yy;
     for j:=1 to n do
      rtemp[j]:=route[j];
     temp:=rtemp[xx];
     rtemp[xx]:=rtemp[yy];
     rtemp[yy]:=temp;
     delta:=TWeight(rtemp)-TWeight(route);
     ratio:=-delta/temperature;
     if delta<0 then
      begin
       for j:=1 to n do
        route[j]:=rtemp[j];
      end
     else
     if abs(ratio)<ln(1/eps) then
       if random<exp(ratio) then
        begin
         for j:=1 to n do
           route[j]:=rtemp[j];
        end;
        i:=i+1;
     until i=repetition;
     t:=t+1;
     temperature:=exp(t*ln(alpha))*t0;
     until temperature<eps;
     writeln(f,'改进回路总长=',TWeight(route));
     write(f,'改进回路路径=');
     for i:=i to n do
       write(f,route[i],' ');
       writeln(f);
       System.Close(f);
   end;
有一个这样的文本文件：
1 6734 1453 
2 2233 10 
3 5530 1424 
4 401 841 
5 3082 1644 
6 7608 4458 
7 7573 3716 
8 7265 1268 
9 6898 1885 
10 1112 2049 
11 5468 2606 
12 5989 2873 
13 4706 2674 
14 4612 2035 
15 6347 2683 
16 6107 669 
17 7611 5184 
18 7462 3590 
19 7732 4723 
20 5900 3561 
21 4483 3369 
请问如何用这个算法处理这些数据，也就是把全部数据读进去，用这个算法统计出结果。我直接调用这个算法函数后就一直提示“数据有错误”

解决方案 »

  1.   

     if(IOResult <>0)or(n <4)or(n>maxn)or(datatype <1)or(datatype>2)or(count <1)
    这一句中  datatype>2这个条件导致的
      

  2.   

    Temp_DX ,可以说清楚一点吗？我还是想不明白呀
      

  3.   

    提示是"数据有错误"
     if(IOResult <>0)or(n <4)or(n>maxn)or(datatype <1)or(datatype>2)or(count <1)then 
       begin 
        ShowMessage('数据有错误！'); 
        System.Close(f); exit; 
       end; 
    说明这个条件成立了
    你输入的数据是
    1 6734 1453  
    2 2233 10  
    ……
    就第一行数据来说
    你输入的是n=2,datatype=6734,count=1453
    条件是而datatype>2  所以就ShowMessage('数据有错误！'); 
      

  4.   

    多谢Temp_DX兄，这个我明白了，可是我把datatype>2这个条件删去了，也调试不出结果。本人是菜鸟，郁闷呀，，
    这个算法是一本书里照抄的，我太菜了，有算法也不会运用。。唉
    有谁可以帮我看看如果运用这个算法先多谢大家了
      

  5.   

    procedure T_TSPSA_RUN;
    const maxn=500;alpha=0.95;
    type
      arr1=array of array of item;
      arr2=array of item;
    var
      n,i,j,ii,jj,count,xx,yy,t,temp:item;
      datatype:byte;
      temperature,delta,t0,repetition,ratio:real;
      w:arr1;route,rtemp:arr2;x,y:array of real;
      f:System.Text;
      FN:string;
      inf : integer;  //这变量定义原本没有的，只有我加了上去才能编译
    function TWeight(route:arr2):item;
    var
      k,s:item;
    begin
      s:=0;
      for k:=1 to n-1 do
        s:=s+W[route[k],route[k+1]];
        s:=s+w[route[n],route[1]];
        tweight:=s;
    end;begin
     AssignFile(f,FN);
     Reset(f);
     {$I-}Readln(f,n,datatype,count);{$I+}
     if(IOResult<>0)or(n<1)or(n>maxn)or(datatype<1)or(count<1)then
       begin
        ShowMessage('数据有错误！');
        System.Close(f); exit;
       end;
     t0:=count;
     SetLength(w,n+1,n+1);
     if datatype=1 then
       begin
        SetLength(x,n+1);
        SetLength(y,n+1);
        for i:=1 to n do
          begin
           {$I-}readln(f,ii,x[i],y[i]);{$I+}
           if (IOResult<>0)or(ii<>i) then
             begin ShowMessage('数据错误');
             System.Close(f);exit;
             end;
          end;
        for i:=1 to n-1 do
        for j:=i+1 to n do
          begin
           w[i,j]:=trunc(sqrt(sqr(x[i]-x[j])+sqr(y[i]-y[j]))+0.5);
           w[j,i]:=w[i,j];
          end;
        for i:=1 to n do
          w[i,j]:= inf;
        SetLength(x,0);
        SetLength(y,0);
     end
     else
     begin
       for i:=1 to n-1 do
       for j:=i+1 to n do
        begin
         {$I-}readln(f,ii,jj,w[i,j]);{$I+}
         if (IOResult<>0)or(ii<>i)or(jj<>j)or(w[i,j]<1)then
          begin
          ShowMessage('数据错误');
           System.Close(f); exit;
          end;
          w[j,i]:=w[i,j];
        end;
        for i:=1 to n do
         w[i,j]:=inf;
     end;
     SetLength(route,n+1);
     SetLength(rtemp,n+1);
     System.Close(f);
     FN:=Copy(FN,1,Length(FN)-4)+'.OUT';
     ShowMessage('输出结果存入文件:'+FN);
     AssignFile(f,FN);
     Rewrite(f);
     for i:=1 to n do
       route[i]:=i;
     writeln(f,'初始回路总长=',TWeight(route));
     repetition:=count;
     temperature:=t0;
     randomize;
     t:=0;
     repeat
       i:=0;
       repeat
         repeat
           xx:=random(n)+1;
           yy:=random(n)+1;
         until xx<>yy;
         for j:=1 to n do
          rtemp[j]:=route[j];
         temp:=rtemp[xx];
         rtemp[xx]:=rtemp[yy];
         rtemp[yy]:=temp;
         delta:=TWeight(rtemp)-TWeight(route);
         ratio:=-delta/temperature;
         if delta<0 then
          begin
           for j:=1 to n do
            route[j]:=rtemp[j];
          end
         else
         if abs(ratio)<ln(1/eps) then
           if random<exp(ratio) then
            begin
             for j:=1 to n do
               route[j]:=rtemp[j];
            end;
            i:=i+1;
         until i=repetition;
         t:=t+1;
         temperature:=exp(t*ln(alpha))*t0;
         until temperature<eps;
         writeln(f,'改进回路总长=',TWeight(route));
         write(f,'改进回路路径=');
         for i:=i to n do
           write(f,route[i],' ');
           writeln(f);
           System.Close(f);
       end;
    ==================
    有一个这样的文本文件： 
    1 1734 1453  
    2 2233 1150  
    3 2530 1424  
    4 4001 1841  
    5 3082 1644  
    6 7608 4458  
    7 3573 3716  
    8 3265 1268  
    9 2898 1885  
    10 1112 2049  
    11 5468 2606  
    12 5989 2873  
    13 4706 2674  
    14 4612 2035  
    15 3347 2683  
    16 4107 1669  
    17 3611 5184  
    18 1462 3590  
    19 1732 4723  
    20 4900 3561  
    21 4483 3369
    22 1189 1025
    23 2101 2250
    24 1023 1001
    25 3320 2140
      

  6.   

    Sorry，漏了item 和eps的定义
    var
      Form1: TForm1;
      const eps=1E-8;  //上面这个算法漏了两个eps和item的定义
      type item=integer;
    implementation
     {$R *.dfm}procedure T_TSPSA_RUN;
    const maxn=500;alpha=0.95;
    type
      arr1=array of array of item;
      arr2=array of item;
        
      

  7.   

    你的测试数据少了第一行
    N,DATATYPE,COUNT
    n表示有n行数据
    datatype 不是1就是2 所以才会有if(IOResult <>0)or(n <4)or(n>maxn)or(datatype <1)or(datatype>2)or(count <1)then 这个判断
    不需要去掉datatype>2
    count应该是温度
    你从哪看的算法再去看看  应该还有一行数据
      

  8.   

    procedure T_TSPSA_RUN; 
    const maxn=500;alpha=0.95; 
    type 
      arr1=array of array of item; 
      arr2=array of item; 
    var 
      n,i,j,ii,jj,count,xx,yy,t,temp:item; 
      datatype:byte; 
      temperature,delta,t0,repetition,ratio:real; 
      w:arr1;route,rtemp:arr2;x,y:array of real; 
      f:System.Text; 
      FN:string; 
      inf : integer;  //这变量定义原本没有的，只有我加了上去才能编译 
    //很有问题呀..function TWeight(route:arr2):item;
    k,s:item;begin 
      s:=0; 
      for k:=1 to n-1 do 
        s:=s+W[route[k],route[k+1]]; 
        s:=s+w[route[n],route[1]]; 
        tweight:=s; 
    end; begin 
     AssignFile(f,FN);  
     Reset(f); 
     {$I-}Readln(f,n,datatype,count);{$I+} 
     if(IOResult <>0)or(n <1)or(n>maxn)or(datatype <1)or(datatype>2)or(count <1)then 
       begin 
        ShowMessage('数据有错误！'); 
        System.Close(f); exit; 
       end; 
     t0:=count; 
     SetLength(w,n+1);    //又是一个手误...
     if datatype=1 then 
       begin 
        SetLength(x,n+1); 
        SetLength(y,n+1); 
        for i:=1 to n do 
          begin 
           {$I-}readln(f,ii,x[i],y[i]);{$I+} 
           if (IOResult <>0)or(ii <>i) then 
             begin ShowMessage('数据错误'); 
             System.Close(f);exit; 
             end; 
          end; 
        for i:=1 to n-1 do 
        for j:=i+1 to n do 
          begin 
           w[i,j]:=trunc(sqrt(sqr(x[i]-x[j])+sqr(y[i]-y[j]))+0.5); 
           w[j,i]:=w[i,j]; 
          end; 
        for i:=1 to n do 
          w[i,j]:= inf;    //这里应该是w[i,i]
    这个赋值非常不理解,因为inf并没有赋值,如果按照你加的定义inf:integer的话,那就只是默认的0
        SetLength(x,0); 
        SetLength(y,0); 
     end 
     else 
     begin 
       for i:=1 to n-1 do 
       for j:=i+1 to n do 
        begin 
         {$I-}readln(f,ii,jj,w[i,j]);{$I+} 
         if (IOResult <>0)or(ii <>i)or(jj <>j)or(w[i,j] <1)then 
          begin 
          ShowMessage('数据错误'); 
           System.Close(f); exit; 
          end; 
          w[j,i]:=w[i,j]; 
        end; 
        for i:=1 to n do 
         w[i,j]:=inf;     //w[i,i] 同上
     end; 
     SetLength(route,n+1); 
     SetLength(rtemp,n+1); 
     System.Close(f); 
     FN:=Copy(FN,1,Length(FN)-4)+'.OUT'; 
     ShowMessage('输出结果存入文件:'+FN); 
     AssignFile(f,FN); 
     Rewrite(f); 
     for i:=1 to n do 
       route[i]:=i; 
     writeln(f,'初始回路总长=',TWeight(route)); 
     repetition:=count; 
     temperature:=t0; 
     randomize; 
     t:=0; 
     repeat 
       i:=0; 
       repeat 
         repeat 
           xx:=random(n)+1; 
           yy:=random(n)+1; 
         until xx <>yy; 
         for j:=1 to n do 
          rtemp[j]:=route[j]; 
         temp:=rtemp[xx]; 
         rtemp[xx]:=rtemp[yy]; 
         rtemp[yy]:=temp; 
         delta:=TWeight(rtemp)-TWeight(route); 
         ratio:=-delta/temperature; 
         if delta <0 then 
          begin 
           for j:=1 to n do 
            route[j]:=rtemp[j]; 
          end 
         else 
         if abs(ratio) <ln(1/eps) then 
           if random <exp(ratio) then 
            begin 
             for j:=1 to n do 
               route[j]:=rtemp[j]; 
            end; 
            i:=i+1; 
         until i=repetition; 
         t:=t+1; 
         temperature:=exp(t*ln(alpha))*t0; 
         until temperature <eps; 
         writeln(f,'改进回路总长=',TWeight(route)); 
         write(f,'改进回路路径='); 
         for i:=1 to n do   //这里应该是从1 to n吧..
           write(f,route[i],' '); 
           writeln(f); 
           System.Close(f); 
       end; 
    ================== 
    有一个这样的文本文件：  //第一行是我随意加的
    25 1 500  
    1 1734 1453   
    2 2233 1150   
    3 2530 1424   
    4 4001 1841   
    5 3082 1644   
    6 7608 4458   
    7 3573 3716   
    8 3265 1268   
    9 2898 1885   
    10 1112 2049   
    11 5468 2606   
    12 5989 2873   
    13 4706 2674   
    14 4612 2035   
    15 3347 2683   
    16 4107 1669   
    17 3611 5184   
    18 1462 3590   
    19 1732 4723   
    20 4900 3561   
    21 4483 3369 
    22 1189 1025 
    23 2101 2250 
    24 1023 1001 
    25 3320 2140 
      

  9.   

    好，在这里10000分感激Temp_DX 的热心帮助。偶好感动！！！。。我待会考试回来再测试一下算法
      

  10.   

    嘿嘿 看错了
    SetLength(w,n+1,n+1); //保持原样 
      

  11.   

    打错了，应该不能运行。。出现提示：invalid pointer operation..
      

  12.   

    Temp_DX兄，你调试的时候能正常运行吗？有没有得出运算结果？
      

  13.   

    全部发上来好了..
    program Project1;{$APPTYPE CONSOLE}uses
      SysUtils,
      Dialogs;const
      maxn=500;alpha=0.95;
      eps=1E-8;
    type
      item=integer;
      arr1=array of array of item;
      arr2=array of item;  
    var
      n,i,j,ii,jj,count,xx,yy,t,temp:item;  
      datatype:byte;  
      temperature,delta,t0,repetition,ratio:real;  
      w:arr1;route,rtemp:arr2;x,y:array of real;  
      f:System.Text;  
      FN:string;  
      inf : integer;  //这变量定义原本没有的，只有我加了上去才能编译  
    //很有问题呀.. function TWeight(route:arr2):item;
    var
    k,s:item; begin  
      s:=0;  
      for k:=1 to n-1 do  
        s:=s+W[route[k],route[k+1]];  
        s:=s+w[route[n],route[1]];  
        tweight:=s;  
    end;
    begin
     readln(FN);   //输入文件的地址 例：d:\1.txt
     AssignFile(f,FN);   
     Reset(f);
     {$I-}Readln(f,n,datatype,count);{$I+}  
     if(IOResult  <>0)or(n  <1)or(n>maxn)or(datatype  <1)or(datatype>2)or(count  <1)then  
       begin  
        ShowMessage('数据有错误！');  
        System.Close(f); exit;  
       end;
     t0:=count;
     SetLength(w,n+1,n+1);   
     if datatype=1 then  
       begin  
        SetLength(x,n+1);  
        SetLength(y,n+1);  
        for i:=1 to n do  
          begin  
           {$I-}readln(f,ii,x[i],y[i]);{$I+}  
           if (IOResult  <>0)or(ii  <>i) then  
             begin ShowMessage('数据错误');  
             System.Close(f);exit;  
             end;  
          end;  
        for i:=1 to n-1 do  
        for j:=i+1 to n do  
          begin  
           w[i,j]:=trunc(sqrt(sqr(x[i]-x[j])+sqr(y[i]-y[j]))+0.5);
           w[j,i]:=w[i,j];
          end;  
        for i:=1 to n do  
          w[i,i]:= inf;    //这里应该是w[i,i]
    //这个赋值非常不理解,因为inf并没有赋值,如果按照你加的定义inf:integer的话,那就只是默认的0
        SetLength(x,0);  
        SetLength(y,0);  
     end  
     else  
     begin  
       for i:=1 to n-1 do  
       for j:=i+1 to n do  
        begin  
         {$I-}readln(f,ii,jj,w[i,j]);{$I+}  
         if (IOResult  <>0)or(ii  <>i)or(jj  <>j)or(w[i,j]  <1)then  
          begin  
          ShowMessage('数据错误');  
           System.Close(f); exit;  
          end;  
          w[j,i]:=w[i,j];  
        end;  
        for i:=1 to n do  
         w[i,i]:=inf;     //w[i,i] 同上
     end;  
     SetLength(route,n+1);  
     SetLength(rtemp,n+1);  
     System.Close(f);  
     FN:=Copy(FN,1,Length(FN)-4)+'.OUT';  
     ShowMessage('输出结果存入文件:'+FN);
     AssignFile(f,FN);
     Rewrite(f);
     for i:=1 to n do
       route[i]:=i;  
     writeln(f,'初始回路总长=',TWeight(route));  
     repetition:=count;  
     temperature:=t0;  
     randomize;  
     t:=0;  
     repeat  
       i:=0;  
       repeat  
         repeat  
           xx:=random(n)+1;  
           yy:=random(n)+1;  
         until xx  <>yy;  
         for j:=1 to n do  
          rtemp[j]:=route[j];  
         temp:=rtemp[xx];  
         rtemp[xx]:=rtemp[yy];  
         rtemp[yy]:=temp;  
         delta:=TWeight(rtemp)-TWeight(route);  
         ratio:=-delta/temperature;  
         if delta  <0 then  
          begin  
           for j:=1 to n do  
            route[j]:=rtemp[j];  
          end  
         else  
         if abs(ratio)  <ln(1/eps) then  
           if random  <exp(ratio) then  
            begin  
             for j:=1 to n do  
               route[j]:=rtemp[j];  
            end;  
            i:=i+1;  
         until i=repetition;  
         t:=t+1;  
         temperature:=exp(t*ln(alpha))*t0;  
         until temperature  <eps;  
         writeln(f,'改进回路总长=',TWeight(route));  
         write(f,'改进回路路径=');  
         for i:=1 to n do   //这里应该是从1 to n吧.. 
           write(f,route[i],' ');  
           writeln(f);  
           System.Close(f);
    end.
      

  14.   

    晕，大哥，我不明白你的修改？
    FN:='f:\123\1.txt' //我现在加上初始化变量
    readln(FN);   //输入文件的地址 例：d:\1.txt//原代码是w[i,j]:=inf,你说这里应该是w[i,i]，于是我改成w[i,j]:=w[i,i]
    //但你发过来的代码却是w[i,i]=inf,你说inf没有赋值，默认是0，
    //我不明白你的修法问题一：FN:='f:\123\1.txt'; 我在readln(FN);前加上这句应该没错吧
    问题二：w[i,j]:=inf 这一句如何改？inf这个变量还要不要？
    问题三： for i:=1 to n do   //这里应该是从1 to n吧.. 这一句循环是不是这样修
      

  15.   

    问题一：FN:='f:\123\1.txt'; 我在readln(FN);前加上这句应该没错吧  
    如果你加上FN:='f:\123\1.txt';就没必要readln(FN);我加上readln(FN);只是用于手动输入文本路径; 问题二：w[i,j]:=inf 这一句如何改？inf这个变量还要不要？  
    你说原文是w[i,j]:=inf; 因为inf没有定义,只是初始为0,所以我认为inf有问题. 
    另外w[i,j]中的j在之前循环过后就没再定义,而之前储存数据的时候,整个二维数组中惟独留下了w[i,i]这一个对角线没有储存,所以我认为这里应该是w[i,i]:=inf;     问题三： for i:=1 to n do   //这里应该是从1 to n吧.. 这一句循环是不是这样修 
    这个是的 
      

  16.   

    Temp_DX 大哥。真的太牛了。。我服了。跟你意思，程序成功了。。看来自己的能力。特别是数学能力，要有待加强