⟦c9722d5c4⟧

TextFile

linda=algol index.no
\f


                         
linda
(LINEÆR DATAUDJÆVNING M. RESTFEJLUDSKRIFT.
 GOS:  feb. 1979.)

begin
comment  Som input kræves:
     1) En overskrift indrammet i <>.
     2) Antallet af observerede størrelser (N).
     3) Antallet af parametre der skal bestemmes (n).
     4) De N ligninger med vægte, saaledes:
          Først de n koefficienter til parametrene, dernæst
          den tilsvarende observerede størrelse og endelig
          usikkerheden paa denne størrelse.
     Hvis N=n beregnes ikke usikkerheder;
integer N, n, p;
boolean B, nl, sp, closeres;
array head(1:12);
zone res(128,1,stderror);
closeres:= outmedium(res);
readhead(in,head,1); read(in,N,n);
nl:= false add 10; sp:= false add 32; p:= 1;
write(res,<:<12>:>,nl,3,string head(increase(p)),nl,3);

if N<n then goto slut else begin
integer i, j, k;
real S, s, h, y;
integer array lg,cif(1:n),space(1:2);
array a, aa(1:N,1:n+2), A(1:n,1:n+1), lox(1:2), lop(1:n);
read(in,a);

comment Evaluation of x layout starts here;

begin
real man; integer b,h,d,fn,fe,s,ex;
for j:=n+1,n+2 do begin
h:= b:= 1; d:= fn:= 0;
for i:=1 step 1 until N do begin
   man:= a(i,j); if man<>0 then begin
   ex:= entier(ln(abs man)/ln10); man:= man*10**(-ex);
   if man<0 then fn:= 1; 
   man:= abs man; y:= man - round man; k:= 0;
   for k:=k+1 while abs y>5*10**(k-11) do begin
      man:= (man - entier man)*10; y:= man - round man end;
   if k>b then b:= k;
   s:= if ex<0 then 1 else ex+1;
   if s>h then h:= s;
   s:= if ex<0 then k-ex-1 else if s>k then 0 else k-s;
   if s>d then d:= s
end end i;
if j=n+1 then fn:= 1;
comment b,h,d determine a layout of the form
        <<ddd.ddd0000> for column j;
if h+d>b+3 then begin
   comment exponent layout;
   s:= b-d-1; fe:= if s<0 then 1 else 0;
   s:= if abs s>9 or h-1>9 then 2 else 1;
   h:= 1; d:= b-1; space(j-n):= b+fn+s+fe+2
end else begin
   s:= fe:= 0; space(j-n):= h+fn+(if d>0 then d+1 else 0)
end;
k:= b shift 4 add h shift 4 add d shift 4 add fn
      shift 2 add s shift 4 add fe;
lox(j-n):= 0.0 add 511 shift 39 add k
end j;
end layout;
k:= 0;
for i:=1 step 1 until N do begin
   h:= a(i,n+2);
   if h<>0 then begin k:=k+1;
   for j:=1 step 1 until n+1 do aa(k,j):= a(i,j)/h
end end;
if k<n then goto slut;
B:= k>n;
ortho(aa,A,k,n);
write(res,sp,space(1)//2+8,<:obs.:>,
          sp,space(1)+3,<:calc.:>,
          sp,space(1),<:obs-calc.:>,
          sp,(space(1)+space(2))//2+1,<:delta:>);
S:= 0;
for i:=1 step 1 until N do begin
   y:= 0; h:= a(i,n+2);
   for j:=1 step 1 until n do y:= y + a(i,j)*A(j,n+1);
   s:= a(i,n+1) - y;
   write(res,nl,1,string lox(1),a(i,n+1),y,
                s,string lox(2),h);
   if h<>0 then S:= S + (s/h)**2
end;
S:= S/(if B then k-n else 1);
write(res,nl,2,<:Standard deviation: :>,<<d.dd'-d>,sqrt(S),nl,3); 
write(res,<:Solution and error matrix::>,nl,2);
p:= (n-1) mod 5 + 1; k:= 1;
for i:=1 step 1 until n do lg(i):= 14;
rep:
for j:=k step 1 until p do begin
  h:= A(j,n+1); s:= sqrt(A(j,j)*S);
  cif(j):= if B then
    entier(ln(abs h)/ln10)-entier(ln(s/2)/ln10)+1 else 10;
  if cif(j)<1 then cif(j):= 4;
  write(res,string format(lg(j),cif(j),h,lop(j)),h)
end;
if B then begin
   write(res,nl,1);
   for j:=k step 1 until p do begin
     write(res,string lop(j),sqrt(A(j,j)*S));
     if cif(j)<>0 then write(res,<:':>,<<d>,cif(j));
   end;
   write(res,nl,1);
   for i:=1 step 1 until p do begin write(res,nl,1);
   for j:=k step 1 until i-1 do write(res,sp,14);
   for j:=j step 1 until p do write(res,<<____-d.dddd'-d>,A(i,j)*S)
end i end;
write(res,nl,2); k:= p+1; p:= p+5; if k<n then goto rep
end;

slut: write(res,<:<25>:>); close(res,closeres) end
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦c9722d5c4⟧ TextFile

Derivation

TextFile
