Bài 1: Viết chương trình tính tích các số từ 1 đến n.
Bài giải:
uses crt;
var n,i,tich:integer;
begin
clrscr;
tich:=1;
write('Nhap n:');readln(n);
for i:=1 to n do tich:=tich*i;
write('Tich so tu 1 den ',n,' la:',tich);
readln;
end.

Bài 2:Viết chương trình tính tổng nghịch đảo từ 1 đến n.
Bài giải:
uses crt;
var i,n:integer;
tong:real;
begin
clrscr;
tong:=0;
write('Nhap n:');readln(n);
for i:=1 to n do
tong:=tong+1/i;
write('Tong ngich dao cac to tu 1 den ',n,' la:',tong:2:3);
readln;
end.

Bài 3: Viết chương trình tìm ước của n.
Bài giải:
uses crt;
var n,i:integer;
begin
clrscr;
write('Nhap n:');readln(n);
write('Cac uoc cua ',n,' la:');
for i:=1 to n do if n mod i=0 then write(i:3);
readln;
end.

Bài 4: Viết chương trình tìm ước chẵn của n.
Bài giải:
uses crt;
var n,i:integer;
begin
clrscr;
write('Nhap n:');readln(n);
write('Cac uoc chan cua ',n,' la:');
for i:=1 to n do if (n mod i=0) and (i mod 2=0) then write(i:3);
readln;
end.
Bài 5: Viết chương trình tìm ước lẻ của n.
Bài giải:
uses crt;
var n,i:integer;
begin
clrscr;
write('Nhap n:');readln(n);
write('Cac uoc le cua ',n,' la:');
for i:=1 to n do if (n mod i=0) and (i mod 2=1) then write(i:3);
readln;
end.

Bài 6: Viết chương trình tính tổng nghịch đảo giai thừa từ 1 đến n:
S=1/1! + 1/2! + … + 1/n!
Bài giải:
uses crt;
var i,n:integer;
tong,tich:real;
begin
clrscr;
tong:=0;
tich:=1;
write('nhap n:');readln(n);
for i:=1 to n do
begin
tich:=tich*i;
tong:=tong+1/tich;
end;
writeln('Tong nghich dao giai thua tu 1 den ',n,' =',tong:2:1);
readln;
end.

Bài 7: Viết chương trình tìm a, b, c thỏa mãn a3 + b3 + c3=100a + 10b +c.
Bài giải:
uses crt;
var i,j,k,n:integer;
begin
clrscr;
write('Cac so tu 100->999 thoa man DK a^3+b^3+c^3=100a+10b+c la:');
for i:=1 to 9 do
for j:=0 to 9 do
for k:=0 to 9 do
if (sqr(i)*i+sqr(j)*j+sqr(k)*k=100*i+10*j+k) then
writeln(i,j,k);
readln;
end.

Bài 8: Viết chương trình thỏa mãn a2 + b2 = c3 (pytago) chạy từ 1 đến n.
Bài giải:
uses crt;
var n,j,i,k:integer;
begin
clrscr;
write('Ban muon nhap bao nhiu so:');readln(n);
write('Cac so tu 1-> ',n,' thoa man DL pytago la:');
writeln;
for i:=1 to n do
for j:=i to n do
for k:=1 to n do
if {(k<>i)and(k<>j)and(i<>j)and}(sqr(i)+sqr(j)=sqr(k)) then
writeln(i,'^2 +',j,'^2 =',k,'^2');
readln;
end.

Bài 9: Viết chương trình nhập 2 số a và b và kiểm tra xem a có phải là ước của b hay không và ngược lại.
Bài giải:
uses crt;
var a,b:integer;
begin
clrscr;
write('Nhap so thu nhat:');readln(a);
write('Nhap so thu hai:');readln(b);
if a mod b = 0 then writeln(b,' la uoc cua ',a,'.')
else writeln(b,' ko la uoc cua ',a,' .');
if b mod a = 0 then writeln(a,' la uoc cua ',b,' .')
else writeln(a,' ko la uoc cua ',b,' .');
readln;
end.

Bài 10: Viết chương trình tìm UCLN, BCNN của a và b.
Bài giải:
uses crt;
var a,b:integer;
(****)
function USC(c,d:integer):integer;
begin
while c<>d do
if c>d then c:=c-d
else d:=d-c;
USC:=c;
end;
function BC(c,d:integer):integer;
begin
BC:=(c*d) div USC(c,d);
end;
(*****)
begin
clrscr;
write('Nhap so thu nhat:');readln(a);
write('Nhap so thu hai:');readln(b);
writeln('Uoc chung cua ',a,' va ',b,' la:',USC(a,b));
writeln('Boi chung cua ',a,' va ',b,' la:',BC(a,b));
readln;
end.

Bài 11: Nhập số n, cho biết đó có phải là số nguyên tố không?
Bài giải:
uses crt;
var n,i:integer;
begin
clrscr;
write('Nhap so n:');readln(n);
i:=2;
while (n mod i<>0) and (n>i) do
i:=i+1;
if n=i then writeln(n,' la so nguyen to.')
else writeln(n,' ko la so nguyen to.');
readln;
end.

Bài 12: Nhập hai số m, n kiểm tra có phải 2 số nguyên tố cùng nhau hay không?
Bài giải:
uses crt;
var a,b:integer;
(****)
function USC(c,d:integer):integer;
begin
while c<>d do
if c>d then c:=c-d
else d:=d-c;
USC:=c;
end;
(*****)
begin
clrscr;
write('Nhap so thu nhat:');readln(a);
write('Nhap so thu hai:');readln(b);
if USC(a,b)=1 then writeln(a,' va ',b,' la hai so nguyen to cung nhau.')
else writeln(a,' va ',b,' la hai so ko nguyen to cung nhau.');
readln;
end.

Bài 13: Nhập số n, tìm ước lẻ lớn nhất.
Bài giải:
uses crt;
var n,uoc,i:integer;
begin
clrscr;
write('Nhap n:');readln(n);
for i:=1 to n do
if (n mod i = 0) and (i mod 2=1) then uoc:=i;
writeln('Uoc le lon nhat cua ',n,' la:',uoc);
readln;
end.

Bài 14: Nhập tử và mẫu của 2 phân số. Quy đồng.
Bài giải:
uses crt;
var a,b,c,d,x,y,mc:integer;

(******************)
function UCLN(a,b:integer):integer;
begin

while a<>b do if a>b then a:=a-b
else b:=b-a;
UCLN:=a;

end;
(******************)
begin
clrscr;
write('Nhap tu so thu nhat:');readln(a);
write('Nhap mau so thu nhat:');readln(b);
write('Nhap tu so thu hai:');readln(c);
write('Nhap mau so thu hai:');readln(d);

mc:=(b*d) div ucln(b,d);
x:=a*d;
y:=b*c;
writeln('Quy dong 2 phan so la:',x,'/',mc,'va',y,'/',mc);
readln;
end.
Bài 16: Nhập vào 1 phân số. Tối giản.
Bài giải:
uses crt;
var n,tu,mau:integer;
(*****)
function USC(a,b:integer):integer;
begin
if a>b then a:=a-b
else b:=b-a;
USC:=a;
end;
(*****)
begin
clrscr;
write('Nhap tu so:');readln(tu);
write('Nhap mau so:');readln(mau);
if (mau<>0) then
begin
if tu<>0 then
begin
begin
n:=USC(tu,mau);
tu:=tu div n;
mau:=mau div n;
end;
if mau<0 then
begin
tu:=-tu;
mau:=-mau;
end;
end
else mau:=1;
writeln('Phan so toi gian:',tu,'/',mau);
end
else writeln('Mau so ko dc bang 0.');
readln;
end.

