Home » Source Code » » ENDLESS.PAS

ENDLESS.PAS ( File view )

From:
  • By 2010-07-31
  • View(s):5
  • Download(s):0
  • Point(s): 1
			const
datanum =20;           {
数据个数
}
paranum =2;            {
模型参数
}
type
a1=array[0..datanum] of real;
a2=array[0..datanum,0..paranum] of real;
a3=array[0..paranum,0..datanum] of real;
a4=array[0..paranum,0..paranum+1] of real;
a5=array[0..paranum] of real;
a7=array[0..paranum+1] of real;
a6=array[0..paranum] of integer;
var
y : a1;                {
y为数组
}
q : a2;                {
q为测量矩阵
}
p : a3;                {
p为q的转置
}
h : a4;                {
h为q.T*q
}
b,X : a5;              {
b为q.T*y;x为待求AR模型参数
}
w : a6;
xx :  a7;
filename1,filename2,filename3 ,filename4: text;
aic,aico : real;

Procedure Ein(var m : a1;var q : a2);           {
读入数据
}
var i,j,k : integer;
begin
  assign(filename1,'f:\shiyan\data.txt');
  reset(filename1);
  for i:=1 to datanum do
    begin
      readln(filename1,y[i]);
      writeln(y[i]);
    end;
  writeln('display q:');
  for j:=1 to datanum-paranum do
  begin
    for k:=1 to paranum do
    begin
      q[j,k]:=y[j+paranum-k];
      write(q[j,k]:12:5);
    end;
    writeln;
  end;
  writeln('display q.t: ' );
end;

Procedure  change(var q : a2);                    {
求q的转置
}
var i,j,k : integer;
begin
for k:=1 to paranum do
begin
  for i:=1 to datanum-paranum do
    begin
    p[k,i]:=q[i,k];
    write(p[k,i]:10:5,'      ');
    end;
    writeln;
    end;
writeln('display  q.T*q:  ');
end;

procedure mutipl1;                               {
求q.T*q
}
var m,n,l : integer;
begin
for m:=1 to paranum do
 begin
   for n:=1 to paranum do
    begin
     h[m,n]:=0;
     for l:=1 to datanum-paranum do
     h[m,n]:=h[m,n]+p[m,l]*q[l,n];
     write(h[m,n]:10:5,'      ');
    end;
    writeln;
 end;
 writeln('display q.T*y:');
end;


procedure mutipl2;                          {
求q.T*y
}
var i,j : integer;
begin
  for i:=1 to paranum do
  begin
    b[i]:=0;
    for j:=1 to datanum-paranum do
    b[i]:=b[i]+p[i,j]*y[j+paranum];
    writeln(b[i]:10:5);
  end;
  writeln('X:');
end;

procedure gause;                              {
求解模型估计参数X
}
var i,j,k,l,n : integer;
     r,e : real;
begin
for i:=1 to paranum do h[i,paranum+1]:=b[i]; {
化为增广矩阵
}
for i:=1 to paranum do  {
从每行开始做如下循环作业(i循环)
}
   begin
      l:=i;   n:=0;  e:=h[i,0];  {
p,q,e赋值
}
      for j:=i to paranum do    {
从节点行以下所有行作如下动作(j循环)
}
         for k:=0 to paranum do{
k循环
}
            if abs(h[j,k])>abs(e) then
            begin e:=h[j,k];
            n:=k;
            l:=j;
            end; {
从第j行中求出最大值,配合j循环可得第i行后所有元素中的最大值,并确定其位置p,q
}
      if abs(e)>1.0E-10 then{
if1
}{
如此行后最大值小于10-10  ,视此行后所有元素为0,不再计算
}{
此为if1
}
      begin
        if l<>i then {
此为if2
}{
如p=I,即最大值在此行,不调整换行,否则换行
}
        begin
        for k:=1 to paranum+1 do begin xx[k]:=H[i,k];H[i,k]:=H[l,k];H[l,k]:=xx[k];end; {
换行,i行与此行后最大值行互换
}
        end; {
if2
}
        for j:=1 to paranum do   {
j循环
}
          begin if (j<>i) and (H[j,n]<>0
...
...
(Please download the complete source code to view)
			
...
Expand> <Close

Want complete source code? Download it here

Point(s): 1

Download
0 lines left, continue to read
Sponsored links

File list

Tips: You can preview the content of files by clicking file names^_^
Name Size Date
ENDLESS.PAS4.55 kB27-03-05|22:16
...
Sponsored links

ENDLESS.PAS (1.94 kB)

Need 1 point
Your Point(s)

Your Point isn't enough.

Get point immediately by PayPal

More(Debit card / Credit card / PayPal Credit / Online Banking)

Submit your source codes. Get more point

LOGIN

Don't have an account? Register now
Need any help?
Mail to: support@codeforge.com

切换到中文版?

CodeForge Chinese Version
CodeForge English Version

Where are you going?

^_^"Oops ...

Sorry!This guy is mysterious, its blog hasn't been opened, try another, please!
OK

Warm tip!

CodeForge to FavoriteFavorite by Ctrl+D