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.