{ FRIEDMAN.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Program na vypocet Friedmanovho testu } { podla vzorca } { } { p 1 2 } { S = ( R - --- n (p + 1) ) } { i=1 i 2 } { } { Datum:04.02.2004 http://www.trsek.com } program friedman; uses crt,dos; const max = 60; statist = 'fried_s.dat'; var n,p:integer; riad:integer; { pocet riadkov } q:real; s_file:string; r:array[1..max,1..max] of real; rj:array[1..max,1..max] of real; s1,s5 : real; { chi parameter pre 1% a 5% } procedure uvod; begin WriteLn('Friedmanov test'); WriteLn(' /h - help'); WriteLn(' %1 - nazov suboru'); WriteLn; end; procedure help; begin WriteLn; WriteLn('Program na vypocet Friedmanovho testu'); WriteLn('podla vzorca:'); WriteLn; WriteLn(' p 1 2 '); WriteLn(' S = ( R - --- n (p + 1) ) '); WriteLn(' i=1 i 2 '); WriteLn; Halt(0); end; procedure DivideArg; begin if( paramcount > 0 )then begin if( paramstr(1) = '/h' )then help; if( paramstr(1) = '/H' )then help; if( copy(paramstr(1),1,1) <> '/' )then s_file := paramstr(1); end; end; procedure ClearVar; var x,y:integer; begin for x:=1 to max do for y:=1 to max do begin r[x,y] := 0; rj[x,y] := 0; end; end; function TestFile( s_file:string ):byte; var DirInfo: SearchRec; begin FindFirst(s_file, Archive, DirInfo); TestFile := DosError; end; function NextInt(var s:string):real; var err:integer; vys:real; begin Val( Copy( s, 1, Pos(';', s)-1 ), vys, err ); Delete( s, 1, Pos(';', s) ); NextInt := vys; end; function ReadFriedFile( s_file:string; var riad:integer ):byte; var f:text; s:string; pom:string; begin { nevyhnutne kontroly na existenciu suboru } if( TestFile( s_file )>0 )then begin WriteLn('Subor ', s_file, ' neexistuje.'); Halt(1); end; Assign(f, s_file ); ReSet(f); { znuluj n,p } n := 0; p := 0; riad := 0; { citaj riadky zaradom } while( not(eof(f))) do begin { precitaj p-ty riadok } ReadLn( f, s ); s := s+';'; inc(riad); { inkrementuj riadok } p := p+1; n := 0; if( p>max )then begin ReadFriedFile := 1; exit; end; while( length(s) > 0 ) do begin { incrementuj v stlpci } n := n+1; if( n>max )then begin ReadFriedFile := 3; exit; end; { vybratie dalsieho faktora A } r[n,p] := NextInt(s); { vybratie dalsieho bloku } rj[n,p] := NextInt(s); end; end; Close(f); ReadFriedFile := 0; end; procedure ReadKeyboard; var x,y:integer; s:string; err:integer; begin WriteLn('Zadaj parametre n,p:'); ReadLn(n); ReadLn(p); WriteLn('Dalej zadavaj hodnoty pevnosti v tahu:'); for x:=1 to n do for y:=1 to p do begin Write('Pec ',x,', faktor A',y,' = '); ReadLn(s); Val( s, r[x,y], err ); Write('Pec ',x,', faktor A',y,' poradie = '); ReadLn(s); Val( s, rj[x,y], err ); end; { precitaj kvantily } Write('Zadaj prislusnu S0.01: '); ReadLn( s1 ); Write('Zadaj prislusnu S0.05: '); ReadLn( s5 ); WriteLn('Hodnoty zadane. Spustam vypocet.'); end; function SumRij(j:integer):real; var x:integer; sum:real; begin sum := 0; for x:=1 to n do sum := sum + rj[x,j]; SumRij := sum; end; function SumMocnina:real; var y:integer; sum:real; sumr:real; begin sum := 0; for y:=1 to p do begin sumr := SumRij(y); sum := sum + ( sumr * sumr ); end; SumMocnina := sum; end; procedure ChiKvantil(var s1,s5:real; p,n:byte); var f:text; i:byte; s:string; begin { existuje subor kvantily ? } if( TestFile( statist )>0 )then begin WriteLn('Subor ', statist, ' neexistuje.'); Halt(1); end; assign( f, statist ); reset(f); while( not(eof(f))) do begin ReadLn(f,s); s := s+';'; if( NextInt(s) = p )then if( NextInt(s) = n )then begin s1 := NextInt(s); s5 := NextInt(s); end; end; close(f); end; begin ClrScr; s_file := ''; riad := 0; Uvod; DivideArg; ClearVar; { nacitavanie zo suboru } if( length( s_file ) > 0 )then begin WriteLn('Vypocet podla suboru: ', s_file ); if( ReadFriedFile( s_file, riad )>0 )then begin WriteLn('Velke mnozstvo dat v subore.'); WriteLn('Maximalne ', max,' poloziek.'); Halt(2); end; { hodnoty s1, s5 } ChiKvantil( s1, s5, p, n ); end else { Nacitanie z klavesnice } ReadKeyboard; q := SumMocnina - (n*n*p*(p+1)*(p+1))/4; { doplnok slovneho vyjadrenia vysledku } WriteLn; WriteLn('Testovacie kriterium je q=',q:0:6); WriteLn('Prislusny chi-kvantil pro dany pocet vyberu je :'); WriteLn(' ',s1:0:3,' pro 1% hladinu a'); WriteLn(' ',s5:0:3,' pro 5% hladinu.'); Write('Z toho vyplyva, ze hypoteza '); if q<=s1 then if q<=s5 then Write('plati ako') else Write('plati') else if q<=s5 then Write('neplati') else Write('neplati ani'); Write(' pre 95% odhad, '); if q<=s5 then if q<=s1 then Write('tak') else Write('ale plati') else if q<=s1 then Write('ale neplati') else Write('ani'); Write(' pre 99% odhad.'); Repeat Until KeyPressed; end.