unitfp.pas

一个多元非线性回归分析源码以及其中的公式列表

  REAgainValue:extended;

  PMul        :int64;
  ii          :integer;

  properties0 :Extended;
  properties1 :Extended;
  properties2 :Extended;
  properties3 :Extended;

begin
  //初始设定      
  SetThreadPriority(GetCurrentThread(),THREAD_PRIORITY_LOWEST);
  randomize;
  MydMax:=MaxExtended;
  setlength(MyabcList,high(abcList)+1);
  setlength(abcMax,high(abcList)+1);
  setlength(MyabcMax,high(abcList)+1);
  for i:=low(MyabcList) to high(MyabcList) do
    MyabcList[i]:=abcList[i];
  iAgain:=1;
  ReAgain:=0;
  REAgainValue:=-MaxExtended;

  properties0:=abs(GetKeyValue('网格爬山法.最小区域宽度'));
  properties1:=abs(GetKeyValue('网格爬山法.区域缩小倍数'));
  if properties1=0 then properties1:=1;
  properties2:=abs(GetKeyValue('网格爬山法.精度缩小倍数'));    
  if properties2=0 then properties2:=1;
  properties3:=abs(GetKeyValue('网格爬山法.总循环精度放大倍数'));   
  if properties3=0 then properties3:=1;

  //循环
  NowTime:=windows.GetTickCount();
  MyTime:=NowTime;
  while MyTime=NowTime do   //不按“停止”键就一直运行
  begin  
      application.ProcessMessages;
    Grid:=1;
    for i:=low(MyabcList) to high(MyabcList) do
      Grid:=Grid*MyabcList[i].Precision;
    for i:=0 to (Grid-1) do
    begin
      PMul:=1;
      for j:=low(MyabcList) to high(MyabcList) do
      begin
        PMul:=pMul*MyabcList[j].Precision;
        ii:=trunc((i mod PMul)/(PMul/MyabcList[j].Precision));
        MyabcList[j].Default:=(ii+0.5)/MyabcList[j].Precision*(MyabcList[j].maxV-MyabcList[j].MinV)+MyabcList[j].MinV;
        if MyabcList[j].PType=2 then
          MyabcList[j].Default:=trunc(MyabcList[j].Default);
      end;
      dTemp:=abs(GetFBValue(MyabcList));

      if dTemp<MydMax then    //局部最大
      begin
        MydMax:=dTEmp;
        for j:=low(MyabcMax) to high(MyabcMax) do
          MyabcMax[j]:=MyabcList[j].Default;
        application.ProcessMessages;
      end;
      if dTemp<dMax then     //全局最大
      begin
        dMax:=dTEmp;
        for j:=low(abcMax) to high(abcMax) do
          abcMax[j]:=MyabcList[j].Default;
        application.ProcessMessages;
      end;

      application.ProcessMessages;
      while runPause=true do
      begin
        application.ProcessMessages;
        sleep(1);
      end;
      application.ProcessMessages;
      if MyTime<>NowTime then exit;
      application.ProcessMessages;
    end;

    SumAgain:=0;
    for j:=low(MyabcList) to high(MyabcList) do
    begin
      if MyabcList[j].PType=2 then
      begin
        if abs(MyabcList[j].MaxV-MyabcList[j].MinV)>1 then
          sumAgain:=sumAgain+abs(MyabcList[j].MaxV-MyabcList[j].MinV);
      end
      else
        sumAgain:=sumAgain+abs(MyabcList[j].MaxV-MyabcList[j].MinV);
    end;
    if sumAgain=REAgainValue then
    begin
       REAgain:=REAgain+1;
    end
    else
    begin
      REAgainValue:=sumAgain;
      REAgain:=0;
    end;

    if (sumAgain<properties0) or (REAgain=10) then      //重来
    begin
      for j:=low(MyabcList) to high(MyabcList) do
      begin
        iAgain:=iAgain*properties3;
        MyabcList[j]:=abcList[j];
        //MyabcList[j].MinV:=max(abcList[j].MinV,abcMax[j]-(abcList[j].MaxV-abcList[j].MinV)/iAgain/2);
        //MyabcList[j].MaxV:=min(abcList[j].MaxV,abcMax[j]+(abcList[j].MaxV-abcList[j].MinV)/iAgain/2);
        MyabcList[j].Precision:=trunc(abcList[j].Precision*iAgain);          //属性2
      end;
      MydMax:=MaxExtended;
    end
    else
    begin
      for j:=low(MyabcList) to high(MyabcList) do
      begin
        MyabcList[j].MinV:=max(MyabcList[j].MinV,MyabcMax[j]-(MyabcList[j].MaxV-MyabcList[j].MinV)/(properties1)/2);//属性0   //局部爬山
        MyabcList[j].MaxV:=min(MyabcList[j].maxV,MyabcMax[j]+(MyabcList[j].MaxV-MyabcList[j].MinV)/(properties1)/2);
        if MyabcList[j].PType=2 then
        begin
          MyabcList[j].MinV:=trunc(MyabcList[j].MinV);
          MyabcList[j].MaxV:=trunc(MyabcList[j].MaxV);
        end;
        MyabcList[j].Precision:=trunc(max(3.0,MyabcList[j].Precision/properties2));//属性1
      end;
    end;
    
  end;

