24小时热门版块排行榜    

查看: 2115  |  回复: 16

dingd

铁杆木虫 (职业作家)

【答案】应助回帖

代码中有“M[1,i,2]/abs(M[1,i,2])”,而M[1,i,2]有被赋值为0的时候(注意yy数组中有0项),这样会导致被0除的错误。
11楼2012-03-26 15:14:45
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

wdxiao

银虫 (正式写手)

将程序修改了一下,精简了一些。

Title "surf";
Parameters a[1,4], b[1,4],theta[0,pi/2],phi[-pi/8,pi/8];
Minimum;
StartProgram;
const xx: array[1..24] of double
        =(0.703,1.698,1.698,0.703,-0.703,-1.698,-1.698,-0.703,1.246,3.008,3.008,1.246,-1.246,
        -3.008,-3.008,-1.246,0,-2.926,-4.138,-2.926,0,2.926,4.138,2.926);
      yy: array[1..24] of double
        =(1.698,0.703,-0.703,-1.698,-1.698,-0.703,0.703,1.698,3.008,1.246,-1.246,-3.008,-3.008,
        -1.246,1.246,3.008,4.138,2.926,0,-2.926,-4.138,-2.926,0,2.926);
var i,j: Integer;
    Etot,r,angle,out1,out2,out3: double;
    Ax,Ay,Ar,Ae,Bx,By,Br,Be,dist,rou: double;
    M: array[1..3,1..24,1..4] of double;
Begin
for j:=1 to 24 do
    begin
        M[1,j,1]:=xx[j];  //这里xx【j】的方括号应该是英文,不知为啥小木虫自动删除了
        M[1,j,2]:=yy[j];
    end;
for i:=1 to 8 do
    for j:=1 to 3 do
      begin
         M[j,i,3]:= 1.9;
         M[j,i,4]:= 0.044;
         M[j,i+8,3]:= 1.9;
         M[j,i+8,4]:= 0.044;
         M[j,i+16,3]:= 2.11;
         M[j,i+16,4]:= 0.202;
       end;
for i:=1 to 24 do
  begin
     r:=sqrt(M[1,i,1]*M[1,i,1]+M[1,i,2]*M[1,i,2]);
     if M[1,i,1]>=0 then
          angle:=arcsin(M[1,i,2]/r)
       else
          angle:= (M[1,i,2]/abs(M[1,i,2]))*(pi-abs(arcsin(M[1,i,2]/r)));
          angle:=angle+phi;
          M[1,i,1]:=r*cos(angle);
          M[1,i,2]:=r*sin(angle);
     M[2,i,1]:=M[1,i,1]+b;
     M[3,i,1]:=M[1,i,1]+a*cos(theta);
     M[3,i,2]:=M[1,i,2]+a*sin(theta);
  end;
Etot:=0;
for i:=1 to 24 do
    for j:=1 to 24 do
       begin
            Ax:=M[1,i,1];
            Ay:=M[1,i,2];
            Ar:=M[1,i,3];
            Ae:=M[1,i,4];
            Bx:=M[2,j,1];
            By:=M[2,j,2];
            Br:=M[2,j,3];
            Be:=M[2,j,4];
            dist:=sqrt((Ax-Bx)*(Ax-Bx)+(Ay-By)*(Ay-By));
            rou:=dist/(Ar+Br);
            if dist>3.311 then
                out1:= sqrt(Ae*Be)*(290000*exp(-12.5*rou)-2.25/exp(6*ln(rou)))
              else
                out1:= 336.176*sqrt(Ae*Be)/(rou*rou);
            Bx:=M[3,j,1];
            By:=M[3,j,2];
            Br:=M[3,j,3];
            Be:=M[3,j,4];
            dist:=sqrt((Ax-Bx)*(Ax-Bx)+(Ay-By)*(Ay-By));
            rou:=dist/(Ar+Br);
            if dist>3.311 then
                out2:= sqrt(Ae*Be)*(290000*exp(-12.5*rou)-2.25/exp(6*ln(rou)))
              else
                out2:= 336.176*sqrt(Ae*Be)/(rou*rou);
            Ax:=M[2,i,1];
            Ay:=M[2,i,2];
            Ar:=M[2,i,3];
            Ae:=M[2,i,4];
            dist:=sqrt((Ax-Bx)*(Ax-Bx)+(Ay-By)*(Ay-By));
            rou:=dist/(Ar+Br);
            if dist>3.311 then
                out3:= sqrt(Ae*Be)*(290000*exp(-12.5*rou)-2.25/exp(6*ln(rou)))
              else
                out3:= 336.176*sqrt(Ae*Be)/(rou*rou);
           Etot:=out1+out2+out3+Etot;
        end;
FunctionResult:= Etot;
End;
EndProgram;
12楼2012-03-26 15:25:14
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

wdxiao

银虫 (正式写手)

引用回帖:
11楼: Originally posted by dingd at 2012-03-26 15:14:45:
代码中有“M/abs(M)”,而M有被赋值为0的时候(注意yy数组中有0项),这样会导致被0除的错误。

谢谢!
这的确是个问题。

