5 algorytmów liczbowych
Uses crt;
var C:Char;
Good:boolean;
Procedure Zad1;
{1. program ktory sprawdza czy podana z klawiatury liczba naturalna n jest pierwsza i wpisuje odpowiedni komunikat}
Var
Liczba,Mozliwosci:LongInt;
Pierwsza:Boolean;
Begin
Pierwsza:=True;
Write('Podaj Liczb©:');Readln(Liczba); {wczytuje liczbe od uzytkownika}
Mozliwosci:=1; {ustala wstepna wartosc mozliwosci.. dzielenie przez wszystkie liczby od 2
do 1 mniej niz podana liczba, liczba pierwsza dzieli sie przecierz tyko przez siebie i 1 :) }
While ((Pierwsza)and(Mozliwosci< Liczba-1)) do
Begin
Inc(Mozliwosci); {zwiekszenie zmiennej mozliwosci o 1}
if Liczba mod Mozliwosci=0 then {jezeli przy dzieleniu nie ma reszty, znaczy ze liczba dzieli sie przez cos wiecej niz
tylko 1 i siebie sama (te dwie mozliwosci sa oczywiscie z miejsca wykluczone)}
Begin
Pierwsza:=False; {od razu zatrzymanie petli.. po co szukac dalej i przedluzac dzialanie programu?}
writeln('Znalazlem dzielnik:',Mozliwosci,' (',Liczba,' div ',mozliwosci,'=',Liczba div mozliwosci,')');
{wypisanie dzielnika na jakim sie zatrzymal program..dodalem to w fazie testow, mozesz to spox usunac}
end;
end;
write('Podana Liczba to ',liczba,' i '); {wypisanie wstepi i podaj liczby}
if NOT Pierwsza then write('nie '); {jezeli znaleziono inny dzielnik niz 1 i liczba to pierwsza=false, czyli NOT true}
writeln('jest liczba pierwsza.');
writeln('wcisnij < Enter> , aby kontynuowac...');
readln;
End;
Procedure Zad2;
{2. progrqam ktory dla dowolnej liczby naturalnej n sprawdza czy jest to liczba doskonala}
Var
Suma,Liczba,Mozliwosci:LongInt;
Begin
Write('Podaj Liczb©:');Readln(Liczba); {wczytuje liczbe od uzytkownika}
Suma:=0;{Poczatkowa wartosc sumy=0}
Mozliwosci:=0; {ustala wstepna wartosc mozliwosci.. dzielenie przez wszystkie liczby od 1
do 1 mniej niz podana liczba}
While Mozliwosci< Liczba-1 do
Begin
Inc(Mozliwosci); {zwiekszenie zmiennej mozliwosci o 1}
if Liczba mod Mozliwosci=0 then
Suma:=Suma+Mozliwosci;{dodajemy dzielniki}
end;
write('Podana liczba to ',liczba,' i ');
If Suma< > Liczba then write('nie ');
writeln('jest liczba doskonala.');
writeln('wcisnij < Enter> , aby kontynuowac...');
readln;
End;
Procedure Zad3;
{3. program ktory znajduje i wypisuje wszystkie liczby doskonala od 1 do 1000
(liczba naturalna jest doskonala gdy jest suma swoich dzielnikow wlasciwych, np. 6 jest liczba doskonala bo 1+2+3=6)}
Var
Suma,Liczba,Mozliwosci:LongInt;
Begin
writeln('Liczby doskonale od 1 do 1000:');
For Liczba:=1 to 1000 do
Begin
Suma:=0;{Poczatkowa wartosc sumy=0}
Mozliwosci:=0; {ustala wstepna wartosc mozliwosci.. dzielenie przez wszystkie liczby od 1
do 1 mniej niz podana liczba}
While Mozliwosci< Liczba-1 do
Begin
Inc(Mozliwosci); {zwiekszenie zmiennej mozliwosci o 1}
if Liczba mod Mozliwosci=0 then
Suma:=Suma+Mozliwosci;{dodajemy dzielniki}
end;
If Suma=Liczba then write(Liczba,',');
End;
writeln('wcisnij < Enter> , aby kontynuowac...');
readln;
End;
Procedure Zad4;
{4. program ktory dla dwoch dowolnych liczb naturalnych znajduje i wypisuje wszystkie wspolne dzielniki tych liczb}
Var
Liczba1,Liczba2,Mozliwosci:LongInt;
dzielniki:Boolean;
Begin
dzielniki:=False;
Write('Podaj 1 Liczb©:');Readln(Liczba1); {wczytuje liczbe od uzytkownika}
Write('Podaj 2 Liczb©:');Readln(Liczba2);
Mozliwosci:=0;
While ((Mozliwosci< Liczba1-1)and(Mozliwosci< Liczba2-1)) do
Begin
Inc(Mozliwosci); {zwiekszenie zmiennej mozliwosci o 1}
if ((Liczba1 mod Mozliwosci=0)and(Liczba2 mod Mozliwosci=0)) then
Begin
if NOT Dzielniki then
begin
Dzielniki:=True;
writeln('Znalazlem nastepujace wspolne dzielniki:');
end;
write(Mozliwosci,',');{wypisanie dzielnika i przecinka}
end;
end;
if NOT Dzielniki then write('NIE znalazlem wspolnych dzielnikow.');
writeln;
writeln('wcisnij < Enter> , aby kontynuowac...');
readln;
End;
Procedure Zad5;
{5. program ktory znajduje i wypisuje wszystkie liczby Armstronga
(to takie liczby ktore sa rowne sumie szescianow swoich cyfr)}
Var
A,Suma,Liczba:LongInt;
S:String;
Cyfra:Byte;
B:Integer;
Function Szescian(A:LongInt):LongInt;
Begin
Szescian:=A*A*A;
End;
Begin
writeln('Znalezione liczby:');
{wiesz tam pisze wszystkie, to troche trudne...i napewno dlugo trwa
maxymalny zasieg w TP to -2147483647 do 2147483647
tutaj ustawilem zasieg tylko od -100000 do 100000
nie wiem, ale wydaje mi sie ze innych liczb nie znajdzie...}
For Liczba:=-100000 to 100000 do
Begin
Suma:=0;
Str(Liczba,S);{przerobic liczbe na ciag znakow}
For Cyfra:=1 to Length(S) do
Begin
Val(S[Cyfra],A,B);{pierwszy znak przerabiamy spowrotem na liczbe i mamy pierwsza cyfre :) itd.}
Suma:=Suma+Szescian(A);{dodajemy szesciany}
End;
if Suma=Liczba then write(Liczba,',');
End;
writeln;
writeln('wcisnij < Enter> , aby kontynuowac...');
readln;
End;
Begin
Repeat
clrscr;
writeln('Wybierz zadanie:');
writeln('1-liczba pierwsza');
writeln('2-liczba doskonala');
writeln('3-liczby doskonale 1-1000');
writeln('4-wspolne dzielniki 2 liczb');
writeln('5-liczby Amstronga');
writeln('Esc- Wyjscie');
Good:=False;
Repeat
C:=Readkey;
Case C of '1','2','3','4','5',#27:Good:=True;end;
Until Good;
clrscr;
Case C of
'1':Zad1;
'2':Zad2;
'3':Zad3;
'4':Zad4;
'5':Zad5;
End;
Until C=#27;
End.