BAI TAP PASCAL VA LOI GIAI

<span class='text_page_counter'>(1)</span>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.

<span class='text_page_counter'>(2)</span> 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ữ.

<span class='text_page_counter'>(3)</span> 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 2<>0 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 d<>1 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').

<span class='text_page_counter'>(4)</span> 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;.

<span class='text_page_counter'>(5)</span> 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]);.

<span class='text_page_counter'>(6)</span> 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);.

<span class='text_page_counter'>(7)</span> 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]);.

<span class='text_page_counter'>(8)</span> 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;.

<span class='text_page_counter'>(9)</span> 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);.

<span class='text_page_counter'>(10)</span> 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;.

<span class='text_page_counter'>(11)</span> 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;.

<span class='text_page_counter'>(12)</span> 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;.

<span class='text_page_counter'>(13)</span> 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;.

<span class='text_page_counter'>(14)</span> 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;.

<span class='text_page_counter'>(15)</span> 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;.

<span class='text_page_counter'>(16)</span> 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.

<span class='text_page_counter'>(17)</span> 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);.

<span class='text_page_counter'>(18)</span> 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');.

<span class='text_page_counter'>(19)</span> 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;.

<span class='text_page_counter'>(20)</span> 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;.

<span class='text_page_counter'>(21)</span> end; end; begin clrscr; write(' Nhap n=');readln(n); nhap; hienthi; sapxep; readln; end..

<span class='text_page_counter'>(22)</span>