SHARE
TWEET

Untitled

a guest Nov 12th, 2019 63 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program Mnogestva;
  2. uses
  3.   System.SysUtils;
  4.  
  5. type
  6.    Mnogestv = set of 1..200;
  7. function Check(var InputPeremenn: byte): byte;
  8. var
  9.    i: Byte;
  10.    IsCorrect: Boolean;
  11. begin
  12.    IsCorrect := True;
  13.    repeat
  14.       try
  15.          Readln(InputPeremenn);
  16.          if ((InputPeremenn > 0) and (InputPeremenn < 255)) then
  17.             IsCorrect := True
  18.          else
  19.          begin
  20.             IsCorrect := False;
  21.             WriteLn('Ошибка ввода.Введите заново данный элемент')
  22.          end;
  23.       except
  24.          IsCorrect := False;
  25.          WriteLn('Ошибка ввода.Введите заново данный элемент')
  26.       end;
  27.    until IsCorrect;
  28.    Check := InputPeremenn;
  29. end;
  30.  
  31.  
  32.  
  33. function GetMnogest(var MnName: Mnogestv) :Mnogestv;
  34. var
  35.    Size, Number, i: byte;
  36. begin
  37.    MnName := [];
  38.    Size := Check(Size);
  39.    for i := 1 to Size do
  40.    begin
  41.       WriteLn('Введите ',i,' элемент множества');
  42.       Number := Check(Number);
  43.       MnName := MnName + [Number];
  44.    end;
  45.    GetMnogest := MnName;
  46. end;
  47.  
  48.  
  49.  
  50. procedure FindThatINeed(ResultSet:Mnogestv);
  51. var
  52.    i, Num: byte;
  53. begin
  54.    Num := 0;
  55.    Write('Элементы множества Y, которые делятся на 3 без остатка:');
  56.    for i := 3 to 255 do
  57.       if (i in ResultSet) and (i mod 3 = 0) then
  58.       begin
  59.          Num := i;
  60.          Write(i,' ');
  61.       end;
  62.    if Num = 0 then
  63.       WriteLn('Нет подходящих чисел!')
  64.    else
  65.       WriteLn;
  66. end;
  67.  
  68.  
  69.  
  70. procedure IfInResult(var ResultSet, ThirdSet: Mnogestv);
  71. var
  72.    i, Num, k: byte;
  73.    IsCorrect: boolean;
  74. begin
  75.    if ResultSet <= ThirdSet then
  76.       WriteLn('Множествo Х3 находится во множестве Y')
  77.    else
  78.       WriteLn('Множествo Х3 Во множестве Y не находится');
  79. end;
  80.  
  81.  
  82.  
  83. function Console(FirstSet, SecondSet, ThirdSet, ResultSet: Mnogestv):Mnogestv;
  84. begin
  85.    WriteLn('Введите количество элементов в 1 множестве:');
  86.    FirstSet := GetMnogest(FirstSet);
  87.    WriteLn('Введите количество элементов вo 2 множестве:');
  88.    SecondSet := GetMnogest(SecondSet);
  89.    ResultSet := FirstSet * SecondSet;
  90.    FindThatINeed(ResultSet);
  91.    WriteLn('Введите количество элементов в 3 множестве:');
  92.    ThirdSet := GetMnogest(ThirdSet);
  93.    IfInResult(ResultSet, ThirdSet);
  94.    Console := ResultSet;
  95. end;
  96.  
  97.  
  98.  
  99. function FromFile(): Mnogestv;
  100. var
  101.    FirstSet, SecondSet, ThirdSet, ResultSet: Mnogestv;
  102.    Name: String;
  103.    IsCorrect: boolean;
  104.    input: text;
  105.    Num: byte;
  106. begin
  107.    FirstSet := [];
  108.    SecondSet := [];
  109.    ThirdSet := [];
  110.    ResultSet := [];
  111.    repeat
  112.       WriteLn('Введите название файла:');
  113.       ReadLn(Name);
  114.       Name := Name + '.txt';
  115.       IsCorrect := True;
  116.       try
  117.          Assign(Input,Name);
  118.          Reset(Input);
  119.          if not(eof(Input)) then
  120.             IsCorrect := True
  121.          else
  122.          begin
  123.             IsCorrect := False;
  124.             WriteLn('Данный файл пуст.Попробуйте другой.');
  125.          end;
  126.          while (not Eof(Input)) do
  127.          begin
  128.             while (not Eoln(Input)) do
  129.             begin
  130.                 Read(Input, Num);
  131.                 FirstSet := FirstSet + [Num];
  132.             end;
  133.             Readln(Input);
  134.             while (not Eoln(Input)) do
  135.             begin
  136.                 Read(Input, Num);
  137.                 SecondSet := SecondSet + [Num];
  138.             end;
  139.             Readln(Input);
  140.             while (not Eoln(Input)) do
  141.             begin
  142.                 Read(Input, Num);
  143.                 ThirdSet := ThirdSet + [Num];
  144.             end;
  145.          end;
  146.       except
  147.          IsCorrect := False;
  148.          WriteLn('Название введено неправильно.Попробуйте еще раз.');
  149.       end;
  150.    until IsCorrect;
  151.    CloseFile(input);
  152.    ResultSet := SecondSet * FirstSet ;
  153.    FindThatINeed(ResultSet);
  154.    IfInResult(ResultSet, ThirdSet);
  155.    FromFile := ResultSet;
  156. end;
  157.  
  158.  
  159.  
  160. procedure WritetoFile(ResultSet: Mnogestv);
  161. var
  162.    Output: text;
  163.    i, Num: byte;
  164. begin
  165.    Assign(Output,'C:\Users\nikita\Desktop\ResultMnog.txt');
  166.    Reset(Output);
  167.    Rewrite(Output);
  168.    Num := 0;
  169.    Write(Output,'Элементы множества Y, которые делятся на 3 без остатка:');
  170.    for i := 3 to 255 do
  171.       if (i in ResultSet) and (i mod 3 = 0) then
  172.       begin
  173.          Num := i;
  174.          Write(Output,i,' ');
  175.       end;
  176.    if Num = 0 then
  177.       WriteLn(Output,'Нет подходящих чисел!')
  178.    else
  179.       WriteLn;
  180.    WriteLn('Записано!');
  181.    Close(Output);
  182. end;
  183.  
  184.  
  185.  
  186. procedure Main;
  187. var
  188.    FirstSet, SecondSet, ThirdSet, ResultSet: Mnogestv;
  189.    Thing, Place: string;
  190.    IsCorrect: boolean;
  191. begin
  192.    WriteLn('Данная программа формирует множество Y = X1 U X2 и выводит элементы Y,которые делятся на 3 без остатка.');
  193.    repeat
  194.       WriteLn('Если вы хотите считать множество с файла,то напишите:F');
  195.       WriteLn('Если вы хотите считать множество с консоли, то напишите:C');
  196.       try
  197.          ReadLn(Thing);
  198.          if (Thing = 'F') or (Thing = 'f') then
  199.          begin
  200.             IsCorrect := True;
  201.             ResultSet := FromFile();
  202.          end
  203.          else
  204.             if (Thing = 'C') or (Thing = 'c') then
  205.             begin
  206.                IsCorrect := True;
  207.                ResultSet := Console(FirstSet,SecondSet,ThirdSet,ResultSet);
  208.             end
  209.             else
  210.             begin
  211.                IsCorrect := False;
  212.                WriteLn('Ошибка ввода.Введите заново!')
  213.             end;
  214.       except
  215.          IsCorrect := False;
  216.          WriteLn('Ошибка ввода.Введите заново!')
  217.       end;
  218.    until IsCorrect;
  219.    repeat
  220.       WriteLn('Если вы хотите записать результат в файл,то напишите:Y');
  221.       WriteLn('Если нет,то напишите:N');
  222.       try
  223.          ReadLn(Place);
  224.          if (Place = 'Y') or (Place = 'y') then               {C:\Users\nikita\Desktop\ResultMnog.txt   }
  225.          begin
  226.             IsCorrect := True;
  227.             WriteToFile(ResultSet);
  228.          end
  229.          else
  230.             if (Place = 'N') or (Place = 'n') then
  231.             begin
  232.                IsCorrect := True;
  233.             end
  234.             else
  235.             begin
  236.                IsCorrect := False;
  237.                WriteLn('Ошибка ввода.Введите заново!')
  238.             end;
  239.       except
  240.          IsCorrect := False;
  241.          WriteLn('Ошибка ввода.Введите заново!')
  242.       end;
  243.    until IsCorrect;
  244.    Readln;
  245.    ReadLn;
  246. end;
  247.  
  248.  
  249.  
  250. begin
  251.    Main;
  252. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top