datamaker.pas

常用数学计算工具

{ _ScaX=128+64+1;  _ScaXY=128+64+2; //离散变量函数
}   //数据个数          总和             平均值         平方的和          sqrt(SumofSqrtes)
const _Number=0;        _Sum=1;          _Mean=2;       _SumOfSquares=3;  _Norm=4;
    //减平均数平方的和  TotalVariance/N Sqrt(PopnVariance) TotalVariance/(n-1) Sqrt(Variance
      _TotalVariance=5; _PopnVariance=6; _PopnStdDev=7; _Variance=8;      _StdDev=9;
    //最大值             最小值
      _MaxValue=10;     _MinValue=11;
function GetSimpson(X1,Y1,X2,Y2,X3,Y3,X:Extended):Extended;//用辛朴生法求函数(二次插值法)
//var
// _x1,_y1,_x2,_y2,_c1,_c2,a,b,c:Extended;
begin
{ _x1:=X2*X2-X1*X1; _x2:=X3*X3-X1*X1;
 _y1:=X2-X1;       _y2:=X3-X1;
 _c1:=Y2-Y1;       _c2:=Y3-Y1;

 if _x1*_y2-_x2*_y1<>0 then begin
  a:=(_c1*_y2-_c2*_y1)/(_x1*_y2-_x2*_y1);
  b:=(_c1*_x2-_c2*_x1)/(_y1*_x2-_y2*_x1);
  c:=Y1-a*X1*X1-b*X1;
  Result:=a*x*x+b*x+c;
 end else Result:=(x-x1)*(y3-y1)/(x3-x1);  }
 Result:=y1*(x-x2)/(x1-x2)*(x-x3)/(x1-x3)+
         y2*(x-x1)/(x2-x1)*(x-x3)/(x2-x3)+
         y3*(x-x1)/(x3-x1)*(x-x2)/(x3-x2);
end;
function GetScaValue(Value:Extended;Index:Byte;FunCommand:TFunCommand):Extended;
begin
  Result:=0;
//.......
end;

function GetFunValue(var FunCom:TFunCommand; Value:Extended):Extended;
function FunValue(PFunCom:PFunCommand):Extended;//主函数之一
begin
 Result:=Value;
end;
begin
 Result:=FunValue(@FunCom);
end;

function GetFunValueN(var FunCom:TFunCommand; ValueX1:Extended; ValueY2:Extended=0;ValueZ3:Extended=0; ValueU4:Extended=0; ValueV5:Extended=0; ValueW6:Extended=0; ValueAN:PExtended=nil):Extended;
function FunValue(PFunCommand:PFunCommand):Extended;//主函数之一
begin
 Result:=ValueX1;
end;
begin
 Result:=FunValue(@FunCom);
end;
/////////
function ScaStrToFunCom(S:String; Var FunCommand:TFunCommand; Strict:Boolean; Opt:Boolean=False):Boolean;
var
 Spos,i,Times:Integer;
 hasColon,hasTime:Boolean;
 temp:String;
 X,OldX:Extended;
function AddValue:Boolean;
begin
 Result:=TextToFloat(PChar(Temp),X,fvExtended);
 if not Result then exit;
 inc(FunCommand.Len);
 SetLength(FunCommand.DivFunction,FunCommand.Len);
 FunCommand.DivFunction[FunCommand.Len-1].Value2:=X;
 PWord(@FunCommand.DivFunction[FunCommand.Len-1].FunIndex)^:=Times-1;
