uses crt;
var
p, n, k, m, min :integer;
ch :char;
path, s, ErrMsg, Msg :string;
f :text;
flag :boolean;
{ Preobrazovivaet chislo v stroku }
function IntToStr(i: longint): string;
var
s: string[11];
begin
CLRSCR;
Str(i, s);
IntToStr:=s;
end;
{ dobavlyaet v stroku 's' novuyu stroku s 'krasniy stroki' }
procedure AddLine(var s :string; line :string);
begin
s:=s+Chr(10)+Chr(13)+line;
end;
{ n! }
function fact(n :integer; var cv :integer) :longint;
begin
if n=0 then
fact:=1
else begin
cv:=cv+1;
fact:=n*fact(n-1, cv);
end;
end;
{ n!! }
function fact2(n :integer; var cv :integer) :longint;
begin
if n<=0 then
fact2:=1
else begin
cv:=cv+1;
fact2:=n*fact2(n-2, cv);
end;
end;
{ Po celim n i k vichislyaet chislo sochetaniy }
function Combination(n, k :integer; var cv :integer) :integer;
begin
if (k = 0) or (k = n) then
Combination:=1
else begin
cv:=cv+2;
Combination:=Combination(n-1, k, cv) + Combination(n-1, k-1, cv);
end;
end;
{ nahodit naibol'shiy obshiy delitel }
function Nod(n, m, i :integer; var cv :integer): integer;
begin
if (n mod i=0) and (m mod i=0) then
Nod:=i
else begin
cv:=cv+1;
Nod:=Nod(n, m, i-1, cv);
end;
end;
{ Formiruet posledovatelnost chisel Fibonacci <= n }
procedure fib(a, b, n :integer; var cv :integer; var Msg :string);
var
c :integer;
begin
{ nahodim ocherednoe chislo fibonacchi }
c:=b; b:=a+b; a:=c;
if b<=n then begin
AddLine(Msg, IntToStr(b));
cv:=cv+1;
fib(a, b, n, cv, Msg);
end;
end;
{ Proveryaet chislo n na prostotu }
function Prostoe(n, i :integer; var cv :integer): boolean;
begin
if i=n then { esli perebrali vse chisla ot 2 do n-1 }
Prostoe:=true
else if (n mod i=0) then { esli i delit n bez ostatka, znachit ono ne prostoe }
Prostoe:=false
else begin
cv:=cv+1;
Prostoe:=Prostoe(n, i+1, cv);
end;
end;
{ summa cifr chisla }
function SummaCifr(n :longint; var cv :integer): longint;
begin
if (n > 0) then begin
cv:=cv+1;
SummaCifr:=(n - (n div 10)*10) + SummaCifr(n div 10, cv)
end else
SummaCifr:=0;
end;
{ Palimdrom - kokda stroka slev na pravo i naoborot chitaetsya odinakovo }
function Palindrom(s :string; i, j :integer; var cv :integer) :boolean;
begin
if i=0 then
Palindrom:=true
else begin
if s[i]<>s[j] then
Palindrom:=false
else begin
cv:=cv+1;
Palindrom:=Palindrom(s, i-1, j+1, cv);
end;
end;
end;
{ Nahodit spisok deliteley chisla n }
procedure VseDeliteli(n, i :integer; var cv :integer; var Msg :string);
begin
if i<=n then begin
if (n mod i = 0) then AddLine(Msg, IntToStr(i));
cv:=cv+1;
VseDeliteli(n, i+1, cv, Msg);
end;
end;
{ Schitivanie vhodnih dannih dla algoritmov iz faila }
function GetDataFromFile(p :integer) :boolean;
begin
GetDataFromFile:=false;
{ schitivaem dannie iz faila }
write('Vvedite imya faila: ');
readln(path);
assign(f, path);
{$I-} { otkluchaem kontrol' oshibok vvoda-vivoda }
reset(f);
{$I+} { vkluchaem }
if IOResult <> 0 then
writeln('Ne udalos otkrit file')
else begin
{ schitivaem vhodnie dannie iz faila po nomeru algoritma }
case p of
1, 2, 4, 5, 6, 9:begin
read(f, n);
writeln('n=',n);
end;
3:begin
read(f, n);
writeln('n=',n);
read(f, m);
writeln('m=',m);
end;
7:begin
readln(f, s);
writeln('s=',s);
end;
8:begin
read(f, n);
writeln('n=',n);
read(f, k);
writeln('k=',k);
end;
end;
GetDataFromFile:=true;
close(f);
end;
end;
{ Schitivanie vhodnih dannih s klaviaturi }
procedure GetDataFromConsole(p :integer);
begin
case p of { p - nomer algoritma }
1,2:begin
write('Vvedite n:');
readln(n);
end;
3:begin
write('vvedite pervoe chislo:');
readln(n);
write('vvedite vtoroe chislo:');
readln(m);
end;
4:begin
write('Input n (>0):');
readln(n);
end;
5:begin
write('vvedite chislo:');
readln(n);
end;
6:begin
write('vvedite chislo:');
readln(n);
end;
7:begin
write('Vvedite stroky:');
readln(s);
end;
8:begin
write('vvedite n:');
readln(n);
write('vvedite k:');
readln(k);
end;
9:begin
write('vvedite chislo:');
readln(n);
end;
end;
end;
{ Vizov algoritma s nomerom 'p' i formirovanie rezultatov }
procedure Operate(p :integer);
var
cv :integer;
begin
cv:=1;
ErrMsg:='';
Msg:='';
case p of
1:begin
if n>12 then
ErrMsg:='Slishkom bolshoe chislo!'
else
Msg:=IntToStr(fact(n, cv));
end;
2:begin
if n>12 then
ErrMsg:='Slishkom bolshoe chislo!'
else
Msg:=IntToStr(fact2(n, cv));
end;
3:begin
if n<m then
min:=n
else
min:=m;
Msg:='NOD='+IntToStr(Nod(n, m, min, cv));
end;
4:begin
if n>0 then begin
k:=0; m:=1;
Msg:='1';
fib(k, m, n, cv, Msg);
end;
end;
5:begin
if Prostoe(n, 2, cv) then
Msg:='Chislo prostoe'
else
Msg:='Chislo NE prostoe';
end;
6:begin
while n >= 10 do begin
n:=SummaCifr(n, cv);
AddLine(Msg, IntToStr(n));
end;
end;
7:begin
{ stroka dlinoy v 1 simvol - palindrom }
if Length(s)=1 then
flag:=true
else begin
{ esli v stroke nechetnoe kol-vo elementov }
if Frac(length(s)/2)=0 then
flag:=Palindrom(s, length(s) div 2, length(s) div 2 + 1, cv)
else
flag:=Palindrom(s, length(s) div 2, length(s) div 2 + 2, cv)
end;
if flag then
Msg:='Palindrom'
else
Msg:='Eto ne palindrom';
end;
8:begin
Msg:='Chislo kombinaciy iz '+IntToStr(n)+' po '+IntToStr(k)+
' = '+IntToStr(Combination(n, k, cv));
end;
9:begin
VseDeliteli(n, 1, cv, Msg);
end;
else Exit;
end;
if ErrMsg<>'' then
writeln(ErrMsg)
else begin
AddLine(Msg, 'Kolvo rekursivnih vizovov = '+IntToStr(cv));
writeln(Msg);
end;
end;
{ Sohranenie rezultatov vipolneniya algoritma v fail }
procedure SaveToFile;
var
cv :integer;
begin
write('Vvedite imya faila: ');
readln(path);
assign(f, path);
{$I-}
rewrite(f);
{$I+}
if IOResult <> 0 then
writeln('Ne udalos sozdat fail')
else begin
writeln(f, 'Algoritm: ', p);
case p of
1, 2, 4, 5, 6, 9:begin
writeln(f, 'n=', n);
end;
3:begin
writeln(f, 'n=', n);
writeln(f, 'm=', m);
end;
7:begin
writeln(f, 's=',s);
end;
8:begin
writeln(f, 'n=', n);
writeln(f, 'k=', k);
end;
end;
if ErrMsg<>'' then
writeln(f, ErrMsg)
else
writeln(f, Msg);
close(f);
end;
end;
{ osnovnoy blok programmi }
begin
{ ochishaem ekran }
clrscr;
p:=1;
while p <> 0 do begin
writeln('Menu');
writeln('1. n!');
writeln('2. n!!');
writeln('3. NOD');
writeln('4. Fibonacchi');
writeln('5. Prostoe');
writeln('6. Summa cifr chisla');
writeln('7. Palindrom');
writeln('8. Kolvo perestanovok iz n po k');
writeln('9. Vse deliteli chisla');
writeln('0. Exit');
write('Vvedite nomer punkta:');
readln(p);
if (p>0) and (p<10) then begin
flag:=true;
write('Prochitat dannie iz faila? (y/n):');
readln(ch);
if (ch='y') then
flag:=GetDataFromFile(p)
else
GetDataFromConsole(p);
{ zapuskaem algoritm }
if flag then begin
Operate(p);
write('Sohranit rezultati v fail? (y/n):');
readln(ch);
if (ch='y') then SaveToFile;
writeln('---');writeln;
end;
end;
end;
end.
