Program DEMO1; {keskmise ja standardh„lbe hindamine}
{$M 65000, 0, 655360} {pinu maht suurte massiivide jaoks}

Const nmax = 10000; {suurim lubatud lugemite arv seerias}
Var   n : integer;  {tegelik lugemite arv seerias}
    out : text;     {v„ljund, kas ekraan väi fail}

Function Lugem : single;
   {Gaussi jaotus, keskv„„rtus = 6, standardh„lve = 1}
   Var x : single; i : integer;
   Begin x := random;
      for i := 2 to 12 do x := x + random;
      lugem := x;
   End;

Procedure Esimene (var kesk, sigma : single);
   Var i : integer;
       s : single;
       x : array [1..nmax] of single;
   Begin
      if n > nmax then begin {alternatiivne meetod oleks $R+}
         writeln ('Lugemite arv ei tohi olla suurem kui ', nmax);
         writeln ('Vajuta ENTER!'); readln; halt;
      end;
      for i := 1 to n do x [i] := lugem;
      s := 0;
      for i := 1 to n do s := s + x [i];
      kesk := s / n;
      s := 0;
      for i := 1 to n do s := s + sqr (x [i] - kesk);
      sigma := sqrt (s / (n - 1));
   End;

     {Värdlusvariante:
      s := x [1]; for i := 2 to n do s := s + x [i];
      sigma := sqrt (s / n);
      sigma := sqrt (s / (n * (n - 1)));
      sigma := sqrt (abs ((s / (n - 1)));}

Procedure Teine (var kesk, sigma : single);
   Var i : integer;
       x, s, ss : single;
   Begin
      s := 0; ss := 0;
      for i := 1 to n do begin
         x := lugem;
         s := s + x;
         ss := ss + x * x;
      end;
      kesk := s / n;
      sigma := sqrt ((ss - s * kesk) / (n - 1));
   End;

Procedure Kolmas (var kesk, sigma : single);
   Var i : integer;
       x, ss : single;
   Begin
      ss := 0;
      for i := 1 to n do begin
         x := lugem;
         kesk := ((i - 1) * kesk + x) / i;
         ss := ss + x * x;
      end;
      sigma := sqrt ((ss - n * kesk * kesk) / (n - 1));
   End;

Var m, s : single; {keskv„„rtuse ja standardh„lbe hinnangud}
    i, k : integer;
    nimi : string;

BEGIN
writeln;
write ('V„ljundfaili nimi (vahetu ENTER = ekraan) : ');
readln (nimi); assign (out, nimi); rewrite (out);
writeln (out, 'Fail: ', nimi); writeln (out);
repeat
   writeln ('Arvutamise läpetab lugemite arv = 0');
   write ('Lugemite arv = '); readln (n);
   if n > 0 then begin
      write ('Korduste arv = '); readln (k);
      writeln (out, n, ' lugemit, ', k, ' kordust');
      for i := 1 to k do begin
         Esimene (m, s); writeln (out, '1) m =', m:6:3, '  s =', s:6:3);
           Teine (m, s); writeln (out, '2) m =', m:6:3, '  s =', s:6:3);
          Kolmas (m, s); writeln (out, '3) m =', m:6:3, '  s =', s:6:3);
      end;
      writeln (out);
   end;
until n = 0;
close (out);
END.





Program DEMO2; {standardh„lbe hindamise katseline analyys}

Const  k = 100000; {Monte Carlo statistika maht}
Var  out : text;

Function Lugem : single;
   {Gaussi jaotus, keskv„„rtus = 6, standardh„lve = 1}
   Var x : single; i : integer;
   Begin x := random;
      for i := 2 to 12 do x := x + random;
      lugem := x;
   End;

Procedure Sigmad (n : longint; var sigma1, sigma2 : double);
   Var i : longint;
       x, s, ss : double;
   Begin
      s := 0; ss := 0;
      for i := 1 to n do begin
         x := lugem;
         s := s + x;
         ss := ss + x * x;
      end;
      sigma1 := sqrt ((ss - s * s / n) /    n   );
      sigma2 := sqrt ((ss - s * s / n) / (n - 1));
   End;

Var s1, s2, sum1, sum2, ssum1, ssum2,
    skesk1, skesk2, ssigma1, ssigma2 : double;
    n, i, j : longint;
    nimi : string;

BEGIN
randomize;
writeln;
write ('V„ljundfaili nimi (vahetu ENTER = ekraan) : ');
readln (nimi); assign (out, nimi); rewrite (out);
writeln (out, 'Fail: ', nimi);
writeln (out, 'Monte Carlo statistika maht = ', k);
writeln (out);
writeln (out, '           Keskmine      Sigma');
writeln (out, 'Lugemeid    n   n-1     n   n-1');
n := 4;
for j := 1 to 3 do begin
   sum1 := 0; sum2 := 0; ssum1 := 0; ssum2 := 0;
   for i := 1 to k do begin
      sigmad (n, s1, s2); {s1 := s1 * s1; s2 := s2 * s2;} {s/d}
      sum1 := sum1 + s1; ssum1 := ssum1 + s1 * s1;
      sum2 := sum2 + s2; ssum2 := ssum2 + s2 * s2;
   end;
   skesk1 := sum1 / k;
   ssigma1 := sqrt ((ssum1 - sum1 * skesk1) / (k - 1));
   skesk2 := sum2 / k;
   ssigma2 := sqrt ((ssum2 - sum2 * skesk2) / (k - 1));
   writeln (out, n:8, skesk1:6:3, skesk2:6:3, ssigma1:6:3, ssigma2:6:3);
   n := 5 * n;
end;
close (out); if nimi = '' then readln;
END.






Program DEMO3;   {keskmistamine rikub t„psuse}
{NB: nulliga jagamise risk ei ole v„listatud!}

Const  k = 100000; {Monte Carlo statistika maht}
Var  out : text;

Function Lugem : single;
   {tangensruutk„rbestega jaotus, keskpunkt = 0}
   Var x, s : double;
   Begin
      x := pi * (random - 0.5); s := x / abs (x);
      if random < 0.01 then x := x + s * sqr (sin (x) / cos(x));
      lugem := x / 10;
   End;

Function Keskmine (n : longint) : double;
   Var i : longint;
       s : double;
   Begin
      s := 0;
      for i := 1 to n do begin
         s := s + lugem;
      end;
      keskmine := s / n;
   End;

Var x, s, ss, kesk, sigma : double;
    n, i, j : longint;
    nimi : string;

BEGIN
randomize;
writeln;
write ('V„ljundfaili nimi (vahetu ENTER = ekraan) : ');
readln (nimi); assign (out, nimi); rewrite (out);
writeln (out, 'Fail: ', nimi);
writeln (out, 'Monte Carlo statistika maht = ', k);
writeln (out);
writeln (out, 'Lugemeid   Keskmine  Sigma');
n := 1;
for j := 1 to 4 do begin
   s := 0; ss := 0;
   for i := 1 to k do begin
      x := keskmine (n);
      s := s + x; ss := ss + x * x;
   end;
   kesk := s / k;
   sigma := sqrt ((ss - s * kesk) / (k - 1));
   writeln (out, n:8, kesk:9:3, sigma:9:3);
   n := 5 * n;
end;
close (out); if nimi = '' then readln;
END.






Program DEMO4;  {kahe kerge keha kaalumine}

Const  k = 100; {Monte Carlo statistika maht}
      m01 = 10; {esimese keha mass, mg}
      m02 = 20; {  teise keha mass, mg}
Var  out : text;

Function Viga : single;
   {Normaaljaotusega juhuslik viga, sigma = 1 mg}
   Var x : single; i : integer;
   Begin x := random;
      for i := 2 to 12 do x := x + random;
      viga := x - 6;
   End;

Var x1, x2, y1, y2, s1, s2, ss1, ss2,
    m1, m2, sigma1, sigma2 : double;
    i : longint;
    nimi : string;

BEGIN
randomize;
writeln;
write ('V„ljundfaili nimi (vahetu ENTER = ekraan) : ');
readln (nimi); assign (out, nimi); rewrite (out);
writeln (out, 'Fail: ', nimi);
writeln (out, 'Monte Carlo statistika maht = ', k);
writeln (out);
{Lihtkaalumine}
   s1 := 0; ss1 := 0; s2 := 0; ss2 := 0;
   for i := 1 to k do begin
      x1 := m01 + viga;
      x2 := m02 + viga;
      s1 := s1 + x1; ss1 := ss1 + x1 * x1;
      s2 := s2 + x2; ss2 := ss2 + x2 * x2;
   end;
   m1 := s1 / k; sigma1 := sqrt ((ss1 - s1 * m1) / (k * (k - 1)));
   m2 := s2 / k; sigma2 := sqrt ((ss2 - s2 * m2) / (k * (k - 1)));
   {NB: nimetaja k * (k - 1)}
   writeln (out, 'Lihtkaalumine:');
   writeln (out, '   m1 =', m1:7:3, ' +-', sigma1:6:3, ' mg',
                 '   m2 =', m2:7:3, ' +-', sigma2:6:3, ' mg');
{Multiplekskaalumine}
   s1 := 0; ss1 := 0; s2 := 0; ss2 := 0;
   for i := 1 to k do begin
      y1 := m02 + m01 + viga;
      y2 := m02 - m01 + viga;
      x1 := (y1 - y2) / 2;
      x2 := (y1 + y2) / 2;
      s1 := s1 + x1; ss1 := ss1 + x1 * x1;
      s2 := s2 + x2; ss2 := ss2 + x2 * x2;
   end;
   m1 := s1 / k; sigma1 := sqrt ((ss1 - s1 * m1) / (k * (k - 1)));
   m2 := s2 / k; sigma2 := sqrt ((ss2 - s2 * m2) / (k * (k - 1)));
   writeln (out, 'Multiplekskaalumine:');
   writeln (out, '   m1 =', m1:7:3, ' +-', sigma1:6:3, ' mg',
                 '   m2 =', m2:7:3, ' +-', sigma2:6:3, ' mg');
close (out); if nimi = '' then readln;
END.