end;

procedure RunOptimize2();   //最速下降法
var
  MyTime      :extended;
  i,j         :integer;
  dTemp       :extended;
  MyabcList   :array of TabcList;
  MyabcMax    :array of Extended;

  detaX       :array of extended;

  temp        :extended;
  temp0       :extended;
  tempOld     :extended;

  properties0 :Extended;
  properties1 :Extended;

begin
  //初始设定      
  SetThreadPriority(GetCurrentThread(),THREAD_PRIORITY_LOWEST);
  randomize;
  setlength(MyabcList,high(abcList)+1);
  setlength(abcMax,high(abcList)+1);
  setlength(MyabcMax,high(abcList)+1);
  setlength(detaX,high(abcList)+1);

  for i:=low(MyabcList) to high(MyabcList) do
    MyabcList[i]:=abcList[i];
  for i:=low(detaX) to high(detaX) do
  begin
    detaX[i]:=random(2)*2-1;
  end;
  properties0:=abs(GetKeyValue('最速下降法.最大迭代次数'));
  properties1:=GetKeyValue('最速下降法.步长调整的阻尼系数');
  if properties1<1 then properties1:=1;
  //循环
  NowTime:=windows.GetTickCount();
  MyTime:=NowTime;
  while MyTime=NowTime do   //不按“停止”键就一直运行
  begin
    application.ProcessMessages;
    for i:=0 to trunc(properties0) do      //属性 最大迭代次数 iMax
    begin
      for j:=low(MyabcList) to high(MyabcList) do
      begin
        Temp:=MyabcList[j].Default+detaX[j];
        if Temp>MyabcList[j].MaxV then Temp:=MyabcList[j].MaxV;
        if Temp<MyabcList[j].MinV then Temp:=MyabcList[j].MinV;
        Temp0:=abs(GetFBValue(MyabcList));
        tempOld:=MyabcList[j].Default;
        MyabcList[j].Default:=Temp;
        dTemp:=abs(GetFBValue(MyabcList));
        MyabcList[j].Default:=tempOld;
        if dTemp<TEmp0 then
          if MyabcList[j].PType=2 then
            detaX[j]:=detaX[j]+sgn(detaX[j])
          else
            detaX[j]:=detaX[j]*(properties1+random/10)    //属性  步长调整的阻尼系数
        else
          if MyabcList[j].PType=2 then
            detaX[j]:=-(detaX[j]-sgn(detaX[j]))
          else
            detaX[j]:=-detaX[j]/(properties1+random/10);

      end;
      for j:=low(MyabcList) to high(MyabcList) do
      begin
        Temp:=MyabcList[j].Default+detaX[j];
        if Temp>MyabcList[j].MaxV then Temp:=MyabcList[j].MaxV;
        if Temp<MyabcList[j].MinV then Temp:=MyabcList[j].MinV;
        MyabcList[j].Default:=temp;
      end;

      dTemp:=abs(GetFBValue(MyabcList));

      if dTemp<dMax then     //全局最大
      begin
        dMax:=dTEmp;
        for j:=low(abcMax) to high(abcMax) do
          abcMax[j]:=MyabcList[j].Default;
        application.ProcessMessages;
      end;

      application.ProcessMessages;
      while runPause=true do
      begin
        application.ProcessMessages;
        sleep(1);
      end;
      application.ProcessMessages;
      if MyTime<>NowTime then exit;
      application.ProcessMessages;
    end; //for

    for j:=low(detaX) to high(detaX) do
    begin
      detaX[j]:=random(2)*2-1;
      if MyabcList[j].PType=2 then
        MyabcList[j].Default:=random(trunc(MyabcList[j].maxV-MyabcList[j].MinV)+1)+MyabcList[j].MinV
      else
        MyabcList[j].Default:=random*(MyabcList[j].maxV-MyabcList[j].MinV)+MyabcList[j].MinV;
    end;

  end; //while

end;

procedure RunOptimize3();   //最速下降网格爬山法
var
  MyTime      :extended;
  i,j,k       :integer;
  Grid        :int64;
  dTemp       :extended;
  MyabcList   :array of TabcList;
  MydMax      :extended;
  MyabcMax    :array of Extended;
  SumAgain    :extended;
  iAgain      :extended;
  ReAgain     :integer;
  REAgainValue:extended;

  PMul        :int64;
  ii          :integer;

  detaX       :array of extended;

  temp        :extended;
  temp0       :extended;
  tempOld     :extended;

  properties0 :Extended;
  properties1 :Extended;
  properties2 :Extended;
  properties3 :Extended;
  properties4 :Extended;
  properties5 :Extended;

begin
  //初始设定
  SetThreadPriority(GetCurrentThread(),THREAD_PRIORITY_LOWEST);
  randomize;
  MydMax:=MaxExtended;
  setlength(MyabcList,high(abcList)+1);
  setlength(abcMax,high(abcList)+1);
  setlength(MyabcMax,high(abcList)+1);
  setlength(detaX,high(abcList)+1);
  for i:=low(detaX) to high(detaX) do
  begin
    detaX[i]:=random(2)*2-1;
  end;
  for i:=low(MyabcList) to high(MyabcList) do
    MyabcList[i]:=abcList[i];
  iAgain:=1;
  ReAgain:=0;
  REAgainValue:=-MaxExtended;

  properties0:=abs(GetKeyValue('最速下降网格爬山法.最小区域宽度'));
  properties1:=abs(GetKeyValue('最速下降网格爬山法.区域缩小倍数'));
  if properties1=0 then properties1:=1;
  properties2:=abs(GetKeyValue('最速下降网格爬山法.精度缩小倍数'));
  if properties2=0 then properties2:=1;
  properties3:=abs(GetKeyValue('最速下降网格爬山法.总循环精度放大倍数')); 
  if properties3=0 then properties3:=1;
  properties4:=abs(GetKeyValue('最速下降网格爬山法.最大迭代次数'));
  properties5:=abs(GetKeyValue('最速下降网格爬山法.步长调整的阻尼系数'));
  if properties5<1 then properties5:=1;

  //循环
  NowTime:=windows.GetTickCount();
  MyTime:=NowTime;
  while MyTime=NowTime do   //不按“停止”键就一直运行
  begin  
      application.ProcessMessages;
    Grid:=1;
    for i:=low(MyabcList) to high(MyabcList) do
      Grid:=Grid*MyabcList[i].Precision;
    for i:=0 to (Grid-1) do
    begin
      PMul:=1;
      for j:=low(MyabcList) to high(MyabcList) do
      begin
        PMul:=pMul*MyabcList[j].Precision;
        ii:=trunc((i mod PMul)/(PMul/MyabcList[j].Precision));
        MyabcList[j].Default:=(ii+0.5)/MyabcList[j].Precision*(MyabcList[j].maxV-MyabcList[j].MinV)+MyabcList[j].MinV;
        if MyabcList[j].PType=2 then
          MyabcList[j].Default:=trunc(MyabcList[j].Default);
      end;

      //
      for k:=low(detaX) to high(detaX) do
      begin
        detaX[k]:=random(2)*2-1;
      end;
      for k:=0 to trunc(properties4) do      //属性 最大迭代次数 iMax
      begin
        for j:=low(MyabcList) to high(MyabcList) do
        begin
          Temp:=MyabcList[j].Default+detaX[j];
          if Temp>MyabcList[j].MaxV then Temp:=MyabcList[j].MaxV;
          if Temp<MyabcList[j].MinV then Temp:=MyabcList[j].MinV;
          Temp0:=abs(GetFBValue(MyabcList));
          tempOld:=MyabcList[j].Default;
          MyabcList[j].Default:=Temp;
          dTemp:=abs(GetFBValue(MyabcList));
          MyabcList[j].Default:=tempOld;
          if dTemp<TEmp0 then
            if MyabcList[j].PType=2 then
              detaX[j]:=detaX[j]+sgn(detaX[j])
            else
              detaX[j]:=detaX[j]*(properties5+random/10)     //
          else
            if MyabcList[j].PType=2 then
              detaX[j]:=-(detaX[j]-sgn(detaX[j]))
            else
              detaX[j]:=-detaX[j]/(properties5+random/10);

        end;
        for j:=low(MyabcList) to high(MyabcList) do
        begin
          Temp:=MyabcList[j].Default+detaX[j];
          if Temp>MyabcList[j].MaxV then Temp:=MyabcList[j].MaxV;
          if Temp<MyabcList[j].MinV then Temp:=MyabcList[j].MinV;
          MyabcList[j].Default:=temp;
        end;
      end;
      //

      dTemp:=abs(GetFBValue(MyabcList));


      if dTemp<MydMax then    //局部最大
      begin
        MydMax:=dTEmp;
        for j:=low(MyabcMax) to high(MyabcMax) do
          MyabcMax[j]:=MyabcList[j].Default;
        application.ProcessMessages;
      end;
      if dTemp<dMax then     //全局最大
      begin
        dMax:=dTEmp;
        for j:=low(abcMax) to high(abcMax) do
          abcMax[j]:=MyabcList[j].Default;
        application.ProcessMessages;
      end;

      application.ProcessMessages;
      while runPause=true do
      begin
        application.ProcessMessages;
        sleep(1);
      end;
      application.ProcessMessages;
      if MyTime<>NowTime then exit;
      application.ProcessMessages;
    end;

    SumAgain:=0;
    for j:=low(MyabcList) to high(MyabcList) do
    begin
      if MyabcList[j].PType=2 then
      begin
        if abs(MyabcList[j].MaxV-MyabcList[j].MinV)>1 then 
          sumAgain:=sumAgain+abs(MyabcList[j].MaxV-MyabcList[j].MinV);
      end
      else
        sumAgain:=sumAgain+abs(MyabcList[j].MaxV-MyabcList[j].MinV);
    end;
    if sumAgain=REAgainValue then
    begin
       REAgain:=REAgain+1;