Advertisement
venik2405

lab3_1

Dec 9th, 2020
336
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 4.41 KB | None | 0 0
  1. Program lab3_1;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   System.SysUtils;
  7.  
  8. type
  9.     TString = array of string;
  10.  
  11. Function InputFileLocation(): string;
  12. Var
  13.     IsCorrect: Boolean;
  14.     Location: String;
  15. Begin
  16.     Repeat
  17.         IsCorrect := false;
  18.         WriteLn('Enter file location:');
  19.         ReadLn(Location);
  20.         If FileExists(Location) then
  21.             IsCorrect := true
  22.         Else
  23.         Begin
  24.             WriteLn('Please enter the correct location');
  25.             WriteLn('');
  26.         End;
  27.     Until IsCorrect;
  28.     InputFileLocation := Location;
  29. End;
  30.  
  31.  
  32. Function ChooseInput(): integer;
  33. Var
  34.     Line: String;
  35.     IsCorrect: Boolean;
  36. Begin
  37.     Repeat
  38.         IsCorrect := true;
  39.         WriteLn('Do you want to input from file? (y/n)');
  40.         ReadLn(line);
  41.         Line := Line.ToLower();
  42.         If(Line <> '') and (Line <> 'y') and (Line <> 'n') then
  43.         Begin
  44.             IsCorrect := false;
  45.             WriteLn('Enter valid answer');
  46.         End;
  47.     Until IsCorrect;
  48.     If (Line = '') or (Line = 'y') then
  49.         ChooseInput := 0
  50.     Else
  51.         ChooseInput := 1;
  52. End;
  53.  
  54. Procedure GetLineFromFile(Str: String);
  55. var
  56.     IsCorrect: Boolean;
  57.     TFile: TextFile;
  58. begin
  59.     repeat
  60.         IsCorrect := true;
  61.         AssignFile(TFile, InputFileLocation());
  62.         Reset(TFile);
  63.         ReadLn(TFile, Str);
  64.         CloseFile(TFile);
  65.         if (Length(Str) = 0) then
  66.         begin
  67.             WriteLn('One or both strings are empty. Enter another file location');
  68.             IsCorrect := false;
  69.         end;
  70.     until IsCorrect;
  71. end;
  72.  
  73. Procedure OutputToFile(WordPosition: Integer);
  74. Var
  75.     TxtFile: TextFile;
  76. Begin
  77.     AssignFile(TxtFile, InputFileLocation());
  78.     Rewrite(TxtFile);
  79.     Writeln(TxtFile, WordPosition);
  80. End;
  81.  
  82. Function GetLineFromConsole(): String;
  83. var
  84.     IsCorrect: Boolean;
  85.     InputLine: String;
  86. begin
  87.      repeat
  88.         IsCorrect := true;
  89.         ReadLn(InputLine);
  90.         if Length(InputLine) = 0 then
  91.         begin
  92.             WriteLn('The line is empty, re-enter please');
  93.             IsCorrect := false;
  94.         end;
  95.     until IsCorrect;
  96.     GetLineFromConsole := InputLine;
  97. end;
  98.  
  99. Function FindAmountOfWordsInSentence(Str: String): Integer;
  100. Var
  101.     Amount, I: Integer;
  102. Begin
  103.     Amount := 1;
  104.     for I := 1 to High(Str) do
  105.         if Str[I] = ' ' then
  106.             Inc(Amount);
  107.     FindAmountOfWordsInSentence := Amount;
  108. End;
  109.  
  110. Function FindWords(Str: String; Amount: Integer): TString;
  111. Var
  112.     Words: TString;
  113.     I, J: Integer;
  114. Begin
  115.     J := 1;
  116.     SetLength(Words, Amount);
  117.     for I := 0 to Amount - 1 do
  118.     Begin
  119.         while (Str[J] <> ' ') and (J <= length(Str) ) do
  120.         Begin
  121.             Words[I] := Words[I] + Str[J];
  122.             Inc(J);
  123.         End;
  124.         Inc(J);
  125.     End;
  126.     FindWords := Words;
  127. End;
  128.  
  129. Function FindShortestWord(Amount: Integer; Words: TString): Integer;
  130. Var
  131.     I, MinLength, Pos: Integer;
  132. Begin
  133.     MinLength := Length(Words[0]);
  134.     for I := 0 to Amount - 1 do
  135.         if MinLength > Length(Words[I]) then
  136.         Begin
  137.             MinLength := Length(Words[I]);
  138.             Pos := I;
  139.         End;
  140.     FindShortestWord := Pos;
  141. End;
  142.  
  143. Function FindPosition(Words: TString; Pos: Integer ):Integer;
  144. Var
  145.     I, WordPosition: Integer;
  146. Begin
  147.     Wordposition := 0;
  148.     for I := 0 to (Pos - 1) do
  149.         WordPosition := WordPosition + Length(Words[I]);
  150.     WordPosition := WordPosition + I + 1;
  151.     FindPosition := WordPosition;
  152. End;
  153.  
  154. Procedure Main();
  155. Var
  156.     ChosenInput, Amount, WordPosition, Pos: Integer;
  157.     Str,  ShortestWord: String;
  158.     Words : TString;
  159. Begin
  160.     WriteLn('Программа находит самое короткое слово в предложении и указывает позицию , с которой оно начинается.');
  161.     ChosenInput := ChooseInput();
  162.     If (ChosenInput = 0) then
  163.         GetLineFromFile(Str)
  164.     Else
  165.     Begin
  166.         Writeln('Введите предложение');
  167.         Str := GetLineFromConsole();
  168.     End;
  169.     Amount := FindAmountOfWordsInSentence(Str);
  170.     Words := FindWords(Str, Amount);
  171.     Pos := FindShortestWord(Amount, Words);
  172.     writeln('Позиция самого короткого слова предложения');
  173.     WordPosition := FindPosition(Words, Pos);
  174.     Writeln(WordPosition);
  175.     WriteLn;
  176.     OutputToFile(WordPosition);
  177.     ReadLn;
  178. End;
  179.  
  180. Begin
  181.     Main();
  182. End.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement