Bài tập Pascal và lời giải

BÀI TẬP PASCAL VÀ LỜI GIẢI
Bài 1:
Nhập vào 1 số nguyên gồm 4 chữ số
-Kiểm tra tình chắn lể
-kiểm tra xem có phải là số nguyên tố không
-kiểm tra xem có phải là số hoàn hảo không
Bài 2:
Nhập vào 1 số n nguyên (2<n<20)
-nhập vào mảng n số nguyên dương
-hiện tất cả số nguyên tố trong mảng và đếm xem có bao nhiu sô
Bài 3:
Nhạp vào 1 số n nguyên (2<n<20)
-nhập vào mảng n số nguyên
-tìm số lớn nhất và vị trí của nó
-sắp xếp mảng tang giần theo giá trị
-hiển thị mảng vừa sắp xếp
Bai 4:
-viết chương trình kiểm tra xem 1 số có là số hoàn hảo không
-liệt kê tất cả số hoàn hảo từ 1..2000 và đếm xem có bao nhiu số
Bài 5:
Nhập vào 1 số n nguyên (2<n<20)
-nhập vào một mảng n số thực
-tình trung bình công của tất cả số dương trong mảng
-kiểm tra xem trong mảng có bao nhiu số có giá trị trùng với giá trị của tbc nói trên
Bài 6:
-đếm xem 1 xâu s có bao nhiu kí tự c , ch (không kể in hoa hay thường)
-đém xem xâu s có bao nhiu từ (một từ được định nghĩa là một tập các kí tự không chứa dấu cách)
-chuẩm hóa xâu xóa tất cả kí tự cách ở đầu và cuói câu ,trong xâu không co nhìu hơn một dấu cách đứng liền nhau
Bài 7:
-nhập vào một ma trận m*n
-hiện ma trận vủa nhập
Bài 8:
Giải bài toán FIBONACI
Bài 9:
Kiểm tra tình đối xứng của 1 từ
Bài 10:
Nhập vào các số n , m (2<n,m<20)
-nhập vào ma trận các số nguyên
-xây dựng một mảng thứ 2 gồm các giá trị max của hàng trong ma trận trên
-hiện cả hai mảng ra màn hình
Bai 11:
Nhập vào các số n , m (2<n,m<20)
-nhập vào ma trận gồm các số nguyên
-hiện ma trận vùa nhập ra màn hình
-tìm số nguyên tố và cho bít vị trí của nó
Bai 12:
Nhập vào các số n , m (2<n,m<20)
-nhập một ma trận các số nguyên
-hiện ra màn hình ma trận vừa nhập
-sắp xếp lai ma trận sao cho hàng tăng cột tăng
Bai 13:
-kiểm tra một xâu s1 có mặt tỏng xâu s2 không tình từ 1 vị trí bất kì
-nhập 2 xâu s1 ,s2 .Đếm em xâu s1 có mặt trong xâu s2 bao nhiu lần
Bài 14:
-kiểm tra kí tự bất kì có là chữ cái từ a..z không
-nhập vào một xâu sau đó đếm xem trong xâu có bao nhiu kí tự không pải là chữ cái
Bài 15:
-Nhập vào một danh sách sinh viên (họ tên,năm sinh,dan tộc,điểm 1 ,điểm 2 , điểm 3 ,giới tính)
-hiện danh sách sinh viên vừa nhập dưới dạng cột
STT Hoten Gioitinh Dantoc Diem1 Diem2 Diem3 DTB
-liệt kê danh sách sinh viên đạt loại khá (dtb>7)
Bài 16:
-Nhập vào một danh sách sinh viên (họ tên,năm sinh,dan tộc,điểm 1 ,điểm 2 , điểm 3 ,giới tính)
-hiện danh sách sinh viên vừa nhập dưới dạng cột
STT Hoten Gioitinh Dantoc Diem1 Diem2 Diem3 DTB
-cho bit có bao nhiu phần trăm sinh viên nam bao nhiu phần trăm nữ
Bai 17:
-Nhập vào một danh sách sinh viên (họ tên,năm sinh,dan tộc,điểm 1 ,điểm 2 , điểm 3 ,giới tính)
-hiện danh sách sinh viên vừa nhập dưới dạng cột
STT Hoten Gioitinh Dantoc Diem1 Diem2 Diem3 DTB
-sắp xếp lại danh sách sinh viên tăng dần theo điểm trung bình (không làm sai lệch thông tin) 
Bài giải
Bài 1:
program yen1;
uses crt;
var i,n,k,d:integer;
 ok:boolean;
