end.
2.LẬP MẢNG B TỪ MẢNG A BẰNG CÁCH ĐỔI CHỔ 2 PHẦN TỬ
program p100207;{lap mang b tu mang a bang cach doi cho
hai phan tu }
uses crt;
var a,b:array[1..100] of real;
n,p,q,i:integer;
begin
write('nhap kich
thuot cua mang a :n=');
readln(n);
writeln('nhap cac
phan tu cua mang tren mot dong:');
for i:=1 to n do
read(a[i]); readln;
write('nhap hai vi
tri p,q<=n:');
readln(p,q);
for i:= 1 to n do
b[i]:=a[i];
b[p]:=a[q];
b[q]:=a[p];
writeln('mang b
lap ra tu mang a bang cach doi hai phan tu thu',p,'va thu',q,':');
for i:=1 to n do
write(b[i]:7:1);
readln
end.
3.TÌM UCLN
program p100117;{tim uscln cua hai so nhap tu ban phim}
uses crt;
var m,n:integer;
function us(a,b:integer):integer;
begin
while a<>b do
if a>b then
a:=a-b else if b>a then b:=b-a;
us:=a;
end;
begin
clrscr;
write('nhap hai so nguyen duong m,n:');
readln(m,n);
write(us(m,n));
readln;
end.
3.LẬP MẢNG B TỪ MẢNG A BẰNNG CÁCH LOẠI BỎ PHẦN TỬ MẢNG A
program p100205;{lap mang b tu mang a bang cach loai bo
phan tu mang a}
uses crt;
var a,b:array [1..100] of real;
n,p,i:integer;
begin
write('nhap kich thuot cua mang a: n='); readln(n);
writeln('nhap cac phan tu cua nang a tren mot dong:');
for i:=1 to n do read(a[i]);readln;
write('nhap so p<=n:');readln(p);
if i<P then b[i]:=a[i] else b[i]:=a[i+1];
write('mang b lap tu mang a bang cach loai bo phan tu
mang thu',p,':');
for i:=1 to n-1 do write(b[i]:8:2);readln;
end.
4.LẬP MẢNG B TỪ MẢNG A BẰNG CÁCH CHÈN THÊM MỘT SỐ A
program p100206;{lap mang b tu mang a bang cach chen them
mot so a}
uses crt;
var a,b:array[1..100] of real;
n,i,p:integer;
ap:real;
begin
write('nhap kich thuot mang a:n=');readln(n);
writeln('nhap cac phan tu mang a tren mot dong:');
for i:=1 to n do
read(a[i]);readln;
write('nhap so a:');readln(ap);
write('nhap so
p<=n:'); readln(p);
for i:=1 to n+1 do
if i<p then
b[i]:=a[i]
else if i>p then b[i]:=a[i-1] else b[i]:=ap;
writeln('mang b lap tu mang a bang cach chen a vao vi tri
',p,':');
for i:=1 to n do write(b[i]:8:2);
readln;
end.
4.IN RA BẢNG CỬU CHƯƠNG
program
bang_cuu_chuong;
uses crt;
var i, j:
byte;
begin
clrscr;
write(' BANG CUU CHUONG ');
for i:=1 to 10 do
for j:=1 to 10 do
write(i, '* '
, j
,' = ',
i * j);
readln
end.
5.KIỂM TRA TAM GIÁC VUÔNG
PROGRAM PITAGO;
USES CRT;
VAR A, B, C : INTEGER;
A2, B2, C2 :
LONGINT;
BEGIN
CLRSCR;
WRITE('A, B, C ');
READLN(A, B, C);
A2:=A;
B2:=B ;
C2:=C;
A2:= A2*A;
B2:= B2*B ;
C2 :=C2*C;
IF (A2= B2+ C2) OR (B2=A2+C2) OR (C2=A2+B2) THEN WRITELN
(' BA SO DA NHAP LA BO BA SO PITAGO')
ELSE WRITELN(' BA SO DA NHAP KHONG PHAI LA BO BA SO
PITAGO');
READLN
END.
6.DANH SÁCH MÓC NỐI KIỂU CON TRỎ(đếm nút và xắp xếp)
type listlink = ^contro
;
contro =
record
info:integer ;
link:listlink;
end;
var
a:array[1..100] of integer;
function
demnut(l:listlink):word;
var
p:listlink; dem:word;
begin
p:=l;
dem:=0;
while
p<>nil do
begin
dem:=dem+1;
p:=p^.link;
end;
end;
procedure sapxep(l:listlink);
var i,j,t
:listlink;
begin
if l<>nil
then
i:=l;
while
(i^.link <> nil) do
begin
j:=i^.link;
while j<>nil do
begin
if i^.info > j^.info then
begin
t:=i^.info ;
i^.info:=j^.info;
i^.info:=t;
end
;j:=j^.link;
end;
i^.link;
end;
end;
begin
writeln('nhap so
phan tu cua mang n:=');
readln(n);
dnut(l);
sapxep(l);
end.
7.giải phương trình bậc hai
program Giai_PTB2;
uses crt;
var a, b, c : real;
d, x1, x2 :
real;
begin
clrscr;
writeln(' a, b, c=');
readln(a, b, c);
d:= b*b-4*a*c;
if d<0 then write (' phuong trinh vo nghiem')
else
begin
x1:=(-b-sqrt(d))/(2*a);
x2:=(-b+sqrt(d))/(2*a);
writeln(' x1 =',
x1:8:3, 'x2 =',x2:8:3);
end;
readln
end.
8.bài tập hoán vị
var try:integer;
const max=100;
var a:array[0..100] of integer;
n:integer;
procedure
try(n:integer):integer;
var
i,j,tg:integer;
kt:boolean;
begin
kt:=true;
for i:=1 to n do
begin
a[i]:=i;
write(a[i],' ');
end;
writeln;
while kt
do
begin
kt:=false;
for i:=1
to n do
if
a[i]<a[i+1] then kt:=true;
if kt
then
begin
i:=n-1;
while
(a[j]<a[i])and(j>=1) do
begin
dec(i);
j:=n
;
end;
while
(a[j]<a[i])and(j<=1)do
begin
dec(j);
tg:=a[i];
a[i]:=a[j];
a[j]:=tg;
inc(i);
j:=n;
end;
while i<j do
begin
tg:=a[i];
a[i]:=a[j];
a[j]:=tg ;
i:=i+1;
j:=j-1;
end;
for
i:=1 to n do
write(a[i],'');
writeln;
end;
end;
end;
begin
writeln('hoan vi cua so:=',try);
readln ;
end.
9.in ngược xâu
var s,s1:string;
procedure innguoc(s:string);
Begin
if(length(s)>0) then
begin
write(copy(s,length(s),1));
delete(s,length(s),1);
innguoc(s);
end;
End;
Begin
write('Nhap xau: ');readln(s);
innguoc(s);
readln;
End.
10.tính n^x
VAR N,X:INTEGER;
FUNCTION F(N,X:INTEGER):INTEGER;
BEGIN
IF X=1 THEN
F:=N
ELSE
F:=(F(N,X-1)) * N
END;
BEGIN
WRITELN('NHAP N:= ');READLN(N);
WRITELN('NHAP X = ');READLN(X);
WRITELN('
KET QUA LA:',F(N,X));
READLN;
END.
11.dựng cây nhị phân ,duyệt cây,đếm nút lá,cây nhị phân giảm dần
program cau_1;
uses crt;
type Btree=^cell;
cell=record
data:integer;
left,right:btree;
end;
var T, p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12:
BTree;
procedure DungCayNhiPhan(L, R: BTree;x: Integer;var
T:Btree);
var p: Btree;
Begin
new(p);
p^.data:=x;
p^.right:=R;
p^.left:=L;
T:=p;
End;
Procedure DuyetCay(T: BTree);
Begin
if T <>
nil then
Begin
Duyetcay(T^.Left);
write(T^.Data, ' ');
Duyetcay(T^.Right);
End;
End;
Function nutla(T:Btree):word;
Begin
if T=nil
then nutla:=0
else if
(T^.right = nil) and (T^.left = nil) then
nutla:= 1
else
nutla:= nutla(T^.left) + nutla(T^.right) +1;
end;
procedure TranverInOrder(T:Btree);
begin
if T <>
nil then
begin
TranverInOrder(T^.right);
write(T^.Data,' ');
TranverInOrder(T^.left);
end;
end;
{Chuong trinh
chinh}
BEGIN
clrscr;
dungcayNhiPhan(nil,
nil, 10, p1);
dungcayNhiPhan(nil, nil, 24, p2);
dungcayNhiPhan(nil, nil, 30, p3);
dungcayNhiPhan(nil, nil, 50, p4);
dungcayNhiPhan(nil, nil, 60, p5);
dungcayNhiPhan(nil, nil, 70, p6);
dungcayNhiPhan(p1, p2, 20, p7);
dungcayNhiPhan(p3, nil, 40, p8);
dungcayNhiPhan(p4, p5, 55, p9);
dungcayNhiPhan(p6, nil, 75, p10);
dungcayNhiPhan(p7, p8, 25, p11);
dungcayNhiPhan(p9, p10, 65, p12);
dungcayNhiPhan(p11, p12, 45, T);
writeln;
write('Cay can
dung la: ');
Duyetcay(T);
writeln;
writeln;
writeln('So
nut tren cay la: ',CountNode(t));
writeln;
write('cay
theo thu tu giam dan la: ');
TranverInOrder(T);
writeln;
readln;
End.
12.tìm ước chung lớn nhất
program timucln;
var a, b :integer;
function ucln(a,b:integer):integer;
var r :word ;
begin
r:=a mod b;
while r
<> 0 do
begin
a:=b;
b:=r ;
r:=a mod b;
end;
ucln:=b;
end;
begin
writeln('nhap
a,b= ');
readln(a,b);
writeln('uoc
chung lon nhat la :=',ucln(a,b));
readln;
end.
13.tính tổng
var n:integer;
function
tong(n:integer):integer;
begin
if n=1 then
tong:=1
else
tong:=tong(n-1)+2*n;
end;
begin
writeln('nhap
:=',) ;readln(n);
writeln('tong tren
la :',tong(n));
readln;
end.
13.sau bao nhiêu năm thì tuổi cha gấp đôi tuổi con
program tuoi;
uses crt;
var tcha, tcon, dem :integer;
begin
clrscr;
write('hay nhap tuoi cha va tuoi con vao:=
');
readln(tcha, tcon);
dem:=1;
while (tcha div tcon) <> 2 do
begin
dem:=dem+1;
tcha:=
tcha+dem;
tcon:=tcon+dem;
end;
writeln('sau ',dem, ' nam thi tuoi cha gap doi tuoi
con');
readln
end.
Tập tin hệ thống
