program liczby;
uses
crt;
var
suma, n, i, j, k: longint;
tablica_pierwsze : array of longint;
tablica_male :array of longint;
binarnie : array of integer;
pierwsza, pierwsza2 :boolean;
begin
clrscr;
setlength(tablica_pierwsze,2);
setlength(tablica_male,0);
tablica_pierwsze[0]:=2;
tablica_pierwsze[1]:=3;
k:=500000; {g˘rny zakres poszukiwaä}
for n:=4 to k {doeclowo milion} do
begin
pierwsza:=true;
i:=0;
repeat
if (n mod tablica_pierwsze[i])=0 then pierwsza:=false;
i:=i+1
until (pierwsza=false) or (i=length(tablica_pierwsze)-1);
if pierwsza=true then
begin
setlength(tablica_pierwsze, length(tablica_pierwsze)+1);
tablica_pierwsze[length(tablica_pierwsze)-1]:=n;
end;
end;
{readln();}
writeln('Sprawdzilem ', k ,' liczb. Znalazlem ',length(tablica_pierwsze)-1, ' liczb naturlanych.');
writeln();
writeln();
{przeliczanie na binarne i ponowne szukanie liczb pierwszych}
for i:=0 to length(tablica_pierwsze)-1 do
begin
j:=tablica_pierwsze[i];
setlength(binarnie,0);
repeat
setlength(binarnie,length(binarnie)+1);
binarnie[length(binarnie)-1]:=j mod 2;
j:= j div 2;
until j<1;
{sumowanie cyfr binarnych}
suma:=0;
for n:=0 to length(binarnie)-1 do suma:=suma+binarnie[n];
writeln('Suma cyfr liczby ',tablica_pierwsze[i],' po konwersji na zapis binarny wynosi ', suma);
{sprawdzanie czy suma jesy liczba pierwsza}
pierwsza2:=true;
n:=2;
repeat
if (suma mod n)=0 then pierwsza2:=false;
n:=n+1;
until (pierwsza2=false) or (n>=suma-1);
if pierwsza2=true then
begin
setlength(tablica_male, length(tablica_male)+1);
tablica_male[length(tablica_male)-1]:=tablica_pierwsze[i];
{ writeln(tablica_pierwsze[i]);}
end;
end;
{wypisani liczb podwojnie pierwszych}
readln();
writeln('Nacisnij ENTER by poznac wszystkie liczby [pierwsze z zakresu ktorych suma cyfr w zapicie binarnym jest iczba pierwsza');
readln();
for i:=0 to length(tablica_male)-1 do writeln(tablica_male[i]);
writeln();
writeln('Znalazalem ', length(tablica_male), ' liczb spelniajacyh warunki zadania.');
writeln('Wszystkich liczb pierwszych w podanym zakresie bylo ', length(tablica_pierwsze));
readln();
end.
Działa poprawnie, kolega wykonał większość pracy :P
Anyways to wypisuje już wszystkie liczby i robi z nimi to co chciałem, wystarczy ustalić zakres. Teraz zastanawia mnie co zrobić, żeby sprawić że liczby będą pokazywać się jak w skrypcie:
program ExCzyLiczbaPierwsza;
{$APPTYPE CONSOLE}
uses
Math, SysUtils;
function ND(N: Int64): Int64;
var
i: Int64;
begin
if N<2 then ND := 0 // liczby mniejsze niz 2 nie sa pierwsze
else
if N<4 then ND := N // liczby 2 i 3 sa pierwsze
else
// dla liczb wiekszych rownych 4 sprawdzamy najpierw czy sa podzielne
// przez 2 i 3
if (N mod 2=0) then ND := 2
else
if (N mod 3=0) then ND := 3
else
begin
ND := N; i := 1;
// dopiero pozniej sprawdzamy, czy sa podzielne przez 6*i-1 i 6*i+1
// podczas, gdy 6*i-1<=czesci calkowitej z pierwiastka kwadratowego
// badanej liczby
while 6*i-1<=Int(Power(N, 0.5)) do
begin
if N mod(6*i-1)=0 then
begin
ND := 6*i-1; Break;
end
else
if N mod(6*i+1)=0 then
begin
ND := 6*i+1; Break;
end;
// to jest element interfejsu - nie jest niezbedny
// kiedy dlugo trzeba czekac na wynik, to ten kod pokazuje ile
// procent dzielnikow juz sprawdzono
if i mod 1000000=0 then
Write( #13, i div 1000000, 'M (',
100.0*i/Int(Power(N, 0.5)): 0:1, '%)'#13 );
Inc(i);
end
end;
end;
var
tylko_pierwsze, tylko_ilosc, znak : Char;
i, ile_pierwszych, iND, M, N : Int64;
czas, czas_calk : TDateTime;
begin
Writeln( 'Program szuka liczb pierwszych wsrod liczb nieparzystych '
+ 'z podanego zakresu.' );
repeat
tylko_pierwsze := #0;
Write(#13#10#13#10'Podaj poczatek zakresu: '); Readln(M);
Write('Podaj koniec zakresu: '); Readln(N);
Write('Pokaz tylko ilosc liczb pierwszych z tego zakresu [t/n]:');
Readln(tylko_ilosc);
if UpCase(tylko_ilosc)<>'T' then
begin
Write('Pokaz tylko liczby pierwsze [t/n]:');
Readln(tylko_pierwsze);
end;
if M mod 2=0 then M := M + 1;
czas_calk := Now; Writeln; i:=M; ile_pierwszych := 0;
while i<N do
begin
// To ta linijka sprawdza namniejszy dzielnik liczby wiekszy od 1
// oraz oblicza, ile czas zabralo jego szukanie
czas := Now; iND := ND(i); czas := 86400*(Now - czas);
if iND=i then
begin
if UpCase(tylko_ilosc)<>'T' then
Writeln(i, #9'czas: ', czas:0:3, ' s <--- liczba pierwsza ---');
ile_pierwszych := ile_pierwszych + 1;
end
else
if (UpCase(tylko_pierwsze)<>'T')and(UpCase(tylko_ilosc)<>'T') then
Writeln(i, #9'czas: ', czas:0:3, ' s'#9'najmniejszy dzielnik: ', iND);
i := i + 2;
end;
czas_calk := 86400*(Now - czas_calk);
Writeln( #13#10'Ilosc znalezionych liczb pierwszych: ', ile_pierwszych,
#13#10'Calkowity czas wyszukiwania (z wyswietl.): ', czas_calk:0:3,
' s'#13#10'(UWAGA! wyswietlanie bardzo wydluza oczekiwanie na ',
'wyniki)' );
writeln(iND);
Write(#13#10#13#10'Czy rozpoczac nowe wyszukiwanie [T/N]? '); Readln(znak);
until UpCase(znak)<>'T';
end.
czyli że będzie można normalnie przewijać okienko etc.