Оптимальное проектирование технических систем на ЭВМ / Монте_Карло(3) / Perturb

unit Perturb;

interface
uses math;

function Rq(tau:Extended):extended;
function Rx(j,M:integer):extended;
procedure GenX();
procedure Generate();
procedure Free_vars();
procedure Free_X();

var
sigma_q,A1,A2:Extended;
alfa_1e,alfa_2e:Extended;
beta_e, V_a:Extended;
Tk_1,h_1:Extended;
tau_max, delta_tau:Extended;
alfa_1,alfa_2,beta:Extended;
QQ:array of extended;
Count:integer;
my_mean,my_stddev: extended;
implementation

var
  x1,x2:array of extended;
  q_1:array of extended;
  q_2:array of extended;

Function q2(k:longint) : Extended;
var
  a01,b11:Extended;
  a02,a12,b02,b12,b22,c0,c1:Extended;
begin
  if k+1<Length(QQ) then
  begin
    b11:=exp(-alfa_1*h_1);
    a01:=sigma_q*sqrt(1-sqr(b11));
    q_1[k+1] := a01*x1[k]+b11*q_1[k];//RandG(0,1);
  end;
  if k+2<Length(QQ) then
  begin
    c1:=1-exp(-4*alfa_2*h_1);
    c0:=exp(-alfa_2*h_1)*(exp(-2*alfa_2*h_1)-1)*cos(beta*h_1);
    b22:=exp(-2*alfa_2*h_1);
    b12:=2*exp(-alfa_2*h_1)*cos(beta*h_1);
    b02:=sqrt( (c1 + sqrt( sqr(c1)-4*sqr(c0) ) )/2 );
    a02:=sigma_q*b02;
    a12:=sigma_q*alfa_2/b02;
    q_2[k+2]:=a02*x2[k+2]+a12*x2[k+1]-b12*x2[k+1]-b22*x2[k];
  end;
if A1=1 then
  Result := q_1[k]
else if A1=0 then
  Result := q_2[k]
else
  Result := q_1[k]+q_2[k];
end;

procedure GenX();
var
  i :longint;
begin
  Randomize();
  count:= Trunc(Tk_1/h_1)+1;
  SetLength(x1,count);
  SetLength(x2,count);
  for i:=0 to count-1 do
    x1[i]:=RandG(0,sigma_q);
  for i:=0 to count-1 do
    x2[i]:=RandG(0,sigma_q);
end;

procedure Generate();
var
  i :longint;
begin
  count:= Trunc(Tk_1/h_1)+1;
  SetLength(q_1,count);
  q_1[0]:=0;
  SetLength(q_2,count);
  q_2[0]:=0;
  q_2[1]:=0;
  SetLength(QQ,count);
  i:=0;
  while  i<=count-1 do
    begin
      QQ[i]:=q2(i);
      inc(i);
    end;
  i:=0;
  my_mean:=0;
  while i<=Count-1 do
    begin
      my_mean:=my_mean+QQ[i];
      inc(i);
    end;
  my_mean:=my_mean/Count;
  i:=0;
  my_stddev:=0;
  while i<=Count-2 do
    begin
      my_stddev:=my_stddev+sqr(QQ[i]-my_mean);
      inc(i);
    end;
  my_stddev:=sqrt(my_stddev/Count);
end;

procedure Free_vars();
begin
x1:=nil;
x2:=nil;
q_1:=nil;
q_2:=nil;
QQ:=nil
end;

procedure Free_X();
begin
x1:=nil;
x2:=nil;
end;


function Rq(tau:Extended):extended;
begin
  Result:=sqr(sigma_q)*(A1*exp(-alfa_1*abs(tau))+
    A2*exp(-alfa_2*abs(tau))*cos(beta*tau));
end;

function Rx(j,M:integer):extended;
var
  i:integer;
begin
  Result:=0;
  for i:=1 to Count-j do
    Result:=Result+(QQ[i-1]-my_mean)*(QQ[i-1+j]-my_mean);
  Result:=Result/(Count-j-1)
end;
end.