Các bài tập Pascal cơ bản

Sau đây là đề...

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<n,m<n7)

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)

---

Sau đây là lờ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')

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< readln; nguyento; nhap;>

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< readln; nhap; tang; timmax;>

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< readln; nhap; kiemtra; :',m:2:3); cong bing Trung writeln(' m:="tbc;">

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< readln; nhap; hienthi; xaydung;>

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< readln; nguyento; nhap; hienthi;>

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< readln; nhap; hienthi; sapxep;>

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;

SACH 

writeln('                                                DANH 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.

program baitap;

uses crt;

var x:array[1..8]of integer;

a:array [1..8]of boolean;

b:array[-7..7]of boolean;

c:array[2..16]of boolean;

k,i:integer;

procedure khoitao;

begin

for i:=1 to 8 do

a[i]:=true;

for i:=-7 to 7 do

b[i]:=true;

for i:=2 to 16 do

c[i]:=true;

end;

procedure ghinhan;

begin

for i:=1 to 8 do

write(x[i]);

writeln;

k:=k+1;

end;

procedure try(i:integer );

var j:integer;

begin

for j:=1 to 8 do

if a[j] and b[i-j] and c[i+j] then

begin

x[i]:=j;

a[j]:=false;

b[i-j]:=false;

c[i+j]:=false;

if i=8 then begin ghinhan;

a[j]:=true;

b[i-j]:=true;

c[i+j]:=true;

end

else

begin

try(i+1);

a[j]:=true;

b[i-j]:=true;

c[i+j]:=true;

end;

end;

end;

BEGIN

clrscr;

khoitao;

writeln;

writeln;

try(1);

writeln('co the sap xep duoc ',k,' cach');

readln;

END.

• Đề:
  
  Tính giá trị biểu thức bằng pascal :(
  
  1-x2/2!+x4/4!-x6/6!...
  
  
  
  Quote

1-x2/2!+x4/4!-x6/6!...

Đây là x^2 hay là 2*x .

Đây là x^2 hay là 2*x .

Cái này Em cứ copy vào notepad rùi đổi đuôi thành .Pas là được. Sau đó lưu thành file.