unit UnitFP;

interface

  uses
     Forms, SysUtils, windows, Compile_Hss, DBClient, RunExe_Hss, math,
     DB, Variants;

  type TabcList=record         //注意 比 TParameterList 多了幾個域
    CName     :String;     //參數名稱
    CAddress  :PExtended;  //參數地址
    IfConst   :boolean;    //是否為常數  false:常數 true:變量  (沒有用，這里全部為false)
    PType     :integer;    //參數類型   整數、浮點、常數
    MinV      :extended;   //最小值
    MaxV      :extended;   //最大值
    Default   :extended;   //默認值
    Precision :integer;    //網格精度
  end;

  type TPDList=record
    CName     :String;     //變元名稱
    CAddress  :PExtended;  //變元地址
    Index     :integer;    //變元序號
  end;

  const  DataLength:integer=100;
  const  DataMaxIndex:integer=20;
  var
    Compile   :TCompile;     //編譯執行函數
    abcList   :array of TabcList;       //擬合函數中的 參數
    PDList    :array of TPDList; //擬合函數中的 變元
    dData     :array of array of Extended;  //變元數據矩陣

    NowTime   :Extended;          //當前時間 
    runPause  :boolean;

    ApWay     :integer;        //當前擬合方法
    FBWay     :integer;        //當前 擬合 優劣 檢驗 標準

    ExpressionType :integer;   // -1..DataLength-1 //表達式方式  意義 -1: 0=f() ; N(0-DataLength-1): dN=f() ;
    ExpressionTypeLR :integer; //意義 -1: 0=f(); 0: dN=f() ; 1: f()=dN ;


    dMax        :extended;           //當前最好優化值
    abcMax      :array of extended;  //當前最好參數

    ClientDataSetDataOld: TClientDataSet;   //當前數據源
    ClientDataSetDataOldTemp :TClientDataSet; //臨時保存數據用
    ClientDataSetData: array  of TClientDataSet;

  procedure FieldDefsAssign(var cdX : TClientDataSet);  //生成字段名
  
  function  GetEQ(const str:string;var FirstEQIndex:integer):integer;  // 返回表達式中有幾個等號
  function  IFIn(const F:string;const Af:array of string):boolean;   // F 是否在 字符串數組中 (不區分大小寫)
  function  IFInDCount(const F:string):boolean;    // F 是否在 'd0'...... 中 (不區分大小寫)
  function  strFind(const StrT1,StrT2:string;var index:integer):boolean; //在StrT1中是否有 標識符 StrT2

  function  GetdData(DdataSet:TClientDataSet;var iCount:integer):boolean;    //獲取實驗數據
  function  GetabcData(abcDataSet:TClientDataSet):boolean;//獲取設置好的參數性質

  function  GetFBValue(const cList :array of TabcList;const HowFBWay:integer=-1):Extended;//根據傳來的參數具體值,計算返回 優劣 值

  procedure GetSubValue(const cList :array of TabcList;const pArray :array of extended;var dSubArray:array of extended);overload; //
  function  GetSubValue(const cList :array of TabcList;const pArray :array of extended;const x:extended;const index0,index1:integer):extended;overload;
  
  procedure RunOptimize();
  procedure RunOptimize0();
  procedure RunOptimize1();
  procedure RunOptimize2();
  procedure RunOptimize3();
  procedure RunOptimize4();

  
  function MaxInArray(const Data: array of Extended): Extended;
  function MinInArray(const Data: array of Extended): Extended;

  function Sgn(const x:extended):integer;
  
  function  GetKeyValue(const sKey:string):extended;

  function  GetDataAsStr(const sDataSet: TClientDataSet):string;
  function  GetStrFeildValue(var s:string):variant;
  procedure SetDataAsStr(var sDataSet: TClientDataSet;const sData: string;const CellX:integer=0);

implementation

uses  UnitAuto;

function Sgn(const x:extended):integer;
begin
  if x>0 then
    result:=1
  else if x<0 then
    result:=-1
  else
    result:=0;
end;

function  GetEQ(const str:string;var FirstEQIndex:integer):integer;  // 返回表達式中有幾個等號
var
  i     :integer;
  strT1 :string;
  strT2 :string;

  function  DelNil(const str0:string):string;
  var
    i     :integer;
  begin
    result:='';
    for i:=1 to length(str0) do
    begin
      case str0[i] of
        ' ',#13,#10,#9: result:=result;
        else result:=result+str0[i];
      end;
    end;
  end;

