Advertisement
ksyshshot

Untitled

Oct 30th, 2022
81
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 4.49 KB | Source Code | 0 0
  1. Program Lab_2_2;
  2.  
  3. {$APPTYPE CONSOLE}
  4. {$R *.res}
  5.  
  6. Uses
  7. System.SysUtils;
  8.  
  9. Type
  10. TArr = Array Of Integer;
  11.  
  12. Var
  13. ArrayOfCorrect: TArr;
  14. N: Integer;
  15.  
  16. Function InputNumber(): Integer;
  17. Const
  18. MAX_NUMBER = 2147483647;
  19. MIN_NUMBER = 2;
  20. Var
  21. Number: Integer;
  22. IsCorrect: Boolean;
  23. Begin
  24. Repeat
  25. Writeln ('Введите натуральное число N в диапазоне от ', MIN_NUMBER,' до ', MAX_NUMBER);
  26. IsCorrect := True;
  27. Try
  28. Readln (Number);
  29. Except
  30. Writeln ('Данные введены некорректно');
  31. IsCorrect := False;
  32. End;
  33. If ((IsCorrect) And ((Number < MIN_NUMBER) Or (Number > MAX_NUMBER))) Then
  34. Begin
  35. Writeln ('Введено число неверного диапазона');
  36. IsCorrect := False;
  37. End
  38. Until (IsCorrect);
  39. InputNumber := Number;
  40. End;
  41.  
  42. Function ConsistencyUpToNumber(Number: Integer): TArr;
  43. Var
  44. I: Integer;
  45. ArrNumbers: TArr;
  46. Begin
  47. SetLength (ArrNumbers, Number - 1);
  48. I := 0;
  49. While (I < Number - 1) Do
  50. Begin
  51. ArrNumbers[I] := I + 2;
  52. Inc(I);
  53. End;
  54. ConsistencyUpToNumber := ArrNumbers;
  55. End;
  56.  
  57. Function ArrayOfPrime(Number: Integer): TArr;
  58. Var
  59. IsPrime: Array Of Boolean;
  60. I, J: Integer;
  61. PrimeNumbers: TArr;
  62. Begin
  63. SetLength(IsPrime, Number);
  64. For I := 0 To Number - 1 Do
  65. IsPrime[I] := True;
  66. I := 2;
  67. While (I * I < Number) Do
  68. Begin
  69. If (IsPrime[I]) Then
  70. Begin
  71. J := 2 * I;
  72. While (J < Number) Do
  73. Begin
  74. IsPrime[J] := False;
  75. J := J + I;
  76. End;
  77. End;
  78. Inc (I);
  79. End;
  80. SetLength(PrimeNumbers, Number);
  81. Dec(Number);
  82. J := 0;
  83. For I := 2 To Number Do
  84. If (IsPrime[I]) Then
  85. Begin
  86. PrimeNumbers[J] := I;
  87. Inc (J);
  88. End;
  89. ArrayOfPrime := PrimeNumbers;
  90. End;
  91.  
  92. Function SecondDivision(ArrNumbersElement, Quotient, Number: Integer): Integer;
  93. Var
  94. ArrCorrectnessElement, K: Integer;
  95. ArrOfPrime: TArr;
  96. Begin
  97. ArrCorrectnessElement := 0;
  98. ArrOfPrime := ArrayOfPrime(Number);
  99. K := 0;
  100. While ((K < Number) And (ArrOfPrime[K] <> 0) And (ArrOfPrime[K] <= Quotient)) Do
  101. Begin
  102. If (Quotient = ArrOfPrime[K]) Then
  103. Begin
  104. ArrCorrectnessElement := ArrNumbersElement;
  105. K := Number;
  106. End;
  107. Inc (K);
  108. End;
  109. SecondDivision := ArrCorrectnessElement;
  110. End;
  111.  
  112. Function FindingRequiredNumbers(Number: Integer): TArr;
  113. Var
  114. I, K, Quotient: Integer;
  115. ArrCorrectness, ArrNumbers, ArrOfPrime: TArr;
  116. Begin
  117. ArrOfPrime := ArrayOfPrime(Number);
  118. ArrNumbers := ConsistencyUpToNumber(Number);
  119. Dec(Number);
  120. SetLength (ArrCorrectness, Number);
  121. Dec(Number);
  122. For I := 0 To Number Do
  123. Begin
  124. K := 0;
  125. While ((K < Number) And (ArrOfPrime[K] <> 0) And (ArrOfPrime[K] < ArrNumbers[I])) Do
  126. Begin
  127. If (ArrNumbers[I] Mod ArrOfPrime[K] = 0) Then
  128. Begin
  129. Quotient := ArrNumbers[I] Div ArrOfPrime[K];
  130. ArrCorrectness[I] := SecondDivision(ArrNumbers[I], Quotient, Number + 2);
  131. K := Number;
  132. End;
  133. Inc (K);
  134. End;
  135. End;
  136. FindingRequiredNumbers := ArrCorrectness;
  137. End;
  138.  
  139. Procedure NumberOutput(Number: Integer; ArrCorrect: TArr);
  140. Var
  141. ZeroValue, I: Integer;
  142. Begin
  143. Writeln ('Полученные натуральные числа:');
  144. Dec(Number);
  145. ZeroValue := Number;
  146. For I := 0 To Number Do
  147. If (ArrCorrect[I] <> 0) Then
  148. Begin
  149. Write (ArrCorrect[I], ' ');
  150. Dec(ZeroValue);
  151. End;
  152. If (ZeroValue = Number) Then
  153. Write ('Натуральные числа, соответствующие требованиям, не найдены');
  154. End;
  155.  
  156. Procedure WriteTask ();
  157. Begin
  158. Writeln ('Данная программа находит все натуральные числа, которые можно представить в виде произведения двух простых чисел и которые не превосходят введённое натуральное число N');
  159. End;
  160.  
  161. Begin
  162. WriteTask;
  163. N := InputNumber;
  164. ArrayOfCorrect := FindingRequiredNumbers(N);
  165. NumberOutput(N, ArrayOfCorrect);
  166. Readln;
  167. End.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement