Mot so de thi Pascal

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.. Nhap vao 1 day cac so nguyen tu ban phim cho den khi gap so 0, Sau do t

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



 + =



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 :

n!! = 2.4.6 n (n-chan)1.3.5 n (n-le)

Cho n thuocΝ.Tinh tong S= 1!!-2!!+….+(-1)n+1n!!

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 {ak} duoc xac dinh nhu sau:

a1=1, ak=ak-1+(k-1), k=2,3,…

cho so tu nhien n(n<32768), in ra man hinh cac gtri a1,a2,…,an 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 a1a2 ak duoc goi la so Amstrong neu:

a1a2 ak=a1^k+a2^k+ ak^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 a1a2 ak, la so Amtrong neu: a1a2 ak=a1^k+a2^k+ ak^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(a1,a2, an) 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