begin
  result:=0;
  FirstEQIndex:=0;
  for i:=length(str) downto 1 do
  begin
    if str[i]='=' then
    begin
      inc(result);
      FirstEQIndex:=i;   //返回第一個'='的位置
    end;
  end;
  if result=0 then
  begin
    ExpressionType:=-1;
    ExpressionTypeLR:=-1;
  end
  else if result=1 then
  begin
    strT1:=uppercase(copy(str,1,FirstEQIndex-1));
    strT1:=DelNil(strT1);
    strT2:=uppercase(copy(str,FirstEQIndex+1,length(str)-FirstEQIndex));
    strT2:=DelNil(strT2);
    if (strT1='0') or (strT2='0') then
    begin
      ExpressionType:=-1;
      ExpressionTypeLR:=-1;
    end
    else if (IFInDCount(strT1)) and (not(strFind(StrT2,StrT1,i)))then
    begin
      ExpressionType:=strtoint(copy(strT1,2,length(strT1)-1));
      ExpressionTypeLR:=0;
    end
    else if (IFInDCount(strT2)) and(not( strFind(StrT1,StrT2,i))) then
    begin
      ExpressionType:=strtoint(copy(strT2,2,length(strT2)-1));
      ExpressionTypeLR:=1;
    end
    else
    begin
      ExpressionType:=-1;
      ExpressionTypeLR:=-1;
    end;
  end;

end;

function MaxInArray(const Data: array of Extended): Extended;
var
  I: Integer;
begin
  Result := Data[Low(Data)];
  for I := Low(Data) + 1 to High(Data) do
    if Result < Data[I] then  Result := Data[I];
end;

function MinInArray(const Data: array of Extended): Extended;
var
  I: Integer;
begin
  Result := Data[Low(Data)];
  for I := Low(Data) + 1 to High(Data) do
    if Result > Data[I] then  Result := Data[I];
end;

procedure FieldDefsAssign(var cdX : TClientDataSet);  //生成字段名
var
  i:integer;
begin
  cdX:=TClientDataSet.Create(nil);
  cdX.AfterScroll:=frmMain.ClientDataSetDataAfterScroll;
  cdX.AfterPost:=frmMain.ClientDataSetDataAfterPost;
  cdX.AfterDelete:=frmMain.ClientDataSetDataAfterDelete;
  cdX.AfterClose:=frmMain.ClientDataSetDataAfterClose;
  for i:=0 to DataLength-1 do
  begin
    cdX.FieldDefs.Add('d'+inttostr(i),ftFloat);
  end;
  cdX.CreateDataSet;
end;

function IFIn(const F:string;const Af:array of string):boolean;
var
  i   :integer;
begin
  result:=false;
  for i:=Low(Af) to High(Af) do
  begin
    if uppercase(F)=uppercase(Af[i]) then
    begin
      result:=true;
      exit;
    end;
  end;
end;

function IFInDCount(const F:string):boolean;
var
  s   :string;
  i   :integer;
  Af  :array of string;
begin
  try
    s:=uppercase(f) ;
    case length(s) of
      0:  result:=false;
      1:  result:=false;
      2,3..10:
        begin
          setlength(af,DataLength);
          for i:=0 to DataLength-1 do
          begin
            af[i]:=inttostr(i);
          end;
          if (s[1]='D') and (ifin(copy(s,2,length(s)-1),af)) then
            result:=true
          else
            result:=false;
        end;
      else
        result:=false;
    end;
  except
    result:=false;
  end;
end;

function GetdData(DdataSet:TClientDataSet;var iCount:integer):boolean;
var
  i,nloop  :integer;
begin
  try
    DdataSet.Last;
    DdataSet.First;
    iCount:=DdataSet.RecordCount;
    if not (iCount<0) then
    begin
      setlength(dData,iCount);
      for i:=0 to iCount-1 do
        setlength(dData[i],DataLength);
      i:=0;
      while not (DdataSet.Eof) do
      begin
        for nloop:=0 to DataLength-1 do
        begin
          dData[i,nloop]:=DdataSet.FieldByName('d'+inttostr(nloop)).asfloat;
        end;
        DdataSet.Next;
        i:=i+1;
      end;
      DdataSet.First;
      result:=true;
    end
    else
      result:=false;
  except
    result:=false;
  end;
end;

function GetabcData(abcDataSet:TClientDataSet):boolean;
var
  i   :integer;
  dTemp :extended;
begin
  try
    for i:=low(abcList) to high(abcList) do
    begin
        abcDataSet.First;
        while not(abcDataSet.Eof) do
        begin
          if (abcDataSet.FieldByName('F_TP_NAME').AsString=abcList[i].CName) then
            break
          else
           abcDataSet.Next;
        end;

        abcList[i].PType:=abcDataSet.FieldByName('F_TP_ZF_ID').AsInteger;
        abcList[i].MinV:=abcDataSet.FieldByName('F_TP_MIN').AsFloat;
        abcList[i].MaxV:=abcDataSet.FieldByName('F_TP_MAX').AsFloat;;
        abcList[i].Default:=abcDataSet.FieldByName('F_TP_DEFAULT').AsFloat;;
        abcList[i].Precision:=abcDataSet.FieldByName('F_TP_Precision').AsInteger;;
     end;
     abcDataSet.First;


     for i:=low(abcList) to high(abcList) do
     begin

       if (abcList[i].PType=2) then
       begin
         abcList[i].MinV:=trunc(abcList[i].MinV);
         abcList[i].MaxV:=trunc(abcList[i].MaxV);
       end
       else if (abcList[i].PType=3) then
       begin
         abcList[i].MinV:=abcList[i].Default;
         abcList[i].MaxV:=abcList[i].Default;
         abcList[i].Precision:=1;
       end;

       if (abcList[i].MaxV=abcList[i].MinV) then
       begin
         abcList[i].Default:=abcList[i].MaxV;
       end;

       
       abcList[i].Precision:=abs(abcList[i].Precision);
       if abcList[i].Precision<1 then abcList[i].Precision:=2;
       
       if abcList[i].MaxV<abcList[i].MinV then
       begin
         dTemp:= abcList[i].MaxV;
         abcList[i].MaxV:=abcList[i].MinV;
         abcList[i].MinV:=dTemp;
       end;
     end;

     result:=true;
  except
    result:=false;
  end;
end;

function GetFBValue(const cList :array of TabcList;const HowFBWay:integer=-1):Extended;//越小越好//根據傳來的參數具體值,計算返回 優劣 值
var
  i,j     :integer;
  sum     :extended;
  dVMax   :extended;
  dVMin   :extended;
  dV      :extended;
  dVvar   :array of Extended;
  L       :integer;
  dVP     :Extended;
  MyFBWay :integer;
  Temp    :double;
begin
  sum:=0;
  for i:=low(cList) to high(cList) do    //參數賦值
  begin
    cList[i].CAddress^:=cList[i].Default;
  end;
  if HowFBWay=-1 then
    myFBWay:=FBWay
  else
    myFBWay:=HowFBWay;
  try
    case myFBWay of
      0:   //方差最小  , 返回 方差
      begin       
        sum:=0;
        for i:=low(dData) to high(dData) do
        begin
          for j:=low(PDList) to high(PDList) do
            PDList[j].CAddress^:=dData[i,PDList[j].Index];

          Compile.GetValue(dV);
          Sum:=Sum+dV*dV;
        end;
      end;
      1:   // 差的絕對值和最小 ,返回 差的絕對值的和
      begin
        sum:=0;
        for i:=low(dData) to high(dData) do
        begin
          for j:=low(PDList) to high(PDList) do
            PDList[j].CAddress^:=dData[i,PDList[j].Index];

          Compile.GetValue(dV);
          Sum:=Sum+abs(dV);
        end;
      end;
      2:   // 差的絕對值最大者最小 ,返回 差的絕對值最大者
      begin
        sum:=0;
        for i:=low(dData) to high(dData) do
        begin
          for j:=low(PDList) to high(PDList) do
            PDList[j].CAddress^:=dData[i,PDList[j].Index];

          Compile.GetValue(dV);
          dV:=abs(dV);
          if dV>sum then sum:=dV;
        end;
      end;