function chanle(n:integer):boolean;
begin
 ok:=true;
 if n mod 20 then ok:=false;
 chanle:=ok;
end;
function nguyento(n:integer):boolean;
begin
 ok:=true;
 d:=0;
 for i:=1 to n-1 do
 if n mod i=0 then d:=d+1;
 if d1 then ok:=false;
 nguyento:=ok;
end;
function chinhphuong(n:integer):boolean;
begin
 ok:=true;
 k:=trunc(sqrt(n));
 if sqr(k)n then ok:=false;
 chinhphuong:=ok;
end;
begin
 clrscr;
 write(' Nhap n=');readln(n);
 if chanle(n) then writeln(' So vua nhap la chan')
 else writeln(' So vua nhap la so le');
 if nguyento(n) then writeln(' So vua nhap la nguyen to')
 else writeln(' So vua nhap khong phai la so nguyen to');
 if chinhphuong(n) then writeln(' So vua nhap la so chinh phuong')
 else writeln(' So vua nhap khong la so chinh phuong');
 readln;
end.
Bài 2:
program yen2;
uses crt;
var a:array [ 1..20] of byte;
 i,n,d,j,k:integer;
procedure nhap;
begin
 for i:=1 to n do
 begin
 write(' a[',i,']=');readln(a[i]);
 end;
end;
procedure nguyento;
begin
 write(' Day so cac so nguyen to:');
 k:=0;
 for i:=1 to n do
 begin
 d:=0;
 for j:=1 to a[i]-1 do
 if a[i] mod j=0 then d:=d+1;
 if d=1 then begin
 write(' ',a[i]);
 k:=k+1;
 end;
 end;
 if k=0 then write(' khong co so nao')
 else begin
 writeln;
 writeln(' Trong day co ',k,' so nguyen to');
 end;
end;
begin
 clrscr;
 repeat
 write(' Nhap n=');readln(n);
 until (2<n)and(n<20);
 nhap;
 nguyento;
 readln;
end.
Bài 3:
program yen3;
uses crt;
var a:array [1..20] of integer;
 b:array [1..20] of integer;
 i,n,max,j,tg:integer;
procedure nhap;
begin
 for i:=1 to n do
 begin
 write(' a[',i,']=');readln(a[i]);
 end;
end;
procedure timmax;
begin
 max:=a[1];
 for i:=2 to n do
 if a[i]>max then max:=a[i];
 j:=1;
 for i:=1 to n do
 if a[i]=max then begin
 b[j]:=i;
 j:=j+1;
 end;
 write(' So lon nhat trong day la ',max,' o vi tri thu');
 for i:=1 to j-1 do
 write(', ',b[i]);
 writeln;
end;
procedure tang;
begin
 for i:=1 to n-1 do
 for j:=i+1 to n do
 if a[i]>a[j] then begin
 tg:=a[i];
 a[i]:=a[j];
 a[j]:=tg;
 end;
 write(' Day duoc sap xep lai la:');
 for i:=1 to n do
 write(' ',a[i]);
end;
begin
 clrscr;
 repeat
 write(' Nhap n=');readln(n);
 until (2<n)and(n<20);
 nhap;
 timmax;
 tang;
 readln;
end.
Bài 4:
program yen4;
uses crt;
var n,i,d,k,j:integer;
procedure hoanhao;
begin
 d:=0;
 for i:=1 to n-1 do
 if n mod i=0 then d:=d+i;
 if d=n then writeln(' So vua nhap la so hoan hao')
 else writeln(' So vua nhap khong la so hoan hao');
end;
procedure vietlen;
begin
 write(' Day so hoan hao tu 1-->2000:');
 k:=0;
 for i:=1 to 2000 do
 begin
 d:=0;
 for j:=1 to i-1 do
 if i mod j=0 then d:=d+j;
 if d=i then begin
 write(' ',i);
 k:=k+1;
 end;
 end;
 writeln;
 writeln(' Trong day 1-->2000 co ',k,' so hoan hao');
end;
begin
 clrscr;
 write(' Nhap n=');readln(n);
 hoanhao;
 vietlen;
 readln;
end.
Bài 5:
program yen5;
uses crt;
var a:array [1..20] of real;
 b:array [1..20] of integer;
 i,n,d,j:integer;
 s,m:real;
procedure nhap;
begin
 for i:=1 to n do
 begin
 write(' a[',i,']=');readln(a[i]);
 end;
end;
function tbc:real;
begin
 d:=0;s:=0;
 for i:=1 to n do
 if a[i]>0 then begin
 s:=s+a[i];
 d:=d+1;
 end;
 tbc:=(s/d);
end;
procedure kiemtra;
begin
 d:=0;j:=1;
 for i:=1 to n do
 if m=a[i] then begin
 b[j]:=i;
 d:=d+1;
 j:=j+1;
 end;
 if d=0 then writeln(' Trong mang khong co so nao trung trung binh cong')
 else begin
 write(' Trong day co ',d,' so trung voi trung binh cong o vi tri');
 for i:=1 to j-1 do
 write(', ',b[i]);
 end;
end;
begin
 clrscr;
 repeat
 write(' Nhap n=');readln(n);
 until (2<n)and(n<20);
 nhap;
 m:=tbc;
 writeln(' Trung bing cong :',m:2:3);
 kiemtra;
 readln;
end.
Bài 6:
program yen6;
uses crt;
var st:string;
 i,d:integer;
 ch:char;
function demkitu:integer;
begin
 d:=0;
 for i:=1 to length(st) do
 if (st[i]='c')or(st[i]='C') then d:=d+1;
 demkitu:=d;
end;
function demtu:integer;
begin
 d:=1;
 for i:=1 to length(st) do
 if (st[i]' ')and(st[i+1]=' ') then d:=d+1;
 demtu:=d;
end;
procedure chuanhoa;
begin
 while st[1]=' ' do
 delete(st,1,1);
 while st[length(st)]=' ' do
 delete(st,length(st),1);i:=1;
 repeat
 if (st[i]=' ')and(st[i+1]=' ') then delete(st,i,1) else i:=i+1;
 until i>length(st);
end;
function dem:integer;
begin
 d:=0;
 for i:=1 to length(st) do
 if st[i]=ch then d:=d+1;
 dem:=d;
end;
begin
 clrscr;
 write(' Nhap xau:');readln(st);
 write(' Nhap ki tu:');readln(ch);
 chuanhoa;
 writeln(' Trong xau co ',demkitu,' ki tu C');
 writeln(' Trong xau co ',demtu,' tu');
 writeln(' Ki tu ',ch,' vua nhap co mat ',dem,' lan trong xau');
 readln;
end.
Bài 7:
program yen7;
uses crt;
var a:array[1..10,1..10] of integer;
 i,j,n,m:integer;
procedure nhap;
begin
 for i:=1 to m do
 for j:=1 to n do
 begin
 write(' a[',i,',',j,']=');readln(a[i,j]);
 end;
end;
procedure hienthi;
begin
 writeln(' Ma tran vua nhap la:');
 for i:=1 to m do
 begin
 for j:=1 to n do
 write(' ',a[i,j]:4);
 writeln;
 end;
end;
begin
 clrscr;
 write(' Nhap m,n:');readln(m,n);
 nhap;
 hienthi;
 readln;
end.
Bài 8:
program yen8;
uses crt;
var a:array [1..100] of integer;
 n,i,m,d,s:integer;
procedure fibonaci;
begin
 if n=1 then a[1]:=1
 else begin
 i:=2;s:=1;a[1]:=1;
 repeat
 a[i]:=s;
 i:=i+1;
 s:=a[i-1]+a[i-2];
 until i>n;
 end;
 write(' Day so fibonaci la:');
 for i:=1 to n do
 write(' ',a[i]);
 writeln;
end;
begin
 clrscr;
 write(' Nhap so de tinh day fibonaci:');readln(n);
 write(' Nhap so de kiem tra xem co trong day fibonaci khong:');readln(m);
 fibonaci;
 d:=0;
 for i:=1 to n do
 if a[i]=m then d:=d+1;
 if d=1 then writeln(' So de kiem tra co mat trong day fibonaci')
 else writeln(' So kiem tra khong co mat trong day fibonaci');
 readln;
end. 
Bài 9:
program yen9;
uses crt;
var tu:string; 
 i:integer;
function doixung(tu1:string):boolean;
var ok:boolean;
begin
 ok:=true;
 for i:=1 to (length(tu1) div 2) do
 if tu1[i]tu1[length(tu1)-i+1] then begin
 ok:=false;
 break;
 end;
 doixung:=ok;
end;
begin
 clrscr;
 write(' Nhap tu:');readln(tu);
 if doixung(tu) then writeln(' Tu vua nhap doi xung')
 else writeln(' Tu vua nhap khong doi xung');
 readln;
end.
Bài 10:
program yen10;
uses crt;
var a:array [1..10,1..10] of integer;
 b:array [1..10] of integer;
 i,j,n,m,max:integer;
procedure nhap;
begin
 for i:=1 to n do
 for j:=1 to m do
 begin
 write(' a[',i,',',j,']=');readln(a[i,j]);
 end;
end;
procedure xaydung;
begin
 for j:=1 to m do
 begin
 max:=a[1,j];
 for i:=2 to n do
 if a[j,i]>max then max:=a[j,i];
 b[j]:=max;
 end;
end;
procedure hienthi;
begin
 writeln(' Ma tran vua nhap la:');
 for i:=1 to n do
 begin
 for j:=1 to m do
 write(' ',a[i,j]:4);
 writeln;
 end;
 writeln;
 write(' Day gom cac so max la:');
 for i:=1 to m do
 write(' ',b[i]);
end;
begin
 clrscr;
 repeat
 write(' Nhap n,m:');readln(n,m);
 until (2<n)and(m<20);
 nhap;
 xaydung;
 hienthi;
 readln;
end.
Bài 11:
program yen11;
uses crt;
var a:array [1..10,1..10] of integer;
 b:array [1..100] of integer;
 i,j,n,m,d,k,t:integer;
procedure nhap;
begin
 for i:=1 to n do
 for j:=1 to m do
 begin
 write(' a[',i,',',j,']=');readln(a[i,j]);
 end;
end;
procedure hienthi;
begin
 writeln(' Ma tran vua nhap la:');
 for i:=1 to n do
 begin
 for j:=1 to m do
 write(' ',a[i,j]:4);
 writeln;
 end;
 writeln;
end;
procedure nguyento;
begin
 k:=1;
 for i:=1 to n do
 for j:=1 to m do
 begin
 d:=0;
 for t:=1 to a[i,j]-1 do
 if a[i,j] mod t=0 then d:=d+1;
 if d=1 then begin
 b[k]:=a[i,j];
 k:=k+1;
 end;
 end;
 writeln;writeln;
 writeln(' Day so nguyen to la:');writeln;
 for i:=1 to n do
 for j:=1 to m do
 begin
 for t:=1 to k-1 do
 if b[t]=a[i,j] then begin
 write(' ',b[t]:8);
 writeln(' :hang ',i,' cot ',j,' ');
 end;
 end;
end;
begin
 clrscr;
 repeat
 write(' Nhap n,m:');readln(n,m);
 until (2<n)and(m<20);
 nhap;
 hienthi;
 nguyento;
 readln;
end.
Bài 12:
program yen12;
uses crt;
var a:array [1..10,1..10] of integer;
 b:array [1..100] of integer;
 i,j,n,m,k,tg:integer;
procedure nhap;
begin
 for i:=1 to n do
 for j:=1 to m do
 begin
 write(' a[',i,',',j,']=');readln(a[i,j]);
 end;
