DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »tspln3fitxt«

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦09b4e9619⟧ »thcømat« 
            └─⟦this⟧ 

TextFile

;klab3 2 time.300
;spln3fitxt rene moss 5-3-74/28-06-77
clear spln3fit
spln3fit=set 160
spln3fit=algol 
begin
real sd,x,y,ymin,ymax,dymin,dymax,
     xm,xp,ym,yp,mm,mp,di,dr,intmax,intmin;
integer n,i,j;
boolean smooth,avud;
array T(1:12),TYPE(0:0);
avud:=true;
TYPE(0):=1;
cleararray(T);
for j:=readchar(in,i) while i<33 or i=127 do;
repeatchar(in);
if j<2 or j>5 then begin
   integer array az(0:127);
   for i:=0 step 1 until 127 do az(i):= 6 shift 12 + i;
   for i:=10,12,25 do az(i):= 8 shift 12 + i;
   tableindex:=0;
   intable(az);
   readstring(in,T,1);
   intable(0) end;
read(in,n);
begin
array X,Y,YS,M,SD,D,I(1:n);

i:=read(in,X,YS,SD)-n-n;
for j:=1 step 1 until n do Y(j):=YS(j);
if i=0 then begin
   smooth:=false;
   for i:=1 step 1 until n do SD(i):=0 end
       else begin
   if i=1 then begin
      sd:=SD(1);
      for i:=2 step 1 until n do SD(i):=sd;
      i:=n end;
   if i<>n then begin
      write(out,<:error in data:>);
      endprogram(true) end else
      if -,spln3smth(X,Y,SD,n) then
         write(out,<:smoothing impossible:>)
         else smooth:=true end;
spln3(TYPE,X,Y,M,n);
j:=0;
i:=reservesegm(<:splndata:>,5);
if i=0 or i=3 then begin
   stackcuro;
   if connectcuro(<:splndata:>)<>0 then begin
      unstackcuro;
      j:=-'100 end end;

i:=1;
write(out,string T(increase(i)),
     <:<10><10> i     X         Y      :>);
if smooth then write(out,<:      S           s.d.:>);
write(out,<:     S''    S'  Int(S) 0-x:>);
for i:=1 step 1 until n do begin
   D(i):=spln3dif(X(i),X,Y,M,n);
   I(i):=spln3int(X(i),X,Y,M,n);
   write(out,<:<10>:>,<<dd>,i,<< -d.ddd'+z>,X(i),
        << -ddd.ddd'+z>,YS(i));
   if smooth then write(out,<<  -ddd.ddd'+z>,Y(i),
                        <: +- :>,<<d.d'+z>,SD(i));
   write(out,<< -ddd'+z>,M(i),D(i),I(i)) end i;
closeout;
j:=n+j+130;
if j>0 and avud then begin
if psubmit(<:splndata:>,j)=0 then
   write(out,<:<10>jobnr: :>,<<dddd>,j) else begin
   j:=0;
   if permentry(<:splndata:>,13)=0 then
      write(out,<:<10>result in splndata:>) else
      write(out,<:<10>output lost:>) end
end;
outend(10);

connectcuri(<:v:>);
write(out,<:<10>plot ?:>);
outend(32);
cleararray(T);
readstring(in,T,1);
di:=T(1) shift (-32) shift 32;
i:=1;
if di<>real<:no:> then begin
if di=real<:ye:> then setplotname(<:tek4006a:>,1)
   else setplotname(string T(increase(i)),2);
xm:=X(1); mm:=M(1); ym:=Y(1);
ymin:=ymax:=YS(1);
dymin:=dymax:=D(1);
intmin:=0;
intmax:=I(n);
for i:=2 step 1 until n do begin
   xp:=X(i); yp:=YS(i); mp:=M(i);
   if ymax<yp then ymax:=yp else
      if ymin>yp then ymin:=yp;
   dr:=D(i);
   if dymax<dr then dymax:=dr else
         if dymin>dr then dymin:=dr;
   if mm*mp<0.0 then begin
      di:=spln3dif(xm-mm/(mp-mm)*(xp-xm),X,Y,M,n);
      if dymax<di then dymax:=di else
         if dymin>di then dymin:=di end;
if (if yp>0 then ym<=0 else ym>=0) then begin
   di:=I(i-1);
   if di>intmax then intmax:=di else
      if di<intmin then intmin:=di end;
   xm:=xp; ym:=yp; mm:=mp end i;
plotform(1,4,0);
plotsubform(2,20,1,8,false);
if plotadmini(X(1),X(n),0,intmax,0) then begin
   plotgraph(x,spln3int(x,X,Y,M,n),plotxmax,plotxmin,
         -.1/deltax) end;
plotsubform(2,20,8,22,false);
if plotadmini(X(1),X(n),ymin,ymax,0) then begin
   plotgraph(x,spln3val(x,X,Y,M,n),plotxmin,plotxmax,.1/deltax);
   for i:=n step -1 until 1 do begin
      x:=X(i); y:=YS(i); plotmove(x,y-SD(i)); pendown;
      plotpoint(x,y,5); pendown; plotmove(x,y+SD(i));
      penup end end;
plotsubform(2,20,22,29,false);
if plotadmini(X(1),X(n),dymin,dymax,0) then begin
   plotgraph(x,spln3dif(x,X,Y,M,n),plotxmin,plotxmax,
             .1/deltax) end;
setmargin(14,6);
writeplot(<:<12>job :>,<<dddd>,j);
plotclose end;


end end
if ok.yes
permanent spln3fit▶14◀.13
▶EOF◀