Advertisement
green1ant

3_3 *2

Nov 15th, 2018
268
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 5.22 KB | None | 0 0
  1. program Laba_3_3;
  2. {$APPTYPE CONSOLE}
  3. uses
  4.    SysUtils;
  5.  
  6. type
  7.    TList = array of Integer;
  8.    TInputMode = (WithFile, Console);
  9.  
  10. resourcestring
  11.    InstructionMessage
  12.       = 'This program sorts your sequence using Insertion Sort';
  13.    WayOfInputMessage = 'Where do you want to input data from? [F]ile or [C]onsole';
  14.    IncorrectInputFilePathMessage
  15.       = 'Incorrect input file path, check if file exists and try again';
  16.    IncorrectInputModeMessage = 'Incorrect way of input, choose [F]ile or [C]onsole';
  17.    OutputFileExistsErrorMessage
  18.       = 'Incorrect output file, such file already exists, try again';
  19.    ShouldCreateMessage = 'Do you want to save output data into file? [Y]es or [N]o';
  20.    ShouldCreateErrorMessage = 'Incorrect answer, choose [Y]es or [N]o';
  21.    EmptySequenceMessage = 'Your sequence doesn''t contain any of assumed symbols';
  22.    OutputMessage = 'Composed set based on your sequence';
  23.    SuccessfullySavedMessage = 'Output data was successfully saved into ';
  24.  
  25. function GetInputFilePath: string;
  26. var
  27.    Path: string;
  28. begin
  29.    Writeln('Enter input file path');
  30.    Readln(Path);
  31.    while not FileExists(Path) do
  32.    begin
  33.       Writeln(IncorrectInputFilePathMessage);
  34.       Readln(Path);
  35.    end;
  36.    GetInputFilePath := Path;
  37. end;
  38.  
  39. function ShouldCreateOutputFile: Boolean;
  40. var
  41.    Answer: string;
  42. begin
  43.    Writeln(ShouldCreateMessage);
  44.    Readln(Answer);
  45.    Answer := LowerCase(Answer);
  46.    while (Answer <> 'y') and (Answer <> 'n') do
  47.    begin
  48.       Writeln(ShouldCreateErrorMessage);
  49.       Readln(Answer);
  50.    end;
  51.    ShouldCreateOutputFile := Answer = 'y';
  52. end;
  53.  
  54. function GetOutputFilePath: string;
  55. var
  56.    Path: string;
  57. begin
  58.    Writeln('Enter output file path');
  59.    Readln(Path);
  60.    while FileExists(Path) do
  61.    begin
  62.       Writeln(OutputFileExistsErrorMessage);
  63.       Readln(Path);
  64.    end;
  65.    GetOutputFilePath := Path;
  66. end;
  67.  
  68. function ChooseInputMode: TInputMode;
  69. var
  70.    Mode: string;
  71. begin
  72.    Writeln(WayOfInputMessage);
  73.    Readln(Mode);
  74.    Mode := LowerCase(Mode);
  75.    while (Mode <> 'c') and (Mode <> 'f') do
  76.    begin
  77.       Writeln(IncorrectInputModeMessage);
  78.       Readln(Mode);
  79.    end;
  80.    if Mode = 'f' then
  81.       ChooseInputMode := WithFile
  82.    else
  83.       ChooseInputMode := Console;
  84. end;
  85.  
  86. function ReadFile(var InputFile: TextFile; const Len: Integer): TList;
  87. var
  88.    Sequence: TList;
  89.    i: Integer;
  90. begin
  91.    SetLength(Sequence, Len);
  92.    Reset(InputFile);
  93.    i := 0;
  94.    while not EoF(InputFile) do
  95.    begin
  96.       Read(InputFile, Sequence[i]);
  97.       Inc(i);
  98.    end;
  99.    CloseFile(InputFile);
  100.    ReadFile := Sequence;
  101. end;
  102.  
  103. function CheckData(var InputFile: TextFile; var Len: Integer): Boolean;
  104. var
  105.    AssumedLength, Item: Integer;
  106. begin
  107.    AssumedLength := 0;
  108.    try
  109.       while not EoF(InputFile) do
  110.       begin
  111.          Read(InputFile, Item);
  112.          Inc(AssumedLength);
  113.       end;
  114.       CheckData := True;
  115.       Len := AssumedLength;
  116.    except
  117.       Writeln('Data error');
  118.       Len := - 1;
  119.       CheckData := False;
  120.    end;
  121. end;
  122.  
  123. function ReadConsole: TList;
  124. var
  125.    N, i: Integer;
  126.    IsCorrect: Boolean;
  127.    List: TList;
  128. begin
  129.    IsCorrect := False;
  130.    Writeln('Enter amount of elements of your sequence');
  131.    repeat
  132.       try
  133.          Readln(N);
  134.          IsCorrect := True;
  135.       except
  136.          Writeln('Try again');
  137.       end;
  138.    until IsCorrect;
  139.  
  140.    SetLength(List, N);
  141.  
  142.    Writeln('Enter elems');
  143.    for i := 0 to N - 1 do begin
  144.       IsCorrect := False;
  145.       repeat
  146.          try
  147.             Readln(List[i]);
  148.             IsCorrect := True;
  149.          except
  150.             Writeln('Try again man');
  151.          end;
  152.       until IsCorrect;
  153.    end;
  154.    ReadConsole := List;
  155. end;
  156.  
  157. procedure WriteList(var OutputFile: TextFile; List: TList);
  158. var
  159.    i, LastIndex: Integer;
  160. begin
  161.    LastIndex := High(List);
  162.    for i := 0 to LastIndex do
  163.       Write(OutputFile, List[i], ' ');
  164.    Writeln(OutputFile, '');
  165. end;
  166.  
  167. procedure SortList(var OutputFile: TextFile; List: TList);
  168. var
  169.    i, j, LastIndex, Current: Integer;
  170. begin
  171.    LastIndex := High(List) + 1;
  172.    Writeln(OutputFile, 'Sorted seqeunce');
  173.    for i := 1 to LastIndex do
  174.    begin
  175.       WriteList(OutputFile, List);
  176.       Current := List[i];
  177.       j := i - 1;
  178.       while (List[j] > Current) and (j >= 0) do
  179.       begin
  180.          List[j+1] := List[j];
  181.          Dec(j);
  182.       end;
  183.       List[j+1] := Current;
  184.    end;
  185. end;
  186.  
  187. procedure Main;
  188. var
  189.    Len: Integer;
  190.    List, ListToFile: TList;
  191.    InputFile, OutputFile: TextFile;
  192. begin
  193.    Writeln(InstructionMessage);
  194.    Len := 0;
  195.    case ChooseInputMode() of
  196.       WithFile:
  197.       begin
  198.          Assign(InputFile, {'input.txt'}GetInputFilePath());
  199.          Reset(InputFile);
  200.          if CheckData(InputFile, Len) then
  201.             List := ReadFile(InputFile, Len);
  202.       end;
  203.       Console:
  204.          List := ReadConsole();
  205.    end;
  206.  
  207.    if Len <> -1 then
  208.    begin
  209.       ListToFile := Copy(List);
  210.       SortList(Output, List);
  211.       if ShouldCreateOutputFile() then
  212.       begin
  213.          AssignFile(OutputFile, GetOutputFilePath());
  214.          Rewrite(OutputFile);
  215.          SortList(OutputFile, ListToFile);
  216.          CloseFile(OutputFile);
  217.       end;
  218.    end;
  219.  
  220.    Writeln('Fin!');
  221.    Readln;
  222. end;
  223.  
  224. begin
  225.   Main();
  226. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement