Bài 1:
Program THT_bai1_15;
Uses crt;
Var n,i,d:longint;
a:array[1..1000] of longint;
{--------Kiem tra nguyen to----}
function ktra(n:longint):boolean;
var kt:boolean; i:longint;
begin
kt:=true;
for i:=2 to trunc(sqrt(n)) do
if n mod i = 0 then
kt:=false;
ktra:=kt;
end;
{--------Ham tinh giai thua-------}
function giaithua(n:longint):longint;
var i,gt:longint;
begin
gt:=1;
for i:=1 to n do
gt:=gt*i;
giaithua:=gt;
end;
{--------Xu ly----}
Procedure xuly(n:longint);
var i,dem,m:longint;
begin
d:=0;
m:=n;
for i:=2 to m do
begin
dem:=0;
if ktra(i)=true then
if n mod i<>0 then
begin
write(i,'^',dem,'x');
d:=d+1;
a[d]:=dem;
end
else
begin
while (n mod i=0) do
begin
dem:=dem+1;
n:=n div i;
end;
end;
if dem>0 then
begin
d:=d+1;
a[d]:=dem;
write(i);
if dem>0 then
write('^',dem);
if n>i then
write('x');
end;
if n<=trunc(sqrt(i)) then exit;
end;
end;
{-------Main------}
Begin
clrscr;
write('Nhap n=');
readln(n);
writeln('Giai thua cua ', n,' :',giaithua(n));
xuly(giaithua(n));
writeln;
for i:=1 to d do
write(a[i],' ');
readln;
End.Bài 1 (Cách 2)
program THT_bai1_15;
uses crt;
var dem,Nto:array[1..100000] of longint;
sang:array[2..100000] of longint;
n,x,i,j,k,m:longint;
begin
clrscr;
write('Nhap n:');
readln(n);
{Khoi tao sang[i]=1}
for i:=2 to 100000 do
sang[i]:=1;
x:=100000;
for k:=2 to n div 2 do
sang[k*2]:=0;
i:=3;
while i<=sqrt(x) do
begin
if sang[i]=1 then
for k:=2 to n div i do sang[k*i]:=0;
i:=i+2;
end;
{Sao chep cac so nguyen to qua mang moi}
Nto[1]:=2;
k:=1;
for i:=3 to n do
if sang[i]=1 then
begin
k:=k+1;
Nto[k]:=i;
end;
{k cung la so thanh phan trong bieu dien cua n! vi Nto[k] l… so ngto max<=n}
{voi moi i<=n ghi nhan cac so nguyen to la uoc cua i voi so mu tuong ung}
for i:=1 to k do
dem[i]:=0;
for j:=2 to n do
begin
{phan tich j thanh cac thua so nguyen to}
i:=1;
m:=j;
while m>1 do
begin
while m mod Nto[i]<>0 do
i:=i+1;
dem[i]:=dem[i]+1;
m:=m div Nto[i];
end;
end;
write('(',dem[1]);
for i:=2 to k do write(',', dem[i]);
write(')');
readln;
End.Bài 2:
program Bai2_Nam;
uses crt;
var n,nam_min,nam_max,kq,tam,d:integer;
begin
write('Nhap so ngay:');
readln(n);
d:=1;
nam_min:=1;
nam_max:=0;
while d<n do
begin
d:=d+1;
tam:=nam_max;
nam_max:=nam_max+nam_min;
nam_min:=tam;
end;
kq:=nam_max;
writeln(kq);
readln;
End.Bài 4:
Program Bai4_THT_15;
Uses crt;
Var n,dem_CH:longint;
kq:string;
gen:array[1..100000] of longint;
{-------Doc dl-------}
procedure docdl;
var fi:text;
i:longint;
begin
assign(fi,'gen.inp');
reset(fi);
readln(fi,n);
for i:=1 to n do
readln(fi,gen[i]);
close(fi);
end;
{------Chuyen 1 so sang nhi phan----}
function he2(n:longint):string;
var du:longint; tam:string;
begin
kq:='';
while n<>0 do
begin
du:=n mod 2;
str(du,tam);
kq:=tam+kq;
n:=n div 2;
end;
he2:=kq;
end;
{-------Them 0 dau xau va kiem tra CAN HUYET THONG-----}
function can_huyet(s1,s2:string):boolean;
var i,dem:longint;
begin
while length(s1)<>length(s2) do
begin
if length(s1)>length(s2) then s2:='0'+s2
else s1:='0'+s1;
end;
dem:=0;
for i:=1 to length(s1) do
if s1[i]<>s2[i] then dem:=dem+1;
if dem<=1 then can_huyet:=true
else can_huyet:=false;
end;
{------Xu ly-----}
procedure xuly;
var i,j:longint;
begin
dem_CH:=0;
for i:=1 to n-1 do
for j:=i+1 to n do
if can_huyet(he2(gen[i]),he2(gen[j])) then dem_CH:=dem_CH+1;
end;
{------Ghi ket qua----}
procedure ghidl;
var fo:text;
begin
assign(fo,'gen.out');
rewrite(fo);
write(fo,dem_CH);
close(fo);
end;
{------Main-----}
Begin
docdl;
xuly;
ghidl;
end.