我做了相应的修改,如下:

for i:=1 to 24 do
  begin
     r:=sqrt(M[1,i,1]*M[1,i,1]+M[1,i,2]*M[1,i,2]);
     if M[1,i,1]>=0 then
          angle:=arcsin(M[1,i,2]/r)
       else
           if M[1,i,2]>=0 then
                angle:= pi-abs(arcsin(M[1,i,2]/r))
             else
                angle:= -pi+abs(arcsin(M[1,i,2]/r));
      angle:=angle+phi;
      M[1,i,1]:=r*cos(angle);
      M[1,i,2]:=r*sin(angle);
     M[2,i,1]:=M[1,i,1]+b;
     M[3,i,1]:=M[1,i,1]+a*cos(theta);
     M[3,i,2]:=M[1,i,2]+a*sin(theta);
  end;

但运行程序的时候还是没有任何反应。
13楼2012-03-26 15:33:57
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

dingd

铁杆木虫 (职业作家)

【答案】应助回帖

★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★
wdxiao: 金币+10, ★★★★★最佳答案, 谢谢大侠的帮助! 2012-03-26 16:13:23
dbb627: 金币+5, 谢谢应助! 2012-03-26 17:23:30
1stOpt代码:
CODE:
Title "Type your title here"
Constant xx=[0.703,1.698,1.698,0.703,-0.703,-1.698,-1.698,-0.703,1.246,3.008,3.008,1.246,-1.246,
             -3.008,-3.008,-1.246,0,-2.926,-4.138,-2.926,0,2.926,4.138,2.926],
         yy=[1.698,0.703,-0.703,-1.698,-1.698,-0.703,0.703,1.698,3.008,1.246,-1.246,-3.008,-3.008,
            -1.246,1.246,3.008,4.138,2.926,0,-2.926,-4.138,-2.926,0,2.926];
Parameter a[1,4], b[1,4],theta[0,pi/2],phi[-pi/8,pi/8];
Minimum;
StartProgram;
var i,j: Integer;
    Etot,r,angle,out1,out2,out3: double;
    Ax,Ay,Ar,Ae,Bx,By,Br,Be,dist,rou: double;
    M: array[0..3] of array[1..24] of array[1..4] of double;
Begin
        for i:=1 to 24 do begin
            M[0,i,1]:=xx[i];
            M[0,i,2]:=yy[i];
        end;
        for i:=1 to 8 do begin
            M[0,i,3]:= 1.9;
            M[0,i,4]:= 0.044;
            M[0,i+8,3]:= 1.9;
            M[0,i+8,4]:= 0.044;
            M[0,i+16,3]:= 2.11;
            M[0,i+16,4]:= 0.202;
        end;
        for i := 1 to 24 do
            for j := 1 to 4 do begin
                M[1,i,j]:=M[0,i,j];
                M[2,i,j]:=M[0,i,j];
                M[3,i,j]:=M[0,i,j];
            end;
        for i:=1 to 24 do begin
            r:=sqrt(M[1,i,1]*M[1,i,1]+M[1,i,2]*M[1,i,2]);
            if M[1,i,1]>=0 then
               angle:=arcsin(M[1,i,2]/r)
            else begin
               //angle:= (M[1,i,2]/abs(M[1,i,2]))*(pi-abs(arcsin(M[1,i,2]/r)));
               if M[1,i,2] >=0 then
                  angle:= (pi-abs(arcsin(M[1,i,2]/r)))
               else
                  angle:= -(pi-abs(arcsin(M[1,i,2]/r)));
            end;

            angle:=angle+phi;
            M[1,i,1]:=r*cos(angle);
            M[1,i,2]:=r*sin(angle);
        end;

        for i:=1 to 24 do begin
            M[2,i,1]:=M[1,i,1]+b;
            M[3,i,1]:=M[1,i,1]+a*cos(theta);
            M[3,i,2]:=M[1,i,2]+a*sin(theta);
        end;
        Etot:=0;
        for i:=1 to 24 do
            for j:=1 to 24 do begin
                Ax:=M[1,i,1];
                Ay:=M[1,i,2];
                Ar:=M[1,i,3];
                Ae:=M[1,i,4];
                Bx:=M[2,j,1];
                By:=M[2,j,2];
                Br:=M[2,j,3];
                Be:=M[2,j,4];
                dist:=sqrt((Ax-Bx)*(Ax-Bx)+(Ay-By)*(Ay-By));
                rou:=dist/(Ar+Br);
                if dist>3.311 then
                   out1:= sqrt(Ae*Be)*(290000*exp(-12.5*rou)-2.25/exp(6*ln(rou)))
                else
                   out1:= 336.176*sqrt(Ae*Be)/(rou*rou);
                Bx:=M[3,j,1];
                By:=M[3,j,2];
                Br:=M[3,j,3];
                Be:=M[3,j,4];
                dist:=sqrt((Ax-Bx)*(Ax-Bx)+(Ay-By)*(Ay-By));
                rou:=dist/(Ar+Br);
                if dist>3.311 then
                   out2:= sqrt(Ae*Be)*(290000*exp(-12.5*rou)-2.25/exp(6*ln(rou)))
                else
                   out2:= 336.176*sqrt(Ae*Be)/(rou*rou);
                Ax:=M[2,i,1];
                Ay:=M[2,i,2];
                Ar:=M[2,i,3];
                Ae:=M[2,i,4];
                dist:=sqrt((Ax-Bx)*(Ax-Bx)+(Ay-By)*(Ay-By));
                rou:=dist/(Ar+Br);
                if dist>3.311 then
                   out3:= sqrt(Ae*Be)*(290000*exp(-12.5*rou)-2.25/exp(6*ln(rou)))
                else
                   out3:= 336.176*sqrt(Ae*Be)/(rou*rou);
                Etot:=out1+out2+out3+Etot;
            end;
        FunctionResult:= Etot;
End;
EndProgram;

目标函数值(最小): 67177.7939074056
a: 4
b: 3.02799435416652
theta: 1.37427224016812
phi: -0.0083047462585249
14楼2012-03-26 15:41:42
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

wdxiao

银虫 (正式写手)

引用回帖:
14楼: Originally posted by dingd at 2012-03-26 15:41:42:
1stOpt代码:

Title "Type your title here"
Constant xx=,
         yy=;
Parameter a, b,theta,phi;
Minimum;
StartProgram;
var i,j: Integer;
    Etot,r,angle,out1,out2,out3: double; ...

谢谢。我找到另一处问题了。现在程序可以跑了。

怎么给你送金币?
15楼2012-03-26 15:45:57
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

wdxiao

银虫 (正式写手)

我已送出金币了。不知dingd 大侠是否收到?

初次使用此功能,不知是否操作有误。

谢谢
16楼2012-03-26 16:16:10
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
17楼2012-03-28 03:29:11
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 wdxiao 的主题更新
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[基金申请] 93BebMhtakh前后11位开头都是大写 +4 且听虎啸 2026-08-17 5/250 2026-08-18 00:49 by 蔡棒棒菂
[基金申请] 欢迎发来filecode的Mz6后的代码验证其规律 +37 医学老男孩 2026-08-13 86/4300 2026-08-18 00:18 by longsantaizi
[基金申请] 感觉是下周放榜了 +6 angus9576 2026-08-17 11/550 2026-08-17 23:57 by angus9576
[基金申请] filecode=后面第一个是大写字母 +8 wangze12014 2026-08-14 10/500 2026-08-17 17:05 by xter9665
[基金申请] 时间戳变了,能看出什么问题? +4 基诺咪客 2026-08-17 4/200 2026-08-17 16:10 by Vivilian
[基金申请] 哪位老哥知道今年的国自然具体哪一天放榜? +12 Ldrop2023 2026-08-13 15/750 2026-08-17 15:02 by 小豌豆_发芽
[基金申请] 今天系统多次维护,明天很可能放榜! +8 zju2000 2026-08-16 9/450 2026-08-17 12:20 by lmz0216
[基金申请] 2027广东省杰青 +3 奶牛小黑 2026-08-15 6/300 2026-08-16 20:07 by 奶牛小黑
[基金申请] 快农历七夕节了,轻松一下,男人悄悄话,女施主请不要进来。 +3 Tide man 2026-08-14 3/150 2026-08-16 17:47 by jurkat.1640
[基金申请] 咱们一起用铁证分析2026国家社科基金中标与否 +7 启萌科技 2026-08-12 26/1300 2026-08-16 12:35 by 启萌科技
[基金申请] 有时候,自然基金真的不能太认真 (我的申报经验) +10 majunge000 2026-08-11 12/600 2026-08-16 08:18 by xli1984
[基金申请] 各位道友,我要去昆明玩几天,回来见。 +7 Tide man 2026-08-14 8/400 2026-08-15 01:11 by arzu_hma
[基金申请] 是这周出结果还是下周出结果? +4 yuleib84 2026-08-11 4/200 2026-08-14 23:05 by lfy8008
[硕博家园] 读博的好处 +4 lnee 2026-08-11 4/200 2026-08-14 10:20 by ahsoarli
[基金申请] 重要来源:本周末出结果 +10 瞬息宇宙 2026-08-12 10/500 2026-08-13 15:46 by likettle
[基金申请] 不应该看fileCode +7 且听虎啸 2026-08-12 9/450 2026-08-13 14:27 by flydreamws
[基金申请] 分享一下我之前已中青C的计划书的filecode +4 布布和一二 2026-08-11 5/250 2026-08-13 12:56 by cratir
[基金申请] 结合人工智能,周易传统文化,filecode打分制来了,3分以上希望很大。 +3 Tide man 2026-08-12 4/200 2026-08-13 08:35 by ZJTJZ
[基金申请] 2019年青年基金涵评意见,大家看看几个A,几个B? +11 Tide man 2026-08-11 11/550 2026-08-13 07:35 by 撸猫猫
[基金申请] 什么时候出结果,有咨询渠道??? +3 Tide man 2026-08-11 3/150 2026-08-11 17:54 by kudofaye
信息提示
请填处理意见