[pascal thpt]19 bài tập sơ cấp, trung cấp

[VạnKiếpBấtPhục]

1.VCT tính điểm trung bình 3 môn toán lý hóa theo hệ số 2 1 1 sau đó xếp loại như sau:
a. Loại giỏi: ĐTB>= 8.0 và không có môn nào dưới 6,5
b. Loại khá: 6.5<=ĐTB<=8.0 và không có môn nào dưới 5

c. Loại Trung bình: 5.0<=ĐTB<=6.5 và không có môn nào dưới 3.5
d. Còn lại

program xep_loai_hoc_sinh;
uses crt;
var t,l,h,tbc, min:real;
      xl:string;

begin
write('moi nhap diem toan,ly,hoa: ');
readln(t,l,h);
min:=l;
if min>t then min:=t;
if min>h then min:=h;
tbc:=(t*2+l+h)/4;
if (tbc>=8) and (min>=6.5) then xl:='Gioi';
   else if (tbc>=6.5) and (min>=5)
           then xl:=’Kha’;
           else if (tbc>=5) and (min>=3.5)
                   then xl:='Trung binh'
                   else xl:='yeu';
writeln(‘Diem trung binh:’,tbc:0:1,’ Xep loai:’,xl);
readln;
end.

 

[VạnKiếpBấtPhục]

2. VCT nhập vào tháng, năm. In ra màn hình tháng đó có bao nhiêu ngày?

var n,t,ngay:integer;
begin
write('nhap thang:');readln(t);
write('nhap nam:');readln(n);
case t of
1,3,5,7,8,10,12: ngay:=31;
4,6,9,11:ngay:=30;
2: if n mod 4 = 0 then ngay :=29
   else ngay:=28;
end;
writeln('Thang:',t,' nam:',n,' co: ',ngay,' ngay');
readln;
end.

 

[VạnKiếpBấtPhục]

3.VCT tìm UCLN và BCNN của 2 số nhập từ bàn phím

var a,b,min,max,ucln:integer;
begin
write('moi nhap hai so can xac dinh: ');
readln(a,b);
max:=a;
min:=b;
if max mod min=0 then ucln:=min
   else if min mod max=0 then ucln:=max
            else 
            begin
            repeat
            if max>min then max:=max-min
               else if max<min then min:=min-max;         
            until max=min;
            ucln:=min;
            end;
write('ucln ',ucln);
write('bcnn ',a*b/ucln:1:1);
readln;
end.

 

[VạnKiếpBấtPhục]

4. VCT giải bài toán cổ: 100 trâu 100 bó cỏ và vừa gà vừa chó 36 con 100 chân

var d,n,g:integer;
begin
for d:=1 to 20 do
    for n:=1 to 33 do
        for g:=1 to 98 do
            if d*5+n*3+g=100
               then writeln('Trau dung:',d,'  trau nam:',n,'  trau gia:',g);
readln;
end.
-----
var i,j:integer;
begin
for i:=1 to 25 do
    for j:=1 to 50 do
     if (i*4+j*2=100) and (i+j=36) then writeln(i,' con cho, ',j,' con ga.');
readln;
end.

 

[VạnKiếpBấtPhục]

5.VCT xuất các số nguyên tố từ n tới m

[/B]var   j,n,m,i:integer;
function ktranto(x:integer):boolean;
begin
ktranto:=true;
for i:=2 to x -1 do
    if x mod i=0 then ktranto:=false;
end;
begin
write('moi nhap n,m: ');
readln(n,m);
for j:=n to m do
   if ktranto(j) then writeln(j);
readln;
end.
[B]

 

[VạnKiếpBấtPhục]

6. VCT xuất các số hoàn hảo từ n đến m

[/B]var x,tu,j,i,n,m:integer;
function ktrahhao(x:integer):boolean;
begin
tu:=0;
ktrahhao:=false;
for i:=1 to x div 2 do
    if x mod i=0 then tu:=i+tu;
if tu=x then ktrahhao:=true;
end;
begin;
write('moi nhap n,m: ');
readln(n,m);
for j:=n to m do
    if ktrahhao(j) then writeln(j);
    readln;
end.
[B]

 

[p0pc0rnbaby]

Mấy bài pascal này hồi học lớp 9 đụng là làm hí hoáy chẳng nghỉ ngợi! Lên 11 thì...

 

[VạnKiếpBấtPhục]

7. VCT tạo một mảng số nguyên gồm n phần tử nhỏ hơn 1000. Sắp xếp theo thứ tự tăng dần và giảm dần

const n=10;
var i,j,tam:integer;
    a:array[1..n]of integer;
begin
randomize;
for i:=1 to n do a[i]:=random(1000);
for i:=1 to n-1 do
    for j:=i+1 to n do
        if a[i]<a[j] then
           begin
           tam:=a[i];
           a[i]:=a[j];
           a[j]:=tam;
           end;
for i:=1 to n do
    writeln(a[i]);
readln;
end.

 

[VạnKiếpBấtPhục]

8. VCT đọc 1 số có 3 chữ số từ bàn phím

uses crt;
Var s:array[1..9] of string;
    a,b,c,n:integer;
begin
clrscr;
repeat
write('nhap so nguyen n:');readln(n);
until (n>99)and(n<1000);
a:=n div 100;
b:=n div 10 mod 10 ;
c:=n mod 10;
s[1]:='mot';
s[2]:='hai';
s[3]:='ba';
s[4]:='bon';
s[5]:='nam';
s[6]:='sau';
s[7]:='bay';
s[8]:='tam';
s[9]:='chin';
if (b=0)and(c=0) then write(s[a],'tram');
if (b=0)and(c<>0)then write(s[a],'tram linh',s[c]);
if (b<>0)and (c=0)then write(s[a],'tram',s[b],'muoi');
if (b<>0)and(c=5)then write(s[a],'tram',s[b],'lam');
if (b<>0)and(c<>0)and(c<>5)then write(s[a],'tram',s[b],'muoi',s[c]);
readln; 
end.

 

[VạnKiếpBấtPhục]

9. VCT sửa danh từ riêng nhập sai ( Ví dụ: TraN QuAnG KhAi -> Tran Quang Khai )

uses crt;
var s:string;
    i:integer;
begin
write('nhap mot danh tu rieng:');readln(s);
while s[1]=#32 do delete(s,1,1);
while s[length(s)]=#32 do delete(s,length(s),1);
while pos(#32#32,s)<>0 do delete(s,pos(#32#32,s),1);
for i:=1 to length(s) do
    if (s[i]>=' A')AND(s[i]<='Z')then s[i]:=chr(ord(s[i])+32) ;
s[1]:=upcase(s[1]);
for i:=1 to length(s) do
if s[i]=#32then s[i+1]:=upcase (s[i+1]);
write('danh tu duoc sua lai la:',s);
readln; end.

 

[VạnKiếpBấtPhục]

10. VCT in ngược các từ của 1 xâu, mỗi từ in ra trên 1 dòng và xuất ra số ký tự của mỗi từ
VD: Tran Quang Khai -> Khai :4 ky tu
Quang: 5 ky tu
Tran: 4 ky tu

[/B]uses crt;
var s,s1,s2,t:string;
    a:array[1..100] of string;
    b:array[1..100] of integer;
    i,j,k:integer;
begin
clrscr;
write(' Nhap xau s:');readln(s);
s:=s+' ';
for i:= 1 to length(s) do
    if s[i]<>#32 then t:=t+s[i]
       else begin
            inc(j);
            a[j]:=t;
            t:='';
            end;
for i:=1 to j do b[i]:=length(a[i]);
for k:=i downto 1 do writeln(a[k]:20,'  :',b[k]:4,' ky tu');
readln;
end.
[B]

 

[VạnKiếpBấtPhục]

11. VCT tách 1 xấu S ra làm 4 xâu: S1: chứa các kí tự HOA, S2: chứa các kí tự thường, S3: chứa các số từ 0 tới 9, S4: chứa các ký tự khác

[/B]uses crt;
var hoa,thuong,so:set of char;
    s,s1,s2,s3,s4:string;
    i:integer ;
begin
clrscr;
write('nhap xau s:');readln(s);
hoa:=['A'..'Z'];
thuong:=['a'..'z'];
so:=['0'..'9'];
for i:=1 to length(s) do
    if s[i] in hoa then s1:=s1+s[i]
       else if s[i] in thuong then s2:=s2+s[i]
           else if s[i] in so then s3:=s3+s[i]
                else s4:=s4+s[i];
writeln(s1:6);
writeln(s2:6);
writeln(s3:6);
writeln(s4:6);
readln;
end.
[B]

 

[VạnKiếpBấtPhục]

12. VCT làm thay đổi chức năng phím CAPSLOCK, khi tắt Caps ta gõ chữ cái thì xuất hiện chữ hoa, ngược lại, khi bật Caps thì viết ra chữ thường.

[/B]uses crt;
var hoa,thuong:string;
    ch,t,h:char;
Begin
clrscr;
for t:='a'to'z'do thuong:=thuong+t;
for h:='A'to'Z'do hoa:=hoa+h;
repeat
ch:=readkey;
if pos(ch,thuong)<>0 then ch:=upcase(ch)
   else if pos(ch,hoa)<>0 then ch:=chr(ord(ch)+32);
write(ch);
until ch=#13;
end.
[B]

 

[VạnKiếpBấtPhục]

13.VCT nhập các kí tự từ bàn phím không cho hiện kí tự này lên mà chỉ hiện dấu * như kiểu mật khẩu. Hỏi có hiện mật khẩu không. Nếu có thì xuất dãy vừa nhập.

uses crt;
var s:string;
    ch,tl:char;
Begin
clrscr;
write('Nhap mat khau:');
repeat
ch:=readkey;
write('*');
s:=s+ch;
until ch=#13;
writeln;
write('Co hien mat khau khong(c/k):');readln(tl);
if upcase(tl)='C' then write(' Mat khau la:',s);
readln;
end.

 

[VạnKiếpBấtPhục]

14. VCT đổi 1 số <4000 ra số La mã (L=50, C=100, D=500, M=1000)

var a,x,y,w,z:integer;
    n: array [0..3] of string;
    t: array [0..9] of string;
    c: array [0..9] of string;
    d: array [0..9] of string;
begin
n[1]:='C';n[2]:='CC';n[3]:='CCC';
t[1]:='M';t[2]:='MM';t[3]:='MMM';t[4]:='MD';
    t[5]:='D';t[6]:='DM';t[7]:='DMM';t[8]:='DMMM';t[9]:='MC';
c[1]:='X';c[2]:='XX';c[3]:='XXX';c[4]:='XL';
    c[5]:='L';c[6]:='LX';c[7]:='LXX';c[8]:='LXXX';c[1]:='XM';
d[1]:='I';d[2]:='II';d[3]:='III';d[4]:='IV';
    d[5]:='V';d[6]:='VI';d[7]:='VII';d[8]:='VIII';d[1]:='IX';
{I$-}
repeat
write('moi nhap so: ');
readln(a);
until (a<4000) and (IOResult=0);
{I$+}
x:=a div 1000;
y:=a mod 1000 div 100;
w:=a mod 100 div 10;
z:=a mod 10;
write(n[x],t[y],c[w],d[z]);
readln;
end.

 

[VạnKiếpBấtPhục]

15. Viết chương trình điều chỉnh 1 số nguyên bị nhập sai từ bàn phím. Sau đó sẽ cho biết số nhập sai và số đã sửa nếu người dùng yêu cầu
Ví dụ: Nhập 23vsdjvs44 thì chương trình sẽ sửa là 2344

[/B]var s,s1:string;
    i,j:integer;
    so:set of char;
    tloi:char;
begin
readln(s);
so:=['0'..'9'];
for i :=1 to length(s) do if s[i]in so then s1:=s1+s[i];
write('Co hien so khong (c/k)');readln(tloi);
if upcase(tloi)<>'C' then write('Tam biet')
  else if length(s1)<length(s)then write('Ban nhap so sai: ',s,' sua lai la: ',s1)
         else write('Ban nhap so chinh xac:',s);readln;
end.
[B]

 

[VạnKiếpBấtPhục]

16. Nhập 1 xâu S bao gồm số và kí tự, in ra xâu đã sắp xếp số theo thứ tự tăng dần còn vị trí các kí tự vẫn giữ nguyên?

var a:array[1..100]of integer;
   s,s1,s2:string;
    i,X,c,tam,j,n:integer;
    so  : SET OF integer;
Begin
so:=['0'..'9'];
readln(s);
for i:=1 to length(s) do
 if (s[i] in so) then
 begin
 val(s[i],x,c);
 j:=j+1;
 a[j]:=x
 end;
for i:=1 to j-1 do
    for n:=i+1 to j do
        if a[i]>a[n] then
        begin
        tam:=a[i];
        a[i]:=a[n];
        a[n]:=tam;
        end;
for i:=1 to j do
    begin
    str(a[i],s1);
    s2:=s2+s1;
    end;
n:=0;s1:='';
for i:=1 to length(s) do if s[i] in so then
    begin
    inc(n);
    delete(s,i,1);
    insert(s2[n],s,i);
    end;
write(s);
readln;
end.

 

[VạnKiếpBấtPhục]

17. VCT cho nhập 1 xâu kí tự trong đó có lẫn vào 1 số có 3 chữ số - có kiểm tra việc nhập sai và cho phép nhập lại. Kiểm tra cho biết số đó có phải là số nguyên tố hay không.

var s,s1:string;
    x,vt,c,dem,i:integer;
function ktranto(a:integer):boolean;
begin
ktranto:=true;
for i:=2 to a-1 do
    if a mod i=0 then ktranto:=false;
end;
begin
repeat
dem:=0;
write('moi nhap xau: ');
readln(s);
for i:=1 to length(s) do
    if s[i] in ['0'..'9'] then
       begin
       dem:=dem+1;
       if dem=1 then vt:=i;
       s1:=copy(s,vt,3);
       val(s1,x,c);
       end;
until (c=0) and (x>99) and (dem=3);
if ktranto(x) then write('day la so nguyen to :',x);
readln;
end.

 

[VạnKiếpBấtPhục]

18.VCT kiểm tra việc nhập vào 1 kí tự và 1 xâu kí tự bằng kí tự in hoa sau đó cho biết số lần kí tự xuất hiện trong xâu kí tự.

uses crt;
var i,dem:integer;
    ch:char;
    s:string;
begin
clrscr;
repeat
write('moi nhap ki tu: ');
readln(ch);
until ch in ['A'..'Z'];
repeat
write('moi nhap xau ki tu: ');
readln(s);
dem:=0;
for i:=1 to length(s) do
    if s[i] in ['A'..'Z'] then inc(dem);
until dem=length(s);
dem:=0;
for i:=1 to length(s) do
    if ch=s[I] then inc(dem);
write(ch,' xuat hien ',dem, ' trong ', s);
readln;
end.

 

[VạnKiếpBấtPhục]

19. VCT nhập vào 2 xâu S và S1 và in ra kí tự chung của 2 xâu

var s,s1,s2:string;
    i:integer;
begin
write('moi nhap sau thu nhat: ');
readln(s);
write('moi nhap sau thu hai: ');
readln(s1);
i:=1;
repeat
s2:=copy(s,i+1,length(s));
if pos(s[i],s2)<>0 then delete(s,i,1)
    else inc(i);
until pos(s[i],s2)=0;
for i:=1 to length(s) do
    if pos(s[i],s1)<>0 then
       writeln('ki ',s[i],' xuat hien trong ca hai sau');
readln;
end.