end;
begin
 FillChar(FunCommand,SizeOf(FunCommand),0);
 Result:=False; hasColon:=False; hasTime:=False;
 if S='' then exit;
 Spos:=1; Times:=1; OldX:=-1.1e4932;
 for i:=1 to Length(s) do
  Case S[i] of
    ':' : if hasColon and Strict then exit //: ..: 不对
          else begin
           HasColon:=True;  hasTime:=False;
           Temp:=Copy(S,SPos,i-SPos);
           SPos:=i+1;
           if not AddValue then exit;
           if (OldX>=X)and Strict then exit; //后者必须大
           OldX:=X;  Times:=1;
          end;
    '\' : if HasColon or (not Strict) then begin // / ../也不行
           HasColon:=False; hasTime:=False;
           Temp:=Copy(S,SPos,i-SPos);
           SPos:=i+1;
           if not AddValue then exit;
           Times:=1;
          end else exit;
    '*': if Strict or hasTime then exit else begin //统计数据的方式
          hasTime:=True;
          Temp:=Copy(S,SPos,i-SPos);
          TextToFloat(PChar(Temp),X,fvExtended);
          Times:=Round(X);
          if (Times<1)or(Times>$10000) then exit;
          SPos:=i+1;
         end;
  end;
 i:=Length(s);
 if S[i]<>'\' then begin
  Temp:=Copy(S,SPos,i-SPos+1);
  if not AddValue then exit;
 end;
 if FunCommand.Len=0 then exit;
 if (FunCommand.Len mod 2<>0)and Strict then exit;
 Result:=True;
end;
function IsStr(S:String; Pos:Integer; SubStr:String):Boolean; //S是否在该位置上是Substr
var
 i:Integer;
begin
 Result:=False;
 if Length(s)-Pos+1<Length(SubStr) then exit;
 for i:=1 to Length(SubStr) do
  if S[i+Pos-1]<>SubStr[i] then exit; //含有该SubStr

 for i:=Pos+Length(SubStr) to Length(S) do
  begin
   case s[i] of
    ' ': ;
    '(': Break;
    else exit; //含有其他字符，故而不是SubStr
   end;
  end;
 Result:=True;
end;
function IsAddSub(S:String; Pos:Integer; Complex:Boolean=False):Byte; //'+','-'号是单操作符号还是双操作符号
var       //0:是加减法 1:是不在科学计数法中的正负号 2:是在科学计数法中的正负号 3:Complex中的正负号
 i:Integer;
 HasNum:Boolean;
begin
 Result:=1;
 if (pos<=1)or(pos>=Length(s)) then exit;
 i:=pos;  HasNum:=False;
 repeat
  i:=i-1;
  case s[i] of
   ' ': ;
   '(','*','/','+','-': if Result=2 then begin
               if not HasNum then Result:=0;
               exit;
            end else begin Result:=1; exit; end;
   'E','e': begin
             if i<2 then begin Result:=0; exit; end;
             Result:=2;
            end;
   '0'..'9': if Result<>2 then begin Result:=0; exit; end
                          else HasNum:=True;
   '.': if Result<>2 then begin Result:=0; exit; end;
   ',': if Complex then begin Result:=3; exit; end;
   else begin Result:=0; exit; end;
  end;
 until i<2;
end;

function TrimBrakets(S:String):string; //除去'(',')'号
var
 i,BPos:Integer;
begin
 Result:=S;
 if s='' then exit; 
 while (Result[1]='(') and(Result[Length(Result)]=')') do
  begin
   bPos:=1;
   for i:=2 to Length(Result)-1 do
    begin
     case Result[i] of
      '(': Inc(BPos);//BPos:=BPos+1;
      ')': Dec(BPos);//BPos:=BPos-1;
     end;
     if BPos=0 then exit;
    end;
   Delete(Result,1,1);
   Delete(Result,Length(Result),1);
   if Result='' then exit;
  end;
end;

function MakeVarN(S:String; VarN:TStrings; Var Index:Byte):Boolean;
var
 i:Integer;
begin
 Result:=False;
 for i:=0 to VarN.Count-1 do
  if S=VarN[i] then
   begin
    Index:=_OrgA+i;
    Result:=True;
    exit;
   end;
end;

function StrToFunC(S:String; Var FunCommand:TFunCommand; VC,VC2,VC3,VC4,VC5,VC6:String;VN:TStrings):Boolean; //主函数之二
                                                                     //递归函数
begin
 Result:=False;
 FillChar(FunCommand,SizeOf(FunCommand),0);  //先初始化,清零
// ......
end;

procedure OptimizeFunCom(var FunCommand:TFunCommand);
var
 i:Integer;
 Temp:TFunCommand;//Array of TDivFunction;
begin
 for i:=0 to FunCommand.Len-1 do
  if (FunCommand.DivFunction[i].FunIndex<128+64)and
    (FunCommand.DivFunction[i].SubFun<>nil) then begin
   OptimizeFunCom(FunCommand.DivFunction[i].SubFun^);//子优化
   if FunCommand.DivFunction[i].SubFun^.Len=1 then begin
    Temp.DivFunction:=FunCommand.DivFunction[i].SubFun^.DivFunction;//保存原地址
    Case FunCommand.DivFunction[i].FunIndex of
     _OrgX{,_OrgY,_OrgZ,_OrgU}: begin //原函数，无意义;注意,不能是_OrgY,_OrgZ,_OrgU,否则会造成混乱
      FunCommand.DivFunction[i].FunIndex:=FunCommand.DivFunction[i].SubFun^.DivFunction[0].FunIndex;
      FunCommand.DivFunction[i].Value2:=FunCommand.DivFunction[i].SubFun^.DivFunction[0].Value2;
      FunCommand.DivFunction[i].SubFun:=FunCommand.DivFunction[i].SubFun^.DivFunction[0].SubFun;
      SetLength(temp.DivFunction,0); //释放内存
     end;
     else begin Case FunCommand.DivFunction[i].SubFun^.DivFunction[0].FunIndex of
       _OrgX{,_OrgY,_OrgZ,_OrgU}: begin //子函数为无意义的原函数;注意,不能是_OrgY,_OrgZ,_OrgU,否则会造成混乱
        FunCommand.DivFunction[i].Value2:=FunCommand.DivFunction[i].SubFun^.DivFunction[0].Value2;
        FunCommand.DivFunction[i].SubFun:=FunCommand.DivFunction[i].SubFun^.DivFunction[0].SubFun;
        SetLength(temp.DivFunction,0); //释放内存
       end;
      _Const: if FunCommand.DivFunction[i].FunIndex<>_Random then begin //把常数算出来,但Random不要
       Get1Value(FunCommand.DivFunction[i].SubFun^.DivFunction[0].Value2,FunCommand.DivFunction[i].FunIndex);
       FunCommand.DivFunction[i].FunIndex:=_Const;
       FunCommand.DivFunction[i].Value2:=FunCommand.DivFunction[i].SubFun^.DivFunction[0].Value2;
       FreeFunCommand(FunCommand.DivFunction[i].SubFun^);
      end end; end;
    end;
   end;//单一函数
  end;
  //清除常数运算
  if FunCommand.Len<=1 then exit;
  for i:=0 to FunCommand.Len-1 do
      if FunCommand.DivFunction[i].FunIndex<>_Const then exit;

  FunCommand.DivFunction[0].Value2:=GetFunValue(FunCommand,0);
  FunCommand.Len:=1; SetLength(FunCommand.DivFunction,1);
  FunCommand.DivFunction[0].SubFun:=nil;
  FunCommand.DivFunction[0].FunIndex:=_Const;
end;

function IsForeDiv(S:String; Pos:Integer):Boolean; //确定 *, /
var
 i:Integer;
begin
 Result:=False;
 if pos<0 then exit;
 if pos>=Length(s) then exit;
 i:=pos;
 repeat
  i:=i-1;
  case s[i] of
   ' ':;
   '/': begin result:=True; exit; end;
   else exit;
  end;
 until i<0;
end;

function StrToFunCom(S:String; Var FunCommand:TFunCommand; VarC:Char):Boolean;
begin
 Result:=StrToFunComN(S,FunCommand,Varc);
end;
function OptStr(s:String):String;
var  //对S做必要的休整
 i:Integer;
begin
 result:='';
 for i:=1 to Length(S) do
  case S[i]of  //对-，+符号的双重含义进行解释
   '+','-'
      : if (IsAddSub(S,i)=1) then begin
         if isForeDiv(s,i)
            then result:=result+s[i]+'1/' //  /f()
            else result:=result+s[i]+'1*'; // *f()
        end else result:=result+s[i]; // if End;
   '[','{': result:=result+'(';  //[,{ = (
   ']','}': result:=result+')';  //],} = )
   else result:=result+s[i];
  end; //Case End
 Result:=UpperCase(Result);
end;
                                                                                                                                           //VarC7:String='UNKNOW'
function StrToFunComN(S:String; Var FunCommand:TFunCommand; VarC:String; VarC2:String='UNKNOW'; VarC3:String='UNKNOW'; //VarC7:String='UNKNOW'
                                    VarC4:String ='UNKNOW'; VarC5:String='UNKNOW'; VarC6:String='UNKNOW'; VarCN:TStrings=nil):Boolean;
var  //对S做必要的休整
 pS:String;
begin
 ps:=OptStr(S);
 Result:=StrToFunC(ps,FunCommand,UpperCase(VarC),UpperCase(VarC2),UpperCase(VarC3),UpperCase(VarC4),UpperCase(VarC5),UpperCase(VarC6),VarCN);
 OptimizeFunCom(FunCommand);
end;
/////////////////////
procedure FreeFunCommand(var FunCommand:TFunCommand);
var
 i:Integer;
begin
 for i:=0 to High(FunCommand.DivFunction) do
  begin
   if FunCommand.DivFunction[i].SubFun<>nil then
    begin
     FreeFunCommand(FunCommand.DivFunction[i].SubFun^);
     FreeMem(FunCommand.DivFunction[i].SubFun);
     FunCommand.DivFunction[i].SubFun:=nil;
    end;
  end;
 SetLength(FunCommand.DivFunction,0);
 FunCommand.Len:=0;
end;

function ManageFunCom(FunCommand:TFunCommand; XYs:Array of Const):PDivFunction;
var
 i,
 X:Integer;
 Temp:PFunCommand;
begin
 Result:=nil; X:=0;
 Temp:=@FunCommand;
 for i:=0 to High(XYs)-1 do
  begin
   with XYs[i] do
    begin
     if VType=vtInteger
        then X:=vInteger
        else exit;
    end;
   if (x<0)or(x>=Temp^.Len)then exit;
   if Temp^.DivFunction[x].SubFun<>nil
      then Temp:=Temp^.DivFunction[x].SubFun
      else exit;
  end;
 with XYs[High(XYs)] do
  begin
    if VType=vtInteger
       then X:=vInteger
       else exit;
   end;
 if (x<0)or(x>=Temp.Len)then exit;
 Result:=@Temp^.DivFunction[x];
end;


procedure GetFCS(FunCommand:TFunCommand;var value:Integer); //递归函数
var
 i:Integer;
begin
 Value:=Value+Sizeof(TFunCommand);
 for i:=0 to FunCommand.Len-1 do
  if FunCommand.DivFunction[i].SubFun<>nil then
   GetFCS(FunCommand.DivFunction[i].SubFun^,Value);
end;
function GetFunComSize(FunCommand:TFunCommand):Integer; //获得FunCommand的实际占用内存数量
var
 Value:Integer;
begin
 Value:=0;
 GetFCS(FunCommand,Value);
 Result:=Value;
end;
procedure SaveFunCom(var FunCommand:TFunCommand; Stream:TStream);
var
 SPos,
 i:Integer;
 HasSubFun:Boolean;
begin
 SPos:=Stream.Position;
 Stream.Size:=Stream.Size+4; Stream.Position:=SPos;
 Stream.Write(FunCommand.Len,4);//写入Stream