Mot so de thi Pascal doc

DE THI PASCAL HP1 Director by:Luu Cong Hoan
BT 2.29.Giai PT ax+b>0
Program BT229;
Uses crt;
Var a,b,x:real;
Begin
clrscr;
writeln('Giai BPT dang ax+b>0');
write('Nhap vao a,b= '); readln(a,b);
if a=0 then
if b>0 then
writeln('Pt co vo so nghiem!')
else
write('Pt vo nghiem!');
if a<>0 then
begin
if a>0 then writeln('Pt co nghien la x> ',-b/a:0:4);
if a<0 then writeln('Pt co nghien la x< ',-b/a:0:4);
end;
readln
End.
BT 2.20.Giai BPT bac hai : ax^2+bx+c >0
Uses crt;
Var a,b,c,d,x1,x2:real;
Begin clrscr;
writeln('Giai bpt ax^2+bx+c>0');
write('Nhap vao a,b,c:'); readln(a,b,c);
d:=b*b-4*a*c;
if a>0 then
begin
if d<0 then writeln('BPT co vo so nghien thuc');

if d=0 then writeln('BPT co nghien la moi x khac ',-b/(2*a):0:2);
if d>0 then
begin
x1:=(-b-sqrt(d))/(2*a); x2:=(-b+sqrt(d))/(2*a);
writeln(' BPT co nghiem x<',x1:0:2,' x>',x2:0:2);
end;
end;
if a<0 then
begin
if d<=0 then writeln('BPT vo nghien!');
if d>0 then
begin
x1:=(-b+sqrt(d))/(2*a);
x2:=(-b-sqrt(d))/(2*a);
writeln('BPT co nghiem la: ',x1:0:2,' <x< ',x2:0:2);
end;
end;
if a=0 then
begin
if b=0 then
begin
if c>0 then writeln('BPT co vo so nghiem x thuoc R') else writeln('BPT vo nghiem');
end;
if b>0 then writeln('BPT co nghiem x >',-c/b:0:2);
if b<0 then writeln('BPT co nghiem x <',-c/b:0:2);
end;
readln
End.
BT 2.21.Giai PT bac 4: ax^4+bx^2+c =0 (a#0)
Uses crt;

Var a,b,c,d:real;
t1,t2:real;
Begin clrscr;
repeat
writeln('Giai pttp ax^4+bx^2+c=0 (a#0)');
write('nhap he so a,b,c='); readln(a,b,c);
until a<>0;
d:=b*b-4*a*c;
if d<0 then writeln('pt vo nghiem');
if d=0 then
begin
if a*b>0 then writeln('pt vo nghiem');
if a*b=0 then writeln('pt co 1 nghiem x=0');
if a*b<0 then writeln('pt co 2 nghiem x1=',-sqrt(-b/2/a):0:2,'; x2=',sqrt(-b/2/a):0:2);
end;
if d>0 then
begin
t1:=(-b-sqrt(d))/2/a; t2:=(-b+sqrt(d))/2/a;
if a>0 then
begin
if t2<0 then writeln('pt vo nghiem');
if t2=0 then writeln('pt co 1 nghiem x=0');
if t2>0 then
begin
if t1<0 then writeln('pt co 2 nghiem x1=',-sqrt(t2):0:2,'; x2=',sqrt(t2):0:2);
if t1=0 then writeln('pt co 3 nghiem x1=0; x2=',-sqrt(t2):0:2,'; x3=',sqrt(t2):0:2);
if t1>0 then
begin
writeln('pt co 4 nghiem x1=',-sqrt(t1):0:2,'; x2=',sqrt(t1):0:2);
writeln(' x3=',-sqrt(t2):0:2,'; x4=',sqrt(t2):0:2);

end;
end;
end;
if a<0 then
begin
if t1<0 then writeln('pt vo nghiem');
if t1=0 then writeln('pt co 1 nghiem x=0');
if t1>0 then
begin
if t2<0 then writeln('pt co 2 nghiem x1=',-sqrt(t1):0:2,'; x2=',sqrt(t1):0:2);
if t2=0 then writeln('pt co 3 nghiem x1=0; x2=',-sqrt(t1):0:2,'; x3=',sqrt(t1):0:2);
if t2>0 then
begin
writeln('pt co 4 nghiem x1=',-sqrt(t1):0:2,'; x2=',sqrt(t1):0:2);
writeln(' x3=',-sqrt(t2):0:2,'; x4=',sqrt(t2):0:2);
end;
end;
end;
end;
readln
End.
BT 2.22.Giai PT bac nhat 2 an :
ax by c
dx ey f
+ =


+ =

Var a,b,c,d,e,f,DT,Dx,Dy:real;

Begin
writeln(‘Giai HPT bac nhat 2 an so’);
write(‘Nhap cac he so a,b,c=’); readln(a,b,c);
write(‘Nhap cac he so d,e,f=’); readln(d,e,f);
DT:=a*e-b*d;
Dx:=c*e-b*f;
Dy:=a*f-c*d;
if DT=0 then
Begin
If Dx=Dy=0 then writeln(‘HPT co vo so nghiem!’);
If (Dx<>0) or (Dy<>0) then writeln(‘HPT vo nghiem!’);
End;
if DT<>0 then writeln(‘HPT co ng ! x=’,Dx/DT:0:2,’ y=’,Dy/DT:0:2);
readln
End.
BT 2.23. Cho 3 so thuc duong a,b,c.
a, Ton tai hay khong, mot tam giac nhan chung lam 3 canh.
b, Neu ton tai, xet tam giac do la vuong, nhon hay tu.
Var a,b,c:real;
Begin
write('Nhap vao 3 so bat ki a,b,c='); readln(a,b,c);
if (a>0) and (b>0) and (c>0) and (a+b>c) and (c+b>a) and (a+c>b) then
begin
writeln('Day la 3 canh cua mot tam giac');
if (a*a+b*b=c*c) or (a*a+c*c=b*b) or (c*c+b*b=a*a) then writeln('Day la tam giac vuong')
else begin
if (a*a+b*b>c*c) and (a*a+c*c>b*b) and (c*c+b*b>a*a) then
writeln('Day la tam giac nhon')
else writeln('Day la tam giac tu');
end;

end
else writeln('Day ko la 3 canh tam giac');
readln
End.
BT 2.26. Cho so tu nhien n(n<=1000);
a, Hoi n co bao nhieu chu so. b, Tinh tong cac chu so cua n.
c, Tim chu so dau tien, cuoi cung cua n.
Var n,:word;
Scs,Tcs,Csd,Csc:byte;
Begin
repeat
writeln(‘Cho so tu nhien n(n<1000)); readln(n);
until (n>0) and(n<1000);
Csc:=n mod 10;
Tcs:=0; Scs:=0;
repeat
Scs:=Scs+1;
Tcs:=Tcs+(n mod 10);
Csc:= n mod 10;
until n=0;
writeln(n, ‘co’,Scs,’so chu so’);
writeln(‘Tong cac chu so la’,Tcs);
writeln(‘Chu so dau la’,Csd,’;Chu so cuoi’,Csc);
readln
End.
BT 2.29. Nhap vao 1 day cac so nguyen tu ban phim cho den khi gap so 0,
Sau do tinh tong cac so duong, trung binh cong cac so am.
Var n,Tsd,Tsa:integer; d:byte;
Begin
writeln('Nhap vao 1 day cac so nguyen cho den khi gap so 0');

Tsd:=0; Tsa:=0; d:=0;
repeat
write('Nhap n='); readln(n);
if n>0 then Tsd:=Tsd+n;
if n<0 then
begin
Tsa:=Tsa+n;
inc(d);
end;
until n=0;
writeln('TongSoDuong la:',Tsd);
if d>0 then writeln('TrungBinhCong so am la:',Tsa/d:0:2)
else writeln(‘Khong co so am nao’);
readln
End.
BT 2.35. Cho so tu nhien h(1<h<25).Su dung ki tu ‘*’
in ra ma hinh tam giac can dac voi chieu cao h
Var i,j,h:byte;
Begin
writeln('In Tamgiac can boi * chieu cao h(1<h<25)');
repeat
write('Nhap chieu cao h(1<h<25):');
readln(h);
until (h>1) and (h<25);
for i:=1 to h do
begin
gotoxy(41-i,i); {41 48}
for j:=1 to 2*i-1 do write('*');
writeln;
end;

readln;
End.
BT 2.37. Btoan :”Tram trau tram co, trau dung an 5, trau nam an 3
lai nhai nghe hoa, ba con 1 bo”
Var d,n,ng:byte;
SoNg:word;
Begin
SoNg:=0;
writeln('Trau dung Trau nam Nghe hoa');
for ng:=1 to 100 do
for n:=1 to 34 do
for d:=1 to 20 do
if 5*d+3*n+ng/3=100 then
begin
writeln(d:4,n:4,ng:4);
inc(SoNg);
end;
if SoNg>0 then writeln('So nghiem Btoan la',SoNg)
else writeln(‘PT vo nghiem’);
readln
End.
BT 2.38. Tim nghiem ngduong PT:2x+5y=k, voi k nhap tu ban phim(k<=10000).
Var k,x,y,SoNg:word;
Begin
writeln('Giai pt 2x+5y=k,k nhap tu ban phim');
repeat
write('Nhap so tu nhien k(k<10000):');
readln(k);
until (k>0) and (k<10000);
SoNg:=0;

for x:=1 to Trunc(k/2) do
for y:=1 to Trunc(k/5) do
if 2*x+5*y=k then
begin
write('(',x,',',y,') ');
inc(SoNg);
end;
writeln;
if SoNg>0 then writeln('So nghiem nguyen duong PT la:',SoNg)
else writeln(‘PT vo nghiem nguyen duong’);
readln
End.
BT 2.39. Mot nguoi gui vao ngan hang so tien A dong.Lai xuat moi thang la 0.8%.
De co B dong(B>A), can phai gui it nhat bao nhieu thang ?
Const LS=0.008;
Var A,B:real; t:word;
Begin
writeln('BToan gui tien tiet kiem');
write('Co bao nhieu?'); readln(A);
write('Muon co bao nhieu?'); readln(B);
t:=0;
while A<B do
begin
A:=A*LS;
inc(t);
end;
writeln('Can gui it nhat la ',t,' thang');
writeln('Bam phim Enter de ket thuc!');
readln
End.

BT 2.40. Mot nguoi gui vao ngan hang so tien A dong ,loai co ki han 3 thang
(tron 3 thang tinh lai 1 lan) voi lai suat moi thang la 1.0%.
Hoi sau t thang nguoi do nhan duoc bao nhieu tien?
Const LS=0.01;
Var A: real;
i,t: word;
Begin
writeln('Lai suat gui tiet kiem co ky han');
write('Co bao nhieu?'); readln(A);
write('Gui trong bao lau(thang):'); readln(t);
for i:=1 to Trunc(t/3) do A:= A+3*0.01*A;
writeln('So tien co sau ',t,' thang la:',A:0:0);
readln
End.
{Sau du 3 thang moi duoc tinh lai, luc do lai suat duoc nhap vao von,
nghia la sau du 3 thang co A:=A+3*0.01*A. so lan duoc tinh la[t/3]}
BT 2.44. So n!! duoc dinh nghia nhu sau :

1.3.5 n (n-le)
n!! =
2.4.6 n (n-chan)



Cho n thuoc.Tinh tong S= 1!!-2!!+….+(-1)
n+1
n!!.
Var i,n:integer;
S,S1,S2:real;
Begin

repeat
write('Nhap vao so tu nhien n:');readln(n);
until n>0;
writeln('Tinh S=1!!-2!!+ +[(-1)^(n+1)]*n!!');
S:=0; S1:=1; S2:=1;
for i:= 1 to n do
if i mod 2 <> 0 then
begin
S1:=S1*i;
S:=S+S1;
end
else
begin
S2:=S2*i;
S:=S-S2;
end;
writeln('Tong can tim la S=',S:0:2);
writeln('Bam phim Enter de tro ve!');
readln;
End.
BT 2.48.Cho 2 so nguyen n,m(n,m< 2147483648).Tim (m,n)?[n,m]?
Var m,n,mn:longint;
Begin
writeln('Tim UXLN,BCNN cua 2 so nguyen');
write('cho m,n:'); readln(m,n);
if (m=0) and (n=0) then writeln('Ko ton tai UCLN,BCNN') else
begin
m:=ABS(m); n:=ABS(n); mn:=ABS(m*n);
if m*n =0 then writeln('UCLN=',m+n,' BCNN ko ton tai') else
begin

while m<>n do
if m>n then m:=m-n
else n:=n-m;
writeln('UCLN=',m,' ;BCNN=',mn div m);
end;
end;
writeln('Ban phim Enter de tro ve !');
readln
End.
{Cach2 : Function UCLN(a,b:longint): longint;
var r: longint;
begin
a:=Abs(a) ;
b:=Abs(b) ;
while b<>0 do
begin
r:=a mod b; a:=b; b:=r;
end;
UCLN:= a;
end; }
BT 2.49.Cho so tu nhien n(n<214783648).Ktra xem n co thuoc day Fibonaci
hay khong? Neu co thi nam o vi tri nao?
Var n,f0,f1,f,p:Longint;
ok:Boolean;
Begin
writeln('Ktra n thuoc day Fibonaci?');
repeat
write('Cho so tu nhien n(n<2147483648)');
readln(n);
until n>0;

if n=1 then writeln('So 1 thuoc day, o vi tri 1 hoac 2')
else
begin
f0:=1; f1:=1; f:=2;
ok:=false; p:=2;{so n chua thuoc day,Vitri neu co tu 3}
while (f<=n) and (not ok) do
begin
f0:=f1;
f1:=f;
f:=f0+f1;
ok:=(f=n);
inc(p);
end;
if ok then write('So ',n,' thuoc day,o vi tri ',p)
else
writeln('So ',n,' khong thuoc day Fibonaci');
end;
writeln;
writeln('Bam phim Enter de ket thuc!');
readln
End.
BT 2.50. Day so {a
k
} duoc xac dinh nhu sau:
a
1
=1, a
k
=a
k-1

+(k-1), k=2,3,…
cho so tu nhien n(n<32768), in ra man hinh cac gtri a
1
,a
2
,…,a
n
.
uses crt;
Var a,n,k:integer;
Begin clrscr;
repeat
write('Nhap so tu nhien n(n<32767)'); readln(n);
until n>0;
writeln('Day so can tim la:');
write(1);
a:=1;
for k:=2 to n do
begin
a:=a+(k-1);
write(' ',a);
end;
readln
End.
BT 2.54. So tu nhien a
1
a
2
a
k

duoc goi la so Amstrong neu:
a
1
a
2
a
k
=a
1
^k+a
2
^k+ a
k
^k .Tim cac so Amstrong co it hon 4 chu so?
Uses crt;
Var i,a,b,c:byte; d:word;
Begin
clrscr;
writeln(‘So a
1
a
2
a
k
, la so Amtrong neu: a
1
a
2
a
k

=a
1
^k+a
2
^k+ a
k
^k);
writeln('Cac so Amstrong co it hon 4 chu so:');
d:=9;
for i:=1 to 9 do write(i,' ');
for a:=1 to 9 do
for b:=0 to 9 do
if 10*a+b=a*a+b*b then
begin
write(a,b,' ');
inc(d);
end;
for a:=1 to 9 do
for b:=0 to 9 do
for c:=0 to 9 do
if 100*a+10*b+c=a*a*a+b*b*b+c*c*c then
begin
write(a,b,c,' ');
inc(d);
end;
writeln;
writeln('Co ',d,' so Amstrong co it hon 4 chu so!');
readln
End.
BT 2.55.So n thuoc N duoc goi la so palindrome neu no doi xung(Vd:121,3223, )

Kiem tra so n(n<2147483648) co la so palindrome hay khong?
Var d,l,i:integer; n:longint;
s: string;
Begin
repeat
write('cho n=');readln(n);
until (n>0);
str(n,s);
l:= length(s);
d:=0;
for i:= 1 to l div 2 do
if s[i] = s[l-i+1] then inc(d);
if d = l div 2 then writeln(n,' la xau doi xung')
else writeln(n,' ko la xau doi xung');
readln;
End.
BT 3.4.Cho 3 so thuc a,b,c tinh gia tri cua bthuc.
Uses crt;
Var a,b,c:real;
Function Min(a,b:real):real;
begin
if a<b then min:=a else min:=b;
end;
Function Max(a,b,c:real):real;
var m:real;
begin
m:=a;
if m<b then m:=b;
if m<c then m:=c;
max:=m;

end;
Begin {Ctrinh chinh}
clrscr;
writeln('Tinh gia tri cua bieu thuc:');
writeln('(min(a,a+b)+min(a,b+c))/(1+max(a+bc,1,2008))');
write('Cho 3 so thuc a,b,c: '); readln(a,b,c);
writeln('Gia tri cua bthuc da cho la:');
writeln((min(a,a+b)+min(a,b+c))/(1+max(a+b*c,1,2008)));
readln
End.
BT 3.5.Cho so thuc s,t tinh gia tri bthuc.
Var s,t:real;
Function H(a,b:real):real;
begin
H:=a/(1+b*b)+b/(1+a*a)-(a-b)*(a-b)*(a-b);;
end;
Function Max(a,b,c:real):real;
var m:real;
begin
m:=a;
if m<b then m:=b;
if m<c then m:=c;
Max:=m;
end;
Begin {Ctrinh chinh}
writeln('Tinh gia tri bieu thu');
writeln('P=H(s,t)+Max((h(s-t,st))^2,(H(s-t,s+t))^4,(h(1,1)');
write('Cho 2 so s,t:'); readln(s,t);
writeln('P= ',H(s,t)+Max(H(s-t,s*t)*H(s-t,s*t),H(s-t,s+t)*H(s-t,s+t)*H(s-t,s+t)*H(s-t,s+t),h(1,1)):0:2);
readln;

End.
BT 3.6.Tim UCLN cua 4 so nguyen a,b,c,d nhap tu ban phim?
Var a,b,c,d:longint;
Function ucln(a,b:longint):longint;
var r:longint;
begin
while b<>0 do
begin
a:=Abs(a);
b:=Abs(b);
r:=a mod b;
a:=b;
b:=r;
end;
ucln:=a;
end;
Begin
write('nhap vao a,b,c,d:'); readln(a,b,c,d);
if (a=0) and (b=0) and (c=0) and (d=0) then writeln('UCLN ko ton tai!')
else begin
writeln('UCLN(a,b,c,d)=',ucln(ucln(ucln(a,b),c),d));
end;
readln;
End.
BT 3.7.Viet ham de quy tim UCLN 2 so nghuyen duong a,b.Ap dung tim UCLN(a
1
,a
2
, a
n

)
uses crt;
Var i,n:word; a1,u,b:longint;
Function ucln(a,b:longint):longint;
begin
a:=Abs(a); b:=Abs(b);
if b=0 then ucln:=a
else ucln:=ucln(b,a mod b);
{if a*b=0 then ucln:=a+b
else if a>b then ucln:=ucln(a mod b,b)
else ucln:=ucln(a,b mod a); }
end;
Function bcnn(a,b:longint):longint;
begin
a:=Abs(a); b:=Abs(b);
bcnn:=a*b div ucln(a,b);
end;
Begin {Ctrinh chinh}
clrscr;
writeln('Tim UCLN,BCNN cua n so nguyen nhap tu ban phim');
write('Cho so phan tu n= '); readln(n);
write('So thu 1:'); readln(a1);
u:=a1; b:=a1;
for i:=2 to n do
begin
write('So thu ',i,':');readln(a1);{nhap so thu i vao a1}
u:=ucln(u,a1);{gan u bang UCLN cua u va a1}
b:=bcnn(b,a1);{gan b bang BCNN cua b va a1}
end;
writeln('UCLN= ',u);

writeln('BCNN= ',b);
readln;
End.
BT 3.11. Thap Ha Noi
Var n:byte; d:longint;
Procedure Doi(k,c1,c2,c3:integer);
begin
if k=1 then
begin
d:=d+1;
write('Buoc',d,':',c1,'->',c2,' ');
exit;
end;
Doi(k-1,c1,c3,c2);
Doi(1,c1,c2,c3);
Doi(k-1,c3,c2,c1);
end;
Begin {Ctrinh chinh}
write('Cho so dia:'); readln(n);
d:=0;
Doi(n,1,2,3);
readln
End.
BT 3.18. Tim cac so nguyen to cung nhau voi n va nho hon n.
Var i,n:longint;
Function ucln(a,b:longint):longint;
var r:longint;
begin
a:=Abs(a); b:=Abs(b);
while b<>0 do

begin
r:=a mod b;
a:=b;
b:=r;
end;
ucln:=a;
end;
Begin
writeln('Liet ke cac so nho hon n va nguyen to cung nhau voi n');
write('Cho so tu nhien n='); readln(n);
writeln('Cac so nho hon n va nguyen to cung nhau voi n la:');
for i:=1 to n-1 do
if ucln(i,n)=1 then write(i,' ');
readln;
End.
BT 3.19. Tim cac so nguyen to nho hon n.
Var i,n:longint;
Function Nto(n:longint):boolean;
var i:longint;
begin
Nto:=false;
if n<2 then exit;
for i:=2 to trunc(sqrt(n)) do
if n mod i=0 then exit;
Nto:=true;
end;
Begin
write('Cho so tu nhien n:'); readln(n);
for i:=2 to n-1 do
if Nto(i) then write(i,' ');

readln;
End.
BT 3.20. Tim cac so hoan hao nho hon k (k thuoc N)
Var i,k,d:longint;
Function Tonguoc(n:longint):longint;
var s,i:longint;
begin
s:=0;
for i:=1 to n div 2 do
if n mod i=0 then s:=s+i;
Tonguoc:=s;
end;
Begin
writeln('Tim cac so hoan hao nho hon k!');
write('nhap k:');readln(k);
d:=0;
for i:=2 to k-1 do
if i=Tonguoc(i) then
begin
write(i,' ');
inc(d);
end;
if d=0 then writeln('Ko co so hoan hao nao nho hon',k);
readln;
End.
BT 3.22. Tim cac so H-Nto nam giua 2 stn m va n(n,n<2147483648)
Var m,n,i,d:longint;
Function Nto(n:longint):boolean;
var i:longint;
begin

Nto:=false;
if n<2 then exit;
for i:=2 to trunc(sqrt(n)) do
if n mod i =0 then exit;
Nto:=true;
end;
Begin
writeln('Tim so H-Nto nam giua 2 stn m va n');
repeat
write('nhap m,n:'); readln(m,n);
until (m>0) and (n>0) and (m<n);
d:=0;
for i:=m to n do
if Nto(i) and Nto(trunc(sqrt(i))) then
begin
write(i,' ');
inc(d);
end;
if d=0 then writeln('Ko co so H-Nto nao giua ',m,' va ',n);
readln;
End.
BT 3.23. So palidrome n duoc goi la Hp-nguyen to neu n la so nguyen to( vi du:2,3,5,7 ).Nhap 2 so tu
nhien m,n(m<n<2147483648),tim tat ca cac so H-nguyen to giua m va n.
uses c1rt;
Var m,n,i,dem:longint;
Function nto(n:longint):boolean;
var i:longint;
begin
nto:=false;
if n<2 then exit;

for i:=2 to trunc(sqrt(n)) do
if n mod i=0 then exit;
nto:=true;
end;
Function Dx(n:longint):boolean;{doi xung}
var d,l,i:byte; s:string;
begin
Dx:=false;
str(n,s); l:=length(s); d:=0;
for i:=1 to l div 2 do
if s[i]=s[l-i+1] then d:=d+1;
Dx:=(d=l div 2);
end;
Begin
writeln('Tim so Hp_ngto giau m va n');
repeat
write('Cho m,n(m<n):'); readln(m,n);
until (m>0) and (n>0) and (m<n);
dem:=0;
for i:= m to n do
if nto(i) and Dx(i) then
begin
write(i,' ');
inc(dem);
end;
if dem=0 then writeln('Ko co so Hp-ngto nao');
readln;
End.
Link đề thi HSG Toán
+ />+ />+ />+ />%E1%BB%8EI-L%E1%BB%9AP-8