home *** CD-ROM | disk | FTP | other *** search
/ The Best of the Best / _.img / 02018 / st17.pas < prev    next >
Pascal/Delphi Source File  |  1987-08-08  |  57KB  |  1,512 lines
  1. program Statistik;
  2.  
  3.   Type astring = string[80];
  4.        Eingabeart=(Urli,Haeufigk2);
  5.        sort_liste = array[1..300] of real;
  6.        Satz1=Record
  7.                Mnam:String[9];
  8.                Udat:array[1..300] of real;
  9.                anz_zeile:integer;
  10.              end;
  11.        Satz2=Record
  12.                g:char;
  13.                Hnam:array[1..2] of String[9];
  14.                Hdat:array[1..2,1..23] of real;
  15.                       ahi:array[1..23,1..23] of real;
  16.                       anz_sp,anz_ze:integer;
  17.               end; {von Satz2}
  18.  
  19.   label beg1;
  20.  
  21.   var nr1,nr2,et,OK,row,col,anz,e1,j,k,p,wnr,ior,ende,a_sp,drive:integer;
  22.       Eart:Eingabeart;
  23.       s1:array[1..15] of Satz1;
  24.       s2:Satz2;
  25.       dat1:file of Satz1;
  26.       dat2:file of Satz2;
  27.       rahmen1,rahmen2,rahmen3,rahmen4,wstr,hstr,kommx:astring;
  28.       sor1,sor2:sort_liste;
  29.       liste,e_a,frg,grup,hfrg:char;
  30.       wort1:string[20];
  31.       drv,E_Csr:string[11];
  32.       titelz:string[50];
  33.       DatIO,Drivename:string[40];
  34.       erw:string[4];
  35.       lr,l_sp,e_sp,l_ze,e_ze,ak_nr,ak_ze,ak_sp,ac:integer; {Variablen für Scrollen}
  36.       erfanz,durchlauf,mnr,slaz,laz,l_esp,cur_sp,cur_ze,uab,abnr,maxanz:integer;
  37.       Stfehler,umwa,verbess,eingeben:boolean;
  38.       nenner,ar,br,sresi,ydsum,xsum,ysum,xsumq,xysum,Ewert,yari,xari,xgeo:real;
  39.       xhar,xvari1,xvari2,xstand1,xstand2,yvari1,yvari2,ystand1,ystand2:real;
  40.       klw,grw,spw,medi,cova,covxy1,covxy2,rpear,rako,conti,rpar,rbipar,mpar:real;
  41.       Matr:array[1..15,1..15] of real;
  42.       Mmat:array[1..10,1..20] of real;
  43.       pxy,mulma:array[1..10] of real;
  44.       nr:array[1..10] of integer;
  45.  
  46.   const  t11='╔═════╦';
  47.          t12='═══════════╤';
  48.          t13='═══════════╗';
  49.          t14='║     ║';
  50.          t15='           │';
  51.          t16='           ║';
  52.          t17='╟─────╫';
  53.          t18='───────────┼';
  54.          t19='───────────╢';
  55.          t20='╚═════╩';
  56.          t21='═══════════╧';
  57.          t22='═══════════╝';
  58.  
  59. {$I typedef.sys}
  60. {$I graphix.sys}
  61. {$I kernel.sys}
  62. {$I windows.sys}
  63. {$I Twindow.inc}
  64.  
  65. procedure fdisplay(var s: astring ; var r,c : integer);
  66. begin
  67.   INLINE(
  68. $8B/$5E/$04/$8B/$3F/$4F/$8B/$5E/$08/$8B/$07/$48/$8B/$5E/$0C/$32/$ED/$8A/$0F/
  69. $80/$F9/$00/$74/$40/$C4/$76/$0C/$46/$BB/$40/$00/$8E/$C3/$26/$F7/$26/$4A/$00/
  70. $03/$F8/$D1/$E7/$26/$8B/$16/$63/$00/$83/$C2/$06/$B8/$00/$B8/$26/$8B/$1E/$10/
  71. $00/$81/$E3/$30/$00/$83/$FB/$30/$75/$03/$B8/$00/$B0/$8E/$C0/$EC/$A8/$01/$75/
  72. $FB/$FA/$EC/$A8/$01/$74/$FB/$A4/$47/$E2/$F1/$FB)
  73. end;
  74.  
  75. procedure Farbwahl(v,h: integer);
  76. begin
  77.   textcolor(v);textbackground(h);
  78. end;
  79.  
  80. procedure CRdelay(n: real);
  81. var i:real;
  82.     ch:char;
  83.     quit:boolean;
  84.  
  85. begin
  86.   i:=0;
  87.   ch:=' ';
  88.   repeat
  89.     i:=i+1;
  90.     quit:=false;
  91.     if keypressed then
  92.      begin
  93.       read(kbd,ch);
  94.        quit:=(ch=^C);
  95.        if (ch=^[) and keypressed then
  96.        begin
  97.         read(kbd,ch);
  98.         quit:=(ch='D');
  99.         ch:=' ';
  100.        end;
  101.      end;
  102.     if quit then
  103.      begin
  104.       leavegraphic;
  105.       halt;
  106.      end;
  107.   until (ch=^M) or (i>=n);
  108. end;
  109.  
  110. procedure waitreturn(n: real);
  111. begin
  112.   write(' Weiter mit <RETURN> = ',#17,#196,#217);
  113.   CRdelay(n);
  114. end;
  115.  
  116. procedure Stern(x,y:integer);
  117. begin
  118.     x:=WindowX(x);
  119.     y:=WindowY(y);
  120.     SetWindowModeOff;
  121.     DrawStar(x,y,2);
  122.     SetWindowModeOn;
  123. end;
  124.  
  125. procedure ClearEol(i:integer);
  126. begin
  127.   gotoxy(1,i);
  128.   write('                                                                               ');
  129. end;
  130.  
  131. procedure DefineWindowIBM(i,X1,Y1,X2,Y2:integer);
  132. begin
  133.   DefineWindow(i,Trunc(X1/79*XMaxGlb+0.001),Trunc(Y1/199*YMaxGlb+0.001),
  134.                  Trunc(X2/79*XMaxGlb+0.5),Trunc(Y2/199*YMaxGlb+0.5));
  135. end;
  136.  
  137. procedure E_Fehler(ft:astring);
  138. begin
  139.   Open_Window(3,10,10,70,14,14,5,' Fehlermeldung ');
  140.   gotoxy(3,2);write(#7,ft);
  141.   delay(4000);Close_Window(3);Farbwahl(0,7);
  142. end;
  143.  
  144. procedure Tab_eingeb(hw,x,y:integer);
  145. begin
  146.   repeat read(kbd,frg);
  147.     if frg in ['-','.','0'..'9',#8] then begin
  148.       gotoxy(x+ac,y);
  149.       if (ac>0) and (frg=#8) then begin
  150.         Farbwahl(7,4);ac:=ac-1;gotoxy(x+ac,y);write(' ');
  151.         gotoxy(x+ac,y);Farbwahl(0,7);
  152.         delete(wort1,length(wort1),1);
  153.       end;
  154.       if (frg<>#8) and (ac>=0) then begin
  155.         gotoxy(x+ac,y);ac:=ac+1;
  156.         if ac>hw then Exit;
  157.         write(frg);wort1:=wort1+frg;
  158.       end;
  159.     end; {of if}
  160.   until frg=^M;
  161. end;
  162.  
  163. procedure Sortier(var liste:sort_liste; a,e:integer);
  164. var v,h:real;
  165.     l,r:integer;
  166. begin
  167.   l:=a;r:=e;
  168.   v:=liste[trunc((a+e)/2)];
  169.   repeat
  170.     while liste[l] < v do l:=l+1;
  171.     while v < liste[r] do r:=r-1;
  172.     if l <= r then
  173.       begin
  174.         h:=liste[l];liste[l]:=liste[r];liste[r]:=h;
  175.         l:=l+1;r:=r-1;
  176.       end;
  177.   until l > r;
  178.   if a < r then Sortier(liste,a,r);
  179.   if l < e then Sortier(liste,l,e);
  180. end;  { von Sortier}
  181.  
  182. procedure P_korr(mer1,mer2:integer);
  183. var xvari,yvari:real;
  184.     i:integer;
  185. begin
  186.   Stfehler:=true;
  187.   cova:=0;xari:=0;yari:=0;for i:=1 to laz do begin
  188.     xari:=xari+s1[mer1].Udat[i];yari:=yari+s1[mer2].Udat[i];
  189.   end;
  190.   xari:=xari/laz;yari:=yari/laz;
  191.   xvari:=0;yvari:=0;for i:=1 to laz do begin
  192.     xvari:=xvari+Sqr(s1[mer1].Udat[i]-xari);yvari:=yvari+Sqr(s1[mer2].Udat[i]-yari);
  193.   end;
  194.   xvari1:=xvari/laz;yvari1:=yvari/laz;
  195.   xstand1:=sqrt(xvari1);ystand1:=sqrt(yvari1);
  196.   for i:=1 to laz do cova:=cova+(s1[mer1].Udat[i]*s1[mer2].Udat[i]-xari*yari);
  197.   cova:=cova/laz;
  198.   if (xstand1=0) or (ystand1=0) then Stfehler:=false;
  199.   if stfehler then rpear:=cova/(xstand1*ystand1) else rpear:=2;
  200. end;
  201.  
  202. procedure gaussalg(as,az:integer);
  203. var  i,z,hind: integer;
  204.      mul,dv,hilf: real;
  205. begin
  206.   for p:=1 to as do begin
  207.       hind:= p;
  208.       while ((abs(Mmat[p,p]) <= 1.0E-12) and (hind < az )) do begin
  209.         for k:= 1 to as do begin
  210.           hilf:= Mmat[p,k];
  211.           Mmat[p,k]:= Mmat[hind+1,k];
  212.           Mmat[hind+1,k]:= hilf
  213.         end;
  214.         hind:= hind + 1
  215.       end;
  216.       if (abs(Mmat[p,p]) > 1.0E-12) then begin
  217.       dv:= Mmat[p,p];
  218.       for k:=1 to as do
  219.         Mmat[p,k]:= Mmat[p,k] / dv;
  220.       for i:=1 to az-1 do
  221.       begin
  222.         if p+i <= az then z:= p+i
  223.                      else z:=p+i-az;
  224.         mul:= -Mmat[z,p];
  225.         for k:=1 to as do
  226.           Mmat[z,k]:= Mmat[z,k] + Mmat[p,k] * mul
  227.       end
  228.       end;
  229.     end
  230.   end;
  231.  
  232. Procedure Rangkorr;
  233. var rx,ry:array[1..300] of real;
  234.     kx,gx,ky,gy:integer;
  235.     rangdiff:real;
  236. begin
  237.   for j:=1 to laz do begin
  238.     kx:=0;gx:=0;ky:=0;gy:=0;
  239.     for k:=1 to laz do begin
  240.       if s1[nr1].Udat[k]>s1[nr1].Udat[j] then kx:=kx+1 else
  241.         if s1[nr1].Udat[k]=s1[nr1].Udat[j] then gx:=gx+1;
  242.       if s1[nr2].Udat[k]>s1[nr2].Udat[j] then ky:=ky+1 else
  243.         if s1[nr2].Udat[k]=s1[nr2].Udat[j] then gy:=gy+1;
  244.     end;
  245.     rx[j]:=kx+(gx+1)/2;
  246.     ry[j]:=ky+(gy+1)/2;
  247.   end;
  248.   rangdiff:=0;for j:=1 to laz do rangdiff:=rangdiff+sqr(rx[j]-ry[j]);
  249.   rako:=1-(6*rangdiff/laz/(sqr(laz)-1));
  250. end;
  251.  
  252. Procedure Regfu;
  253. begin
  254.   xsum:=0.0;ysum:=0.0;xsumq:=0.0;xysum:=0.0;
  255.   for j:=1 to laz do begin
  256.     xsum:=xsum+s1[nr1].Udat[j];
  257.     ysum:=ysum+s1[nr2].Udat[j];
  258.     xsumq:=xsumq+Sqr(s1[nr1].Udat[j]);
  259.     xysum:=xysum+(s1[nr1].Udat[j]*s1[nr2].Udat[j]);
  260.   end;
  261.   Nenner:=(laz*xsumq)-(Sqr(xsum));
  262.   if nenner<>0 then begin
  263.     br:=((laz*xysum)-(xsum*ysum))/nenner;
  264.     ar:=((ysum*xsumq)-(xsum*xysum))/nenner;
  265.   end;
  266. end;
  267.  
  268. procedure Wind_anz;
  269. var i:integer;
  270. begin
  271.   window(1,1,80,25);
  272.   Open_Window(2,45,3,75,8+anz,7,4,' Mögliche Merkmale ');
  273.   gotoxy(3,1);write('Übersicht aller Merkmale:');
  274.   for i:=1 to anz do begin
  275.     gotoxy(7,i+2);Farbwahl(0,7);write(i:2,' ');Farbwahl(7,4);write(' ',s1[i].Mnam);
  276.   end;
  277.   gotoxy(5,4+anz);write('Weiter mit <SPACE> !');
  278.   repeat read(kbd,frg) until frg=' ';
  279.   Close_Window(2);
  280. end;
  281.  
  282. {-----------------------------------------------------------------------------}
  283. {$I grafinfo.inc}
  284. {-----------------------------------------------------------------------------}
  285. Overlay Procedure Diskein_aus;
  286. label datanf;
  287.  
  288. type string80 = string[80]; {filename & Pfad}
  289.  
  290. procedure dir(filename:string80);
  291.  
  292. var drive,x   :byte; {drive-nr und help byte}
  293.     dir_regs  :record ax,bx,cx,dx,bp,si,di,ds,es,flags : integer; end;
  294.     subdir    :string[15];
  295.     vol       :string[43];
  296.     free      :real;
  297.     lines,nof :integer; {Anzahl der Files}
  298.     dta       :array[0..42] of char;
  299.  
  300. procedure process_entry;
  301. var name,date : string[8];
  302.     ext       : string[3];
  303.     time      : string[6];
  304.     hlps      : string[15];
  305.     len       : real; {File-Länge}
  306.     a,b,c     :byte;
  307. begin
  308.   name:='';a:=0;
  309.   repeat
  310.   if not(ord(dta[$1e+a]) in [0,ord('.')]) then name:=name+dta[$1e+a];
  311.   a:=succ(a);
  312.   until (a=8) or (dta[$1e+a] in ['.',#0]);
  313.   ext:='';
  314.   repeat
  315.   if not(ord(dta[$1e+a]) in [0,ord('.')]) then ext:=ext+dta[$1e+a];
  316.   a:=succ(a);
  317.   until (length(ext)=3) or (dta[$1e+a]=#0);
  318.   repeat name:=name+' ';ext:=ext+' '; until length(name)=8;
  319.   a:=ord(dta[24]) and $1f;
  320.   b:=((ord(dta[25]) shl 8+ord(dta[24])) and $01e0)shr 5;
  321.   c:=ord(dta[25])shr 1+80;
  322.   str(b,hlps);
  323.   if b<10 then hlps:='0'+hlps;
  324.   date:=hlps+'.';
  325.   str(a,hlps);
  326.   if a<10 then hlps:='0'+hlps;
  327.   date:=hlps+'.'+date;
  328.   str(c,hlps);
  329.   date:=date+hlps;
  330.   time:='';
  331.   a:=ord(dta[23]) shr 3;
  332.   b:=((ord(dta[23]) shl 8+ord(dta[22])) and $07ff) shr 5;
  333.   str(a,hlps);
  334.   if a<10 then hlps:=' '+hlps;
  335.   time:=hlps+':';
  336.   str(b,hlps);
  337.   if b<10 then hlps:='0'+hlps;
  338.   time:=time+hlps;
  339.   len:=ord(dta[26])+256.0*ord(dta[27])+65536.0*ord(dta[28]);
  340.   if ext=copy(erw,2,3) then begin
  341.     writeln(' ',name,'  ',ext,'   ',len:6:0,date:10,' ',time:6);
  342.     lines:=lines+1;
  343.   end;
  344.   fillchar(dta[22],21,0);
  345. end; { of process_entry}
  346.  
  347. begin { von DIR}
  348.   with dir_regs do begin
  349.   for x:=1 to length(filename) do filename[x]:=upcase(filename[x]);
  350.   if (filename='') or ((length(filename)=2) and (filename[2]=':')) then
  351.     filename:=filename+'*.*';
  352.   filename:=filename+#0;
  353.   if filename[2]=':' then drive:=ord(filename[1])-64 else drive:=0;
  354.   getdir(drive,subdir);
  355.   drive:=ord(subdir[1])-64;
  356.   fillchar(dta,43,0); {clear dta}
  357.   ax:=$1a00;
  358.   ds:=seg(dta); dx:=ofs(dta);
  359.   msdos(dir_regs);
  360.   vol:=#255+#0+#0+#0+#0+#0+#8+chr(drive)+'???????????';
  361.   ax:=$1100;
  362.   ds:=seg(vol); dx:=ofs(vol)+1;
  363.   msdos(dir_regs);
  364.   vol:=copy(dta,9,11);
  365.   Open_Window(2,30,2,78,23,0,7,' Inhaltsverzeichnis von '+subdir);
  366.   write('  Kennsatz in Laufwerk ',chr(drive+64));
  367.   if lo(ax)=$ff then writeln(' hat keinen Namen') else
  368.                      writeln(' ist ',vol);
  369.   nof:=0;write('  ');Farbwahl(7,0);
  370.   writeln(' Name    Erweit.  Länge   Datum    Zeit  ');Farbwahl(0,7);
  371.   Window(33,5,77,22);
  372.   ax:=$4e00; ds:=seg(filename); dx:=ofs(filename)+1; cx:=$f7; msdos(dir_regs);
  373.   if (flags and 1<>1) then begin {kein Fehler}
  374.     process_entry;nof:=1;lines:=1; {erster File}
  375.     repeat
  376.     ax:=$4f00;ds:=seg(filename); dx:=ofs(filename)+1; msdos(dir_regs);
  377.     if flags and 1<>1 then begin
  378.       if lines>16 then begin
  379.         write(' Weitere Dateien  ══>  Leertaste drücken ! ');
  380.         repeat read(kbd,frg) until frg=' ';
  381.         lines:=1;Clrscr;
  382.       end;
  383.       process_entry; nof:=succ(nof); end;
  384.     until (flags and 1=1);
  385.   end;
  386.   if nof=0 then writeln(' Die Diskette ist leer !') else begin
  387.     ax:=$3600;
  388.     dx:=drive;
  389.     msdos(dir_regs);
  390.     free:=1.0*ax*bx*cx;
  391.     writeln(nof:9,' Datei(en)  ',free:0:0,' bytes frei');
  392.   end;
  393. end;
  394. end;
  395.  
  396. begin  { von Overlay Diskein_aus }
  397.   Open_Window(1,10,7,70,17,14,1,DatIO);
  398.   gotoxy(5,3);write('Bitte geben Sie das Laufwerk an, das Ihre ');
  399.   gotoxy(5,4);write('Datendiskette enthält (A - B).');
  400.   gotoxy(5,6);write('Laufwerk = ___');
  401.   gotoxy(5,7);write('Bei <RETURN> wird das Laufwerk A genommen.');
  402.   repeat gotoxy(17,6);read(kbd,frg) until (frg in ['a','b','A','B']) or (frg=chr(13));
  403.   if frg in ['A','B'] then frg:=chr(ord(frg)+32);
  404.   if frg=chr(13) then frg:='a';
  405.   drv:=frg+':';Clrscr;
  406.   gotoxy(8,2);write('Bitte geben Sie einen Dateinamen ein !');
  407.   gotoxy(8,3);write('(maximal 8 Zeichen, ohne Erweiterung)');
  408.   gotoxy(1,4);if e_a='s' then write('       Bitte keine Erweiterungen eingeben !')
  409.   else begin
  410.     write('Bitte "U" für Urliste, "H" für Häufigkeitstabelle drücken !');
  411.     repeat read(kbd,liste) until liste in ['u','U','h','H'];
  412.     liste:=Upcase(liste);
  413.     if liste='U' then erw:='.URL' else begin
  414.       gotoxy(1,4);write('Bitte "1" oder "2" für die Dimension der Tabelle drücken ! ');
  415.       repeat read(kbd,liste) until liste in ['1','2'];
  416.       if liste='1' then erw:='.HI1' else erw:='.HI2';
  417.     end;
  418.   end;
  419.   gotoxy(8,8);write('Mit       => Directoryanzeige ');
  420.   gotoxy(12,8);Farbwahl(0,7);write(' F10 ');
  421.   Farbwahl(14,1);
  422. datanf:wort1:='';ac:=0;gotoxy(8,6);write('Dateiname = ________ ');gotoxy(20,6);
  423.   repeat read(kbd,frg);
  424.     if (frg=^[) and keypressed then begin
  425.       read(kbd,frg);
  426.       if frg='D' then begin
  427.         Window(1,1,80,25);
  428.         Dir(drv);
  429.         gotoxy(4,18);write(' Weiter mit <SPACE> = Leertaste !');
  430.         repeat read(kbd,frg) until frg=' ';
  431.         Close_Window(2);Window(11,8,69,17);
  432.         Farbwahl(14,1);gotoxy(20+ac,6);
  433.       end
  434.       else goto datanf;
  435.     end
  436.     else begin
  437.       Farbwahl(14,1);
  438.       if (ac>0) and (frg=chr(8)) then begin
  439.         ac:=ac-1;gotoxy(20+ac,6);write('_');delete(wort1,length(wort1),1);
  440.         gotoxy(20+ac,6);
  441.       end
  442.       else if frg<>chr(13) then if frg<>#8 then begin
  443.         gotoxy(20+ac,6);ac:=ac+1;write(frg);wort1:=wort1+frg;
  444.       end;
  445.     end;
  446.   until frg=chr(13);
  447.   if ((length(wort1)>9) and (wort1[2]<>':')) or (length(wort1)>11) then goto datanf;
  448.   if wort1[2]=':' then wort1:=wort1+erw else wort1:=drv+wort1+erw;
  449.   if e_a='s' then
  450.     if Eart=Urli then begin
  451.       assign(dat1,wort1);
  452.       rewrite(dat1);
  453.       for j:=1 to a_sp do write(dat1,s1[j]);
  454.       close(dat1);
  455.     end
  456.     else begin
  457.       assign(dat2,wort1);
  458.       rewrite(dat2);
  459.       write(dat2,s2);
  460.       close(dat2);
  461.     end;
  462. end;
  463. {-----------------------------------------------------------------------------}
  464. {$I anf_dru.inc}
  465. {-----------------------------------------------------------------------------}
  466. {$I Grafik.inc}
  467. {-----------------------------------------------------------------------------}
  468. Overlay Procedure Partkorr;
  469. label neules;
  470. var hilfv:real;
  471. begin
  472.   Open_Window(1,6,5,74,20,14,1,' Partielle Korrelation ');cur_ze:=8;
  473.   gotoxy(2,2);writeln('Bitte geben Sie zuerst die beiden Merkmale an, zwischen welchen');
  474.   writeln(' Sie die Korrelation berechnen möchten und dann das Merkmal, das');
  475.   write(' konstant gehalten werden soll !');
  476.   gotoxy(5,14);write('Mit       Anzeige der möglichen Merkmale.');
  477.   gotoxy(9,14);Farbwahl(0,7);write(' F10 ');Farbwahl(14,1);
  478.   gotoxy(5,5);write('Bitte geben Sie die Nummer des gewählten Merkmales ein');
  479.   gotoxy(5,6);write(' und bestätigen Sie Ihre Auswahl mit <RETURN>');
  480. neules:ac:=1;wort1:='';gotoxy(5,cur_ze);
  481.   write('Nummer des             Merkmales : __');
  482.   gotoxy(16,cur_ze);if cur_ze=8 then write('ersten (X) ') else if cur_ze=9 then
  483.     write('zweiten (Y)') else write(' konstanten');
  484.   repeat gotoxy(40,cur_ze);read(kbd,frg) until (frg in ['1'..'9']) or (frg=^[);
  485.   if (frg=^[) and keypressed then begin
  486.     wind_anz;Window(7,6,73,19);Farbwahl(14,1);goto neules;
  487.   end;
  488.   wort1:=wort1+frg;gotoxy(40,cur_ze);write(wort1);
  489.   if a_sp>9 then Tab_eingeb(2,40,cur_ze) else Tab_eingeb(1,40,cur_ze);
  490.   if ((a_sp>9) and (ac>2)) or ((a_sp<10) and (ac>1)) then goto neules;
  491.   val(wort1,ak_nr,e1);if ak_nr>anz then goto neules;
  492.   if cur_ze=8 then begin
  493.     nr[1]:=ak_nr;cur_ze:=9;goto neules;
  494.   end
  495.   else if cur_ze=9 then begin
  496.     nr[2]:=ak_nr;if nr[1]<>nr[2] then cur_ze:=11;goto neules;
  497.   end
  498.   else nr[3]:=ak_nr;
  499.   if (nr[1]=nr[3]) or (nr[2]=nr[3]) then goto neules;
  500.   pxy[1]:=Matr[nr[1],nr[2]];
  501.   pxy[2]:=Matr[nr[1],nr[3]];
  502.   pxy[3]:=Matr[nr[2],nr[3]];
  503.   for j:=1 to 3 do if pxy[j]=2 then Stfehler:=false;
  504.   Clrscr;
  505.   if Stfehler=false then begin
  506.     gotoxy(3,4);write('Eine der Korrelationskoeffizienten ist nicht berechenbar.');
  507.     gotoxy(3,6);write('Bitte verlassen Sie dieses Memue mit <SPACE> und');
  508.     gotoxy(3,8);write('waehlen Sie andere Merkmale aus !');
  509.   end
  510.   else begin
  511.     gotoxy(5,3);write('Korrelationskoeffizient r(X,Y) = ',pxy[1]:6:4);
  512.     gotoxy(5,4);write('Korrelationskoeffizient r(X,U) = ',pxy[2]:6:4);
  513.     gotoxy(5,5);write('Korrelationskoeffizient r(Y,U) = ',pxy[3]:6:4);
  514.     hilfv:=0;rpar:=0;rpar:=pxy[1]-(pxy[2]*pxy[3]);
  515.     hilfv:=sqrt((1-sqr(pxy[2]))*(1-sqr(pxy[3])));
  516.     if hilfv>0 then rpar:=rpar/hilfv;
  517.     gotoxy(10,7);write('r(X,Y)/U = ');
  518.     if hilfv>0 then write(rpar:6:4) else write('nicht berechenbar, da Nenner = 0');
  519.   end;
  520.   gotoxy(5,10);write('X = ',s1[nr[1]].Mnam,'  Y = ',s1[nr[2]].Mnam,'  U = ',s1[nr[3]].Mnam);
  521.   gotoxy(5,13);write('Weiter mit <SPACE> = Leertaste !');
  522.   repeat read(kbd,frg) until (frg = ' ');
  523.   Close_Window(1);
  524. end;
  525. {-----------------------------------------------------------------------------}
  526. Overlay Procedure Biparkorr;
  527. label neules,wiederh;
  528. var hilfv:real;
  529. begin
  530.   Open_Window(1,5,4,75,20,14,1,' Bi-partielle Korrelation ');cur_ze:=8;
  531.   if anz<4 then begin
  532.     gotoxy(4,5);write('Dieser Koeffizient ist nur ab 4 Merkmalen berechenbar.');
  533.     gotoxy(5,15);write('Weiter mit <SPACE> = Leertaste !');Farbwahl(0,7);
  534.     gotoxy(50,15);write(' F1 ');Farbwahl(14,1);write(' Druck');
  535.     goto wiederh;
  536.   end;
  537.   gotoxy(2,2);writeln('Bitte geben Sie zuerst die beiden Merkmale an, zwischen welchen');
  538.   writeln(' Sie die Korrelation berechnen möchten und dann die beiden Merkmale,');
  539.   write(' die konstant gehalten werden sollen !');
  540.   gotoxy(5,14);write('Mit       Anzeige der möglichen Merkmale.');
  541.   gotoxy(9,14);Farbwahl(0,7);write(' F10 ');Farbwahl(14,1);
  542.   gotoxy(5,5);write('Bitte geben Sie die Nummer des gewählten Merkmales ein');
  543.   gotoxy(5,6);write(' und bestätigen Sie Ihre Auswahl mit <RETURN>');
  544. neules:ac:=1;wort1:='';gotoxy(5,cur_ze);
  545.   write('Nummer des                 Merkmales : __');gotoxy(16,cur_ze);
  546.   case cur_ze of
  547.     8: write('  ersten (X)   ');
  548.     9: write('  zweiten (Y)  ');
  549.     11:write('zu X konstanten');
  550.     12:write('zu Y konstanten');
  551.   end;
  552.   repeat gotoxy(44,cur_ze);read(kbd,frg) until (frg in ['1'..'9']) or (frg=^[);
  553.   if (frg=^[) and keypressed then begin
  554.     wind_anz;Window(6,5,74,19);Farbwahl(14,1);goto neules;
  555.   end;
  556.   wort1:=wort1+frg;gotoxy(44,cur_ze);write(wort1);
  557.   if a_sp>9 then Tab_eingeb(2,44,cur_ze) else Tab_eingeb(1,44,cur_ze);
  558.   if ((a_sp>9) and (ac>2)) or ((a_sp<10) and (ac>1)) then goto neules;
  559.   val(wort1,ak_nr,e1);if ak_nr>anz then goto neules;
  560.   case cur_ze of
  561.     8: begin nr[1]:=ak_nr;cur_ze:=9;goto neules; end;
  562.     9: begin nr[2]:=ak_nr;if nr[1]<>nr[2] then cur_ze:=11;goto neules; end;
  563.    11: begin nr[3]:=ak_nr;
  564.          if (nr[3]<>nr[2]) and (nr[3]<>nr[1]) then cur_ze:=12;goto neules;
  565.        end;
  566.    12: nr[4]:=ak_nr;
  567.   end;
  568.   if (nr[4]=nr[1]) or (nr[4]=nr[2]) or (nr[4]=nr[3]) then goto neules;
  569.   pxy[1]:=Matr[nr[1],nr[2]];
  570.   pxy[2]:=Matr[nr[1],nr[3]];
  571.   pxy[3]:=Matr[nr[1],nr[4]];
  572.   pxy[4]:=Matr[nr[2],nr[3]];
  573.   pxy[5]:=Matr[nr[2],nr[4]];
  574.   pxy[6]:=Matr[nr[3],nr[4]];
  575.   Clrscr;
  576.   for j:=1 to 6 do if pxy[j]=2 then Stfehler:=false;
  577.   if Stfehler=false then begin
  578.     gotoxy(3,4);write('Eine der Korrelationskoeffizienten ist nicht berechenbar.');
  579.     gotoxy(3,6);write('Bitte verlassen Sie dieses Memue mit <SPACE> und');
  580.     gotoxy(3,8);write('waehlen Sie andere Merkmale aus !');
  581.   end
  582.   else begin
  583.     gotoxy(5,3);write('Korrelationskoeffizient r(X,Y) = ',pxy[1]:6:4);
  584.     gotoxy(5,4);write('Korrelationskoeffizient r(X,U) = ',pxy[2]:6:4);
  585.     gotoxy(5,5);write('Korrelationskoeffizient r(X,V) = ',pxy[3]:6:4);
  586.     gotoxy(5,6);write('Korrelationskoeffizient r(Y,U) = ',pxy[4]:6:4);
  587.     gotoxy(5,7);write('Korrelationskoeffizient r(Y,V) = ',pxy[5]:6:4);
  588.     gotoxy(5,8);write('Korrelationskoeffizient r(U,V) = ',pxy[6]:6:4);
  589.     hilfv:=0;rbipar:=0;
  590.     rbipar:=pxy[1]-(pxy[2]*pxy[4])-(pxy[3]*pxy[5])+(pxy[2]*pxy[6]*pxy[5]);
  591.     hilfv:=sqrt((1-sqr(pxy[2]))*(1-sqr(pxy[5])));
  592.     if hilfv>0 then rbipar:=rbipar/hilfv;
  593.     gotoxy(10,10);write('r(X/U,Y/V) = ');
  594.     if hilfv>0 then write(rbipar:6:4) else write('nicht berechenbar, da Nenner = 0');
  595.   end;
  596.   gotoxy(5,12);write('X = ',s1[nr[1]].Mnam,'   Y = ',s1[nr[2]].Mnam);
  597.   gotoxy(5,13);write('U = ',s1[nr[3]].Mnam,'   V = ',s1[nr[4]].Mnam);
  598. wiederh:gotoxy(5,15);write('Weiter mit <SPACE> = Leertaste !');
  599.   repeat read(kbd,frg) until (frg = ' ');
  600.   Close_Window(1);
  601. end;
  602. {-----------------------------------------------------------------------------}
  603. Overlay Procedure Multikorr_reg;
  604. label wiederh1,neules1,neules2,neufrg;
  605. var hilfv,ym:real;
  606.     i,iz,loesz,eind:integer;
  607.     Xiar:array[1..15] of real;
  608.  
  609. begin
  610.   Stfehler:=true;
  611.   Open_Window(1,2,1,79,25,14,1,' Multiple Korrelation ');
  612.   (*******   Merkmale eingeben *******)
  613.   gotoxy(5,21);write('Mit       Anzeige der möglichen Merkmale.');
  614.   gotoxy(9,21);Farbwahl(0,7);write(' F10 ');Farbwahl(14,1);
  615.   gotoxy(2,2);write('Bitte geben Sie die Nummer des abhängigen Merkmales ein.');
  616.  neules1:Farbwahl(14,1);ac:=1;wort1:='';
  617.   gotoxy(2,3);write('Nummer von Y = abhängiges Merkmal: __');
  618.   repeat gotoxy(38,3);read(kbd,frg) until (frg in ['1'..'9']) or (frg=^[);
  619.   if (frg=^[) and keypressed then begin
  620.     wind_anz;Window(3,2,78,24);Farbwahl(14,1);goto neules1;
  621.   end;
  622.   wort1:=wort1+frg;gotoxy(37,3);write(wort1);
  623.   if a_sp>9 then Tab_eingeb(2,37,3) else Tab_eingeb(1,37,3);
  624.   if ((a_sp>9) and (ac>2)) or ((a_sp<10) and (ac>1)) then goto neules1;
  625.   val(wort1,abnr,e1);if abnr>anz then goto neules1;
  626.   if anz>10 then maxanz:=10 else maxanz:=anz-1;
  627. neufrg:gotoxy(2,5);
  628.   write('Wieviele unabhängige Merkmale möchten Sie auswählen ? (max ',maxanz:2,')     ');
  629.   gotoxy(66,5);read(uab);if (uab<1) or (uab>maxanz) then goto neufrg;
  630.   gotoxy(2,6);write('Möchten Sie bestimmte Merkmale bestimmen (J/N) ? ');
  631.   gotoxy(2,7);write('Bei N=Nein werden die ersten ',uab:2,' Merkmale genommen.');
  632.   repeat gotoxy(54,6);read(kbd,frg) until frg in ['n','N','j','J'];write(frg);
  633.   if (frg='j') or (frg='J') then begin
  634.     for j:=1 to uab do begin
  635.      neules2:Farbwahl(14,1);ac:=1;wort1:='';
  636.       gotoxy(2,8+j);write(j:2,'.Merkmal X',j:1,' = __');
  637.       repeat gotoxy(18,8+j);read(kbd,frg) until (frg in ['1'..'9']) or (frg=^[);
  638.       if (frg=^[) and keypressed then begin
  639.         wind_anz;Window(3,2,78,24);Farbwahl(14,1);goto neules2;
  640.       end;
  641.       wort1:=wort1+frg;gotoxy(18,8+j);write(wort1);
  642.       if a_sp>9 then Tab_eingeb(2,18,8+j) else Tab_eingeb(1,18,8+j);
  643.       if ((a_sp>9) and (ac>2)) or ((a_sp<10) and (ac>1)) then goto neules2;
  644.       val(wort1,nr[j],e1);if (nr[j]>anz) or (nr[j]=abnr) then goto neules2;
  645.       for k:=1 to j-1 do if nr[j]=nr[k] then goto neules2;
  646.     end;
  647.   end (* von if frg=j *)
  648.   else begin
  649.     k:=1;
  650.     for j:=1 to uab do begin
  651.       if j=abnr then k:=k+1;
  652.       nr[j]:=k;
  653.       k:=k+1;
  654.     end;
  655.   end;
  656.   (******* Multiple Korrelation *******)
  657.   for j:=1 to 10 do
  658.     for k:=1 to 20 do Mmat[j,k]:=0;
  659.   for j:=1 to uab do begin
  660.     pxy[j]:=Matr[abnr,nr[j]];Mmat[j,j]:=1.0;if pxy[j]>1 then Stfehler:=false;
  661.     for k:=j+1 to uab do begin
  662.       Mmat[j,k]:=Matr[nr[j],nr[k]];Mmat[k,j]:=Mmat[j,k];
  663.       if Matr[nr[j],nr[k]]>1 then Stfehler:=false;
  664.     end;
  665.   end;
  666.   Clrscr;
  667.   if Stfehler=false then begin
  668.     gotoxy(5,4);write('Mindestens Einer der Korrelationskoeffizienten ist ');
  669.     gotoxy(5,6);write('nicht berechenbar !');
  670.     gotoxy(5,9);write('Bitte verlassen Sie dieses Menue mit <SPACE> und');
  671.     gotoxy(5,11);write('waehlen Sie andere Merkmale aus !');
  672.     goto wiederh1;
  673.   end;
  674.   gotoxy(2,2);write('Die Matrix der einzelnen Korrelationskoeffizienten:');
  675.   gotoxy(trunc(uab/2)*6+3,3);write('R(X):');
  676.   gotoxy(67,3);write('r(Y,X(i):');
  677.   gotoxy(2,4);write('┌');gotoxy(68,4);write('┌      ┐');
  678.   for j:=1 to uab do begin
  679.     gotoxy(2,4+j);write('│');
  680.     for k:=1 to uab do write(Mmat[j,k]:6:3);
  681.     write(' │');cur_sp:=WhereX;cur_ze:=WhereY;
  682.     gotoxy(68,4+j);write('│',pxy[j]:6:3,'│');
  683.   end;
  684.   gotoxy(cur_sp-1,4);write('┐');
  685.   gotoxy(2,cur_ze+1);write('└');
  686.   gotoxy(cur_sp-1,cur_ze+1);write('┘');gotoxy(68,cur_ze+1);write('└      ┘');
  687.   gotoxy(3,16);write('Y = ',s1[abnr].Mnam);
  688.   write('   X(',nr[1]:1,')=',s1[nr[1]].Mnam,'  X(',nr[2],')=',s1[nr[2]].Mnam);
  689.   for j:=3 to uab do begin
  690.     if j<7 then gotoxy(16*(j-2)-13,17) else gotoxy(16*(j-6)-13,18);
  691.     write('X(',nr[j]:1,')=',s1[nr[j]].Mnam);
  692.   end;
  693.   for j:=1 to uab do Mmat[j,j+uab]:=1;
  694.   gaussalg(uab+uab,uab);
  695.   iz:=0;i:=0;
  696.   while (i<uab) and (iz=0) do begin
  697.     i:=i+1;
  698.     if (abs(Mmat[i,i]-1) > 1.0E-12) then begin  {Mmat[i,i]<>1}
  699.       gotoxy(3,20);write('Die Matrix ist nicht invertierbar');iz:=1;
  700.     end;
  701.   end;
  702.   if iz=0 then begin
  703.     for j:=1 to uab do begin
  704.       mulma[j]:=0;
  705.       for k:=1 to uab do mulma[j]:=mulma[j]+pxy[k]*Mmat[k,j+uab];
  706.     end;
  707.     hilfv:=0;for j:=1 to uab do hilfv:=hilfv+mulma[j]*pxy[j];
  708.     mpar:=sqrt(hilfv);
  709.     gotoxy(3,19);write('B[X(',abnr:1,'),[');
  710.     for j:=1 to uab-1 do write('X(',nr[j]:1,'),');
  711.     write('X(',nr[uab]:1,')]] = ');
  712.     gotoxy(9+uab*3,20);write(hilfv:8:6);
  713.     gotoxy(uab*3,21);write('r = √B = ',mpar:6:4);
  714.   end;
  715. wiederh1:gotoxy(5,23);write('Weiter mit <SPACE> = Leertaste !');
  716.   repeat read(kbd,frg) until (frg = ' ');
  717.   Close_Window(1);
  718.   (******* Multiple Regression *******)
  719.   Open_Window(1,3,2,78,24,14,1,' Multiple Regression ');
  720.   for j:=1 to anz do begin
  721.     Xiar[j]:=0;for k:=1 to laz do Xiar[j]:=Xiar[j]+s1[j].Udat[k];
  722.     Xiar[j]:=Xiar[j]/laz;
  723.   end;
  724.   Clrscr;if uab>4 then begin
  725.     gotoxy(5,7);write('Die Parameter der Regressionsgleichung werden berechnet.');
  726.     gotoxy(5,9);write('Bitte etwas Geduld !');
  727.   end;
  728.   yari:=Xiar[abnr];
  729.   for j:=1 to 10 do
  730.     for k:=1 to 20 do Mmat[j,k]:=0;
  731.   for j:=1 to uab do begin
  732.     for p:=1 to laz do
  733.       Mmat[j,j]:=Mmat[j,j]+Sqr(s1[nr[j]].Udat[p]-Xiar[nr[j]]);
  734.     for k:=j+1 to uab do begin
  735.       For p:=1 to laz do
  736.        Mmat[j,k]:=Mmat[j,k]+(s1[nr[j]].Udat[p]-Xiar[nr[j]])*(s1[nr[k]].Udat[p]-Xiar[nr[k]]);
  737.       Mmat[k,j]:=Mmat[j,k];
  738.     end;
  739.     For p:=1 to laz do
  740.       Mmat[j,uab+1]:=Mmat[j,uab+1]+(s1[abnr].Udat[p]-yari)*(s1[nr[j]].Udat[p]-Xiar[nr[j]]);
  741.   end; {von j=1 - uab}
  742.   Gaussalg(uab+1,uab);
  743.   eind:=0;i:=1;
  744.   while (abs(Mmat[i,i]-1)<=1.0E-12) and (i<uab+1) do i:=i+1;
  745.   if i=uab+1 then eind:=1;
  746.   loesz:=1; i:=0;
  747.   repeat
  748.     i:=i+1;k:=1;
  749.     while (abs(Mmat[i,k])<=1.0E-12) and (k<=uab+1) do k:=k+1;
  750.     if k=uab+1 then begin
  751.       hstr:=' Das Gleichungssystem hat keine Lösung !';
  752.       loesz:=0;
  753.     end;
  754.     if k=uab+2 then loesz:=1;
  755.   until ((loesz = 0) or (i=uab));
  756.   if (loesz=1) and (eind<>1) then hstr:=' Das Gleichungssystem hat unendlich viele Lösungen ';
  757.   if (loesz=1) and (eind=1) then hstr:='     ';
  758.   if loesz=0 then begin
  759.     gotoxy(3,5);write(hstr);  (** keine Lösung **)
  760.   end
  761.   else begin
  762.     for j:=1 to uab do pxy[j]:=Mmat[j,uab+1]; {pxy[j]=b[nr[j]]}
  763.     ar:=yari;for j:=1 to uab do ar:=ar-(pxy[j]*Xiar[Nr[j]]);
  764.     Clrscr;
  765.     gotoxy(10,2);write('Die Regressionsgleichung lautet:');
  766.     gotoxy(4,4);write('Y [');
  767.     for j:=1 to uab-1 do write('X(',nr[j]:1,'),');
  768.     write('X(',nr[uab]:1,')] = ');
  769.     gotoxy(14,5);write(ar:10:3,' + ');
  770.     for j:=1 to uab do begin
  771.       gotoxy(9,5+j);write(pxy[j]:7:3,' * X(',nr[j]:2,') ');
  772.       if j<uab then write('+ ');
  773.     end;
  774.     gotoxy(5,16);write(hstr);
  775.     gotoxy(3,17);write('Y = ',s1[abnr].Mnam);
  776.     write('   X(',nr[1]:1,')=',s1[nr[1]].Mnam,'  X(',nr[2]:1,')=',s1[nr[2]].Mnam);
  777.     for j:=3 to uab do begin
  778.       if j<7 then gotoxy(16*(j-2)-13,18) else gotoxy(16*(j-6)-13,19);
  779.       write('X(',nr[j]:1,')=',s1[nr[j]].Mnam);
  780.     end;
  781.   end; {of else}
  782.   gotoxy(5,21);write('Weiter mit <SPACE> = Leertaste !');
  783.   repeat read(kbd,frg) until (frg = ' ');
  784.   Close_Window(1);
  785. end;
  786. {-----------------------------------------------------------------------------}
  787. {$I eingabe.inc}
  788. {-----------------------------------------------------------------------------}
  789. Overlay Procedure statauswert;
  790. var vari,m:real;
  791.     windtext:string[60];
  792.     klassi:array[1..25] of real;
  793. begin
  794.   if erw='.HI1' then mnr:=1 else mnr:=ak_nr;
  795.   windtext:=' Statistische Kenndaten von Merkmal '+s1[mnr].Mnam;
  796.   Open_Window(2,7,5,73,24,14,3,windtext);
  797.   if s1[2].anz_zeile=1 then begin
  798.     gotoxy(5,1);writeln('Zur Berechnung wurden die Klassenmitten der einzelnen');
  799.     write('    Gruppen verwendet !');
  800.   end;
  801.   if erw='.URL' then klw:=sor1[1] else klw:=s1[1].Udat[1];
  802.   gotoxy(10,3);write('Kleinster Wert = ',klw:9:2);
  803.   if erw='.URL'then grw:=sor1[slaz] else if s1[2].anz_zeile=1
  804.     then grw:=s1[2].Udat[laz] else grw:=s1[1].Udat[laz];
  805.   gotoxy(10,4);write('Größter Wert   = ',grw:9:2);
  806.   spw:=grw-klw;gotoxy(10,5);write('Spannweite     = ',spw:9:2);
  807.   if erw='.URL' then begin
  808.     xari:=0;for j:=1 to laz do xari:=xari+sor1[j];
  809.     xari:=xari/laz;gotoxy(10,8);write('Arithmetisches Mittel = ',xari:9:2);
  810.     m:=(laz+1)/2; if m=int(m) then medi:=sor1[round(m)]
  811.     else medi:=(sor1[round(m+0.5)]+sor1[trunc(m)])/2;
  812.     xgeo:=0;for j:=1 to laz do xgeo:=xgeo+ln(sor1[j]);
  813.     xgeo:=EXP(xgeo/laz);gotoxy(10,9);write('Geometrisches Mittel  = ',xgeo:9:2);
  814.     xhar:=0;for j:=1 to laz do xhar:=xhar+(1/sor1[j]);
  815.     xhar:=laz/xhar;gotoxy(10,10);write('Harmonisches Mittel   = ',xhar:9:2);
  816.     vari:=0;for j:=1 to laz do vari:=vari+Sqr(sor1[j]-xari);
  817.     xvari1:=vari/laz;
  818.     xvari2:=vari/(laz-1);
  819.   end; (* Ende von erw=URL*)
  820.   if erw='.HI1' then begin
  821.     for j:=1 to laz do
  822.       if s1[2].anz_zeile=1 then klassi[j]:=(s1[2].Udat[j]+s1[1].Udat[j])/2
  823.                            else klassi[j]:=s1[1].Udat[j];
  824.     if s1[2].anz_zeile=1 then k:=3 else k:=2;
  825.     xari:=0;for j:=1 to laz do xari:=xari+(s1[k].Udat[j]*klassi[j]);
  826.     xari:=xari/s1[k+1].Udat[laz];
  827.     gotoxy(10,8);write('Gewogenes arithmetisches Mittel = ',xari:9:2);
  828.     j:=1;while s1[k+3].Udat[j]<50 do j:=j+1;
  829.     if s1[2].anz_zeile=1 then begin
  830.       if j=1 then medi:=s1[1].Udat[1]+((50/s1[5].Udat[1])*(s1[2].Udat[1]-s1[1].Udat[1]))
  831.         else medi:=s1[1].Udat[j]+(((50-s1[6].Udat[j-1])/s1[5].Udat[j])*
  832.                                        (s1[2].Udat[j]-s1[1].Udat[j]));
  833.     end
  834.     else medi:=s1[1].Udat[j];
  835.     xgeo:=1;for j:=1 to laz do xgeo:=xgeo*(EXP(s1[k+2].Udat[j]/100*ln(klassi[j])));
  836.     gotoxy(10,9);write('Gewogenes geometrisches Mittel = ',xgeo:9:2);
  837.     xhar:=0;for j:=1 to laz do xhar:=xhar+(s1[k+2].Udat[j]/klassi[j]);
  838.     xhar:=100/xhar;gotoxy(10,10);write('Gewogenes harmonisches Mittel = ',xhar:9:2);
  839.     vari:=0;for j:=1 to laz do vari:=vari+(Sqr(klassi[j]-xari)*s1[k].Udat[j]);
  840.     xvari1:=vari/s1[k+1].Udat[laz];
  841.     xvari2:=vari/(s1[k+1].Udat[laz]-1);
  842.   end;
  843.   xstand1:=sqrt(xvari1);
  844.   xstand2:=sqrt(xvari2);
  845.   gotoxy(10,6);write('Median         = ',medi:9:2);
  846.   gotoxy(10,11);write('Varianz (n)   = ',xvari1:10:2);
  847.   gotoxy(10,12);write('Varianz (n-1) = ',xvari2:10:2);
  848.   gotoxy(10,13);write('Standardabweichung (n)    = ',xstand1:9:3);
  849.   gotoxy(10,14);write('Standardabweichung (n-1)  = ',xstand2:9:3);
  850.   gotoxy(10,15);write('Variationskoeffizient (n)   = ',(xstand1/xari):8:3);
  851.   gotoxy(10,16);write('Variationskoeffizient (n-1) = ',(xstand2/xari):8:3);
  852.   gotoxy(10,18);write('Weiter mit <SPACE> = Leertaste !');
  853.   repeat read(kbd,frg) until (frg = ' ');
  854.   Close_Window(2);
  855. end;
  856. {-----------------------------------------------------------------------------}
  857. Overlay Procedure Stat2berech;
  858. var fij,chi,xvari,yvari:real;
  859.     windtext:string[60];
  860.     klassi:array[1..2,1..22] of real;
  861. begin
  862.   if erw='.URL' then begin
  863.     windtext:=' Statistische Kenndaten von X = '+s1[nr1].Mnam+' und Y = '+s1[nr2].Mnam;
  864.     xari:=0;yari:=0;for j:=1 to laz do begin
  865.       xari:=xari+sor1[j];yari:=yari+sor2[j];
  866.     end;
  867.     xari:=xari/laz;yari:=yari/laz;
  868.     xvari:=0;yvari:=0;for j:=1 to laz do begin
  869.       xvari:=xvari+Sqr(sor1[j]-xari);yvari:=yvari+Sqr(sor2[j]-yari);
  870.     end;
  871.     xvari1:=xvari/laz;yvari1:=yvari/laz;
  872.     xvari2:=xvari/(laz-1);yvari2:=yvari/(laz-1);
  873.   end;
  874.   if erw='.HI2' then begin
  875.     windtext:=' Statistische Kenndaten von X = '+s2.Hnam[1]+' und Y = '+s2.Hnam[2];
  876.     for j:=1 to s2.anz_sp do
  877.       if s2.g='G' then klassi[1,j]:=(s2.Hdat[1,j+1]+s2.Hdat[1,j])/2
  878.                            else klassi[1,j]:=s2.Hdat[1,j+1];
  879.     for j:=1 to s2.anz_ze do
  880.       if s2.g='G' then klassi[2,j]:=(s2.Hdat[2,j+1]+s2.Hdat[2,j])/2
  881.                            else klassi[2,j]:=s2.Hdat[2,j+1];
  882.     xari:=0;for j:=1 to s2.anz_sp do xari:=xari+(s2.ahi[j,23]*klassi[1,j]);
  883.     yari:=0;for j:=1 to s2.anz_ze do yari:=yari+(s2.ahi[23,j]*klassi[2,j]);
  884.     xari:=xari/s2.ahi[23,23];yari:=yari/s2.ahi[23,23];
  885.     xvari:=0;for j:=1 to s2.anz_sp do xvari:=xvari+(Sqr(klassi[1,j]-xari)*s2.ahi[j,23]);
  886.     yvari:=0;for j:=1 to s2.anz_ze do yvari:=yvari+(Sqr(klassi[2,j]-yari)*s2.ahi[23,j]);
  887.     xvari1:=xvari/s2.ahi[23,23];yvari1:=yvari/s2.ahi[23,23];
  888.     xvari2:=xvari/(s2.ahi[23,23]-1);yvari2:=yvari/(s2.ahi[23,23]-1);
  889.   end;
  890.   Clrscr;Open_Window(2,6,3,73,23,14,3,windtext);gotoxy(38,3);
  891.   if (s2.g='G') and (erw='.HI2') then begin
  892.     gotoxy(3,1);writeln('Zur Berechnung der nachfolgenden Werte wurden die');
  893.     write('  Klassenmitten der einzelnen Gruppen verwendet !');gotoxy(38,4);
  894.   end;
  895.   xstand1:=sqrt(xvari1);ystand1:=sqrt(yvari1);
  896.   xstand2:=sqrt(xvari2);ystand2:=sqrt(yvari2);
  897.   write('Werte von X    Werte von Y ');
  898.   gotoxy(6,5);write('Arithmetisches Mittel:');gotoxy(39,5);write(xari:9:2,'   ',yari:9:2);
  899.   gotoxy(6,6);write('Varianz (n) :');gotoxy(39,6);write(xvari1:9:2,'   ',yvari1:9:2);
  900.   gotoxy(6,7);write('Varianz (n-1) :');gotoxy(39,7);write(xvari2:9:2,'   ',yvari2:9:2);
  901.   gotoxy(6,8);write('Standardabweichung (n) :');
  902.   gotoxy(39,8);write(xstand1:9:3,'   ',ystand1:9:3);
  903.   gotoxy(6,9);write('Standardabweichung (n-1) :');
  904.   gotoxy(39,9);write(xstand2:9:3,'   ',ystand2:9:3);
  905.   gotoxy(6,11);write('Statistische Größen von 2 Merkmalen:');
  906.   cova:=0;chi:=0;
  907.   if erw='.URL' then begin
  908.     for j:=1 to laz do cova:=cova+(s1[nr1].Udat[j]*s1[nr2].Udat[j]-xari*yari);
  909.     covxy1:=cova/laz;covxy2:=cova/(laz-1);
  910.   end;
  911.   if erw='.HI2' then begin
  912.     for j:=1 to s2.anz_sp do begin
  913.       for k:=1 to s2.anz_ze do begin
  914.         cova:=cova+((klassi[1,j]-xari)*(klassi[2,k]-yari)*s2.ahi[j,k]);
  915.         fij:=(s2.ahi[j,23]*s2.ahi[23,k])/s2.ahi[23,23];
  916.         if fij<>0 then chi:=chi+(sqr(s2.ahi[j,k]-fij)/fij);
  917.       end;
  918.     end;
  919.     covxy1:=cova/s2.ahi[23,23];covxy2:=cova/(s2.ahi[23,23]-1);
  920.     conti:=sqrt(chi/(s2.ahi[23,23]+chi));
  921.   end;
  922.   gotoxy(6,12);write('Die Kovarianz von x und y  S(x,y) [bzgl. n] = ',covxy1:9:3);
  923.   gotoxy(6,13);write('Die Kovarianz von x und y  S(x,y) [bzgl. (n-1)] = ',covxy2:9:3);
  924.   gotoxy(6,14);write('Pearsonscher Korrelationskoeffizient r(x,y) = ');
  925.   nenner:=(xstand1*ystand1);
  926.   if nenner=0 then write('****') else begin
  927.     rpear:=covxy1/nenner;write(rpear:6:4);
  928.   end;
  929.   if erw='.URL' then begin
  930.     if laz>1 then begin
  931.       rangkorr;
  932.       gotoxy(6,15);writeln('Spearmannscher Rangkorrelationskoeffizient  rs(x,y) = ',rako:6:4);
  933.     end;
  934.     regfu;if nenner=0 then write('    Regressionsgleichung nicht berechenbar, da Nenner=0')
  935.     else begin
  936.       gotoxy(6,16);write('Regressionsgleichung: Y = ',ar:7:2,' + ',br:7:2,' * X');
  937.     end;
  938.   end
  939.   else if erw='.HI2' then begin
  940.     gotoxy(6,15);write('Kontigenzkoeffizient = ');
  941.     if fij<>0 then write(conti:6:4) else write('****');
  942.   end;
  943.   gotoxy(2,17);write('**** als Ergebnis bedeutet, daß der Wert nicht berechenbar ist.');
  944.   gotoxy(10,19);write('Weiter mit <SPACE> = Leertaste !');
  945.   repeat read(kbd,frg) until (frg = ' ');
  946.   Close_Window(2);
  947. end;
  948. {-----------------------------------------------------------------------------}
  949. Overlay Procedure Humwandeln;
  950. var zaehler:real;
  951.  
  952.   procedure E_umwandel;
  953.   begin
  954.     zaehler:=1;
  955.     s1[1].Mnam:=s1[ak_nr].Mnam;
  956.     k:=1;s1[1].Udat[1]:=sor1[1];
  957.     for j:=2 to laz do begin
  958.       if sor1[j]>sor1[j-1] then begin
  959.         s1[2].Udat[k]:=zaehler;zaehler:=1;
  960.         k:=k+1;s1[1].Udat[k]:=sor1[j];
  961.         if k>22 then begin
  962.           umwfehler;exit;
  963.         end;
  964.       end
  965.       else zaehler:=zaehler+1;
  966.     end;{ of for ..}
  967.   s1[3].Udat[1]:=s1[2].Udat[1];s1[2].Udat[k]:=zaehler;s1[1].anz_zeile:=k+1;
  968.   end;
  969.  
  970.   procedure G_umwandel;
  971.   label neuk,umend;
  972.   var dw:real;
  973.   begin
  974.     grup:='G';s2.g:='G';Grupaus;
  975.     if frg='2' then begin
  976.       et:=1;ok:=1;s2.Hnam[1]:=s1[ak_nr].Mnam;s1[1].Mnam:=s2.Hnam[1];
  977.       s2.Hdat[1,1]:=sor1[1];Ma_ein;
  978.       for j:=1 to l_sp do begin
  979.         s1[1].Udat[j]:=s2.Hdat[1,j];
  980.         if j>1 then s1[2].Udat[j-1]:=s1[1].Udat[j];
  981.       end;
  982.       l_sp:=l_sp-1;
  983.     end
  984.     else begin
  985.       k:=trunc(Sqrt(laz))+1;dw:=trunc(((sor1[laz]-sor1[1])/k*10)+0.999)/10;
  986.       s1[1].Udat[1]:=sor1[1];s1[1].Mnam:=s1[ak_nr].Mnam;
  987.       for j:=1 to k do begin
  988.         s1[2].Udat[j]:=s1[1].Udat[j]+dw;s1[1].Udat[j+1]:=s1[2].Udat[j];
  989.       end;
  990.       l_sp:=k;
  991.     end;
  992.     for j:=1 to l_sp do s1[3].Udat[j]:=0;
  993.     k:=1;s1[2].Udat[l_sp]:=s1[2].Udat[l_sp]+0.01;
  994.     for j:=1 to laz do begin
  995.       neuk:if sor1[j]<s1[2].Udat[k] then s1[3].Udat[k]:=s1[3].Udat[k]+1
  996.            else begin
  997.              k:=k+1;if k>l_sp then begin k:=k-1;goto umend;end else goto neuk;
  998.            end;
  999.     end; { of for ..}
  1000. umend:s1[4].Udat[1]:=s1[3].Udat[1];s1[1].anz_zeile:=k+1;s1[2].Udat[l_sp]:=s1[2].Udat[l_sp]-0.01;
  1001.   end;
  1002.  
  1003. begin
  1004.   for col:=1 to 6 do begin
  1005.     for row:=1 to 300 do s1[col].Udat[row]:=1E+7;
  1006.   end;
  1007.   umwa:=true;wnr:=3;Farbwahl(0,7);Clrscr;
  1008.   gotoxy(10,11);write('Möchten Sie ');Farbwahl(7,0);write(' G ');
  1009.   Farbwahl(0,7);write('ruppierte Daten oder ');Farbwahl(7,0);
  1010.   gotoxy(22,13);write(' E ');Farbwahl(0,7);write('inzeldaten eingeben ?');
  1011.   gotoxy(10,15);write('Bitte geben Sie eine der inversen Buchstaben ein !');
  1012.   repeat read(kbd,grup) until grup in ['g','G','e','E'];ClrScr;
  1013.   grup:=Upcase(grup);if grup='E' then E_umwandel else G_umwandel;
  1014.   if umwa=false then G_umwandel;
  1015. end;
  1016. {-----------------------------------------------------------------------------}
  1017. Overlay Procedure Ein_Auswert;
  1018. label neules;
  1019.  
  1020. begin {of Ein_Auswert}
  1021.   Open_Window(1,10,8,70,17,14,1,' Merkmal-Abfrage ');
  1022.   gotoxy(4,1);write('Welches Merkmal möchten Sie auswerten ?');
  1023.   gotoxy(4,2);write('Bitte geben Sie die Nummer des Merkmales ein !');
  1024.   gotoxy(4,8);write('Mit       Anzeige der möglichen Merkmale.');
  1025.   gotoxy(8,8);Farbwahl(0,7);write(' F10 ');Farbwahl(14,1);
  1026.   gotoxy(4,6);write('Bestätigen Sie Ihre Auswahl mit <RETURN> !');
  1027. neules:gotoxy(7,4);write('Merkmal-Nr.: __');ac:=1;wort1:='';
  1028.   repeat gotoxy(20,4);read(kbd,frg) until (frg in ['1'..'9']) or (frg=^[);
  1029.   if (frg=^[) and keypressed then begin
  1030.     Wind_anz;Window(11,9,69,16);Farbwahl(14,1);goto neules;
  1031.   end;
  1032.   wort1:=wort1+frg;gotoxy(20,4);write(wort1);
  1033.   if a_sp>9 then Tab_eingeb(2,20,4) else Tab_eingeb(1,20,4);
  1034.   if ((a_sp>9) and (ac>2)) or ((a_sp<10) and (ac>1)) then goto neules;
  1035.   val(wort1,ak_nr,e1);if ak_nr>a_sp then goto neules;
  1036.   if l_ze>160 then begin
  1037.     Farbwahl(14,1);Clrscr;gotoxy(7,3);
  1038.     writeln('Die Urliste von ',s1[ak_nr].Mnam,' wird sortiert.');
  1039.     write('            Bitte kurz warten !  ');
  1040.   end;
  1041.   Move(s1[ak_nr].Udat,sor1,SizeOf(s1[ak_nr].Udat));
  1042.   Sortier(sor1,1,laz);slaz:=laz;
  1043.   Close_Window(1);Clrscr;
  1044. end;
  1045.  
  1046. {-----------------------------------------------------------------------------}
  1047. Overlay Procedure H2_umw;
  1048. label neuk1,neuk2;
  1049. var i:integer;
  1050.  
  1051.   procedure HE_umw;
  1052.   begin
  1053.     s2.Hdat[1,1]:=1E+9;s2.Hdat[2,1]:=1E+9;
  1054.     s2.g:='E';s2.anz_sp:=1;s2.anz_ze:=1;s2.Hdat[1,2]:=sor1[1];s2.Hdat[2,2]:=sor2[1];
  1055.     for j:=2 to laz do begin
  1056.       if sor1[j]>sor1[j-1] then begin
  1057.         s2.anz_sp:=s2.anz_sp+1;
  1058.         if s2.anz_sp>22 then begin umwfehler;exit; end
  1059.         else s2.Hdat[1,s2.anz_sp+1]:=sor1[j];
  1060.       end;
  1061.       if sor2[j]>sor2[j-1] then begin
  1062.         s2.anz_ze:=s2.anz_ze+1;
  1063.         if s2.anz_ze>22 then begin umwfehler;exit; end
  1064.         else s2.Hdat[2,s2.anz_ze+1]:=sor2[j];
  1065.       end;
  1066.     end;{ of for ..}
  1067.   end;
  1068.  
  1069.   procedure HG_umw;
  1070.   var dw1,dw2:real;
  1071.   begin
  1072.     grup:='G';s2.g:='G';Grupaus;
  1073.     s2.Hdat[1,1]:=sor1[1];s2.Hdat[2,1]:=sor2[1];
  1074.     if frg='2' then begin
  1075.       et:=1;ok:=1;Ma_ein;
  1076.       et:=2;Ma_ein;
  1077.     end
  1078.     else begin
  1079.       k:=trunc(Sqrt(laz))+1;dw1:=trunc(((sor1[laz]-sor1[1])/k*10)+0.999)/10;
  1080.       dw2:=trunc(((sor2[laz]-sor2[1])/k*10)+0.999)/10;
  1081.       for j:=1 to k do begin
  1082.         s2.Hdat[1,j+1]:=s2.Hdat[1,j]+dw1;
  1083.         s2.Hdat[2,j+1]:=s2.Hdat[2,j]+dw2;
  1084.       end;
  1085.       if dw1=0 then s2.anz_sp:=1 else s2.anz_sp:=k;
  1086.       if dw2=0 then s2.anz_ze:=1 else s2.anz_ze:=k;
  1087.     end;
  1088.   end;
  1089.  
  1090. begin    {von H2_umw}
  1091.   s2.Hnam[1]:=s1[nr1].Mnam;s2.Hnam[2]:=s1[nr2].Mnam;
  1092.   umwa:=true;wnr:=3;Farbwahl(0,7);Clrscr;
  1093.   gotoxy(10,11);write('Möchten Sie ');Farbwahl(7,0);write(' G ');
  1094.   Farbwahl(0,7);write('ruppierte Daten oder ');Farbwahl(7,0);
  1095.   gotoxy(22,13);write(' E ');Farbwahl(0,7);write('inzeldaten eingeben ?');
  1096.   gotoxy(10,15);write('Bitte geben Sie einen der beiden Buchstaben ein !');
  1097.   repeat read(kbd,grup) until grup in ['g','G','e','E'];ClrScr;
  1098.   grup:=Upcase(grup);if grup='E' then HE_umw else HG_umw;
  1099.   if umwa=false then HG_umw;
  1100.   for j:=1 to 23 do begin
  1101.     for k:=1 to 23 do s2.ahi[j,k]:=0;
  1102.   end;
  1103.   if s2.g='G' then begin
  1104.     s2.Hdat[1,s2.anz_sp+1]:=s2.Hdat[1,s2.anz_sp+1]+0.01;
  1105.     s2.Hdat[2,s2.anz_ze+1]:=s2.Hdat[2,s2.anz_ze+1]+0.01;
  1106.   end;
  1107.   for j:=1 to laz do begin
  1108.     i:=1;k:=1;
  1109.   neuk1:if (s1[nr1].Udat[j]>=s2.Hdat[1,k]) and (s1[nr1].Udat[j]<s2.Hdat[1,k+1]) then begin
  1110.     neuk2:if (s1[nr2].Udat[j]>=s2.Hdat[2,i]) and (s1[nr2].Udat[j]<s2.Hdat[2,i+1])
  1111.        then begin
  1112.          if grup='E' then s2.ahi[k-1,i-1]:=s2.ahi[k-1,i-1]+1
  1113.             else s2.ahi[k,i]:=s2.ahi[k,i]+1;
  1114.          end
  1115.        else begin
  1116.          i:=i+1;if i<23 then goto neuk2;
  1117.        end;
  1118.      end
  1119.      else begin
  1120.        k:=k+1;if k<23 then goto neuk1;
  1121.      end;
  1122.   end; { of for ..}
  1123.   if s2.g='G' then begin
  1124.     s2.Hdat[2,s2.anz_ze+1]:=s2.Hdat[2,s2.anz_ze+1]-0.01;
  1125.     s2.Hdat[1,s2.anz_sp+1]:=s2.Hdat[1,s2.anz_sp+1]-0.01;
  1126.   end;   
  1127. end;
  1128. {-----------------------------------------------------------------------------}
  1129. Overlay Procedure Zwei_Auswert;
  1130. label neules;
  1131. begin {von Zwei_Auswert}
  1132.   wort1:='';
  1133.   Open_Window(1,10,8,70,17,14,1,' Merkmal-Abfrage ');
  1134.   gotoxy(4,1);write('Welche Merkmale möchten Sie auswerten ?');
  1135.   gotoxy(4,2);write('Bitte geben Sie die Nummer der beiden Merkmale ein !');
  1136.   gotoxy(4,8);write('Mit       Anzeige der möglichen Merkmale.');
  1137.   gotoxy(8,8);Farbwahl(0,7);write(' F10 ');Farbwahl(14,1);cur_ze:=4;
  1138.   gotoxy(4,6);write('Bestätigen Sie Ihre Auswahl mit <RETURN> !');
  1139. neules:Farbwahl(14,1);ac:=1;wort1:='';gotoxy(7,cur_ze);
  1140.   write('Nummer des                       Merkmales :  __');
  1141.   Farbwahl(9,0);gotoxy(18,cur_ze);if cur_ze=4 then write('ersten (unabhängigen)')
  1142.   else write('zweiten (abhängigen)');
  1143.   Farbwahl(14,1);
  1144.   repeat gotoxy(53,cur_ze);read(kbd,frg) until (frg in ['1'..'9']) or (frg=^[);
  1145.   if (frg=^[) and keypressed then begin
  1146.     wind_anz;Window(11,9,69,16);Farbwahl(14,1);goto neules;
  1147.   end;
  1148.   wort1:=wort1+frg;gotoxy(53,cur_ze);write(wort1);
  1149.   if a_sp>9 then Tab_eingeb(2,53,cur_ze) else Tab_eingeb(1,53,cur_ze);
  1150.   if ((a_sp>9) and (ac>2)) or ((a_sp<10) and (ac>1)) then goto neules;
  1151.   val(wort1,ak_nr,e1);if ak_nr>anz then goto neules;
  1152.   if cur_ze=4 then begin
  1153.     nr1:=ak_nr;cur_ze:=5;goto neules;
  1154.   end
  1155.   else nr2:=ak_nr;
  1156.   if nr1=nr2 then goto neules;
  1157.   if laz>90 then begin
  1158.     Farbwahl(14,1);Clrscr;gotoxy(7,3);
  1159.     writeln('Die beiden Urlisten werden sortiert.');
  1160.     write('            Bitte kurz warten !  ');
  1161.   end;
  1162.   Close_Window(1);
  1163. end;
  1164. {-----------------------------------------------------------------------------}
  1165.  
  1166. procedure Zweidim_Haeuf(n1,n2:integer);
  1167. var l2:integer;
  1168. begin
  1169.   E_Csr:='        ';l_esp:=2;
  1170.   Farbwahl(0,7);Eart:=Haeufigk2;erw:='.HI2';ok:=1;lr:=1;l_sp:=1;
  1171.   if wnr=1 then begin
  1172.     s2.hnam[1]:=s1[n1].Mnam;s2.hnam[2]:=s1[n2].Mnam;s2.g:=Upcase(grup);
  1173.     cur_sp:=20;et:=1;Ma_ein;et:=2;Ma_ein;
  1174.   end;
  1175.   rahmen1:='╔════════════════════╦══════════╤══════════╤══════════╤══════════╦═══════════╗';
  1176.   rahmen2:='║                    ║          │          │          │          ║           ║';
  1177.   rahmen3:='╟────────────────────╫──────────┼──────────┼──────────┼──────────╫───────────╢';
  1178.   rahmen4:='╚════════════════════╩══════════╧══════════╧══════════╧══════════╩═══════════╝';
  1179.   if wnr<3 then titelz:='  Eingabe zweidimensionaler Häufigkeiten  '
  1180.      else titelz:='Umwandlung in zweidimensionale Häufigkeitstabelle';
  1181.   kommx:=' Ausprägungen von '+s2.hnam[1]+' ';
  1182.   wort1:='A. von '+s2.hnam[2];
  1183.   Clrscr;Rahmen_erstell;H_Eingabe;
  1184. end;
  1185.  
  1186. procedure Eindim_Haeuf(un_ze:integer);
  1187. begin
  1188.   Eart:=Urli;E_Csr:='         ';erw:='.HI1';
  1189.   if grup in ['e','E'] then begin
  1190.     ende:=4;s1[2].anz_zeile:=0;s1[2].Mnam:='  f(i)';
  1191.     s1[3].Mnam:='  F(i)';s1[4].Mnam:=' h(i) [%]';s1[5].Mnam:=' H(i) [%]';
  1192.     a_sp:=5;l_esp:=2;lr:=1;
  1193.   end
  1194.   else begin
  1195.     ende:=5;s1[2].anz_zeile:=1;s1[2].Mnam:='';s1[3].Mnam:='  f(i)';
  1196.     s1[4].Mnam:='  F(i)';s1[5].Mnam:=' h(i) [%]';s1[6].Mnam:=' H(i) [%]';
  1197.     a_sp:=6;l_esp:=3;lr:=2;
  1198.   end;
  1199.   rahmen_bild;Farbwahl(0,7);Clrscr;
  1200.   titelz:=' Eingabetabelle eindimensionaler Häufigkeiten ';
  1201.   kommx:=' Verschiedene Häufigkeiten ';Rahmen_erstell;
  1202.   Ur_Eingabe(un_ze);
  1203. end;
  1204.  
  1205. procedure Urliste;
  1206. begin
  1207.   Eart:=Urli;E_Csr:='         ';erw:='.URL';
  1208.   if anz>6 then ende:=5 else ende:=anz-1;
  1209.   rahmen_bild;
  1210.   Farbwahl(0,7);Clrscr;titelz:='   Eingabetabelle der Urliste   ';
  1211.   kommx:=' Merkmale ';Rahmen_erstell;
  1212.   a_sp:=anz;l_esp:=anz;lr:=1;
  1213.   Ur_Eingabe(300);
  1214. end;
  1215.  
  1216. procedure Haeufigkeitstab(dim,n1,n2:integer);
  1217. begin
  1218.   Farbwahl(0,7);Clrscr;
  1219.   gotoxy(10,11);write('Möchten Sie ');Farbwahl(7,0);write(' G ');
  1220.   Farbwahl(0,7);write('ruppierte Daten oder ');Farbwahl(7,0);
  1221.   gotoxy(22,13);write(' E ');Farbwahl(0,7);write('inzeldaten eingeben ?');
  1222.   gotoxy(10,15);write('Bitte geben Sie eine der inversen Buchstaben ein !');
  1223.   repeat read(kbd,grup) until grup in ['g','G','e','E'];ClrScr;
  1224.   if wnr=3 then Exit;
  1225.   if dim=1 then Eindim_Haeuf(25) else Zweidim_Haeuf(n1,n2);
  1226. end;
  1227.  
  1228. procedure Ein_Auswahl;
  1229. var dim:integer;
  1230. begin
  1231.   if anz>2 then Urliste else begin
  1232.     if anz=1 then dim:=1 else dim:=2;
  1233.     gotoxy(20,18);Farbwahl(0,7);write(' 1 ');Farbwahl(7,1);write(' Urliste eingeben ');
  1234.     gotoxy(20,20);Farbwahl(0,7);write(' 2 ');Farbwahl(7,1);write(' Häufigkeitstabelle eingeben ');
  1235.     gotoxy(20,22);write('Bitte wählen Sie eine der beiden Möglichkeiten durch ');
  1236.     gotoxy(20,23);write('Eingabe der vorgestellten Zahl aus !');
  1237.     repeat
  1238.     read(kbd,frg) until frg in ['1','2'];
  1239.     if frg='1' then Urliste else Haeufigkeitstab(dim,1,2);
  1240.   end;
  1241. end;
  1242.  
  1243. procedure EA_Fehler;
  1244. begin
  1245.   ClearScreen;
  1246.   gotoxy(25,12);write(' Falscher Dateiname ');
  1247.   delay(3500);
  1248. end;
  1249.  
  1250. procedure Tasteingabe;
  1251. begin
  1252.   Farbwahl(7,1);ClrScr;
  1253.   gotoxy(20,11);Write('Anzahl der Merkmale ? (max.15): ');
  1254.   anz:=0;read(anz);if (anz<1) or (anz>15) then begin
  1255.     write (chr(7));
  1256.     for j:=1 to 6 do begin
  1257.       if j in [1,3,5] then Farbwahl(0,7)
  1258.       else Farbwahl(7,1);
  1259.       gotoxy(20,13);Write('Bitte mindestens 1 und maximal 15 eingeben !');
  1260.       delay(1000);
  1261.     end;
  1262.     Tasteingabe;
  1263.   end
  1264.   else begin
  1265.     MnamEingabe;
  1266.     Ein_Auswahl;
  1267.   end;
  1268. end;
  1269.  
  1270. procedure Dateieingabe;
  1271. begin
  1272.   DatIO:=' Eingabewerte werden aus Datei gelesen ';
  1273.   anz:=0;e_a:='l';Diskein_aus;
  1274.   if (erw='.URL') or (erw='.HI1') then Eart:=Urli else Eart:=Haeufigk2;
  1275.   if Eart=Urli then assign(dat1,wort1) else assign (dat2,wort1);
  1276.   {$I-}
  1277.   if Eart=Urli then reset(dat1) else reset (dat2);
  1278.   {$I+}
  1279.   if ioresult>0 then begin
  1280.     Close_Window(1);
  1281.     EA_Fehler;
  1282.     Dateieingabe;
  1283.   end
  1284.   else begin
  1285.     if Eart=Urli then begin
  1286.       while not eof(dat1) do begin
  1287.         anz:=anz+1;read(dat1,s1[anz]);
  1288.       end;
  1289.     end
  1290.     else read(dat2,s2);
  1291.     if Eart=Urli then close(dat1) else close(dat2);
  1292.     Close_Window(1);
  1293.     if erw='.URL' then Urliste else if erw='.HI1' then begin
  1294.       if s1[2].anz_zeile=0 then grup:='E' else grup:='G';
  1295.       Eindim_Haeuf(25);
  1296.     end;
  1297.     if erw='.HI2' then Zweidim_Haeuf(1,2);
  1298.   end; {of ioresult=0}
  1299. end;
  1300. {-----------------------------------------------------------------------------}
  1301. Overlay procedure Einwaehlen;
  1302. var ausw1:integer;
  1303. begin
  1304.   ausw1:=0;frg:='1';while frg<>'0' do begin
  1305.     Open_Window(1,10,5,70,20,7,0,' Auswertung der Urliste ');
  1306.     Farbwahl(0,7);gotoxy(5,2);write(' 1 ');gotoxy(5,4);write(' 2 ');
  1307.     gotoxy(5,6);write(' 0 ');Farbwahl(7,0);
  1308.     gotoxy(9,2);write('Berechnung statistischer Kenngrößen');
  1309.     gotoxy(9,4);write('Umwandlung in eine Häufigkeitstabelle');
  1310.     gotoxy(9,6);write('Weiter im Programm');
  1311.     gotoxy(5,11);write('Bitte geben Sie eine der obigen Ziffern ein !');
  1312.     repeat read(kbd,frg) until frg in ['0'..'2'];
  1313.     Close_Window(1);
  1314.     if frg='1' then statauswert;
  1315.     if frg='2' then begin
  1316.       ausw1:=ausw1+1;
  1317.       if ausw1>1 then begin
  1318.         Open_Window(1,15,7,65,12,14,2,' Doppelte Umwandlung ');
  1319.         gotoxy(2,2);write('Die Urliste ist schon umgewandelt worden .');
  1320.         gotoxy(2,4);write('Bitte geben Sie eine andere Nummer ein !');
  1321.         Delay(4500);Close_Window(1);
  1322.       end
  1323.       else begin
  1324.         Humwandeln;
  1325.         Eindim_Haeuf(s1[1].anz_zeile-1);
  1326.         Farbwahl(0,7);ClearEol(23);ClearEol(24);
  1327.         gotoxy(10,23);write('Weiter mit <SPACE> = Leertaste !');
  1328.         repeat read(kbd,frg) until (frg=' ');
  1329.       end;
  1330.     end;
  1331.   end; { of while ... }
  1332. end;
  1333. {-----------------------------------------------------------------------------}
  1334. Overlay Procedure Zweiwaehlen;
  1335. begin
  1336.   hfrg:='1';while hfrg<>'0' do begin
  1337.     Open_Window(1,9,5,71,20,7,0,' Auswahl der Verarbeitung ');
  1338.     if laz>90 then begin
  1339.       gotoxy(10,4);write('Die beiden Urlisten werden sortiert .');
  1340.       gotoxy(10,6);write('Bitte einen Moment Geduld !');
  1341.     end;
  1342.     Move(s1[nr1].Udat,sor1,SizeOf(s1[nr1].Udat));
  1343.     Move(s1[nr2].Udat,sor2,SizeOf(s1[nr2].Udat));
  1344.     Sortier(sor1,1,laz);
  1345.     Sortier(sor2,1,laz);Clrscr;
  1346.     Farbwahl(0,7);gotoxy(3,2);write(' 1 ');gotoxy(3,4);write(' 2 ');gotoxy(3,6);write(' 3 ');
  1347.     gotoxy(3,8);write(' 0 ');Farbwahl(7,0);
  1348.     gotoxy(7,2);write('Umwandlung in eine zweidimensionale Häufigkeitstabelle');
  1349.     gotoxy(7,4);write('Streudiagramm');
  1350.     gotoxy(7,6);write('Statistische Kennzahlen errechnen');
  1351.     gotoxy(7,8);write('Weiter im Programm');
  1352.     gotoxy(7,11);write('Bitte geben Sie eine der obigen Ziffern ein !');
  1353.     repeat read(kbd,hfrg) until hfrg in ['0'..'3'];
  1354.     Close_Window(1);
  1355.     if hfrg='1' then begin
  1356.       H2_umw;Zweidim_Haeuf(nr1,nr2);
  1357.       Farbwahl(0,7);ClearEol(23);ClearEol(24);
  1358.       gotoxy(10,23);write('Weiter mit <SPACE> = Leertaste !');
  1359.       repeat read(kbd,frg) until (frg=' ');
  1360.     end;
  1361.     if hfrg='2' then begin
  1362.       Streudia;
  1363.       LeaveGraphic;
  1364.     end;
  1365.     if hfrg='3' then Stat2berech;
  1366.   end; { von while hfrg<>'0'}
  1367. end;
  1368. {-----------------------------------------------------------------------------}
  1369. Overlay Procedure Mehrauswahl;
  1370. var   zl:integer;
  1371. begin
  1372.   if anz>7 then begin
  1373.     Clrscr;
  1374.     gotoxy(10,10);write('Die Korrelationskoeffizienten werden errechnet.');
  1375.     gotoxy(16,11);write('Bitte kurz warten !');
  1376.   end;
  1377.   for j:=1 to anz do begin
  1378.     for k:=j+1 to anz do begin
  1379.       P_korr(j,k);Matr[j,k]:=rpear;Matr[k,j]:=rpear;
  1380.     end;
  1381.     Matr[j,j]:=1.0;
  1382.   end;
  1383.   if anz<10 then zl:=6 else zl:=5;
  1384.   Clrscr;
  1385.   gotoxy(15,1);Farbwahl(9,0);write(' Korrelationsmatrix aller Merkmale ');
  1386.   Farbwahl(7,0);gotoxy(5,2);
  1387.   write('Falls *** in der Matrix vorkommt, so ist dieser Wert nicht berechenbar.');
  1388.   gotoxy(25,3);writeln('r[X(1),X(2),...X(',anz:1,')] =');
  1389.   writeln(' ┌');for j:=1 to anz do writeln(' │');writeln(' └');
  1390.   for j:=1 to anz do begin
  1391.     gotoxy(3,4+j);
  1392.     for k:=1 to anz do if Matr[j,k]>1 then write(' ***',' ':zl-4) else write(Matr[j,k]:zl:zl-3);
  1393.     write(' │');
  1394.   end;
  1395.   gotoxy(anz*zl+4,4);write('┐');
  1396.   gotoxy(anz*zl+4,anz+5);write('┘');
  1397.   for j:=1 to anz do begin
  1398.     case j of
  1399.       1: gotoxy(2,anz+6);
  1400.       5: gotoxy(2,anz+7);
  1401.       9: gotoxy(2,anz+8);
  1402.      13: gotoxy(2,anz+9);
  1403.     end;
  1404.     write('  X(',j:1,') = ',s1[j].Mnam);
  1405.   end;
  1406.   gotoxy(5,25);write('Weiter mit <SPACE> = Leertaste');
  1407.   repeat read(kbd,frg) until (frg=' ');
  1408.   frg:='1';while frg<>'0' do begin
  1409.     Open_Window(1,11,7,70,20,14,1,' Auswertungsabfrage ');
  1410.     Farbwahl(0,7);for j:=1 to 3 do begin
  1411.       gotoxy(5,2*(j+1));write(j:2,' ');
  1412.     end;
  1413.     gotoxy(5,10);write(' 0 ');Farbwahl(14,1);
  1414.     gotoxy(2,1);write('Die nachfolgend aufgeführten Kennzahlen basieren auf dem');
  1415.     gotoxy(12,2);write('Pearson',#39,'schen Korrelationskoeffizienten.');
  1416.     gotoxy(9,4);write('Partielle Korrelation');
  1417.     gotoxy(9,6);write('Bipartielle Korrelation');
  1418.     gotoxy(9,8);write('Multiple Korrelation / Regression');
  1419.     gotoxy(9,10);write('Weiter im Programm');
  1420.     gotoxy(5,12);write('Bitte geben Sie eine der obigen Ziffern ein !');
  1421.     repeat read (kbd,frg) until frg in ['0'..'4'];
  1422.     Close_Window(1);Farbwahl(0,7);Clrscr;
  1423.     case frg of
  1424.       '1': Partkorr;
  1425.       '2': Biparkorr;
  1426.       '3': Multikorr_reg;
  1427.     end;
  1428.   end;
  1429. end;
  1430. {-----------------------------------------------------------------------------}
  1431. Overlay Procedure Hauswert2;
  1432. begin
  1433.   frg:='1';while frg<>'0' do begin
  1434.     Open_Window(1,11,7,69,19,14,1,' Auswertungsabfrage ');
  1435.     gotoxy(3,2);writeln('Die Auswertungen gelten für 2-dimensionale Merkmale.');
  1436.     if s2.g='G' then write('  Es wurden die jeweiligen Gruppenmitten verwendet.');
  1437.     Farbwahl(0,7);gotoxy(3,5);write(' 1 ');gotoxy(3,7);write(' 2 ');gotoxy(3,9);write(' 0 ');
  1438.     Farbwahl(14,1);gotoxy(7,5);write('Auswertung statistischer Kenndaten');
  1439.     gotoxy(7,7);write('Streudiagramm');gotoxy(7,9);write('Weiter im Programm');
  1440.     gotoxy(3,11);write('Bitte geben Sie eine der obigen Ziffern ein !');
  1441.     repeat read (kbd,frg) until frg in ['0'..'2'];
  1442.     Close_Window(1);Farbwahl(0,7);Clrscr;
  1443.     if frg='1' then stat2berech;
  1444.     if frg='2' then Hstreu;
  1445.   end;
  1446. end;
  1447. {-----------------------------------------------------------------------------}
  1448. procedure Auswert2;
  1449. begin
  1450.   frg:='1';while frg<>'0' do begin
  1451.     Open_Window(1,10,5,70,20,7,0,' Graphische Darstellungen ');
  1452.     Farbwahl(0,7);gotoxy(5,2);write(' 1 ');gotoxy(5,4);write(' 2 ');gotoxy(5,6);write(' 3 ');
  1453.     gotoxy(5,8);write(' 4 ');gotoxy(5,10);write(' 0 ');
  1454.     Farbwahl(7,0);gotoxy(9,2);write('Histogramm/Balkendiagramm');
  1455.     gotoxy(9,4);write('Kreisdiagramm');gotoxy(9,6);write('Summenhäufigkeitskurve');
  1456.     gotoxy(9,8);write('Statistische Kenndaten');gotoxy(9,10);write('Weiter im Programm');
  1457.     gotoxy(5,13);write('Bitte geben Sie eine der obigen Ziffern ein !');
  1458.     repeat read(kbd,frg) until frg in ['0'..'4'];
  1459.     Close_Window(1);
  1460.     case frg of
  1461.       '1':if s1[2].anz_zeile=1 then Histo else Balken;
  1462.       '2':Kreis;
  1463.       '3':Summhaeuf;
  1464.       '4':statauswert;
  1465.     end;
  1466.   end;
  1467. end;
  1468.  
  1469. procedure Menue1;
  1470. begin
  1471.   Open_Window(1,10,6,70,16,7,0,' Auswahl der Auswertungsart ');
  1472.   gotoxy(5,2);Farbwahl(0,7);write(' 1 ');gotoxy(5,4);write(' 2 ');
  1473.   Farbwahl(7,0);gotoxy(9,2);write('Auswertung eines Merkmales');
  1474.   gotoxy(9,4);write('Gleichzeitige Auswertung zweier Merkmale');
  1475.   if anz>2 then begin
  1476.     Farbwahl(0,7);gotoxy(5,6);write(' 3 ');
  1477.     Farbwahl(7,0);write(' Gleichzeitige Auswertung von mehr als 2 Merkmalen');
  1478.   end;
  1479.   gotoxy(5,8);write('Bitte geben Sie eine der obigen Ziffern ein !');
  1480.   if anz >2 then repeat read(kbd,frg) until frg in ['1'..'3']
  1481.     else repeat read(kbd,frg) until frg in ['1','2'];
  1482.   Close_Window(1);
  1483.   if frg='1' then begin
  1484.     Ein_Auswert;Einwaehlen;
  1485.   end
  1486.   else if frg='2' then begin
  1487.     Zwei_Auswert;Zweiwaehlen;
  1488.   end
  1489.   else Mehrauswahl;
  1490. end;
  1491.  
  1492. begin
  1493.   durchlauf:=1;
  1494. beg1:Anfangsbild_wert;
  1495.   if wnr=1 then Tasteingabe else Dateieingabe;
  1496.   Farbwahl(0,7);ClearEol(23);ClearEol(24);
  1497.   gotoxy(10,23);write('Weiter mit <SPACE> = Leertaste !');
  1498.   repeat read(kbd,frg) until (frg=' ');
  1499.   if erw='.URL' then if anz>1 then Menue1 else begin
  1500.     Ein_Auswert;Einwaehlen;
  1501.   end;
  1502.   if erw='.HI1' then Auswert2;
  1503.   if erw='.HI2' then Hauswert2;
  1504.   Open_Window(1,10,7,70,18,7,0,'Abfrage auf Ende oder weitere Bearbeitung ');
  1505.   gotoxy(3,5);write('Möchten Sie weitere Auswertungen durchführen (J/N) ?');
  1506.   repeat read(kbd,frg) until frg in ['j','J','n','N'];
  1507.   Close_Window(1);
  1508.   if (frg='j') or (frg='J') then begin
  1509.     durchlauf:=durchlauf+1;goto beg1;
  1510.   end;
  1511. end.
  1512.