Program KESKMINE;
        {Monte Carlo meetodi demonstratsioon}

Const n = 25; {yksikmootmiste arv}
      m = 5;  {     sqrt (n)     }

Type andmed = array [1..n] of real;


Function lugem (karbsed : boolean) : real;
   {Karbeste puudumisel Gaussi jaotusega m = 0, s = 1 suurus,
    karbeste esinemisel lisandub 1% toenaosusega lisaviga,
    mis on yhtlaselt jaotatud vahemikus [-100..+100]}
   Var x : real; i : integer;
   Begin
   x := 0;
   for i := 1 to 12 do x := x + random;
   x := x - 6; {Gauss m = 0, s = 1}
   if karbsed and (random < 0.01) then x := x + 200 * random - 100;
   lugem := x;
   End;


Procedure mullsort (var x : andmed);
   Var OK : boolean;
        i : integer;
        a : real;
   Begin
   repeat OK := true;
      for i := 2 to n do if x [i-1] > x [i] then begin
         a := x [i-1]; x [i-1] := x [i]; x [i] := a;
         OK := false;
      end;
   until OK;
   End;


Procedure statistika (x : andmed;
                    var
                     km {mediaan},
                     k0 {totaalkeskmine},
                     k1 {valistatud ekstremaalvaartustega keskmine},
                     k2 {kvartiilidevaheline keskmine},
                     k5 {5-ste ryhmade tsenseeritud keskmiste
                                        tsenseeritud keskmine}
                        : real);

   Var          i, j, k : integer;
      a, b, s, min, max,
         vs, vmin, vmax :real;
   Begin

   {On-line rezhiimis teostatavad arvutused}

   {Totaalkeskmine}
   s := 0;
   for i := 1 to n do s := s + x [i];
   k0 := s / n;

   {Ekstreemumtsenseeritud keskmine}
   s := x [1]; min := s; max := s;
   for i := 2 to n do begin;
      s := s + x [i];
      if x [i] < min then min := x [i];
      if x [i] > max then max := x [i];
   end;
   k1 := (s - min - max) / (n - 2);

   {5*5 tsenseeritud keskmine}
   vs := 0; vmin := 1E33; vmax := -vmin;
   i := 1;
   for j := 1 to m do begin
      s := x [i]; i := i + 1; min := s; max := s;
      for k := 2 to m do begin;
         a := x [i];
         s := s + a;
         if a < min then min := a;
         if a > max then max := a;
         i := i + 1;
      end;
      b := (s - min - max) / (m - 2); {m mootmise tsenseeritud keskmine}
      vs := vs + b;
      if b < vmin then vmin := b;
      if b > vmax then vmax := b;
   end;
   k5 := (vs - vmin - vmax) / (m - 2);
   {ylesanne 1 : kirjutada viimane algoritm ratsionaalsemalt
                 kogudes kohe (m - 2)^2 arvu summa}
   {ylesanne 2 : kirjutada algoritm m^k mootmise k-astmelise
                 tsenseeritud keskmise arvutamiseks}




   {On-line rezhiimis mitteteostatavad arvutused}
   mullsort (x);

   {mediaan}
   km := x [13]; {mediaan NB! arvulised indeksid
                              demonstratsiooni lihtsuse huvides}

   {kvartiilidevaheline keskmine}
   s := 0;
   for i := 7 to 19 do s := s + x [i];
   k2 := s / 13;

   End;


Procedure MonteCarlo (kordi : integer; karbsed : boolean; var f : text);
   Var i, j : integer;
       km, k0, k1, k2, k5 : real;
       sm, s0, s1, s2, s5 : real;
       x : andmed;
   Begin
   randomize;
   sm := 0; s0 := 0; s1 := 0; s2 := 0; s5 := 0;
   for i := 1 to kordi do begin
      for j := 1 to 25 do x [j] := lugem (karbsed);
      statistika (x, km, k0, k1, k2, k5);
      sm := sm + km*km;
      s0 := s0 + k0*k0;
      s1 := s1 + k1*k1;
      s2 := s2 + k2*k2;
      s5 := s5 + k5*k5;
   end;
   sm := sm / kordi;
   s0 := s0 / kordi;
   s1 := s1 / kordi;
   s2 := s2 / kordi;
   s5 := s5 / kordi;
   writeln (f, sm:18:4, s0:9:4, s1:9:4, s2:9:4, s5:9:4);
   End;



VAR i : integer;
    f : text;

BEGIN
assign (f, '\b\keskmine.txt'); rewrite (f);
writeln (f, 'Karbesteta  mediaan  totaal  -minmax   7...19     5*5');
for i := 1 to 5 do MonteCarlo (10000, false, f);
writeln (f);
writeln (f, 'Karbestega  mediaan  totaal  -minmax   7...19     5*5');
for i := 1 to 5 do MonteCarlo (10000, true, f);
close (f);
END.

===================================================================

Function Keskmine (grupp, hierarhia : integer) : single;
   Var i : integer; x, s, min, max : single;
   Begin
      s := 0; min := 1E33; max := -min;
      for i := 1 to grupp do begin
         if hierarhia = 1
            then x := lugem
            else x := Keskmine (grupp, hierarhia-1);
         s := s + x;
         if x < min then min := x;
         if x > max then max := x;
      end;
      Keskmine := (s - min - max) / (grupp - 2);
   End;