home *** CD-ROM | disk | FTP | other *** search
- PROGRAM tstmedn(0);
- {$e+ [extended error messages ON] }
- CONST
- bigeven# = MAXINT - 1;
- big# = 999.0;
- Max_N = 5000;
- control_c = false;
- TYPE
- varrecord = RECORD
- CASE success : BOOLEAN OF
- TRUE : ( mean,
- mostfreq,
- middle,
- variance,
- stddevtn,
- stderrmn,
- skewness,
- kurtosis,
- semedian,
- seskewns,
- sekurtss : REAL;
- range : ARRAY[1..2] OF REAL);
- FALSE : ( errmsg1,
- errmsg2,
- errmsg3,
- errmsg4 : BOOLEAN );
- END; { of : definition of type varrecord }
- index = 1..Max_N;
- Scalar = REAL;
- real_array = ARRAY[index] OF scalar;
- list = real_array;
- str8 = STRING 8;
- intarray = ARRAY[1..55] OF INTEGER;
- byte = 0..255;
- VAR
- parameters : varrecord;
- timestring : str8;
- answer : char;
- n,i,number : INTEGER;
- result,mean : scalar;
- A : real_array;
- randarray : intarray;
- randindex,
- seed : INTEGER;
- good# : BOOLEAN;
-
- Procedure readq(VAR a:char);external;
- Procedure time(VAR t:str8 );external;
-
- FUNCTION rndknuth(VAR randarray : intarray) : byte;
- {$c-,m-,f-,r-
- comment : fills the array "randarray" with 55 pseudo random INTEGERS in
- the range 0..bigeven#. Knuth originally specified 10^9 for
- bigeven# . For Pascal/Z the best number = MAXINT - 1.
- Requires the following definitions globally :
- CONST bigeven# = MAXINT - 1;
- TYPE "intarray" = ARRAY[1..55] OF INTEGER;
- "byte" = 0..255;
- VAR "randarray" : "intarray";
- Returns the value 1 ( for reinitializing index to "randarray").
- }
- VAR
- i,j,k : INTEGER;
- BEGIN
- FOR i := 1 TO 55 DO
- BEGIN
- k := i + 31;
- IF k > 55 THEN k := k - 55;
- j := randarray[i] - randarray[k];
- IF j < 0 THEN j := j + bigeven#;
- randarray[i] := j
- END;
- rndknuth := 1;
- END; { of : FUNCTION rndknuth }
-
- PROCEDURE initknuth(VAR randarray : intarray;seed : INTEGER);
- {$c-,m-,f-,r-
- comment : Initializes randarray.Has the same requirements as rndknuth ,
- which FUNCTION is called by initknuth,plus the input value :
- "seed" : this may be a zero,one or any other positive
- INTEGER value.A useful technic when you want to use a "random"
- seed is to create an integer from the time of day , if you have
- it available to your computer.
- }
- VAR
- i,ii,j,k : INTEGER;
- BEGIN
- randarray[55] := seed;
- j := seed;
- k := 1;
- FOR i := 1 TO 54 DO
- BEGIN
- ii := (21 * i) MOD 55;
- randarray[ii] := k;
- k := j - k;
- IF k < 0 THEN k := k + bigeven#;
- j := randarray[ii]
- END;
- i := rndknuth(randarray);
- i := rndknuth(randarray);
- i := rndknuth(randarray);
- END; { of : PROCEDURE initknuth }
-
- FUNCTION random#r : REAL;
- {
- comment : Returns a REAL pseudo random number in the range 0.0 .. 1.0.
- Requires the definitions needed by rndknuth and initknuth
- plus the following global :
- VAR randindex : INTEGER;
- }
- BEGIN
- randindex := randindex + 1;
- IF randindex > 55 THEN randindex := rndknuth(randarray);
- random#r := randarray[randindex]/bigeven#;
- END; { of : FUNCTION random#r }
-
- FUNCTION random#n : REAL;
- {
- comment : Returns a REAL number that is randomly selected from a normally
- distributed population whose mean is zero and variance (and standard dev.)
- is 1.0.
- }
- VAR
- n : INTEGER;
- total : REAL;
- BEGIN
- total := -6.0;
- FOR n := 1 TO 12 DO total := total + random#r;
- random#n := total;
- END; { of : function randomn }
-
-
- procedure initseed;
- {$c-,m-,f- }
- BEGIN
- timestring := ' : : ';
- seed := 0;
- time(timestring);
- FOR i := 1 TO 8 DO seed := seed + ORD(timestring[i]);
- END;
-
- Procedure Show;
- var
- i: index;
- begin
- for i:=1 to N do
- begin
- write(A[i]:10:4);
- if i mod 6 = 0 then writeln;
- end;
- writeln;
- end;
-
- {$iB:SELECT.PAS }
-
- {$iB:MEDIAN.PAS }
-
-
- PROCEDURE popstats(VAR a : list;
- n1st,nlast : INTEGER;
- VAR parameters : varrecord); EXTERNAL;
-
- BEGIN
- {$c+,m+,f+,r+ [Turn on checks for main program : disabled by median & select]}
- initseed;
- initknuth(randarray,seed);
- REPEAT { until control_c }
- repeat
- writeln;
- writeln('Enter number of items in array');
- writeln(' 10 <= n <= ',Max_N:5);
- write('?');
- readln(N);
- good# := (n > 9) AND (n <= Max_N - 1);
- until good#;
-
- writeln;
- writeln('Please stand by while I set up.');
- FOR i := 1 TO n DO
- BEGIN
- A[i] := random#n;
- if (i mod 1000 = 0) then write(i);
- END;
- writeln;
- write('random array filled : do you want to see it ?');
- readq(answer);
- writeln;
- IF answer IN ['y','Y'] then show;
- writeln;
- WRITE('Press return when ready to start');
- readq(answer);
- writeln;
- write( CHR(7), 'START @ ');
- time(timestring);
- write(timestring,' ');
- popstats(A,1,N,parameters);
- time(timestring);
- writeln( CHR(7), 'DONE @ ' ,timestring);
- WITH parameters DO
- BEGIN
- writeln;
- IF success
- THEN BEGIN
- writeln('range := ',range[1]:8:4,' to',range[2]:8:4);
- writeln('median := ',middle:8:4);
- writeln('S.E. of median := ',semedian:8:4);
- writeln('mode := ',mostfreq :8:4);
- writeln('mean := ',mean :8:4);
- writeln('variance := ',variance :8:4);
- writeln('standard deviation := ',stddevtn :8:4);
- writeln('S.E. of the mean := ',stderrmn :8:4);
- writeln('index of skewness := ',skewness:8:4);
- writeln('S.E. of skewness := ',seskewns:8:4);
- writeln('index of kurtosis := ',kurtosis:8:4);
- writeln('S.E. of kurtosis := ',sekurtss:8:4);
- writeln;
- END
- ELSE BEGIN
- writeln('SHIT!');
- END;
- END;
- write('Print the array (Y/N)?');
- readq(answer);
- writeln;
- If (answer='Y') or (answer='y') then Show;
- readq(answer);
- UNTIL control_c;
- END.
-