| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 610 人关注过本帖
标题:关于用delphi 写的蚁群算法的问题
只看楼主 加入收藏
liyuanyh
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2011-11-1
收藏
 问题点数:0 回复次数:2 
关于用delphi 写的蚁群算法的问题
我以前没接触过Delphi,连基本的布局都不知道是否正确,我不知道要再什么环境下运行,希望大家指点,只要能正确运行就可以!谢谢!
program VRPTW;
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

  const inf = 99999999; eps = 1E-8;
  type item = integer;
  var FN:string; f:System.Text;

  procedure T_VRPTW_ANT_RUN;
  const maxn = 500;ruo = 0.7; Q=10;
  label loop;
  type item2 = real;
       arr1 = array of array of item;
       arr2 = array of array of item2;
       arr3 = array of boolean;
       arr4 = array of item;
       arr5 = array of item2;
  var n,i,j,k,l,ii,jj,count,s,maxcount,tweight,index,model,
      qq,capa,m,last,selected,tm,weight:item;
      tmax,tmin:item2;
      datatype:byte;
      w,route,opt,cycle:arr1;
      t,dt:arr2;
      ch:arr3;
      x,y:arr5;
      len,tlen,nearest,series,demand,kcount,tkcount:arr4;


//求得转移概率P 的功能函数
  function PValue(i,j,k:item):item2;
  var l:item;
      sum:item2;
  begin
    sum:=0;
    for l:=2 to n do
      if(capa >= demand[l]) and (ch[l]) and (cycle[k,l] = 0) and(l <> i) then
        sum:=sum + t[i,j]/w[i,l];
      if(sum > eps) and (cycle[k,j] = 0) and (j <> i) then
        sum:=t[i,j]/w[i,j]/sum;
      PValue:=sum;
  end;


  //利用2-opt的方法进行局部优化
