Lab_2.2

Program Lab_2_2;

{$APPTYPE CONSOLE}
{$R *.res}

Uses
    System.SysUtils;

Type
    TArr = Array Of Integer;

Var
    ArrayOfCorrect: TArr;
    N: Integer;

Function InputNumber(): Integer;
Const
    MAX_NUMBER = 2147483647;
    MIN_NUMBER = 2;
Var
    Number: Integer;
    IsCorrect: Boolean;
Begin
    Repeat
        Writeln ('Введите натуральное число N в диапазоне от ', MIN_NUMBER,' до ', MAX_NUMBER);
        IsCorrect := True;
        Try
            Readln (Number);
        Except
            Writeln ('Данные введены некорректно');
            IsCorrect := False;
        End;
        If ((IsCorrect) And ((Number < MIN_NUMBER) Or (Number > MAX_NUMBER))) Then
        Begin
            Writeln ('Введено число неверного диапазона');
            IsCorrect := False;
        End
    Until (IsCorrect);
    InputNumber := Number;
End;

Function ConsistencyUpToNumber(Number: Integer): TArr;
Var
    I: Integer;
    ArrNumbers: TArr;
Begin
    SetLength (ArrNumbers, Number - 1);
    I := 0;
    While (I < Number - 1) Do
    Begin
        ArrNumbers[I] := I + 2;
        Inc(I);
    End;
    ConsistencyUpToNumber := ArrNumbers;
End;

Function ArrayOfPrime(Number: Integer): TArr;
Var
    IsPrime: Array Of Boolean;
    I, J: Integer;
    PrimeNumbers: TArr;
Begin
    SetLength(IsPrime, Number);
    For I := 0 To Number - 1 Do
        IsPrime[I] := True;
    I := 2;
    While (I * I < Number) Do
    Begin
        If (IsPrime[I]) Then
        Begin
            J := 2 * I;
            While (J < Number) Do
            Begin
                IsPrime[J] := False;
                J := J + I;
            End;
        End;
        Inc (I);
    End;
    SetLength(PrimeNumbers, Number);
    Dec(Number);
    J := 0;
    For I := 2 To Number Do
        If (IsPrime[I]) Then
        Begin
            PrimeNumbers[J] := I;
            Inc (J);
        End;
    ArrayOfPrime := PrimeNumbers;
End;

Function SecondDivision(ArrNumbersElement, Quotient, Number: Integer): Integer;
Var
    ArrCorrectnessElement, K: Integer;
    ArrOfPrime: TArr;
Begin
    ArrCorrectnessElement := 0;
    ArrOfPrime := ArrayOfPrime(Number);
    K := 0;
    While ((K < Number) And (ArrOfPrime[K] <> 0) And (ArrOfPrime[K] <= Quotient)) Do
    Begin
        If (Quotient = ArrOfPrime[K]) Then
        Begin
            ArrCorrectnessElement := ArrNumbersElement;
            K := Number;
        End;
        Inc (K);
    End;
    SecondDivision := ArrCorrectnessElement;
End;

Function FindingRequiredNumbers(Number: Integer): TArr;
Var
    I, K, Quotient: Integer;
    ArrCorrectness, ArrNumbers, ArrOfPrime: TArr;
Begin
    ArrOfPrime := ArrayOfPrime(Number);
    ArrNumbers := ConsistencyUpToNumber(Number);
    Dec(Number);
    SetLength (ArrCorrectness, Number);
    Dec(Number);
    For I := 0 To Number Do
    Begin
        K := 0;
        While ((K < Number) And (ArrOfPrime[K] <> 0) And (ArrOfPrime[K] < ArrNumbers[I])) Do
        Begin
            If (ArrNumbers[I] Mod ArrOfPrime[K] = 0) Then
            Begin
                Quotient := ArrNumbers[I] Div ArrOfPrime[K];
                ArrCorrectness[I] := SecondDivision(ArrNumbers[I], Quotient, Number + 2);
                K := Number;
            End;
            Inc (K);
        End;
    End;
    FindingRequiredNumbers := ArrCorrectness;
End;

Procedure NumberOutput(Number: Integer; ArrCorrect: TArr);
Var
    ZeroValue, I: Integer;
Begin
    Writeln ('Полученные натуральные числа:');
    Dec(Number);
    ZeroValue := Number;
    For I := 0 To Number Do
        If (ArrCorrect[I] <> 0) Then
        Begin
            Write (ArrCorrect[I], ' ');
            Dec(ZeroValue);
        End;
    If (ZeroValue = Number) Then
        Write ('Натуральные числа, соответствующие требованиям, не найдены');
End;

Procedure WriteTask ();
Begin
    Writeln ('Данная программа находит все натуральные числа, которые можно представить в виде произведения двух простых чисел и которые не превосходят введённое натуральное число N');
End;

Begin
    WriteTask;
    N := InputNumber;
    ArrayOfCorrect := FindingRequiredNumbers(N);
    NumberOutput(N, ArrayOfCorrect);
    Readln;
End.