end;
procedure hienthi;
begin
 writeln(' Ma tran vua nhap la:');
 for i:=1 to n do
 begin
 for j:=1 to m do
 write(' ',a[i,j]:4);
 writeln;
 end;
 writeln;
end;
procedure sapxep;
begin
 k:=1;
 for i:=1 to n do
 for j:=1 to m do
 begin
 b[k]:=a[i,j];
 k:=k+1;
 end;
 for i:=1 to k-2 do
 for j:=i+1 to k-1 do
 if b[i]>b[j] then begin
 tg:=b[i];
 b[i]:=b[j];
 b[j]:=tg;
 end;
 k:=1;
 for i:=1 to n do
 for j:=1 to m do
 begin
 a[i,j]:=b[k];
 k:=k+1;
 end;
 writeln(' Ma tran duoc sap xep lai la:');
 for i:=1 to n do
 begin
 for j:=1 to m do
 write(' ',a[i,j]:4);
 writeln;
 end;
end;
begin
 clrscr;
 repeat
 write(' Nhap n,m:');readln(n,m);
 until (2<n)and(m<20);
 nhap;
 hienthi;
 sapxep;
 readln;
end.
Bài 13:
program yen13;
uses crt;
var s1,s2:string;
 i,j,d,k,t:integer;
procedure kiemtra;
begin
 d:=0;
 for i:=1 to length(s2) do
 if s2[i]=s1[1] then begin
 k:=2;t:=1;
 for j:=i+1 to (i+length(s1)-1) do
 if s2[j]=s1[k] then begin
 k:=k+1;
 t:=t+1;
 end;
 if t=length(s1) then d:=d+1;
 end;
 if d>0 then begin
 writeln(' Xau s1 co xuat hien trogn xau s2');
 writeln(' Xau s1 xuat hien ',d,' lan trong xau s2');
 end
 else writeln(' Xau s1 khong xuat hien trong xau s2');
end;
begin
 clrscr;
 write(' Nhap xau s1:');readln(s1);
 write(' Nhap xau s2:');readln(s2);
 kiemtra;
 readln;
end.
Bài 14:
program yen14;
uses crt;
type tap=set of char;
var ch:char;
 st:string;
 chucai:tap;
 i,d:integer;
procedure kiemtra;
begin
 if ch in chucai then writeln(' Ki tu ',ch,' co trong bang chu cai')
 else writeln(' Ki tu ',ch,' khong co trong bang chu cai');
 d:=0;
 for i:=1 to length(st) do
 if st[i] in chucai then d:=d+1;
 writeln(' Trong xau co ',length(st)-d,' ki tu khong la chu cai');
end;
begin
 clrscr;
 write(' Nhap ki tu:');readln(ch);
 write(' Nhap xau:');readln(st);
 chucai:=['a'..'z','A'..'Z'];
 kiemtra;
 readln;
end.
Bài 15:
program yen15;
uses crt;
type sinhvien=record
 hoten,dantoc,gioitinh:string;
 namsinh,diem1,diem2,diem3:integer;
 dtb:real;
 end;
 mang=array [1..10] of sinhvien;
var sv:mang;
 i,n,d:integer;
procedure nhap;
begin
 clrscr;
 writeln(' NHAP THONG TIN CHO SINH VIEN');
 for i:=1 to n do
 with sv[i] do
 begin
 write(' Ho ten:');readln(hoten);
 write(' Gioi tinh:');readln(gioitinh);
 write(' Dan toc:');readln(dantoc);
 write(' Diem1,Diem2,Diem3:');readln(diem1,diem2,diem3);
 dtb:=(diem1+diem2+diem3)/3;
 writeln;
 end;
end;
procedure hienthi;
begin
 writeln;writeln;
 writeln(' DANH SACH SINH VIEN VUA NHAP');
 for i:=1 to n do
 with sv[i] do
 begin
 writeln(' Ho ten:',hoten);
 writeln(' Nam sinh:',namsinh);
 writeln(' Diem TB:',dtb:2:2);
 writeln;writeln;
 end;