procedure TwoOpt(p:item);
  var ahead,i,i1,i2,index,j,j1,j2,last,limit,max,next,s1,s2,t1,t2,maxtemp:item;
      pt:arr4;
  begin
    SetLength(pt,n+1);
    t1:=1;
    t2:=1;
    s1:=1;
    s2:=1;
    for i:=1 to p-1 do
      pt[route[k,i]]:=route[k,i+1];
      pt[route[k,p]]:=route[k,l];
    repeat
      maxtemp:=0;
      i1:=1;
      for i:=1 to p-2 do
        begin  //1
          if i=1 then limit:=p-1
          else limit:=p;
          i2:=pt[i1];
          j1:=pt[i2];
          for j:=i+2 to limit do
            begin  //2
              j2:=pt[j1];
              max:=w[i1,i2]+w[j1,j2]-(w[i1,i2]+w[i2,j2]);
              if(max > maxtemp) then
                begin//3
                  s1:=i1;
                  s2:=i2;
                  t1:=j1;
                  t2:=j2;
                  maxtemp:=max;
                end;    //3
                j1:=j2;
            end;//2
            i1:=i2;
        end;//1
        if(maxtemp > 0) then
        Begin//1
          pt[s1]:=t1;
          next:=s2;
          last:=t2;
          repeat
            ahead:=pt[next];
            pt[next]:=last;
            last:=next;
            next:=ahead;
          until next=t2;
        end;//1
    until(maxtemp=0);
    index:=1;
    for i:=1 to p do
      begin
        route[k,i]:=index;
        index:=pt[index];
      end;
  end;

   //蚂蚁移动的程序
  procedure AntMove;
  label lop,select,check,next;
  var a,j,k:item;
  begin
    k:=1;
    capa:=qq;
    last:=n-1;
    for j:=1 to last do
      series[j]:=j+1;
    for j:=1 to last do
      ch[j]:=true;
    for j:=1 to last do
      kcount[j]:=0;

    //lop标签
    lop:
      nearest[k]:=1;
      for j:=1 to n do
        cycle[k,j]:=0;

     //select标签
      select:
        a:=nearest[k];
        j:=1;
        while j<last do
          begin
            index:=0;
            selected:=random(last) + 1;
            if(capa >= demand[series[selected]]) then
              begin
                index:=series[selected];
                if(random < PValue(a,index,k)) then goto check;
                index:=series[selected];
              end;
              j:=j + 1;
          end;
          if index=0 then goto next;

        //check标签
        check:
          cycle[k,nearest[k]]:=index;
          nearest[k]:=cycle[k,nearest[k]];
          ch[index]:=false;
          capa:=capa-demand[index];
          kcount[k]:=kcount[k]+1;
          last:=last-1;
          for j:=selected to last do
            series[j]:=series[j+1];
          if last >= 1 then goto select;

          //next标签
          next:
            if last >= 1 then
              begin
                k:=k+1;
                capa:=qq;
                goto lop;
              end;
              m := k;
  end;

  begin
    AssignFile(f,FN);
    Reset(f);
    {$I-}Readln(f,n,datatype,qq,maxcount);{$I+}
    if(IOResult<>0) or (n<4) or (n>maxn) or (maxcount < 1) or (datatype < 1)
        or(datatype > 2) or (qq <= 0 ) then
        begin
          ShowMessage('数据错误!');
          System.Close(f);
          exit;
        end;

    SetLength(t,n+1,n+1);
    SetLength(dt,n+1,n+1);
    SetLength(w,n+1,n+1);
    SetLength(opt,n+1,n+1);
    SetLength(route,n+1,n+1);
    SetLength(cycle,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];
                t[i,j]:=1;
                dt[i,j]:=0;
                t[j,i]:=t[i,j];
                dt[j,i]:=dt[i,j];
              end;

          for i:=1 to n do
            begin
              w[i,i]:=inf;
              t[i,i]:=1;
              dt[i,i]:=0;
            end;

          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];
                t[i,j]:=1;
                dt[i,j]:=0;
                t[j,i]:=t[i,j];
                dt[j,i]:=dt[i,j];
              end;
              for i:=1 to n do
                begin
                  w[i,i]:=inf;
                  t[i,i]:=1;
                  dt[i,i]:=0;
                end;
        end;

        SetLength(len,n+1);
        SetLength(tlen,n+1);
        SetLength(series,n+1);
        SetLength(nearest,n+1);
        SetLength(tkcount,n+1);
        SetLength(demand,n+1);
        SetLength(kcount,n+1);
        SetLength(ch,n+1);
        demand[1]:=0;
        for i:=2 to n do
        Begin
          {$I-}Readln(f,ii,demand[i]);{$I+}
          if(IOResult<>0) or (ii<>i) or (demand[i]>qq) or (demand[i]<0) then
            begin
              ShowMessage('数据错误!');
              System.Close(f);
              exit;
            end;
        end;
        System.Close(f);
        FN:=Copy(FN,1,Length(FN)-4)+'.OUT';
        ShowMessage('输出结果存入文件:'+FN);
        AssignFile(f,FN);
        Rewrite(f);
        count:=0;
        tweight:=inf;
        index:=1;
        tm:=inf;
        randomize;
        model:=random(3)+1;

      loop:
        AntMove;
        weight:=0;
        for k:=1 to m do
          len[k]:=0;
        for k:=1 to m do
          begin
            index:=1;
            for i:=1 to kcount[k]+1 do
              begin
                route[k,i]:=index;
                index:=cycle[k,index];
              end;
              TwoOpt(kcount[k]+1);
              len[k]:=w[route[k,kcount[k]+1],route[k,1]];
              for i:=1 to kcount[k] do
                len[k]:=len[k]+w[route[k,i],route[k,i+1]];
              weight:=weight+len[k];
          end;

          if m<tm then
            begin
              tm:=m;
              tweight:=weight;
              for k:=1 to tm do
                begin
                  tkcount[k]:=kcount[k];
                  for j:=1 to tkcount[k]+1 do
                    opt[k,j]:=route[k,j];
                  tlen[k]:=len[k];
                end;
            end;

          if m=tm then
            if tweight>weight then
              begin
                tweight:=weight;
                for k:=1 to tm do
                  begin
                    tkcount[k]:=kcount[k];
                    for j:=1 to tkcount[k]+1 do
                      opt[k,j]:=route[k,j];
                      tlen[k]:=len[k];
                  end;
              end;
          //蚁周、蚁密、蚁量三种模型
          for k:=1 to m do
            begin
              case model of
              1:begin
                for l:=1 to kcount[k] do
                  begin
                    ii:=route[k,l];
                    jj:=route[k,l+1];
                    dt[ii,jj]:=dt[ii,jj]+q/len[k];
                  end;
                ii:=route[k,kcount[k]+1];
                jj:=route[k,l];
                dt[ii,jj]:=dt[ii,jj]+q/len[k];
                end;

              2:begin
                for l:=1 to kcount[k] do
                  begin
                    ii:=route[k,l];
                    jj:=route[k,l+1];
                    dt[ii,jj]:=dt[ii,jj]+q;
                  end;
                ii:=route[k,kcount[k]+1];
                jj:=route[k,l];
                dt[ii,jj]:=dt[ii,jj]+q;
                end;

               3:begin
                for l:=1 to kcount[k] do
                  begin
                    ii:=route[k,l];
                    jj:=route[k,l+1];
                    dt[ii,jj]:=dt[ii,jj]+q/w[ii,jj];
                  end;
                ii:=route[k,kcount[k]+1];
                jj:=route[k,l];
                dt[ii,jj]:=dt[ii,jj]+q/w[ii,jj];
                end;
            end;
  end;
  for i:=1 to n do
    for j:=1 to n do
      begin
        t[i,j]:=ruo*t[i,j]+dt[i,j];
        tmax:=1/(tweight*(1-ruo));
        tmin:=tmax/5;
        if(t[i,j]>tmax) then
          t[i,j]:=tmax;
        if(t[i,j]<tmin) then
          t[i,j]:=tmin;
      end;
  count:=count+1;
  for i:=1 to n do
    for j:=1 to n do
      dt[i,j]:=0;
  if count<maxcount then goto loop;
  for k:=1 to tm do
    begin
      writeln(f);
      writeln(f,'第',k,'条路线:');
      writeln(f,'回路总长=',tlen[k]);
      write(f,'回路路径=');
      for j:=1 to tkcount[k]+1 do
        write(f,opt[k,j],'');
        writeln(f,'1');
    end;
  writeln(f);
  writeln(f,'所需车辆数=',tm);
  writeln(f);
  writeln(f,'车辆总行程=',tweight);
  System.Close(f);
end.
搜索更多相关主题的帖子: eps procedure Windows 
2011-11-02 21:09
liyuanyh
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2011-11-1
收藏
得分:0 
大家快帮忙啊
2011-11-02 21:24
suiliwen
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2012-1-7
收藏
得分:0 
需要能力
2012-01-07 19:44
快速回复:关于用delphi 写的蚁群算法的问题
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.021445 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved