MaximTakkaTo

Untitled

Dec 1st, 2020
487
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program Program1;
  2. uses
  3.   GraphABC;
  4.  
  5. CONST
  6.   N = 100000;
  7.   MaxK = 100;
  8.   b = 15;
  9.   lambda = 100;
  10.   c = 2;
  11. type
  12.   DATA = array[1..N] of double;
  13.   otr = array[1..maxK] of integer;
  14.   int = integer;
  15.  
  16. procedure Otcenki(const x : DATA; var Mx, Dx : double);
  17. var
  18.   i : int;
  19. begin
  20.   Mx:=0; Dx:=0;
  21.   //Нахождение мат. ожидания
  22.   For i:=1 to N do Mx:=Mx+x[i];
  23.   Mx:=Mx/N;
  24.   //Нахождение дисперисии
  25.   For i:=1 to N do Dx:=Dx+Sqr(x[i]-Mx);
  26.   Dx:=Dx/N;
  27. end;  
  28.  
  29. procedure Histogr(const d : otr; minx, maxx, dx : double);
  30. var
  31.   mx, my, x0, y0, x, hgt, wdt, i, Step : word;
  32.   Sc, temp : double;
  33.   s : string;
  34.   MaxD : integer;
  35. begin
  36.   //Значение получены экспериментально
  37.   mx:=Window.Width;
  38.   my:=524;
  39.   x0:=128;
  40.   y0:=my + 320;
  41.   wdt:=mx-2*128; //Ширина гистограммы по горизонтали
  42.   hgt:=my-2*16; //Ширина гистограммы по вертикали
  43.   MaxD:=d[1];
  44.   for i:=2 to MaxK do
  45.     if d[i] > MaxD then
  46.       MaxD:=d[i];
  47.   Sc:=hgt/MaxD; //Масштабный коэффициент
  48.   Step:=Trunc(wdt/MaxK);
  49.   Window.Clear();
  50.   SetBrushColor(clWhite);
  51.   SetPenColor(clBlue);
  52.   SetBrushStyle(bsSolid);
  53.  
  54.   //Рисуем гистограмму
  55.   x:=x0;
  56.   for i:=1 to MaxK do
  57.   begin
  58.     mx:=x + Step;
  59.     my:=Trunc(Sc*d[i]);
  60.     //Вывод значений по оси X
  61.     Str((minX + (i-1) * dx):5:4, s);
  62.     TextOut(mx - Step, y0, s);
  63.     //Рисуем столбец
  64.     Rectangle(x, y0, mx, y0 - my);
  65.     Rectangle(x + 1, y0 -1, mx - 1, y0 - my + 1);
  66.     //Вывод значения столбца
  67.     Str(d[i], s);
  68.     if my > 7 * 8 then
  69.       TextOut(x + 12, y0 - my + 4, s)
  70.     else
  71.       TextOut(x + 12, y0 - my - 6*8, s);
  72.     x:=mx;
  73.   end;
  74.   Str(maxX:5:4, s);
  75.   TextOut(x0 + Step*MaxK, y0, s);
  76. end;
  77.  
  78. var
  79.   x : DATA;
  80.   i : int;
  81.   yj, r, minX, maxX, mx, dx, sigma, delta : double;
  82.   inter : otr;
  83.   k : integer;
  84. begin
  85.   MaximizeWindow();
  86.   Randomize;
  87.   //Генерирование реализаций
  88.   for i:=1 to N do
  89.   begin
  90.     r:=Random;
  91.     yj := -ln(r) / lambda;
  92.     x[i]:= exp(c * yj + b);
  93.   end;
  94.   //Нахождения максимума и минимума
  95.   minX:=x[1];
  96.   maxX:=x[1];
  97.   for i:=2 to N do
  98.   begin
  99.     if (x[i] > maxX) then
  100.       maxX:=x[i]
  101.     else if (x[i] < minX) then
  102.       minX:=x[i];
  103.   end;
  104.  
  105.   Otcenki(x, mx, dx);
  106.   //Нахождение среднеквадратичного отклонения
  107.   sigma:=sqr(dx);
  108.   //Длина интервала
  109.   delta:=(maxX-minX)/maxK;
  110.   //Посчет число попавших значений в каждый интервал
  111.   for i:=1 to N do
  112.   begin
  113.     k:=1;
  114.     while (x[i] >= (minX + delta*k)) do
  115.       Inc(k);
  116.     if (k >= maxK) then
  117.       Inc(inter[maxK])
  118.     else
  119.       Inc(inter[k]);
  120.   end;
  121.  
  122.   //Построение гистограммы
  123.   Histogr(inter, minX, maxX, delta);
  124.  
  125.   //Вывод характеристик
  126.   TextOut(10, 20, 'Xmin : ' + minX);
  127.   TextOut(10, 35, 'Xmax : ' + maxX);
  128.   TextOut(10, 50, 'M(x) : ' + mx);
  129.   TextOut(10, 65, 'D(x) : ' + dx);
  130.   TextOut(10, 80, 'SIGMA(x) : ' + sigma);
  131.   TextOut(10, 95, 'dX : ' + delta);
  132. end.
RAW Paste Data