end;
procedure sapxep;
begin
 writeln(' DANH SACH SINH VIEN DAT LOAI KHA');
 writeln;
 d:=0;
 for i:=1 to n do
 if sv[i].dtb>7 then begin
 writeln(' Ho ten:',sv[i].hoten);
 writeln(' Diem TB:',sv[i].dtb:2:3);
 writeln;writeln;
 d:=d+1;
 end;
 if d=0 then writeln(' ( khong co sinh vien nao )');
end;
begin
 clrscr;
 write(' Nhap n=');readln(n);
 nhap;
 hienthi;
 sapxep;
 readln;
end.
Bài 16:
program yen16;
uses crt;
type sinhvien=record
 hoten,dantoc,gioitinh:string;
 namsinh,diem1,diem2,diem3:integer;
 dtb:real;
 end;
 mang=array [1..10] of sinhvien;
var sv:mang;
 i,n,d:integer;
 p:real;
procedure nhap;
begin
 clrscr;
 writeln(' NHAP THONG TIN CHO SINH VIEN');
 for i:=1 to n do
 with sv[i] do
 begin
 write(' Ho ten:');readln(hoten);
 write(' Gioi tinh:');readln(gioitinh);
 write(' Dan toc:');readln(dantoc);
 write(' Diem1,Diem2,Diem3:');readln(diem1,diem2,diem3);
 dtb:=(diem1+diem2+diem3)/3;
 writeln;
 end;
end;
procedure hienthi;
begin
 writeln;writeln;
 writeln(' DANH SACH SINH VIEN VUA NHAP');
 for i:=1 to n do
 with sv[i] do
 begin
 writeln(' Ho ten:',hoten);
 writeln(' Nam sinh:',namsinh);
 writeln(' Diem TB:',dtb:2:2);
 writeln;writeln;
 end;
end;
procedure phantram;
begin
 writeln;writeln;
 writeln(' TY LE NAM NU');
 d:=0;
 for i:=1 to n do
 if sv[i].gioitinh='nam' then d:=d+1;
 p:=(d/n)*100;
 writeln(' Trong danh sach co ',p:2:2,' % la sinh vien nam');
 writeln(' Trong danh sach co ',(100-p):2:2,' % la sinh vien nu');
end;
begin
 clrscr;
 write(' Nhap n=');readln(n);
 nhap;
 hienthi;
 phantram;
 readln;
end.
Bài 17:
program yen17;
uses crt;
type sinhvien=record
 hoten,dantoc,gioitinh:string;
 namsinh,diem1,diem2,diem3:integer;
 dtb:real;
 end;
 mang=array [1..10] of sinhvien;
var sv:mang;
 i,n,j:integer;
procedure nhap;
begin
 clrscr;
 writeln(' NHAP THONG TIN CHO SINH VIEN');
 for i:=1 to n do
 with sv[i] do
 begin
 write(' Ho ten:');readln(hoten);
 write(' Gioi tinh:');readln(gioitinh);
 write(' Dan toc:');readln(dantoc);
 write(' Diem1,Diem2,Diem3:');readln(diem1,diem2,diem3);
 dtb:=(diem1+diem2+diem3)/3;
 writeln;
 end;
end;
procedure hienthi;
begin
 writeln;writeln;
 writeln(' DANH SACH SINH VIEN VUA NHAP');
 for i:=1 to n do
 with sv[i] do
 begin
 writeln(' Ho ten:',hoten);
 writeln(' Nam sinh:',namsinh);
 writeln(' Diem TB:',dtb:2:2);
 writeln;writeln;
 end;
end;
procedure sapxep;
var tg:sinhvien;
begin
 writeln;writeln;
 writeln(' DANH SACH SINH VIEN DUOC SAP XEP LAI LA');
 for i:=1 to n-1 do
 for j:=i+1 to n do
 if sv[i].dtb>sv[j].dtb then begin
 tg:=sv[i];
 sv[i]:=sv[j];
 sv[j]:=tg;
 end;
 for i:=1 to n do
 with sv[i] do
 begin
 writeln(' Ho ten:',hoten);
 writeln(' Diem TB:',dtb:2:2);
 writeln;
 end;
end;
begin
 clrscr;
 write(' Nhap n=');readln(n);
 nhap;
 hienthi;
 sapxep;
 readln;
end.