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 Diem[r]
(1)BÀI TẬP PASCAL VÀ LỜI GIẢI Bài 1: Nhập vào số nguyên gồm 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 số n nguyên (2<n<20) -nhập vào mảng n số nguyên dương -hiện tất số nguyên tố mảng và đếm xem có bao nhiu sô Bài 3: Nhạp vào số n nguyên (2<n<20) -nhập vào mảng n số nguyên -tìm số lớn và vị trí nó -sắp xếp mảng tang giần theo giá trị -hiển thị mảng vừa xếp Bai 4: -viết chương trình kiểm tra xem số có là số hoàn hảo không -liệt kê tất số hoàn hảo từ 2000 và đếm xem có bao nhiu số Bài 5: Nhập vào số n nguyên (2<n<20) -nhập vào mảng n số thực -tình trung bình công tất số dương mảng -kiểm tra xem mảng có bao nhiu số có giá trị trùng với giá trị tbc nói trên Bài 6: -đếm xem 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ừ định nghĩa là tập các kí tự không chứa dấu cách) -chuẩm hóa xâu xóa tất kí tự cách đầu và cuói câu ,trong xâu không co nhìu dấu cách đứng liền Bài 7: -nhập vào ma trận m*n -hiện ma trận vủa nhập Bài 8: Giải bài toán FIBONACI (2) Bài 9: Kiểm tra tình đối xứng 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ảng thứ gồm các giá trị max hàng ma trận trên -hiện hai mảng 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 màn hình -tìm số nguyên tố và cho bít vị trí nó Bai 12: Nhập vào các số n , m (2<n,m<20) -nhập ma trận các số nguyên -hiện màn hình ma trận vừa nhập -sắp xếp lai ma trận cho hàng tăng cột tăng Bai 13: -kiểm tra xâu s1 có mặt tỏng xâu s2 không tình từ vị trí bất kì -nhập xâu s1 ,s2 Đếm em xâu s1 có mặt 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 xâu sau đó đếm xem xâu có bao nhiu kí tự không pải là chữ cái Bài 15: -Nhập vào danh sách sinh viên (họ tên,năm sinh,dan tộc,điểm ,điểm , điểm ,giới tính) -hiện danh sách sinh viên vừa nhập 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 danh sách sinh viên (họ tên,năm sinh,dan tộc,điểm ,điểm , điểm ,giới tính) -hiện danh sách sinh viên vừa nhập 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ữ (3) Bai 17: -Nhập vào danh sách sinh viên (họ tên,năm sinh,dan tộc,điểm ,điểm , điểm ,giới tính) -hiện danh sách sinh viên vừa nhập 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 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') (4) else writeln(' So vua nhap khong la so chinh phuong'); readln; end Bài 2: program yen2; uses crt; var a:array [ 20] of byte; i,n,d,j,k:integer; procedure nhap; begin for i:=1 to n 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 begin d:=0; for j:=1 to a[i]-1 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; (5) 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 begin write(' a[',i,']=');readln(a[i]); end; end; procedure timmax; begin max:=a[1]; for i:=2 to n if a[i]>max then max:=a[i]; j:=1; for i:=1 to n if a[i]=max then begin b[j]:=i; j:=j+1; end; write(' So lon nhat day la ',max,' o vi tri thu'); for i:=1 to j-1 write(', ',b[i]); writeln; end; procedure tang; begin for i:=1 to n-1 for j:=i+1 to n 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 write(' ',a[i]); (6) 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 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 >2000:'); k:=0; for i:=1 to 2000 begin d:=0; for j:=1 to i-1 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 >2000 co ',k,' so hoan hao'); end; begin clrscr; write(' Nhap n=');readln(n); (7) 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 begin write(' a[',i,']=');readln(a[i]); end; end; function tbc:real; begin d:=0;s:=0; for i:=1 to n 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 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 write(', ',b[i]); (8) 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) 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) if (st[i]<>' ')and(st[i+1]=' ') then d:=d+1; demtu:=d; end; procedure chuanhoa; begin while st[1]=' ' delete(st,1,1); while st[length(st)]=' ' 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; (9) function dem:integer; begin d:=0; for i:=1 to length(st) 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 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 for j:=1 to n 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 begin for j:=1 to n write(' ',a[i,j]:4); writeln; end; end; begin clrscr; write(' Nhap m,n:');readln(m,n); (10) 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 write(' ',a[i]); writeln; end; begin clrscr; write(' Nhap so de tinh day fibonaci:');readln(n); write(' Nhap so de kiem tra xem co day fibonaci khong:');readln(m); fibonaci; d:=0; for i:=1 to n if a[i]=m then d:=d+1; if d=1 then writeln(' So de kiem tra co mat day fibonaci') else writeln(' So kiem tra khong co mat day fibonaci'); readln; end Bài 9: program yen9; (11) 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) 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 for j:=1 to m begin write(' a[',i,',',j,']=');readln(a[i,j]); end; end; procedure xaydung; begin for j:=1 to m begin max:=a[1,j]; for i:=2 to n if a[j,i]>max then max:=a[j,i]; b[j]:=max; (12) end; end; procedure hienthi; begin writeln(' Ma tran vua nhap la:'); for i:=1 to n begin for j:=1 to m write(' ',a[i,j]:4); writeln; end; writeln; write(' Day gom cac so max la:'); for i:=1 to m 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 for j:=1 to m begin write(' a[',i,',',j,']=');readln(a[i,j]); end; end; procedure hienthi; (13) begin writeln(' Ma tran vua nhap la:'); for i:=1 to n begin for j:=1 to m write(' ',a[i,j]:4); writeln; end; writeln; end; procedure nguyento; begin k:=1; for i:=1 to n for j:=1 to m begin d:=0; for t:=1 to a[i,j]-1 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 for j:=1 to m begin for t:=1 to k-1 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; (14) 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 for j:=1 to m 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 begin for j:=1 to m write(' ',a[i,j]:4); writeln; end; writeln; end; procedure sapxep; begin k:=1; for i:=1 to n for j:=1 to m begin b[k]:=a[i,j]; k:=k+1; end; for i:=1 to k-2 for j:=i+1 to k-1 if b[i]>b[j] then begin tg:=b[i]; b[i]:=b[j]; b[j]:=tg; end; (15) k:=1; for i:=1 to n for j:=1 to m begin a[i,j]:=b[k]; k:=k+1; end; writeln(' Ma tran duoc sap xep lai la:'); for i:=1 to n begin for j:=1 to m 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) if s2[i]=s1[1] then begin k:=2;t:=1; for j:=i+1 to (i+length(s1)-1) if s2[j]=s1[k] then begin k:=k+1; t:=t+1; end; if t=length(s1) then d:=d+1; end; (16) if d>0 then begin writeln(' Xau s1 co xuat hien trogn xau s2'); writeln(' Xau s1 xuat hien ',d,' lan xau s2'); end else writeln(' Xau s1 khong xuat hien 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 bang chu cai') else writeln(' Ki tu ',ch,' khong co bang chu cai'); d:=0; for i:=1 to length(st) 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 (17) 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 with sv[i] 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 with sv[i] 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 if sv[i].dtb>7 then begin writeln(' Ho ten:',sv[i].hoten); writeln(' Diem TB:',sv[i].dtb:2:3); (18) 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 with sv[i] 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'); (19) for i:=1 to n with sv[i] 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 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; (20) writeln(' NHAP THONG TIN CHO SINH VIEN'); for i:=1 to n with sv[i] 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 with sv[i] 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 for j:=i+1 to n 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 with sv[i] begin writeln(' Ho ten:',hoten); writeln(' Diem TB:',dtb:2:2); writeln; (21) end; end; begin clrscr; write(' Nhap n=');readln(n); nhap; hienthi; sapxep; readln; end (22)