Bài 17: Nhập vào 3 số. Tìm ước số chung của 3 số.
Bài giải:
uses crt;
var a,b,c:integer;
(*****)
function USC(a,b:integer):integer;
begin
while a<>b do
if a>b then a:=a-b
else b:=b-a;
USC:=a;
end;
(*****)
function BC(a,b:integer):integer;
begin
BC:=(a*b) div USC(a,b);
end;
(*****)
begin
clrscr;
write('nhap a:');readln(a);
write('Nhap b:');readln(b);
write('nhap c:');readln(c);
writeln;
writeln('USC cua ',a,',',b,',',c,' la:',USC(USC(a,b),c));
writeln;
write('BC cua ',a,',',b,',',c,' la:',BC(BC(a,b),c));
readln;
end.

Bài 18: Nhập vào 3 số. Sắp xếp tăng và giảm.
Bài giải:
uses crt;
var a,b,c,x,y,z:integer;
(*****)
procedure sx(var a,b:integer);
var tam:integer;
(******)
begin
if a>b then
begin
tam:=a;
a:=b;
b:=tam;
end;
end;
(*****)
begin
clrscr;
write('Nhap so 1:');readln(a);
write('Nhap so 2:');readln(b);
write('Nhap so 3:');readln(c);
x:=a;
y:=b;
z:=c;
writeln('Sap xep tang:');
if a>b then sx(a,b);
if b>c then sx(b,c);
if a>b then sx(a,b);
writeln(a,'<',b,'<',c);
writeln('Sap xep giam:');
if x>y then sx(x,y);
if y>z then sx(y,z);
if x>y then sx(x,y);
writeln(z,'>',y,'>',x);
readln;
end.

Bài 19:Nhập số n. Xuất ra dãy Fibonaxi.
Bài giải:
uses crt;
var a,b,c,n,i:integer;
begin
clrscr;
a:=0;
b:=1;
write('nhap n:');readln(n);
writeln('Day Fibonaxi la:');
for i:=1 to n do
begin
c:=a+b;
b:=a;
a:=c;
write(c:5);
end;
readln;
end.

Bài 20: Nhập số n. Đổi sang nhị phân.
Bài giải:
uses crt;
var n,i:integer;
st,np:string;
begin
clrscr;
write('Nhap n:');readln(n);
repeat
i:= n mod 2;
str(i,st);
np:=st+np;
n:=n div 2;
until n=0;
write('nhi phan ',n,' la:',np);
readln;
end.

Bài 21: Tìm trong các số từ 11 đến 99 các số nguyên tố nghịch đảo nhau.
Bài giải:
uses crt;
var n,i,d,dao,m:integer;
begin
clrscr;
d:=0;
writeln('Cac so dao la:');
for i:=11 to 99 do
begin
m:=i;
dao:=(m mod 10)*10 + m div 10;
n:=dao;
if dao<>m then
repeat
if dao>m then dao:=dao-m
else m:=m-dao;
until dao=m;
if dao=1 then
begin
writeln('(',i,',',n,')');
if d mod 10=0 then writeln;
end;
end;
readln;
end.

Bài 22: Tìm trong các số từ 101 đến 999 các số nguyên tố nghịch đảo nhau.
Bài giải:
uses crt;
var n,i,d,dao,m:integer;
begin
clrscr;
d:=0;
write('Cac so dao la:');
for i:=101 to 999 do
begin
m:=i;
dao:=(m mod 10)*100 + ((m div 10) mod 10)*10 + (m div 100);
n:=dao;
if dao<>m then
repeat
if dao>m then dao:=dao-m
else m:=m-dao;
until dao=m;
if dao=1 then
begin
write('(',i,',',n,')');

{ if d mod 10=0 then writeln;}
end;
end;
readln;
end.

Bài 23: Nhập vào 1 số. Phân tích ra thừa số nguyên tố.
Bài giải:
uses crt;
var n,i:integer;
begin
clrscr;
write('nhap n:');readln(n);
if n<=0 then writeln('Khong phan tich duoc!');
begin
write(n,'=');
repeat
i:=2;
while (n mod i<>0) and (n<>i) do i:=i+1;
n:=n div i;
if n<>1 then write(i,'*')
else write(i);
until n=1;
end;
readln;
end.

Bài 24: Nhập vào 1 số nguyên dương. Tính tổng các chữ số và tìm số các chữ số.
Bài giải:
uses crt;
var n,d,tong,m:integer;
begin
clrscr;
tong:=0;
d:=0;
repeat
write('Nhap n:');readln(n);
if n>=1000 then writeln('Nhap lai!');
until n<1000;
m:=n;
while n>0 do
begin
d:=d+1;
tong:=tong+(n mod 10);
n:=n div 10;
end;
writeln('Tong cac chu so cua so ',m,' la:',tong);
writeln('So ',m,' co ',d,' chu so.');

readln;
end.

Bài 25: Nhập số thực a dương. Tìm n bé nhất để biểu thức:
S= 1 + 1/2 + 1/3 + … + 1/n > a
Bài giải:
uses crt;
var i,n,a:integer;
tong:real;
begin
clrscr;
write('Nhap a:');readln(a);
tong:=0;
n:=0;
while tong begin
n:=n+1;
tong:=tong+1/n;
end;
writeln('n be nhat:',n);
readln;
end.

Bài 26: Nhập x thuộc R. Tính tổng S= 1 + x/! + x2/2! + xn/n!. Bằng 2 cách:
a) Với n được nhập vào.
b) Cho đến khi trị tuyệt đối của số hạn nhỏ hơn sai số cho trước( nhập số mũ), khi đó ta có trị gần đúng là ex theo chuỗi tailong.
Bài giải:
uses crt;
var i,n,x:longint;
u,tong,s:real;
begin
clrscr;
write('X =');readln(x);
write('N =');readln(n);
u:=1;
tong:=1;
for i:=1 to n do
begin
u:=u*x/i;
tong:=tong+u;
end;
writeln('a/ Tong =',tong:2:3);
(***B***)
write('X =');readln(x);
write('Nhap so mu:');readln(n);
u:=1;
s:=1;
n:=1;
while abs(u)>=epx do
begin
inc(n);
u:=u*x/n;
s:=s+u;
end;
write('b/ Tong =',s:2:3);
readln;
end.
Bài 27: Nhập n nguyên và sau đó tính n trong đó
N = 2 x 4 x 6… ( nếu n chẵn)
N= 3 x 5 x 7…. ( nếu n lẽ)
Bài giải:
uses crt;
var n,i,s:integer;
begin
clrscr;
write('Nhap n = ');readln(n);
i:= n mod 2;
s:=1;
while i begin
i:=i+2;
s:=s*i;
end;
write('Tong =',s);
readln;
end.

Bài 28: a) Tìm số tự nhiên lớn nhất nhỏ hơn 1000 và không có ước số nguyên tố nào khác 3, 7, 11.
b) Tìm số tự nhiên nhỏ nhất lớn hơn 1000 và không có ước số nguyên tố nào khác 3, 7, 11.
Bài giải:
uses crt;
var n,i,min,max,doc:longint;
begin
clrscr;
writeln('So lon nhat can tim:');
for i:=1 to 999 do
begin
if (i mod 3=0) and (i mod 7=0) and (i mod 11=0) then
max:=i;
end;
write(max);
writeln;
writeln('So nho nhat can tim:');
for i:=9999 downto 1001 do
begin
if (i mod 3=0) and (i mod 7=0) and (i mod 11=0) then
min:=i;
end;
write(min);
readln;
end.

Bài 29: 2 số tự nhiên gọi là nguyên tố tương đương nếu chúng có chung các ước số nguyên tố. Nhập vào 2 số tự nhiên và kiểm tra xem chúng có nguyên tố tương đương hay không?
Bài giải:
var m,dem,so,n,i:integer;
function snt(n:integer):boolean;
var i:integer;
begin
i:=2;
while (n mod i <>0) and (i if n=i then snt:=true else snt:=false;
end;
begin
clrscr;
dem:=0;
write('Nhap m:');readln(m);
write('Nhap n:');readln(n);
so:=n; dem:=0;
repeat
i:=2;
while (so mod i<>0) and (so>i) do inc(i);
if (m mod i =0) and (n>i) then inc(dem);
so:=so div i;
until (so=1) or (so=0);
if (not(snt(n))) and (not(snt(m))) and (dem<>0) then
writeln(n,' va ',m,' cung nguyen to tuong duong')
else write('Ko nguyen to');
readln;
end.
Bài 30: Nhập số tự nhiên n, tìm số tự nhiên nhỏ nhất khác n và nguyên tố tương đương với n.
Bài giải:
var n,i:integer;
{-----------------}
{------------------}
function ngto(n:integer):boolean;
var i:integer;
begin
i:=2;
while (n mod i<>0) and (n>i) do inc(i);
if n=i then ngto:=true
else ngto:=false;
end;
procedure chuongtrinh(var i,n:integer);
var so,k,dem:integer;
begin
i:=4;
dem:=0;
if (n<4) or (ngto(n)) then exit;
while i<>n do
begin
so:=n;
repeat
k:=2;
while (so mod k<>0) and (so>k) do inc(k);
if (i mod k=0) and (so>k) then inc(dem);
so:=so div k;
until (so=0) or (so=1);
if i=n-1 then i:=n;
if dem=0 then inc(i)
else exit;
end;
end;
{-----------------}
begin
clrscr;
write('Nhap n:');readln(n);
chuongtrinh(i,n);
if (n>3) and (not(ngto(n))) then
writeln(i,' la so nho nhat va cung nguyen to tuong duong voi ',n)
else writeln('khong co so nao cung nguyen to tuong duong voi ',n);
readln;
end.

Bài 31: Dãy số tự nhiên An có tính chất sau:
A1 = A2 = A3 = A4 =1.
An = An-1 + An-3
Tính An với số n được nhập vào.(n>5)
Bài giải:
uses crt;
var i,n,d,a,b,c:integer;
begin
clrscr;
write('nhap n:');readln(n);
write('Tong =');
a:=1;
b:=1;
d:=1;
for i:=1 to n do
begin
if i<5 then c:=a
else
begin
c:=a+b;
a:=d;
d:=b;
b:=c;
end;
end;
write(c);
readln;
end.

Bài 32: a) Nhập n. In ra n số Fibonaxi đầu tiên.
b) Nhập n. In ra các số Fibonaxi nhỏ hơn n.
c) Nhập m. Kiểm tra xem m có phải là số Fibonaxi không?
Bài giải:
uses crt;
var i,n,d,a,b,c,m:integer;
begin
clrscr;
a:=0;
b:=1;
write('nhap n:');readln(n);
writeln('Day Fibonaxi la:');
for i:=1 to n do
begin
c:=a+b;
b:=a;
a:=c;
write(c:5);
end;
writeln;
writeln('Cac so Fibonaxi nho hon bang ',n,' :');
a:=0;
b:=1;
c:=0;
while c<=n do
begin
c:=a+b;
b:=a;
a:=c;
if c<=n then write(c:5);
end;
writeln;
write('Nhap m:');readln(m);
a:=0;
b:=1;
c:=0;
d:=0;
while c<=m do
begin
c:=a+b;
b:=a;
a:=c;
if c=m then inc(d);
end;
if d=0 then writeln(m,' ko la so Fibonaxi')
else write(m,' la so Fibonaxi');
readln;
end.

{----Chuỗi----}
Bài 1: Nhập xâu kí tự bất kì
a) Đếm số lần xuất hiện của 1 kí tự nào đó trong câu.
b) Liệt kê các kí tự có mặt trong xâu cùng số lần xuất hiện của các kí tự đó.
Bài giải:
uses crt;
var str:string[100];
chu:array[#1..#254] of integer;
i:integer;
ch:char;
begin
clrscr;
for ch:=#1 to #254 do chu[ch]:=0;
write(' Nhap chuoi = ');readln(str);
for i:=1 to length(str) do
(chu[upcase(str[i])]):=chu[upcase(str[i])] +1;
writeLn('Cac ki tu trong xau la:');
for ch:=#1 to #254 do
if chu[ch]>0 then writeln(ch, ': xuat hien ',chu[ch],' lan');
readln;
end.

Bài 2: Nhập 1 xâu kí tự.
a) Xét xem trong xâu có K kí tự kề nhau mà như nhau hay không?
b) Hãy xóa đi kí tự kề nhau mà như nhau, chỉ giữ lại một.
Bài giải:
uses crt;
var ch:string[100];
i,k,d,d1,n:integer;
(*****)
function xoa:boolean;
var i:integer;
begin
xoa:=false;
for i:=1 to length(ch)-1 do
if ch[i]=ch[i+1] then
begin
delete(ch,i,1);
xoa:=true;
exit
end;
end;
(*****)
begin
clrscr;

write('Nhap chuoi :');readln(ch);
write('Nhap ki tu K:');readln(k);
n:=length(ch);
d:=0;d1:=0;
for i:=1 to n-1 do
begin
if ch[i]=ch[i+1] then inc(d1)
else d1:=0;
if d1+1>=k then inc(d);
end;
if d>0 then writeln('Co ',k,' ki tu nhu nhau')
else writeln('Khong co ',k,' ki tu nhu nhau');
while xoa do;
write('In lai xau sau khi xoa:');
writeln(ch);
readln;
end.

Bài 3: Nhập 1 xâu kí tự. Kiểm tra tính đối xứng của xâu đó. Nếu xâu không đối xứng thì đảo xâu.
Bài giải:
uses crt;
var str,s:string[100];
n,i:integer;
(*****)
procedure sx(var a,b:char);
var tam:char;
begin
tam:=a;
a:=b;
b:=tam;
end;
procedure dao(n,i:integer);
var j:integer;
begin
for j:=i+1 to n do
if str[i]=str[j] then
begin
sx(str[j],str[n-i+1]);
exit
end;
end;
(*****)
begin
clrscr;
write('Nhap xau:');readln(str);
n:=length(str);
s:='';
for i:=n downto 1 do s:=s+str[i];
if str=s then writeln('Chuoi doi xung:')
else
begin
writeln('Chuoi ko doi xung, chuoi da dao doi xung:');
for i:=1 to n-1 do
dao(n,i);
end;
writeln(str);
readln;
end.

Bài 4: Cho 1 xâu kí tự. Tính xem trong số đó có bao nhiêu loại kí tự khác nhau ( không phân biệt in hoa hay in thường).
Bài giải:
uses crt;
var s:string;
i,j,dem:integer;
t:boolean;
begin
clrscr;
write('Nhap xau:');readln(s);
dem:=0;
for i:=1 to length(s) do
begin
t:=false;
for j:=1 to i-1 do
if((s[j])=(s[i])) then t:=true;
if not(t) then inc(dem);
end;
write('Co ',dem,' ki tu khac nhau.');
readln;
end.

Bài 5: Cho 1 xâu kí tự bất kì, tính:
a) Số lượng các kí tự số.
b) Số lượng các kí tự chữ cái.
Bài giải:
uses crt;
const so: set of char=['0','1','2','3','4','5','6','7','8','9'];
var st,b:string;
a:array[1..100] of integer;
i,j,l,n,dem,dem1,c:integer;
(*****)
procedure sx(var x,y:integer);
var tam:integer;
begin
tam:=x;
x:=y;
y:=tam;
end;
(*****)
begin
clrscr;
write('nhap xau:');readln(st);
dem:=0;
dem1:=0;
for i:=1 to length(st) do
begin
if (st[i] in['0'..'9']) then inc(dem);
if (upcase(st[i]) in['A'..'Z']) then inc(dem1);
end;
write('Co ',dem1,' chu cai.');
writeln;
writeln('Co ',dem,' chu so.');
l:=length(st); i:=1; n:=0;
repeat
if (st[i] in so) then
begin
b:='';
repeat
b:=b+st[i];
inc(i);
until (not(st[i] in so)) or (i>l);
inc(n);
val(b,a[n],c);
end;
inc(i);
until i>l;
for i:=1 to n do write(a[i]:5);
writeln;
writeln('Sx tang:');
for i:=1 to n-1 do
for j:=i to n do
if a[j] for i:=1 to n do write(a[i]:5);
readln;
end.

Bài 6: Cho 1 xâu kí tự bất kì (cả số lẫn chữ). Viết chương trình tách các phần là số của xâu trên và đưa ra 1 mảng số nguyên.
Bài giải:
uses crt;
const so: set of char=['0','1','2','3','4','5','6','7','8','9'];
var a:array[1..100] of integer;
st,b:string;
c,l,i,n,j:integer;
(*****)
procedure sx(var x,y:integer);
var tam:integer;
begin
tam:=x;
x:=y;
y:=tam;
end;
(*****)
begin
clrscr;
write('Nhap xau:');readln(st);
l:=length(st); i:=1; n:=0;
repeat
if (st[i] in so) then
begin
b:='';
repeat
b:=b+st[i];
inc(i);
until (not(st[i] in so)) or (i>l);
inc(n);
val(b,a[n],c);
end;
inc(i);
until i>l;
for i:=1 to n do write(a[i]:5);
writeln;
write('Sx tang:');
writeln;
for i:=1 to n-1 do
for j:=i to n do
if a[j] for i:=1 to n do write(a[i]:5);
readln;
end.

Bài 7: Nhập vào 1 xâu. Biến đổi thành chữ in hoa.
Bài giải:
uses crt;
var s:string;
i,k:integer;
begin
clrscr;
write('Nhap xau:');readln(s);
write('Bien doi in hoa:');
for i:=1 to length(s) do
write(upcase(s[i]));
readln;
end.

Bài 8: Nhập vào 1 xâu. Biến đổi in thường.
Bài giải:
uses crt;
var s:string;
i:integer;
begin
clrscr;
write('Nhap xau:');readln(s);
for i:=1 to length(s) do
if s[i] in ['A'..'Z'] then s[i]:=chr(ord(s[i])+32);
write('Bien doi thuong:',s);
readln;
end.

Bài 9: Nhập vào 1 chuỗi, in ra chuỗi ngược.
Bài giải:
uses crt;
var s:string;
i:integer;
begin
clrscr;
write('nhap chuoi:');readln(s);
write('Chuoi nguoc:');
for i:=length(s) downto 1 do write(s[i]);
readln;
end.

Bài 10: Nhập vào danh sách HS 1 lớp. Sắp xếp lại danh sắp theo thứ tự tăng dần theo chiều dài của tên.
Bài giải:
uses crt;
var hs:string;
i,j,n:integer;
(******)
procedure sx(var a,b:integer);
var tam:integer;
begin
tam:=a;
a:=b;
b:=tam;
end;
(******)
begin
clrscr;
write('Nhap so HS:');readln(n);
for i:=1 to n do
begin
write('Ten HS thu ',i,' :');readln(hs[i]);
end;
for i:=1 to n-1 do
for j:=i+1 to n do
if length(hs[i]) > length(hs[j]) then sx(hs[i],hs[j]);
writeln('Sx theo do dai ten:');
for i:=1 to n do writeln(hs[i]);
readln;
end.

Bài 11: Nhập vào họ tên bất kì sau đó biến đổi các chữ cái đầu tiên là in hoa.
Bài giải:
uses crt;
const chu=['a'..'z'];
var hoten:string;
i,k:integer;
begin
clrscr;
write('Nhap ho ten:');readln(hoten);
k:=length(hoten);
if hoten[1] in chu then hoten[1]:=upcase(hoten[1]);
for i:=2 to k do
if (hoten[i-1]=#32) and (hoten[i] in chu) then
hoten[i]:=upcase(hoten[i]);
write('sau khi bien doi:',hoten);
readln;
end.
Bài 12: Nhập vào 1 đoạn văn. Tính số câu.
Bài giải:
uses crt;
var s:string;
i,d:integer;
begin
clrscr;
write('Nhap 1 doan:');readln(s);
for i:=1 to length(s) do
if s[i]='.' then inc(d);
write('Doan tren co ',d,' cau.');
readln;
end.
Bài 13: Nhập vào 1 số, xóa bỏ các chữ số lẻ. Xuất kết quả dưới dạng đối xứng của phần còn lại.
Vd:1 2 4 5 6 - 2 4 6 6 4 2
Bài giải:
uses crt;
const so=['1','3','5','7','9'];
var s:string;
i:integer;
begin
clrscr;
write('Nhap 1 day so:');readln(s);
i:=1;
while i<=length(s) do
if s[i] in so then
begin
delete(s,i,1);
i:=1;
end
else inc(i);
write('Sau khi xoa cac so le va bien doi doi xung:',s);
for i:=length(s) downto 1 do write(s[i]);
readln;
end.
Bài 14: Nhập vào 1 số, xóa bỏ các chữ số chẵn. Kiểm tra số còn lại có bao nhiêu chữ số. Xuất kết quả dưới dạng đối xứng của phần còn lại.
Bài giải:
uses crt;
const so=['0','2','4','6','8'];
var s:string;
i,dem:integer;
begin
clrscr;
dem:=0;
write('Nhap 1 day so:');readln(s);
i:=1;
while i<= length(s) do
if s[i] in so then
begin
delete(s,i,1);
i:=1;
end
else inc(i);
for i:=1 to length(s) do dem:=dem+1;
writeln('Sau khi xoa cac so chan con ',dem,' so le .');
write('Sau khi xoa cac so chan va bien doi doi xung :',s,' ');
for i:=length(s) downto 1 do write(s[i]);
readln;
end.

{----MẢNG NHIỀU CHIỀU----}
Bài 1: Nhập vào 1 mảng 2 chiều gồm 3 dòng, 4 cột. In ra màn hình các số theo từng dòng và cột đã nhập.
Bài giải:
uses crt;
type matranthuc=array[1..3,1..4] of integer;
var a:matranthuc;
i,j,n,m:integer;
(*****)
procedure xuatmatran(var x:matranthuc);
var i,j:integer;
begin
for i:=1 to 3 do
begin
for j:=1 to 4 do write(a[i,j]:5);
writeln;
end;
end;
begin
clrscr;
write('Nhap so dong:');readln(n);
write('Nhap so cot:');readln(m);
for i:=1 to n do
for j:=1 to m do
begin
write('Nhap a[',i,',',j,']:');
readln(a[i,j]);
end;
xuatmatran(a);
readln;
end.

Bài 2: Cho ma trận vuông A cấp 4, với phần tử nguyên thuộc đoạn từ 1..100. Tìm phần tử lớn nhất, phần tử nhỏ nhất.
Bài giải:
uses crt;
type matranthuc=array[1..4,1..4] of integer;
var a:matranthuc;
i,j,m,n,max,min:integer;
(*****)
procedure xuatmatran(var x:matranthuc);
var i,j:integer;
begin
for i:=1 to 4 do
begin
for j:=1 to 4 do write(a[i,j]:5);
writeln;
end;
end;
(*****)
begin
clrscr;
for i:=1 to 4 do
for j:=1 to 4 do
begin
write('Nhap a[',i,',',j,']:');
readln(a[i,j]);
end;
xuatmatran(a);
max:=a[1,1];
for i:=1 to 4 do
for j:=1 to 4 do
if a[i,j]>max then max:=a[i,j];
min:=a[1,1];
for i:=1 to 4 do
for j:=1 to 4 do
if a[i,j] writeln('PTLN la:',max);
write('PTNN la:',min);
readln;
end.

Bài 3: Cho ma trận vuông A cấp n với phần tử nguyên thuộc đoạn từ 1..100.
a) Sắp xếp tăng dần với từng dòng
b) Sắp xếp giảm theo từng cột
Bài giải:
uses crt;
type matranthuc=array[1..100,1..100] of integer;
var a:matranthuc;
i,j,m,n,k,x:integer;
(*****)
procedure xuatmatran(var t:matranthuc; n:integer);
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to n do write(a[i,j]:5);
writeln;
writeln;
end;
end;
(*****)
procedure sx(var s,t:integer);
var tam:integer;
begin
tam:=s;
s:=t;
t:=tam;
end;
(*****)
begin
clrscr;
write('Ban muon nhap ma tran vuong cap may:');readln(n);
for i:=1 to n do
for j:=1 to n do
begin
write('Nhap a[',i,',',j,']:');
readln(a[i,j]);
end;
writeln('Ma tran ban dau:');
xuatmatran(a,n);
writeln('Sx tang o tung dong la:');
for i:=1 to n do
for j:=1 to n do
for k:=j+1 to n do
if a[i,j]>a[i,k] then sx(a[i,j],a[i,k]);
xuatmatran(a,n);
writeln('Sx giam o tung cot la:');
for j:=1 to n do
for i:=1 to n do
for k:=i+1 to n do
if a[i,j] xuatmatran(a,n);
readln;
end.

Bài 4: Nhập ma trận vuông cấp n. Xuất ra màn hình ma trận chuyển vị (đổi dòng thành cột).
Bài giải:
uses crt; {Matran chuyen vi}
type matranthuc=array[1..100,1..100] of integer;
var a:matranthuc;
i,j,m,n,k,x:integer;
(*****)
procedure xuatmatran(var t:matranthuc; n:integer);
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to n do write(a[i,j]:5);
writeln;
writeln;
end;
end;
(*****)
begin
clrscr;
write('Ban muon nhap ma tran vuong cap may:');readln(n);
for i:=1 to n do
for j:=1 to n do
begin
write('Nhap a[',i,',',j,']:');
readln(a[i,j]);
end;
writeln('Ma tran ban dau:');
xuatmatran(a,n);
writeln;
writeln('Ma tran chuyen vi la:');
for j:=1 to n do
begin
for i:=1 to n do
write(a[i,j]:5);
writeln;
writeln;
end;
readln;
end.

Bài 5: Cho ma trận vuông A cấp n với phần tử nguyên thuộc đoạn 1..100.
a) Tìm phần tử lớn nhất, phần tử nhỏ nhất.
b) In ra ma trận tam giác trên đường chéo chính.
c) In ra ma trận tam giác dưới đường chéo chính.
d) Sắp xếp tăng dần các phần tử đường chéo chính.
e) Tìm ma trận chuyển vị.
Bài giải:
uses crt;
type matranthuc=array[1..100,1..100] of integer;
var a:matranthuc;
i,j,max,min,n,k,l,x:integer;
(*****)
procedure xuatmatran(var t:matranthuc);
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to n do write(a[i,j]:5);
writeln;
writeln;
end;
end;
(*****)
procedure sx(var x,y:integer);
var tam:integer;
begin
tam:=x;
x:=y;
y:=tam;
end;
(*****)
begin
clrscr;
write('Ban muon nhap ma tran vuong cap may:');readln(n);
for i:=1 to n do
for j:=1 to n do
begin
write('Nhap a[',i,',',j,']:');
readln(a[i,j]);
end;
writeln('Ma tran ban dau:');
xuatmatran(a);
max:=a[1,1];
for i:=1 to n do
for j:=1 to n do
if a[i,j]>max then max:=a[i,j];
min:=a[1,1];
for i:=1 to n do
for j:=1 to n do
if a[i,j] writeln('PTLN:',max);
writeln('PTNN:',min);
writeln('Matran tam giac tren duong cheo chinh:');
writeln;
for i:=1 to n do
begin
for j:=1 to n do
if j>i then
write(a[i,j]:5)
else write('':5);
writeln;
writeln;
end;
writeln('Matran tam giac duoi duong cheo chinh:');
writeln;
for i:=1 to n do
begin
for j:=1 to n do
if j else write('':5);
writeln;
writeln;
end;
writeln('SX duong cheo chinh tang.');
for i:=1 to n-1 do
for k:=i+1 to n do
for j:=1 to n-1 do
for l:=j+1 to n do
if (i=j) and (k=l) and (a[i,j]>a[k,l]) then sx(a[i,j],a[k,l]);
xuatmatran(a);
writeln('Matran chuyen vi:');
for j:=1 to n do
begin
for i:=1 to n do
write(a[i,j]:5);
writeln;
writeln;
end;
readln;
end.

{ Chuyên đề 1 }
Bài 1: Nhập dãy số thực a. Tính trung bình cộng các số âm.
Bài giải:
uses crt;
var a:array[1..100] of real;
i,n,dem:integer;
tbc,tong:real;
begin
clrscr;
dem:=0;
tong:=0;
write('Nhap n:');readln(n);
for i:=1 to n do
begin
write('Nhap a[',i,']:');
readln(a[i]);
end;
for i:=1 to n do
if a[i]<0 then
begin
dem:=dem+1;
tong:=tong+a[i];
end;
tbc:=tong/dem;
writeln('TBC cac so am:',tbc:2:3);
readln;
end.

Bài 2: Nhập dãy số nguyên. Tính trung bình cộng các số lẽ.
Bài giải:
uses crt;
var a:array[1..100] of integer;
i,n,dem:integer;
tbc,tong:real;
begin
clrscr;
dem:=0;
tong:=0;
write('Nhap n:');readln(n);
for i:=1 to n do
begin
write('Nhap a[',i,']:');
readln(a[i]);
end;
for i:=1 to n do
if a[i] mod 2=1 then
begin
dem:=dem+1;
tong:=tong+a[i];
end;
tbc:=tong/dem;
writeln('TBC cac so am:',tbc:2:3);
readln;
end.

Bài 3: Sinh ngẫu nhiên dãy n số nguyên. Tìm các số trong dãy thỏa mãn định lý Pytago.
Bài giải:
uses crt;
var a:array[1..100] of integer;
i,n,j,k:integer;
begin
clrscr;
write('Ban muon chon bao nhiu so ngau nhien:');readln(n);
writeln;
randomize;
for i:=1 to n do a[i]:=random(100);
for i:=1 to n do
begin
write(a[i]:3);
end;
for i:=1 to n do
for j:=i to n do
for k:=1 to n do
if (i<>j) and (i<>k) and (k<>j) and (sqr(a[i])+sqr(a[j])=sqr(a[k])) then
writeln(a[i],'^2 +',a[j],'=',a[k],'^2');
readln;
end.

Bài 4: Nhập dãy số nguyên.Tìm các số trong dãy thỏa tính chất a3+b3+c3 = 100a+10b+c.
Bài giải:
uses crt;
var a:array[1..100] of integer;
i,j,k,n:integer;
begin
clrscr;
write('nhap n:');readln(n);
for i:=1 to n do
begin
write('Nhap a[',i,']:');
readln(a[i]);
end;
for i:=1 to n do
for j:=i to n do
for k:=1 to n do
if (i<>j)and(i<>k)and(k<>j)and (sqr(a[i])*a[i]+sqr(a[j])*a[j]+sqr(a[k])*a[k]=100*a[i]+10*a[j]+a[k]) then
writeln(a[i], ' ,a[j], ' ,a[k]);
readln;
end.

Bài 5: Sinh ngẫy nhiên n số nguyên (n<200). Đếm và tính tổng các số lẻ của chúng.
Bài giải:
uses crt;
var a:array[1..100] of integer;
n,i,dem,tong:integer;
begin
clrscr;
tong:=0;
write('nhap n:');readln(n);
dem:=0;
randomize;
for i:=1 to n do a[i]:=random(200);
for i:=1 to n do
begin
write(a[i]:5);
if a[i] mod 2=1 then dem:=dem +1;
tong:=tong+a[i];
end;
writeln;
writeln('Co ',dem,' so le.');
writeln('Tong cac so le:',tong);
readln;
end.
{ Chuyên đề 2 }
Dạng I: Tìm phần tử lớn nhất, nhỏ nhất.
Bài 1: Nhập dãy số nguyên. Tìm phần tử lớn nhất.
Bài giải:
uses crt;
var a:array[1..100] of integer;
i,max,n:integer;
begin
clrscr;
write('nhap n:');readln(n);
for i:=1 to n do
begin
write('Nhap a[',i,']:');
readln(a[i]);
end;
for i:=1 to n do
max:=a[1];
if a[i]>a[1] then max:=a[i];
writeln('GTLN :',max);
readln;
end.

Bài 2: Nhập dãy số thực. Tìm phần tử bé nhất.
Bài giải:
uses crt;
var a:array[1..100] of real;
i,n:integer;
min:real;
begin
clrscr;
write('Nhap n:');readln(n);
for i:=1 to n do
begin
write('Nhap a[',i,']:');
readln(a[i]);
end;
for i:=1 to n do
min:=a[1];
if a[i] writeln('GTNN :',min:2:1);
readln;
end.

Bài 3: Nhập dãy số thực. Tìm hai phần tử có tổng lớn nhất.
Bài giải:
uses crt;
var a:array[1..100] of real;
i,n,j,k:integer;
max,pt1,pt2:real;
begin
clrscr;
write('nhap n:');readln(n);
for i:=1 to n do
begin
write('Nhap a[',i,']:');
readln(a[i]);
end;
max:=a[1] + a[2];
for i:=1 to n do
for j:=i to n do
if i<>j then if (a[i]+a[j]>max) then
begin
max:=a[i]+a[j];
pt1:=a[i];
pt2:=a[j];
end
else if (a[i]+a[j]=max) then
begin
max:=a[i]+a[j];
pt1:=a[i];
pt2:=a[j];
end;
writeln(pt1:2:1 ,' va ' , pt2:2:1,' la 2 pt co tong lon nhat.');
readln;
end.

Bài 4: Nhập dãy số thực. Tìm ba phần tử có tổng lớn nhất và chỉ rõ vị trí của chúng.
Bài giải:
uses crt;
var a:array[1..100] of real;
i,j,k,n:integer;
min,pt1,pt2,pt3:real;
vt1,vt2,vt3:integer;
begin
clrscr;
write('nhap n:');readln(n);
for i:=1 to n do
begin
write('nhap a[',i,']:');
readln(a[i]);
end;
pt1:=a[1];
pt2:=a[2];
pt3:=a[3];
min:=a[1]+a[2]+a[3];
for i:=1 to n do
for j:=i to n do
for k:=j to n do
if (i<>k) and (k<>j) and (j<>i) then
if (a[i]+a[j]+a[k] begin
min:=a[i]+a[j]+a[k];
pt1:=a[i];vt1:=i;
pt2:=a[j];vt2:=j;
pt3:=a[k];vt3:=k;
end
else
if (a[i]+a[j]+a[k]=min) then
begin
min:=a[i]+a[j]+a[k];
pt1:=a[i];vt1:=i;
pt2:=a[j];vt2:=j;
pt3:=a[k];vt3:=k;
end;
writeln(pt1:0:1,',',pt2:0:1,',',pt3:0:1,' la ba phan tu co tong nho nhat.');
writeln(pt1:0:1,' thuoc vi tri a[',vt1,'].');
writeln(pt2:0:1,' thuoc vi tri a[',vt2,'].');
writeln(pt2:0:1,' thuoc vi tri a[',vt3,'].');
readln;
end.

Bài 5:(thi huyện 2007). Nhập dãy số thực. Tìm ba phần tử trong dãy có tổng lớn nhất.
Bài giải:
uses crt;
var a:array[1..100] of real;
i,j,k,n:integer;
max,pt1,pt2,pt3:real;
begin
clrscr;
write('nhap n:');readln(n);
for i:=1 to n do
begin
write('nhap a[',i,']:');
readln(a[i]);
end;
max:=a[1]+a[2]+a[3];
for i:=1 to n do
for j:=i to n do
for k:=j to n do
if (i<>k) and (k<>j) and (j<>i) then
if (a[i]+a[j]+a[k]>max) then
begin
max:=a[i]+a[j]+a[k];
pt1:=a[i];
pt2:=a[j];
pt3:=a[k];
end
else
if (a[i]+a[j]+a[k]=max) then
begin
max:=a[i]+a[j]+a[k];
pt1:=a[i];
pt2:=a[j];
pt3:=a[k];
end;
writeln(pt1:0:1,',',pt2:0:1,',',pt3:0:1,' la 3 phan tu co tong lon nhat.');
readln;
end.
Dạng II: Tìm phần tử thỏa mãn điều kiện

Bài 1: Cho dãy số thực a và nhập số thực x. Kiểm tra xem x có thuộc dãy không. Nếu có chỉ ra vị trí của nó.
Bài giải:
uses crt;
var a:array[1..100] of real;
i,n,dem:integer;
x:real;
begin
clrscr;
dem:=0;
write('nhap n:');readln(n);
for i:=1 to n do
begin
write('Nhap a[',i,']:');
readln(a[i]);
end;
write('Nhap x:');readln(x);
for i:=1 to n do if x=a[i] then dem:=dem+1;
if dem=0 then writeln(x:0:1,' ko thuoc day tren.')
else
for i:=1 to n do
if x=a[i] then writeln(x:0:1,' thuoc day so tren, thuoc vitri a[',i,']');
readln;
end.

Bài 2: Cho dãy số thực a và nhập số thực x. Hãy xóa mọi số lớn hơn x trong dãy.
Bài giải:
uses crt;
var a:array[1..100] of real;
x:real;
i,n:integer;
begin
clrscr;
write('nhap n:');readln(n);
for i:=1 to n do
begin
write('Nhap a[',i,']:');
readln(a[i]);
end;
write('Nhap x:');readln(x);
write('Day so sau khi xoa bo cac so lon hon x la:');
for i:=1 to n do
if a[i]<=x then write(a[i]:6:2);
readln;
end.

Bài 3: (thi huyện 2007). Nhập dãy số thực a. Tìm các số trong dãy bằng tổng hai số khác trong dãy.
Bài giải:
uses crt;
var a:array[1..100] of real;
i,j,k,n:integer;
begin
clrscr;
write('Nhap n:');readln(n);
for i:=1 to n do
begin
write('Nhap a[',i,']:');
readln(a[i]);
end;
for i:=1 to n do
for j:=i to n do
for k:=1 to n do
if (k<>i) and (k<>j) and (i<>j) and (a[i]+a[j]=a[k]) then
writeln(a[k]:2:1,'=',a[i]:2:1 , '+' ,a[j]:2:1);
readln;
end.

Bài 4: (thi tỉnh 2006). Cho một dãy gồm N số tự nhiên được sinh ngẫu nhiên có giá trị trong khoảng [1..100], các phần tử của dãy khác nhau từng đôi một và một số tự nhiên k được nhập từ bàn phím. Hãy tìm một dãy con dài nhất liên tiếp nhau sao cho tổng chia hết cho k. Cho biết độ dài và vị trí bắt đầu của dãy con tìm được.
Ví dụ: Với dãy số 1 3 4 2 7 ( N=5) và k =3
Kết quả: Độ dài của dãy con tìm được thoe yêu cầu là 3, vị trí bắt đầu của dãy con tìm được là 2.
Bài giải:
uses crt;
var a:array[1..100] of integer;
i,vt,k,n,dem,j,tong,max:integer;
begin
clrscr;
write('Nhap n:');readln(n);
write('Nhap so k:');readln(k);
randomize;
a[1]:=random(10);
for i:=2 to n do
repeat
a[i]:=random(10);
until a[i]<>a[i-1];
for i:=1 to n do write(a[i]:3);
writeln;
tong:=0;
dem:=0;
max:=0;
for j:=1 to n do
begin
for i:=j to n do
begin
tong:=tong+a[i];
dem:=dem+1;
if tong mod k=0 then
if dem>max then
begin
max:=dem;
vt:=j;
end;
end;
tong:=0;
dem:=0;
end;
if max<>0 then
begin
writeln('Do dai cua day can tim:',max);
writeln('Vi tri bat dau:',vt);
end
else write('Ko co.');
readln;
end.

Bài 5: Cho dãy n số nguyên a1;a2;…;an. Xếp lại dãy số theo nguyên tắc: a1 đổi chỗ cho an; a2 đổi chỗ với an-1…
Hướng dẫn: công thức đổi: 1 và n – i +1.
Bài giải:
uses crt;
var a:array[1..100] of integer;
j,i,n,tam,so:integer;
(*****)
procedure dc(var a,b:integer);
var tam:integer;
begin
tam:=a;
a:=b;
b:=tam;
end;
(*****)
begin
clrscr;
write('nhap n:');readln(n);
for i:=1 to n do
begin
write('Nhap a[',i,']:');
readln(a[i]);
end;
writeln('Sx theo QT: a[1] doi cho a[',n,'], a[2] doi cho a[',n-1,'].a[3] doi cho a[',n-2,']...');
writeln;
for i:=1 to n do write(a[i]:5);
for i:=1 to (n div 2) do dc(a[i],a[n-i+1]);
writeln;
writeln;
for i:=1 to n do
write(a[i]:5);
readln;
end.

Bài 6: Sinh ngẫu nhiên dãy n số nguyên ( n<2000). Không dùng mảng phụ, hãy chuyển các số âm về đầu dãy, các số dương về cuối dãy sao cho không làm thay đổi trật tự trước sau của các số cùng dấu.
Bài giải:
uses crt;
var a:array[1..100] of integer;
n,m,i:integer;
(*****)
procedure sx(var a,b:integer);
var tam:integer;
begin
tam:=a;
a:=b;
b:=tam;
end;
(*****)
begin
clrscr;
write('ban muon sinh ngau nhien bao nhiu so:');readln(n);
for i:=1 to n do
begin
write('Nhap a[',i,']:');
readln(a[i]);
end;
writeln('Day so ban dau:');
for i:=1 to n do
write(a[i]:3);
writeln;
writeln('Day so sau khi bien doi:');
for i:=1 to n do
if a[i]<0 then write(a[i]:3);
for i:=1 to n do
if a[i]=0 then write(a[i]:3);
for i:=1 to n do
if a[i]>0 then write(a[i]:3);
readln;
end.
{ Chuyên đề 3 }
Dạng I: Sinh ngẫu nhiên.
Bài 1: Sinh ngẫu nhiên n số nguyên. Sắp xếp các số này theo thứ tự tăng dần. Nhập vào một số nguyên x bất kì. Hãy chen số x vào dãy và luôn thỏa mãn là dãy tăng dần. Chỉ ra vị trí chèn.
Bài giải:
uses crt;
var a:array[1..100] of integer;
n,i,j,x,k,vt:integer;
(*****)
procedure sx(var a,b:integer);
var tam:integer;
begin
tam:=a;
a:=b;
b:=tam;
end;
(*****)
begin
clrscr;

write('Ban muon nhap bao nhiu so:');readln(n);
randomize;
for i:=1 to n do a[i]:=random(20);
for i:=1 to n do write(a[i]:3);
writeln;
for i:=1 to n-1 do
for j:=i+1 to n do
if a[i]>a[j] then sx(a[i],a[j]);
writeln('Day so sau khi xep tang dan:');
for i:=1 to n do write(a[i]:3);
writeln;
write('nhap x:');readln(x);
k:=x;
for j:=n downto 1 do
if k else if k>a[n] then vt:=n+1;
for i:=1 to n do
if x a[n+1]:=x;
writeln('Day so sau khi chen ',x,' vao:');
for i:=1 to n+1 do write(a[i]:3);
writeln;
writeln('Vi tri chen la:',vt);
readln;
end.

Bài 2: Sinh ngẫu nhiên n số nguyên dương (n<200).
a) Xóa các số trong dãy nhỏ hơn 10.
b) Xóa các số trong dãy thuộc đoạn [50,99].
Bài giải:
uses crt;
var a:array[1..100] of integer;
n,i,j:integer;
begin
clrscr;

write('Ban muon sinh ngau nhien bao nhiu so:');readln(n);

writeln('Day so ban dau:');
randomize;
for i:=1 to n do a[i]:=random(100);
for i:=1 to n do write(a[i]:3);
writeln;
writeln('Sau khi xoa cac so nho hon 10:');
for i:=1 to n do if a[i]>10 then write(a[i]:3);
writeln;
(*****)
writeln('Sau khi xoa cac so tu 50..99 la:');
for i:=1 to n do
if (a[i]<50) or (a[i]>99) then write(a[i]:3);
readln;
end.

Bài 3: Sinh ngẫu nhiên dãy n số nguyên (n<2000).
a) Tìm phần tử nhỏ nhất và chỉ ra vị trí.
b) Tìm phần tử lớn thứ hai và chỉ ra vị trí
c) Tìm vị trí các dãy đoạn con dài nhất mà các phần tử là 0 (nếu có).
Bài giải:
uses crt;
var a:array[1..100] of integer;
min,max,vt,max2,vt2,vt1,n,i,j,vitri,tong,dem,max3:integer;
begin
clrscr;
write('Ban muon sinh ngau nhien bao nhiu so :');readln(n);
randomize;
for i:=1 to n do a[i]:=random(2000);
for i:=1 to n do write(a[i]:5);
writeln;
min:=a[1];vt1:=1;
max:=a[1];vt:=1;
for i:=1 to n do
begin
if a[i] begin
min:=a[i];
vt1:=i;
end;
if a[i]>max then
begin
max:=a[i];
vt:=i;
end;
end;
max2:=0;
for i:=1 to n do
if (i<>vt) and (a[i]>max2) then
begin
max2:=a[i];
vt2:=i;
end;
max3:=1;
dem:=0;
tong:=0;
for j:=1 to n do
begin
for i:=j to n do
begin
dem:=dem+1;
tong:=tong+a[i];
if (dem>max3) and (tong=0) then
begin
max3:=dem;
vitri:=j;
end;
end;
dem:=0;
tong:=0;
end;
writeln('a/ Phan tu nho nhat:',min,' vi tri ',vt1);
writeln('b/ Phan tu lon thu hai:',max2,' vi tri ',vt2);
if max3>1 then
writeln('c/ Do dai doan con:',max3,' vi tri bat dau:',vitri)
else writeln('c/ khong co');
readln;
end.

Dạng II: Một số bài toán đặc biệt.
Bài 1: “Dãy con”
Cho 2 dãy số thực a1,a2,a3,…,an (1) ; b1,b2,b3,…,bm (2). Dãy (1) được gọi là dãy con của dãy 2 nếu bỏ đi k phần tử (k>=0) trong (2) thì có (1). Chẳng hạn: dãy 1,3,5 là dãy con của dãy 0,1,2,1,4,3,5,7. Hãy nhập vào 2 dãy và cho biết dãy (1) có phải là dãy con của dãy (2) hay không.
Bài giải:
uses crt;
type mang=array[1..100] of integer;
var a,b:mang;
n,m,i,j,h:integer;
{*****}
procedure daycon(var a,b,t:integer;c,d:mang);
var dem,i,j,l,k:integer;
begin
dem:=0;
t:=0;
for i:=1 to a do
begin
for j:=1 to b do
if c[j]=d[i] then
begin
inc(dem);
for l:=1 to a do
for k:=1 to b do
if (l<>i) and (k<>j) and (c[k]=d[l]) then
inc(dem);
end;
if dem>=a then inc(t);
dem:=0;
end;
end;
{*****}
begin
clrscr;
write('muon nhap bao nhieu so trong day 1:');readln(n);
write('Muon nhap bao nhieu so trong day 2:');readln(m);
writeln('Day 1:');
for i:=1 to n do
begin
write('nhap a[',i,']:');
readln(a[i]);
end;
writeln('Day 2:');
for i:=1 to m do
begin
write('nhap b[',i,']:');
readln(b[i]);
end;
write('Day 1:');
for i:=1 to n do write(a[i]:3);
writeln;
write('Day 2:');
for i:=1 to m do write(b[i]:3);
writeln;
if n begin
daycon(n,m,h,b,a);
if h=n then writeln('Day 1 la day con cua day 2')
else writeln('Khong day nao la day con cua day kia');
end;
if n>m then
begin
daycon(m,n,h,a,b);
if h=n then writeln('Day 2 la day con cua day 1')
else writeln('Khong day nao la day con cua day kia');
end;
readln;
end.

Bài 2: “Dãy đoạn con” tương tự dãy con nhưng các phần tử liên tiếp. Chẳng hạn: dãy 1,2,1 là dãy đoạn con của dãy 0,1,2,1,4,5,6,3. Còn dãy 1,4,6 không là dãy đoạn con của nó. Hãy nhập vào 2 dãy và cho biết dãy (1) có phải là dãy đoạn con không.
Bài giải:
uses crt;
type mang=array[1..100] of integer;
var a,b:mang;
n,m,i,j,h:integer;
{-----------}
procedure daycon(var a,b,k:integer;c,d:mang);
var dem,i,j,t,p:longint;
begin
dem:=0;
t:=0;
for i:=1 to a do t:=t*10+d[i];
for i:=1 to b do
begin
for j:=i to b do
begin
p:=p*10+c[j];
if p=t then inc(dem);
end;
if dem<>0 then inc(k);
p:=0;dem:=0;
end;
end;
{-----------------------}
begin
clrscr;
write('muon nhap bao nhieu so trong day 1:');readln(n);
write('Muon nhap bao nhieu so trong day 2:');readln(m);
writeln('Day 1:');
for i:=1 to n do
begin
write('nhap a[',i,']:');
readln(a[i]);
end;
writeln('Day 2:');
for i:=1 to m do
begin
write('nhap b[',i,']:');
readln(b[i]);
end;
write('Day 1:');
for i:=1 to n do write(a[i]:3);
writeln;
write('Day 2:');
...