const
  PathLength  = 65;
  LineFeed = #10;
  CarriageReturn = #13;
  n=100;   {data-selection length}
  intr=10; {Number of intevsals in statistic row}
  OutFile = 'v_res.dat';
type
  Data_Array = array[1..n] of real;
  Data_Array1 = array[1..intr] of real;
  Data_Array2 = array[1..intr,1..2] of real;
  FileName  = string[PathLength];
var
  Y: Data_Array;
  Y1:Data_Array;
  y3:Data_Array2;
  use:    Byte;
  temp_,Length_:  Real;
  MainFileName,OutputFileName: FileName;
  MainFile,NextFile: text;

 function Open(var fp:text; name: Filename): boolean;
  begin
    Assign(fp,Name);
    {$I-}
    Reset(fp);
    {$I+}
    Open := IOResult = 0;
 end { Open };

 procedure OpenMain;
  begin
   if ParamCount = 0 then
    begin
      Write('Enter filename w/ data: ');
      Readln(MainFileName);
      Write('Enter filename for output: ');
      Readln(OutputFileName);
    end
   else
     begin
      if ParamCount > 2 then
               begin
                 Writeln('ERROR: too many paramters.');
                 Writeln('USAGE: tvims.exe input_file output_file');
                 Writeln('input_file must contain data-selection.');
                 Writeln('default output_file is tv_res.dat.');
                 Halt(5)
               end;

      if ParamCount = 1 then
                          begin
                           MainFileName := ParamStr(1);
                           Write('Enter filename for output: ');
                           Readln(OutputFileName)
                          end;
      if ParamCount = 2 then
                          begin
                          MainFileName  := ParamStr(1);
                          OutputFileName:= ParamStr(2)
                          end
     end;
   if (MainFileName = '') or not Open(MainFile,MainFileName) then
    begin
      Writeln('ERROR:  file not found (', MainFileName, ')');
      Halt(1);
    end;
   if (OutputFileName = '') then OutputFileName:=OutFile;
 end {Open Main};

 function MathAwait(y:Data_Array): real;
  begin
   temp_:=0;
   for use:=1 to n do temp_:=temp_ + y[use];
   MathAwait:=temp_/n
  end;

 function Dispersion(MathAwait:real):real;
   var d:Data_Array;
       delt:real;
   begin
    delt:=0;
    for use:=1 to n do delt:=delt+(y[use]-MathAwait)*(y[use]-MathAwait );
    Dispersion:=delt/n
   end;

 procedure Sort_(y:Data_Array;var y1:Data_Array);
  var tmp1:real;
      use2,use1:byte;

  begin
    Writeln('Initialising aray to sort.. ');
    for use1:=1 to n do y1[use1]:=y[use1];
    Writeln('Sorting array.. ');
    for use2:=1 to n do
     begin
      Write('/',CarriageReturn);{Showing that prog. is alive. :) }
      for use1:=1 to n-1 do
        if y1[use1] > y1[use1+1]
          then
            begin
             tmp1:=y1[use1];
             y1[use1]:=y1[use1+1];
             y1[use1+1]:=tmp1
            end;

      Write('\',CarriageReturn);
     end;
    Writeln('Sorted array looks as foolows:');
    for use2:=1 to n do
     Writeln('  ',y1[use2]:3:3);
    Writeln('Also see results in file ',OutputFileName);
    Readln;
  end;

  function Exists(y11:real;n1:byte):byte;
   var RangeLow,RangeHigh:real;   {n1 runs betw. 0 & intr-1}
      templ:byte;
    begin
     Length_:=(y1[n]-y1[1])/10;
     RangeLow:= y1[1] + n1*Length_;
     RangeHigh:=(y1[1] + (n1+1) * Length_ );
     if  ( y11 < RangeHigh  )
      then
       begin
        if ( y11 > RangeLow)  then begin Exists:=1;templ:=1 end
       end
     else begin Exists:=0;templ:=0 end;
     if y11 = RangeHigh  then begin Exists:=2;templ:=2 end;
     if y11 = y1[1] then if n1=0 then begin Exists:=1;templ:=1 end;
     if y11 = y1[n] then if n1=intr-1 then begin Exists:=1;templ:=1 end;
    end; {Exists}


 procedure Write_a_file (y1:Data_Array ;var fp:text; name: Filename);
  var use3,use4:byte;
      X_2,y2:Data_Array1;
      y3:Data_Array2;
      Pteor,Disp_,MathAw_,param_1,param_2,RangeLow,RangeHigh:real;
  begin
    Assign(fp,Name);
    {$I-}
    ReWrite(fp);
    {$I+}
    if  (IOResult = 0 ) = false then
                                  begin
                                   name:=OutFile;
                                   Assign(fp,Name);
                                   ReWrite(fp);
                                  end;
    Write(fp,'This is initial data-selection: ');
    for use3:=1 to n do
     begin
      if frac(use3/6)=0 then Write(fp,CarriageReturn,LineFeed);
      {Making file easy to read.}
      Write(fp,'  ',y[use3]:3:3,'  ');
     end;
    Write(fp,CarriageReturn,LineFeed);
    Write(fp,CarriageReturn,LineFeed);
    Write(fp,'This is  sorted data-selection: ');
    Write(fp,CarriageReturn,LineFeed);
    Write(fp,CarriageReturn,LineFeed);
    for use3:=1 to n do
     begin
      if frac(use3/6)=0 then Write(fp,CarriageReturn,LineFeed);
      {Making file easy to read.}
      Write(fp,'  ',y1[use3]:3:3,'  ');
     end;
    Write(fp,CarriageReturn,LineFeed);
    Write(fp,CarriageReturn,LineFeed);
    MathAw_:=MathAwait(y);
    Disp_:=Dispersion(MathAwait(y));
    Writeln(fp,'Math.Awaiting is          ',MathAw_:6:3);
    Writeln(fp,'Dispersion    is          ',Disp_:6:3);
    Writeln(fp,'Middle Square Differ. is  ',sqrt(Disp_):6:3);
    Length_:=(y1[n]-y1[1])/10;
    Write(fp,CarriageReturn,LineFeed);
    Write(fp,CarriageReturn,LineFeed);
    Writeln(fp,'Counting data for statistic row..');
    Write(fp,CarriageReturn,LineFeed);
    Writeln(fp,'Min. value in data-selection: ',y1[1]:3:3);
    Writeln(fp,'Max. value in data-selection: ',y1[n]:3:3);
    Write(fp,CarriageReturn,LineFeed);
    Writeln(fp,'Dividing to 10 intervals.',CarriageReturn,LineFeed,
               'Interval value is ',Length_:3:3);
    Writeln('Min. value in data-selection:',y1[1]:3:3);
    Writeln('Max. value in data-selection:',y1[n]:3:3);
    Writeln('Dividing to 10 intervals. Interval value is:',
                                             (y1[n]-y1[1])/10:3:3);
    Writeln('Counting number of values hits to each iterval..');
    Writeln(fp,'Counting number of values hits to each iterval..');
    for use4:=1 to intr do y2[use4]:=0; {Initialising array}
    for use4:=0 to intr-1 do
     for use3:=1 to n do
      begin
       if Exists(y1[use3],use4)=1
        then
         begin
         y2[use4+1]:=y2[use4+1]+1;
         writeln('value ',y1[use3]:3:3,' hits to interval ',use4+1);
         writeln('w/ ranges: ', (y1[1] + use4*( (y1[n]-y1[1])/10 ) ):3:3,
                   '  ',(y1[1] + (use4+1) * ( (y1[n]-y1[1])/10 ) ):3:3 );
         end;             {y2 - saves count of includings to an interval}
       if Exists(y1[use3],use4)=2 then
        begin
        y2[use4+1]:=y2[use4+1]+1/2;
        y2[use4]:=y2[use4]+1/2;
        end;
      end;
    Writeln(fp,'Them are as follows: ');
    Writeln('Them are as follows: ');
    for use4:=1 to intr do
     begin
      Writeln(fp,' ',y2[use4]:3:3,' ');
      Writeln(' ',y2[use4]:3:3,' ');
     end;
    Writeln(fp,'Dividing them to data-selection length.');
    Writeln('Dividing them to data-selection length.');
    Writeln('Resulting array is: ');
    Writeln(fp,'Resulting array is: ');
    for use4:=1 to intr do
     begin
      y2[use4]:=y2[use4]/n;              {y2 now contains "p" values}
      Writeln(fp,' ',y2[use4]:3:3,' ');
      Writeln(' ',y2[use4]:3:3,' ');
     end;
    Writeln('These was "p" values for each interval.');
    Writeln(fp,'These was "p" values for each interval.');

    Write(fp,CarriageReturn,LineFeed);
    Writeln(fp,'Counting data for a gistogramm..');

    Writeln('Counting data for a gistogramm..');
    Writeln(fp,'Data ranges for the intervals are as below: ');
    Writeln('Data ranges for the intervals are as below: ');
    for use4:=0 to intr-1 do
     begin                        {use4 runs betw. 0 & intr-1}
     RangeLow:= y1[1] + use4*Length_;
     RangeHigh:=y1[1] + (use4+1) * Length_ ;
     y3[use4+1,1]:=RangeLow;
     y3[use4+1,2]:=RangeHigh;
     end;

    for use4:=1 to intr do
     begin
      Writeln(fp,' Interval ',use4,' start: ',y3[use4,1]:3:3);
      Writeln(fp,'           ',    '   end: ',y3[use4,2]:3:3);
      Write(fp,CarriageReturn,LineFeed);
      Writeln(' interval',use4,' start ',y3[use4,1]:3:3);
      Writeln(' interval',use4,' end   ',y3[use4,2]:3:3);
      Writeln;
     end;
    Writeln(fp,'Interval    **|**   Gistogramm height on it');
    Writeln('Interval    **|**   Gistogramm height on it');
    for use4:=1 to intr do
     begin
     if use4<10 then
      begin
      Writeln(fp,'    ',use4,'                   ',
                                        y2[use4]/Length_:3:9,' ');
      Writeln(   '    ',use4,'                   ',
                                        y2[use4]/Length_:3:9,' ');
      end
     else
      begin
      Writeln(fp,'    ',use4,'                  ',
                                         y2[use4]/Length_:3:9,' ');
      Writeln(   '    ',use4,'                  ',
                                         y2[use4]/Length_:3:9,' ');
      end

     end;
    Write(fp,' ------------------------------------- ');
    Write(' ------------------------------------- ');
    Write(fp,CarriageReturn,LineFeed);
    Write(fp,CarriageReturn,LineFeed);
    Writeln(fp,'Counting data for aproximated function F*(x)..');
    Writeln('Counting data for aproximated function F*(x)..');
    Writeln('   Argument     |   aprox. function  ');
    Writeln('                |     F*(x) value    ');
    Write(fp,CarriageReturn,LineFeed);
    Writeln(fp,'   Argument     |   aprox. function  ');
    Writeln(fp,'                |     F*(x) value    ');
    Writeln(fp,'    ',y1[1]:3:3,'                   ',0);
    Writeln('    ',y1[1]:3:3   ,'                   ',0);
    param_1:=0;
    for use4:=1 to intr do
     begin
     param_1:=param_1+y2[use4];
     Writeln(fp,'    ', y3[use4,2]:3:3,'               ',param_1:3:3);
     Writeln('    ', y3[use4,2]:3:3,'               ',param_1:3:3);
     end;
    Write(fp,' ------------------------------------- ');
    Write(fp,CarriageReturn,LineFeed);
    Write(fp,CarriageReturn,LineFeed);
    flush(fp);
    Writeln;
    Writeln(fp,'Counting data for checking by Xý criterion..');
    Writeln(fp,'Normal probability law: ');
    Write(fp,CarriageReturn,LineFeed);
    Writeln(fp,'(using same values of math. awaiting & dispersion ');
    Writeln(fp,' & manualy entered values from function F*(x) table)');
    Write(fp,CarriageReturn,LineFeed);

    Writeln('Counting data for checking by Xý criterion..');
    Writeln('Normal probability law: ');
    Writeln('(using same values of math. awaiting & dispersion ');
    Writeln(' & manualy entered values from function F*(x) table)');
    Writeln;
    Writeln(fp,'   Interval   |  Probability to hit  |',
                                       ' Absolute value of       ');
    Writeln(fp,'    number    |    in the interval   |',
                                       ' difference  w/ practics ');
    Write(fp,CarriageReturn,LineFeed);
    Writeln('   Interval   |  Probability to hit  |',
                                       '  Absolute value of      ');
    Writeln('    number    |    in the interval   |',
                                       '  difference w/ practics ');
    Writeln;
    Writeln('Well,now for complete counting you need to enter ',
                                                        'some values.');
    Writeln('Use a table in your learnbook,or any other table ',
                                              'w/ function F* values ');
    for use4:=0 to intr-1 do
      begin
       RangeLow:= y1[1] + use4*Length_;
       RangeHigh:=y1[1] + (use4+1) * Length_ ;
       param_1:=(RangeHigh - MathAw_)/sqrt(Disp_);
       param_2:=(RangeLow - MathAw_)/sqrt(Disp_);
       Writeln('Please enter the value of F*(',param_1:3:5,') ');
       Readln(param_1);
       Writeln('Please enter the value of F*(',param_2:3:5,') ');
       Readln(param_2);
       Pteor:=param_1 - param_2;
       if Pteor = 0 then Pteor:= 2.8e-39;
          {Cause Pteor cannot be zero on nonzero interval.
            2.9e-39 is the smallest value in real type.
            This saves from errors in rounding.}
       X_2[use4+1]:=n*Sqr(y2[use4+1]-Pteor)/Pteor;
       Writeln(fp,'       ',use4,'              ',Pteor:3:3,
               '               ',Abs(Pteor - y2[use4+1]):3:3);
       Writeln('       ',use4,'              ',Pteor:3:3,
               '               ',Abs(Pteor - y2[use4+1]):3:3);
      end;
    Write(fp,' -------------------------------------',
                                         '----------------- ');
    Write(fp,CarriageReturn,LineFeed);
    Write(fp,CarriageReturn,LineFeed);
    param_1:=0;
    for use4:=1 to intr do param_1:=param_1+X_2[use4];
    Writeln(fp,'Pirson criterion Xý is ',param_1:4:7);
    Writeln('Pirson criterion Xý is ',param_1:4:7);
    Writeln(fp,'Use a table w/ criterion Xý to determine does this ',
                      ' probability law stisfy ' );
    Writeln(fp,' to that data-selection or not.');
    Writeln(fp,'Use R = ',intr-3,'  (number of power free)');
    Write(fp,CarriageReturn,LineFeed);
    Write(fp,CarriageReturn,LineFeed);
    Writeln(fp,'Well.. Just it''s all. :) ');
    Writeln;
    Writeln('Well.. Just it''s all. :) ');

    Readln;
    Close(fp);
  end; {Write_a_file }


 procedure ProcessFile;
  begin  {Process File}
    Writeln('Reading.. ');
    use:=0;
    while not EOF(mainfile) do
    begin
      use:=use+1;
      Read(MainFile,Y[use]);
      Writeln('Reading: ',use:3,':> ',Y[use]:6:3); {,CarriageReturn}
      if Eoln(MainFile)=true then Readln(MainFile);
    end;
    Writeln('It has been read ',use,' values.');
    Close(MainFile);
    Writeln('Math.Awaiting= ',MathAwait(y):6:3);
    Writeln('Dispersion= ',Dispersion(MathAwait(y)):6:3);
    Writeln('MiddleSquareDiffer. is  ',sqrt(Dispersion(MathAwait(y))):6:3);
    Writeln('Counting data for statistic row..');
    Sort_(y,y1);
    Write_a_file (y1,NextFile,OutputFileName);
  end {Process File};

begin
 OpenMain;
 Writeln('Reading data from file ',MainFileName,' Please wait..');
 ProcessFile;
end.
