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

[thu hà]

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

Code:

[CENTER]
    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.
[/CENTER]

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

Code:

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.

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

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.

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

Code:

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.

​

 

[thu hà]

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

Code:

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.

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

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.

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


Code:

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.

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

Code:

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.

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

Code:

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.

​

 

[thu hà]

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


Code:

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.

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

Code:

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.

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.

Code:

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.

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.

Code:

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.

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

Code:

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.

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

Code:

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.

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?

Code:

    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.

.


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.

Code:

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.

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ự.

Code:

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.

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

Code:

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.

​