Một số bài toán viết bằng ngôn ngữ pascal

Bài 1: Lập hàm tính giá trị hàm số:
a) f(x) = ?

Code:

Code:
program p1b1a;
var x:real;
function hamso1(var x:real) :real;
var f:real;
begin
    if x> (-5) then f:=(sqr(x)+1)/sqrt(exp(5*ln(x))+3)
              else f:=(ln(abs(x+5))/ln(3));
    hamso1:=f;
end;
begin
    write('Nhap x= ');
    readln(x);
    write('gia tri ham so f=',hamso1(x):10:5);
    readln;
end.


b)f(x) = ?

Code:

program p1b1b;
var x:real;
function hamso2(var x:real) :real;
var f: real;
begin
    if x>1 then f:= ln(abs(x/(2+exp(x*ln(5)))))/ln(3)
            else f:= (2*exp(7*ln(x)+sin(exp(ln(x-1)*1/3))))/cos(5*x);
    hamso2:=f;
end;
begin
    write('Nhap gia tri x=');
    readln(x);
    write('Gia tri ham so f=',hamso2(x):10:5);
    readln;
end.

Bài 4: Nhập vào 2 số nguyên dương a,b, in ra màn hình UCLN, BCNN của chúng. Mở rộng: Nhập vào n số nguyên dương, in ra màn hình UCLN, BCNN của n số đó.

Thuật toán:
***tìm ước chung lớn nhất của dãy***
B1: Nhập số n
B2: Khởi tạo i bằng 1.
B3: Nhập số thứ i
B4: nếu iB5: Gán biến min bằng giá trị a[1]
B6: Khởi tạo i bằng 1.
B7: Nếu min>a[i] thì gán min bằng giá trị của a[i]
B8: nếu iB9: Khởi tạo th gán bằng giá trị đúng
B10: Khởi tạo i bằng 1
B11: nếu phần dư của a[i] chia cho min khác 0 thì gán th bằng sai
B12: nếu iB13: nếu th là đúng thì ước chung lớn nhất là min và chuyển tới bước 18.
B14: khởi tạo giá trị của j là phần nguyên của min chia 2.
B15: khởi tạo tk là đúng, khởi tạo i bằng 1
B16: nếu phần nguyên của a[1] chia cho j khác 0 thì gán tk bằng sai, giảm j đi 1
B17: nếu tk là sai thì quay lại bước 15 nếu không thì ước chung lớn nhất nhận giá trị là j+1.
B18: In ra màn hình giá trị ước chung lớn nhất đó.
***tìm bội chung nhỏ nhất của dãy***
B1: Nhập số n
B2: Khởi tạo i bằng 1.
B3: Nhập số thứ i
B4: nếu iB5: Gán biến max bằng giá trị a[1]
B6: Khởi tạo i bằng 1.
B7: Nếu maxB8: nếu iB9: Khởi tạo th gán bằng giá trị đúng
B10: Khởi tạo i bằng 1
B11: nếu phần dư của max chia cho a[i] khác 0 thì gán th bằng sai
B12: nếu iB13: nếu th là đúng thì bội chung nhỏ nhất là max và chuyển tới bước 18.
B14: khởi tạo giá trị của j là max nhân với 2.
B15: khởi tạo tk là đúng, khởi tạo i bằng 1
B16: nếu phần nguyên của j chia cho a[i] khác 0 thì gán tk bằng sai, tăng j thêm 1
B17: nếu tk là sai thì quay lại bước 15 nếu không thì bội chung nhỏ nhất nhận giá trị là j.
B18: In ra màn hình giá trị bội chung nhỏ nhất đó.
Code:

Code:

program p1b4;
type arra= array[1..1000] of integer;
var a: arra;
    i,j,n, max,min :integer;
function ucln(var a:arra; var n, min :integer) :integer;
var th, tk : boolean;
    f: integer;
begin
    th:=true;
    for i:=1 to n do begin
                        if a[i] mod min <> 0 then th:= false;
                    end;
  if th= true then f:=min
  else begin
            j:=(min div 2);
            repeat
            tk:=true;
            for i:=1 to n do
            if ((a[i] mod j) <> 0) then tk:=false;
  j:=j-1;

            until tk= true;
            f:=j+1;

        end;
    ucln:=f;

end;
function bcnn(var a:arra; var n, max:integer) :longint;
var  th,tk : boolean;
    f: integer;
begin
    th:=true;
for i:=1 to n do if max mod a[i] <>0 then th:=false;
    if th= true then f:=max
    else begin
              max:=max*2;
            repeat
            tk:=true;
            for i:=1 to n do if max mod a[i]<>0 then tk:=false;

            max:=max+1;
            until tk = true;
            f:=max-1;
        end;
    bcnn:=f;
end;
begin
    write('nhap so  so nguyen n=');
    readln(n);
    writeln(' nhap day so nguyen');
    for i:=1 to n do  begin
                        write('a[',i,']=');
                      read(a[i]);
                      end;
    max:=a[1];
    for i:=1 to n do if a[i]>max then max:=a[i];
    min:=a[1];
    for i:=1 to n do if a[i]<min then min:=a[i];
    writeln('ucln la: ',ucln(a,n,min));
    writeln('bcnn la: ',bcnn(a,n,max));
    readln;
end.

Bài 5: Nhập vào một số nguyên dương n (n<=50000), cho biết số đó có phải là một số nguyên tố hay không?
Thật toán:
B1: Nhập số nguyên dương n
B2: khởi tạo giá trị tk là đúng, giá trị i là 2.
B3: nếu phần nguyên của n chia cho i bằng 0 thì gán tk là sai
B4: so sánh nếu i< phần nguyên của n chia cho 2 thì tăng i thêm 1 và quay trở lại bước 3.
B5: Nếu tk là đúng thì n chính là số nguyên tố nếu không thì n không là số nguyên tố.
Code:

Code:

program p1b5;
var n, i: longint;
    tk:boolean;
begin
    write('nhap so nguyen duong (n<=50000) n=');
    readln(n);
    tk:=true ;
    for i:=2 to (n div 2) do
        if n mod i =0 then tk:=false;
    if tk= true then writeln('n la so nguyen to')
        else writeln('n khong la so nguyen to');
    readln;
end.

Bài 6: Nhập vào một số nguyên dương n (n<=50000). In ra tất c các số nguyên tố nhỏ hơn hoặc bằng n.
Thuật toán:
B1: Nhập số nguyên dương n
B2: khởi tạo i bằng 2.
B3: Khởi tạo tk bằng đúng, giá trị j là 2
B4: nếu phần nguyên của i chia cho j bằng 0 thì gán tk là sai
B5: so sánh nếu j< phần nguyên của i chia cho 2 thì tăng j thêm 1 và quay trở lại bước 3.
B6: Nếu tk là đúng thì in ra màn hình giá trị của i
B7: Nếu i <n thì tăng i thêm 1 và quay lại bước 3
Code:

Code:

program p1b6;
var  i,j,n : longint;
    tk: boolean;
begin
    write('nhap so nguyen duong n=');
    readln(n);
    write('cac so nguyen to tu 1 toi n la:') ;
    for i:=2 to n do  begin
        tk:=true;
        for j:=2 to i div 2 do  if i mod j =0 then tk:=false;
        if tk= true then write(' ',i,'  ');
                    end;
    readln;
end.

Bài 7: Lập một hàm với dữ liệu đầu vào là một số nguyên n, đầu ra là tổng lập phương n số chẵn tự nhiên đầu tiên: 23 +43+63+…+(2n.)3.
Thuật toán:
B1: Nhập số nguyên n
B2: gán s bằng 0, i bằng 1
B3: gán s bằng s cộng thêm lập phương của 2 nhân i
B4: nếu i<n thì tăng i thêm 1 đơn vị và quay lại bước 3.
B5: in ra màn hình giá trị của s
Code:

Code:

program p1b7;
var s:real;
    i, n :integer;
function tonglap(var n:integer):real;
begin

      s:=0;
      for i:=1 to n do begin
                      s:=s+exp(3*ln(2*n));
                      end;
      tonglap:=s;
end;
begin
    write(' nhap so nguyen n=');
    readln(n);
    write(' tong lap phuong n so chan dau tien=',tonglap(n):10);
    readln;
end.

Bài 8: Lập một hàm, đầu vào là 3 số nguyên a,b,c, đầu ra là xâu ký tự "Đúng" hoặc "Sai" tưng ứng a,b,c là một ngày tháng năm nào đó hoặc không phi. Ví dụ: a=2,b=13,c=1234 thì hàm trả về giá trị "Sai", nếu a=2,b=3,c=1234 thì hàm trả về giá trị "Đúng".

Code:

program p1b8;
type str5=string[5];
var  f: string[5];
    x,y,a,b :byte;
    z, c: integer;
function dungsai(var x, y :byte; var z:integer): str5;
begin
    if ((x=29) and (y=2) and ((z div 4 =0) or((z div 100 =0) and(z div 400=0)))) then f:='sai';
    if (((x>0)and(x<32)) and  ((y>0)and(y<13)) and  (z>0)) then f:='dung'
                                                          else f:='sai';
    dungsai:=f;
end;
begin
    writeln(' nhap lan luot cac gia tri ');
    write(' a='); readln(a);
    write(' b='); readln(b);
    write(' c='); readln(c);
    write(' ket qua la: ',dungsai(a,b,c));
    readln;
end.

Bìa 9: Lập một hàm với đầu vào là một số nguyên k (1<=k<=7), đầu ra là xâu ký tự biểu diễn "thứ " k trong tuần. Ví dụ k=4, thì hàm trả về xâu "thứ tư

Code:

program p1b9;
type str=string[15];
var  k:byte;
function doingay(var k: byte) :str;
var f:string[15];
begin
    case k of
        1: f:='chu? nha^.t';
        2: f:='thu hai';
        3: f:='thu ba';
        4: f:='thu tu';
        5: f:='thu nam';
        6: f:='thu sau';
        7: f:='thu bay?';
    end;
    doingay:=f;
end;
begin
    write(' nhap so k tu 1 toi 7 la:');
    readln(k);
    while
    ( k>7 )or (k <1)
    do begin
            write('nhap sai roi, nhap lai k=');
            readln(k);

        end;
      writeln(' ngay do la ',doingay(k));
      readln;
end.

Bài 10:=Lập hàm với tên hàm là SONGAY, đầu vào là 3 số nguyên biểu diễn ngày, tháng, năm. Đầu ra là số ngày tính từ 1/1/1 đến ngày tháng năm đó. Biết rằng năm nhuận có 366 ngày, năm thường có 365 ngày và năm nhuận là năm chia hết cho 4, đồng thời nếu năm chia hết cho 100 thì cũng phải chia hết cho 400.

Code:

program p1b10;
var a,b:byte;
    c:integer;
function songay(var a,b:byte; var c:integer) : longint;
var s,i:longint;
begin
    s:=0;
    {nam nhuan thi co 366 ngay}
    for i:=1 to c-1 do begin
        if ((i mod 4 =0) or((i mod 100=0) and (i mod 400=0)))then s:=s+366
                                    else s:=s+365;
                      end;
      {cong them so ngay a  }
      s:=s+a;
      {cong them ngay cua thang du}
      for i:=1 to b do begin
          if i mod 2=0 then s:=s+30;
          if i mod 2<>0 then s:=s+31;
          end;
      {nam nhuan thi thang 2 co 29 ngay con binh thuong thi thang 2 co 28 ngay}
      {neu nam c la nam nhuan thi ta phai tru di 1 ngay}

      if (b<2) and ((c mod 4=0)or((c mod 100=0) and (c mod 400=0))) then s:=s-1;
      if(b>1)and ((c mod 4=0)or((c mod 100=0)and(c mod 400=0))) then if b>1 then s:=s-2;
      songay:=s;
end;
begin
    writeln('nhap lan luot ngay thang nam ');
    write('ngay:');readln(a);
    write('thang:');readln(b);
    write('nam:');readln(c);
    write('so ngay la:',songay(a,b,c));
    readln;
end.

Bài 11: Biết ngày 1/1/1 là thứ 2, hãy nhập một ngày tháng năm nào đó, cho biết ngày đó là thứ mấy. Yêu cầu lập hàm, đầu vào là ngày, tháng, năm, đầu ra là thứ tương ứng của ngày tháng năm đó.

Code:

Program p1b11;
type str =string[15];
var  k,a,b:byte;
   c:integer;
function doingay(var k: byte) :str;
var f:string[15];
begin
    case k of
        6: f:='chu? nha^.t';
        0: f:='thu hai';
        1: f:='thu ba';
        2: f:='thu tu';
        3: f:='thu nam';
        4: f:='thu sau';
        5: f:='thu bay?';
    end;
    doingay:=f;
end;
function songay(var a,b:byte; var c:integer) : str;
var s,i:longint;
begin
    s:=0;
    {nam nhuan thi co 366 ngay}
    for i:=1 to c-1 do begin
        if ((i mod 4 =0) or((i mod 100=0) and (i mod 400=0)))then s:=s+366
                                    else s:=s+365;
                      end;
      {cong them so ngay a  }
      a:=a-1;
      s:=s+a;
      {cong them ngay cua thang du}
      for i:=2 to b do begin
          if i mod 2=0 then s:=s+30;
          if i mod 2<>0 then s:=s+31;
          end;
      {nam nhuan thi thang 2 co 29 ngay con binh thuong thi thang 2 co 28 ngay}
      {neu nam c la nam nhuan thi ta phai tru di 1 ngay}

      if (b<2) and ((c mod 4=0)or((c mod 100=0) and (c mod 400=0))) then s:=s-1;
      if (b>1) and ((c mod 4=0)or((c mod 100=0)and(c mod 400=0)))then s:=s-1 else if b>1 then s:=s-2;
   k:= s mod 7;
   songay:=doingay(k);
end;
begin
writeln('nhap lan luot ngay thang nam ');
    write('ngay:');readln(a);
    write('thang:');readln(b);
    write('nam:');readln(c);
writeln('ngay do la ',songay(a,b,c));
readln;
end.

Bài 12: Lập một hàm 'Chuẩn hoá xâu họ tên', đầu vào là một xâu ký tự họ và tên của một người nào đó, đầu ra là xâu họ tên đã được chuẩn hoá: Không có các ký tự trống ở 2 đầu, các ký tự đầu của mỗi từ là chữ cái Hoa, các ký tự còn lại của từ đó là chữ cái thường đồng thời 2 từ cách nhau đúng một dấu cách.
Ví dụ: “ NgUyễn văn thắNg “, hàm phải cho lại kết quả là xâu "Nguyễn Văn Thắng".
Thuật toán:
B1: Nhập xâu x cần chuẩn hóa
B2: chừng nào kí tự đầu tiên của xâu x là dấu cách thì xóa 1 kí tự từ vị trí thứ nhất của xâu x.
B3: Chừng nào kí tự cuối cùng của xâu x là dấu cách thì xóa 1 kí tự từ vị trí cuối cùng của xâu x.
B4: khởi tạo giá trị i bằng 1
B5: Chừng nào kí tự thứ i và thứ i+1 cùng là dấu cách thì xóa bỏ 1 kí tự bắt đầu từ kí tự thứ i trong xâu x.
B6: nếu i < độ dài xâu x thì tăng i thêm 1 và quay lại bước 5.
B7: khởi tạo i bằng 1
B8: nếu kí tự thứ i khác dấu cách thì đổi về kí tự chữ thường
B9: tăng i thêm 1 đơn vị và quay lại bước 8
B10: đổi kí tự đầu tiên thành kí tự in hoa, khởi tạo i bằng 1
B11: nếu kí tự i là dấu cách thì biến đổi kí tự thứ i+1 thành chữ hoa
B12: nếu i< độ dài xâu x thì tăng i thêm 1 và quay lại bước 11
B13: in xâu x vừa sửa ra màn hình.

Code:

program p1b12;
var x:string;
    i,j:integer;
function chuanhoa( var x: string):string;
begin
    while
    x[1]=' '
    do delete(x,1,1);
    while
    x[length(x)]=' '
    do delete(x,length(x),1);
     for i:=1 to length(x) do
    while
    ( x[i]=' ' )and (x[i+1]=' ')
    do delete(x,i,1);
    {bien ca xau thanh in hoa}
    for i:=1 to length(x) do  begin
          x[i]:=upcase(x[i]);
          if x[i] <> ' 'then x[i]:=chr(ord(x[i])+32);
                              end;
    x[1]:=upcase(x[1]);
    for i:=1 to length(x) do if x[i]=' ' then x[i+1]:=chr(ord(x[i+1])-32);
 chuanhoa:=x;
end;
begin
    write('nhap xau x:');
    readln(x);
    write('chuanhoa:',chuanhoa(x));
    readln;
end.

Bài 15: Cho một dãy số nguyên gồm n phần tử.
b- Nhập dãy số (n nhập từ bàn phím, 1<=n<=100).
c- In dãy vừa nhập ra màn hình.
d- Sắp xếp dãy theo chiều tăng dần, viết dãy sau khi sắp xếp ra màn hình.
Thuật toán:
B1: nhập n
B2: khởi tạo i bằng 1
B3: nhập giá trị thứ i
B4: nếu iB5: khởi tạo I bằng 1
B6: in ra màn hình giá trị thứ i
B7: nếu IB8: khởi tạo I bằng 1
B9: khởi tạo j bằng i+1
B10: nếu giá trị thứ I lớn hơn giá trị thứ j thì đổi giá trị của I cho j.
B11: nếu jB12: nếu iB13: khởi tạo giá trị I bằng 1
B14: in ra màn hình giá trị thứ i
B15: nếu i Code:

Code:

program p2b15;
var a:array[1..100] of integer;
    i, j, tg,n:integer;
begin
    write('nhap gia tri n=');
    readln(n);
    for i:=1 to n do begin
                          write('a[',i,']=');
                          readln(a[i]);
                      end;
    writeln('in day so ra man hinh');
    for i:=1 to n do      writeln('a[',i,']=',a[i]);
    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;
    writeln('in day vua sap xep ra man hinh ');
    for i:=1 to n do writeln('a[',i,']=',a[i]);
    readln;
end.

Bài 16: Cho một dãy số nguyên gồm n phần tử (1<=n<=100)
e- Nhập n và dãy số.
f- In dãy vừa nhập ra màn hình.
g- Tìm phần tử lớn nhất, nhỏ nhất, viết giá trị tìm được ra màn hình,
h- In ra màn hình vị trí các phần tử có giá trị bằng giá trị lớn nhất tìm được.
Thuật toán:
B1: nhập n
B2: khởi tạo i bằng 1
B3: nhập giá trị thứ i
B4: nếu iB5: khởi tạo I bằng 1
B6: in ra màn hình giá trị thứ i
B7: nếu IB8: gán max bằng giá trị thứ nhất của dãy, Khởi tạo I bằng 1
B9: nếu giá trị thứ I lớn hơn max thì gán max bằng giá trị thứ i
B10: nếu iB11: in ra man hinh gia trị max
B12: gán min bằng giá trị thứ nhất của dãy, Khởi tạo I bằng 1
B13: nếu giá trị thứ I nhỏ hơn min thì gán min bằng giá trị thứ i
B14: nếu iB15: in ra man hinh gia trị min
B16: Khởi tạo giá trị I bằng 1
B17: nếu max bằng giá trị thứ I thì in ra màn hình vị trí i
B18: nếu I < n thì tăng I thêm 1 và quay lại bước 17
Code:

Code:

program p2b16;
var  a:array[1..100] of integer;
    i,max,min,n:integer;
begin
    write('nhap n=');
    readln(n);
    for i:=1 to n do begin
                          write('a[',i,']=');
                          readln(a[i]);
                          end;
    writeln('in day so vua nhap ra man hinh');
    for i:=1 to n do writeln('a[',i,']=',a[i]);
    max:=a[1];
    min:=a[1];
    for i:=1 to n do if max <a[i] then max:=a[i];
    for i:=1 to n do if min >a[i] then min:=a[i];
    writeln('max=',max);
    writeln('min=',min);
    write('vi tri cac phan tu co gia tri bang max la:');
    for i:=1 to n do if a[i]=max then write(' ',i,',' );
    readln;
end.

Bài 17: Cho một dãy số nguyên gồm n phần tử.
i- Nhập dãy số (n nhập từ bàn phím, 1<=n<=100).
j- In dãy vừa nhập ra màn hình.
k- Tính tổng các phẩn tử dương lẻ.
l- Sắp xếp dãy sao cho các số âm đứng ở đầu dãy, các só dương ở cuối dãy đồng thời các số âm giảm dần, các số dương tăng dần. ví dụ: dãy ban đầu {1, -3, -6, 4, 9, 12, -4, 7, 3, 23, -2} thì dãy sau khi sắp phải là dãy {-2, -3, -4, -6, 1, 3, 4, 7, 9, 12}

Thuật toán:
B1: nhập n
B2: khởi tạo i bằng 1
B3: nhập giá trị thứ i
B4: nếu iB5: khởi tạo I bằng 1
B6: in ra màn hình giá trị thứ i
B7: nếu IB8: gán tổng bằng 0 và khởi tạo I bằng 1
B9: nếu gán trị thứ I lớn hơn 0 và phần dư của nó chia cho 2 khác 0 thì gán tổng bẳng tổng cộng thêm giá trị thứ i
B10: nếu iB11: in ra màn hình giá trị tổng
B12: khởi tạo I bằng 1
B13: khởi tạo j bằng i+1
B14: nếu giá trị thứ i lớn hơn giá trị thứ j thì đổi chỗ 2 giá trị cho nhau
B15: nếu jB16: nếu i < n-1 thì tăng i thêm 1 và quay lại bước 13
B17: khởi tạo i bằng 1
B18: khởi tạo j bằng i+1
B19: nếu giá trị thứ i nhỏ hơn giá trị thứ j và nhỏ hơn 0 thì đổi chỗ 2 giá trị cho nhau
B20: nếu j< n thì tăng j thêm 1 và quay lại bước 19
B21: nếu iB22: khởi tạo i bằng 1
B23:in giá trị thứ I ra màn hình
B24:nếu i < n thì tăng I thêm 1 và quay lại bước 23.

Code:

program p2b17;
var a:array[1..100] of integer ;
    i,tg,j,n :integer;
    s:real;
begin
    write('nhap n=');
    readln(n);
    for i:=1 to n do begin
                  write('a[',i,']=');
                  readln(a[i]);
                  end;
    writeln('in ra man hinh day vua nhap');
    for i:=1 to n do writeln('a[',i,']=',a[i]);
    s:=0;
    for i:=1 to n do if ((a[i] > 0) and (a[i] mod 2<>0)) then s:=s+a[i];
    writeln('tong cac phan tu duong le laf s=',s);
    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;
    for  i:=1 to n-1 do
              for j:=i+1 to n do
                  if ((a[i]<0) and (a[j]<0) and (a[i]<a[j])) then begin
                                            tg:=a[i];
                                            a[i]:=a[j];
                                            a[j]:=tg;
                                            end;
    Writeln('in ra man hinh');
    for i:=1 to n do writeln('a[',i,']=',a[i]);
    readln;
end.

Bài 18: Cho một dãy số nguyên gồm n phần tử.
a.Nhập dãy số (n nhập từ bàn phím, 1<=n<=100).
b.In dãy vừa nhập ra màn hình.
c.Nhập vào một số nguyên x, đếm trong dãy có bao nhiêu số bằng x?
d.Sắp dãy theo chiều giảm dần. Viết dãy sau khi sắp ra màn hình.
e.Nhập vào một số nguyên x, chèn x vào dãy đã sắp giảm dần sao cho dãy sau khi chèn x vào vẫn đảm bảo thứ tự giảm dần.
Thuật toán:
B1: nhập n
B2: khởi tạo i bằng 1
B3: nhập giá trị thứ i
B4: nếu iB5: khởi tạo I bằng 1
B6: in ra màn hình giá trị thứ i
B7: nếu IB8: nhập giá trị của x
B9:khởi tạo i bằng 1, đếm bằng 0
B10: nếu giá trị thứ i bằng x thì tăng biến đếm thêm 1
B11: nếu i B12: in ra màn hình kết quả của biến đếm
B13: khởi tạo I bằng 1
B14: khởi tạo j bằng i+1
B15: nếu giá trị thứ i nhỏ hơn giá trị thứ j thì đổi chỗ 2 giá trị cho nhau
B16: nếu jB17: nếu i < n-1 thì tăng i thêm 1 và quay lại bước 14
B18: khởi tạo I bằng 1
B19: in ra màn hình giá trị thứ i
B20: nếu iB21: khởi tạo i bằng n
B22: chừng nào giá trị thứ I nhỏ hơn x và I khác 0 thì gán giá trị thứ I vào giá trị i+1 và giảm I đi 1 đơn vị
B24: gán giá trị i+1 bằng x
B25: khởi tạo I bằng 1
B26: in ra màn hình giá trị thứ i
B27: nếu iCode:

Code:

program p2b18;
var a: array[1..101] of integer;
    x,i,n,j,tg,dem :integer;
begin
    write('nhap n=');
    readln(n);
    for i:=1 to n do begin
                write('a[',i,']=');
                readln(a[i]);
                end;
    write('in day vua nhap ra man hinh');
    for i:=1 to n do writeln('a[',i,']=',a[i]);
    write('nhap x=');
    readln(x);
    dem:=0;
    for i:=1 to n do if a[i]= x then dem :=dem+1;
    writeln('trong day co so phan tu bang x la:',dem);
    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;
    writeln(' xap xep day giam dan ');
    for i:=1 to n do writeln('a[',i,']=',a[i]);
    i:=n;
    while
    (a[i]<x ) and (i<>0)
    do  begin
    a[i+1]:=a[i];
    i:=i-1;
    end;
    a[i+1]:=x;
    writeln('in ra man hinh');
    for i:=1 to n+1 do writeln('a[',i,']=',a[i]);
    readln;
end.

Bài 19: Cho một dãy số nguyên gồm n phần tử.
a.Nhập dãy số (n nhập từ bàn phím, 1<=n<=100).
b.In dãy vừa nhập ra màn hình.
c.Nhập vào hai số nguyên x và k (1<=k<=n), chèn số x vào vị trí k của dãy. viết dãy kết qu ra màn hình
Thuật toán:
B1: nhập n
B2: khởi tạo i bằng 1
B3: nhập giá trị thứ i
B4: nếu iB5: khởi tạo I bằng 1
B6: in ra màn hình giá trị thứ i
B7: nếu IB8: nhập x và nhập k
B9: khởi tạo I bằng n
B10: gán giá trị thứ I vào giá trị thứ i+1
B11:nếu i>k thì giảm I đi 1 và quay lại bước 10
B12:gán giá trị thứ k bằng x
B13: khởi tạo I bằng 1
B14: in ra màn hình giá trị thứ i
B15: nếu I

Code:

program p1b19;
var a:array[1..101] of integer;
    x,k,n,i :integer;
begin
    write('nhap n=');
    readln(n);
    for i:=1 to n do begin
                      write('a[',i,']=');
                      readln(a[i]);
                      end;
    writeln(' in dayvua nhap ra man hinh');
    for i:=1 to n do writeln('a[',i,']=',a[i]);
    write(' nhap x=');
    readln(x);
    write('nhap k=');
    readln(k);
    for i:=n downto k do a[i+1]:=a[i];
    a[k]:=x;
    writeln('in day vuathem ra man hinh');
    for i:=1 to n+1 do writeln('a[',i,']=',a[i]);
    readln;
end.

Bài 20: Cho một dãy số nguyên gồm n phần tử.
a.Nhập dãy số (n nhập từ bàn phím, 1<=n<=100).
b.In dãy vừa nhập ra màn hình.
c.Đếm xem trong dãy ban đầu có bao nhiêu giá trị khác nhau
d.Nhập vào một số nguyên k (1<=k<=n). xoá phần tử thứ k trong dãy. viết dãy kết quả ra màn hình.
.
Thuật toán:
B1: nhập n
B2: khởi tạo i bằng 1
B3: nhập giá trị thứ i
B4: nếu iB5: khởi tạo I bằng 1
B6: in ra màn hình giá trị thứ i
B7: nếu IB8:Khởi tạo I bằng 2 và đếm bằng 1
B9: gán th bằng đúng, khởi tạo j bằng 1
B10: nếu giá trị thứ I bằng giá trị thứ j thì th được gán bằng sai
B11: nếu jB12: nếu th là đúng thì tăng biến đếm thêm 1
B13: nếu iB14: in ra màn hình biến đếm
B15:nhập k
B16: khởi tạo I bằng k
B17: gán giá trị của i+1 cho giá trị thứ i
B18: nếu iB19: khởi tạo I bằng 1
B20: in ra màn hình giá trị thứ i
B21: nếu i

Code:

program p2b20;
var a:array[1..100]of integer;
    i,j,n,k,dem:integer;
    th:boolean;
begin
    write('nhap n=');
    readln(n);
    for i:=1 to n do begin
              write('a[',i,']=');
              readln(a[i]);
              end;
    writeln('in day vua nhap ta man hinh');
    for i:=1 to n do writeln('a[',i,']=',a[i]);
    dem:=1;
    for i:=2 to n do begin
                  th:=true;
                  for j:=1 to i-1 do  if a[j]=a[i] then th:=false;
                  if th=true then dem:=dem+1;
                  end;
    writeln('so gia tri khac nhau la:',dem);
write('nhap k=');
    readln(k);
    for i:=k to n-1 do a[i]:=a[i+1];
    writeln('in day vua xoa ra man hinh');
    for i:=1 to n-1 do writeln('a[',i,']=',a[i]);
    readln;
end.

Bài 21: Một dãy số Fibonacci được định nghĩa như sau: f1=f2=1, fn=fn-1+fn-2 với mọi n>=3.
a.Nhập vào một số nguyên dương n, in ra màn hình fn.
b.Nhập vào một số nguyên dương k, cho biết k có là một phẩn tử của dãy Fibonaci hay không?
c.Nhập vào một số nguyên dương k, phân tích k thành tổng ít nhất các số là các phần tử của dãy Fibonacci. Ví dụ; k=16 thì: 16=13+2+1

Thuật toán:
B1: nhập n
B2: nếu n=1 hoặc bằng 2 thì gán fn bằng 1 và chuyển tới bước 6
B3: gán f1 bằng 1, f2 bằng 1, khởi tạo I bằng 0
B4: tăng I lên 1, gán fn bằng f1 cộng f2, gán f1 bằng f2, f2 bằng fn
B5: nếu I khác n-2 thì quay lại bước 4
B6; in ra fn
B7: nhập k
B8: nếu k=1 thì chuyển tới bước 13
B9: gán f1 bằng 1, f2 bằng 1,
B10: fn gán bằng f1 cộng f2,f1 gán bằng f2, f2 gán bằng fn
B11:nếu fn < k thì quay lại bước 10
B12: nếu fn khác k thì in ra k không là phần tử của dãy
B13: k là phần tử của dãy

Code:

program p2b21;
var n,k,m:integer;
function fibonacci(var n:integer): integer;
var i, f1, f2, fn  : integer;
begin
   
    if(( n=1) or( n=2)) then fn:=1 else  begin
                                              f1:=1;
                                              f2:=1;
                                              i:=0;
                                              repeat
                                              i:=i+1;
                                              fn:=f1 +f2;
                                              f1:=f2;
                                              f2:=fn;

                                              until  i = (n-2);
                                          end;
    fibonacci:=fn;
end;
procedure kiemtra( var k: integer);
var fn,f1,f2:integer;
begin
    f1:=1;
    f2:=1;
    if k=1 then writeln('k la 1 phan tu cua day fibonacci');
    repeat
    fn:=f1+f2;
    f1:=f2;
    f2:=fn;
    until fn >=k;
    if k=fn then writeln('k la 1 phan tu cua day fibonacci')
            else writeln('k khong la phan tu cua day fibonacci');

end;
procedure phantich( var m:integer);
var f1,f2,fn,phantich:integer;
begin
    f1:=1;
    f2:=1;
    repeat
    fn:=f1+f2;
    f1:=f2;
    f2:=fn;
    until fn >=m;
    if fn=n then writeln('m=',fn) else
        begin
            write('m=',f1);
            phantich:=f1;
            while
            phantich < m
            do begin
                repeat
                fn:=f1+f2;
                f1:=f2;
                f2:=fn;
                until ((fn + phantich) <m) or ((f1 +phantich)>m);
                phantich:=phantich+f1;
end;
                write('+',f1);
        end;
end;
begin
    write('nhap n=');
    readln(n);
    writeln('f(n)=',fibonacci(n));
    write('nhap so k=');
    readln(k);
    kiemtra(k);
    write('nhap m=');
    readln(m);
    phantich(m);
    readln;
end.

Bài 22: Cho một ma trận số nguyên gồm m dòng, n cột (mng 2 chiều)
a.Nhập ma trận số (m,n nhập từ bàn phím, 1<=m,n<=50).
b.In ma trận ra màn hình.
c.Tìm giá trị lớn nhất, nhỏ nhất.
Thuật toán:
B1: Nhập m,n
B2: khởi tạo I bằng 1
B3: khởi tạo j bằng 1
B4: nhập giá trị cho dòng I cột j
B5: nếu jB6: nếu iB7: khởi tạo I bằng 1
B8: khởi tạo j bằng 1
B9: in giá trị dòng I cột j
B10: nếu jB11: nếu iB12: khởi tạo I bằng 1, gán max bằng giá trị dòng 1 cột 1
B13: khởi tạo j bằng 1
B14: nếu max nhỏ hơn giá trị dòng I cột j thì gán max bằng giá trị của dòng I cột j
B15: nếu jB16: nếu iB17: khởi tạo I bằng 1, gán min bằng giá trị dòng 1 cột 1
B18: khởi tạo j bằng 1
B19: nếu min lớn hơn giá trị dòng I cột j thì gán min bằng giá trị của dòng I cột j
B20: nếu jB21: nếu iB22: in ra max, min
Code:

Code:

program p2b22;
var a:array[1..50,1..50] of integer ;
    i,j,max,min,m,n:integer;
begin
    write('nhap so dong m=');
    readln(m);
    write('nhap so cot  n=');
    readln(n);
    for i:=1 to n do
        for j:=1 to m do begin
                  write('a[',i,',',j,']=');
                  readln(a[i,j]);
                  end;
    writeln('in ma tran ra man hinh');
    for i:=1 to n do begin
        for j:=1 to m do write(' ',a[i,j]:5);
        writeln;
        writeln;
        end;
    min:=a[1,1];
    max:=a[1,1];
    for i:=1 to n do
        for j:=1 to m do begin
                    if max <a[i,j] then max:= a[i,j];
                    if min >a[i,j] then min:= a[i,j];
                        end;
    writeln('max=',max);
    writeln('min=',min);
    readln;

end.

Bài 23: Cho một ma trận số nguyên gồm m dòng, n cột (mng 2 chiều)
a.Nhập ma trận số (m,n nhập từ bàn phím, 1<=m,n<=50).
b.In ma trận ra màn hình.
cIn ma trận chuyển vị.
d.Tính định thức của ma trận.

Thuật toán:
B1: Nhập m,n
B2: khởi tạo I bằng 1
B3: khởi tạo j bằng 1
B4: nhập giá trị cho dòng I cột j
B5: nếu jB6: nếu iB7: khởi tạo I bằng 1
B8: khởi tạo j bằng 1
B9: in giá trị dòng I cột j
B10: nếu jB11: nếu iB12: khởi tạo I bằng 1
B13: khởi tạo j bằng 1
B14: in giá trị dòng I cột j
B15: nếu jB16: nếu iCode:

Code:

program p1b23;
type arr=array[1..50,1..50]of integer;
var  a:array[1..50,1..50] of integer;
    b:array[1..50] of integer;
    i,j,m,n:integer;
function dtc3(var a:arr ):integer;
var s:integer;
begin
      s:=a[1,1]*a[2,2]*a[3,3]+a[1,3]*a[2,1]*a[3,2]+a[3,1]*a[1,2]*a[2,3];
      s:=s-(a[1,3]*a[2,2]*a[3,1]+a[1,1]*a[3,2]*a[2,3]+a[3,3]*a[2,1]*a[1,2]);
      dtc3:=s;
end;
begin
    write('so dong la m=');
    readln(n);
    write('so cot la  n=');
    readln(m);
    for i:=1 to m do
        for j:=1 to n do begin
            write('a[',i,',',j,']=');
            readln(a[i,j]);
            end;
    writeln('in day vua nhap ra man hinh');
    for i:=1 to m do begin
        for j:=1 to n do write(' ',a[i,j]:5);
        writeln;
        writeln;
                end;
    writeln('in ma tran chuyen vi len man hinh');
      for j:=1 to n do  begin
          for i:=1 to m do write(' ',a[i,j]:5);
          writeln;
          writeln;
          end;
writeln('tinh dinh thuc');
readln;
end.

Bài 24: Cho một ma trận số nguyên gồm m dòng, n cột (mng 2 chiều)
a.Nhập ma trận số (m,n nhập từ bàn phím, 1<=m,n<=50).
b.In ma trận ra màn hình.
c.Nhập vào một số nguyên x, đưa ra toạ độ (dòng, cột) của những phần tử có giá trị bằng x. cho biết có bao nhiêu phần tử bằng x?

Thuật toán:
B1: Nhập m,n
B2: khởi tạo I bằng 1
B3: khởi tạo j bằng 1
B4: nhập giá trị cho dòng I cột j
B5: nếu j<n thì tằng j thêm 1 và quay lại bước 4
B6: nếu i<m thì tăng I thêm 1 và quay lại bước 3
B7: khởi tạo I bằng 1
B8: khởi tạo j bằng 1
B9: in giá trị dòng I cột j
B10: nếu j<n thì tằng j thêm 1 và quay lại bước 9
B11: nếu i<m thì tăng I thêm 1 và quay lại bước 10
B12: nhập x
B13: khởi tạo I bằng 1 và gán đếm bằng 0
B14: khởi tạo j bằng 1
B15: nếu x bằng giá trị phần tử dòng I cột j thì in ra I,j và tăng biến đếm lên 1
B16: nếu j<n thì tằng j thêm 1 và quay lại bước 15
B17: nếu i<m thì tăng I thêm 1 và quay lại bước 14
B18: in ra giá trị biến đếm
Code:

Code:

program p2b24;
var a:array[1..50,1..50] of integer;
    j,i,dem,n,m,x:integer;
begin
    write('so dong  m=');
    readln(m);
    write('so cot  n=');
    readln(n);
    for i:=1 to m do
        for j:=1 to n do begin
                  write('a[',i,',',j,']=');
                  readln(a[i,j]);
                          end;
    writeln('in ma tran vua nhap ra man hinh');
    for  i:=1 to m do begin
          for j:=1 to n do write(' ',a[i,j]:5);
          writeln;
          writeln;
          end;
    write('nhap x=');
    readln(x);
    dem:=0;
    writeln('tao do cac phan tu trong mang bang` x la:');
    for i:=1 to m do
        for j:=1 to n do if a[i,j]=x then begin
        write('(',i,',',j,')');
        dem:=dem+1;
        end;
        writeln;
    writeln('so phan tu bang x la:',dem);
    readln;
end.

Bài 25: Cho 2 ma trận số nguyên A và B gồm m dòng, n cột (mng 2 chiều)
a.Nhập hai ma trận số (m,n nhập từ bàn phím, 1<=m,n<=50).
b.In từng ma trận ra màn hình.
c.In ma trận tổng C=A+B ra màn hình. Ma trận tổng C là ma trận mà mỗi phần tử Cij=Aij+ Bij
d.Với giả thiết m=n, in ma trận tích C=A*B ra màn hình. Mỗi phần tử (i,j) của ma trận C được tính theo công thức:
Thuật toán:
B1: Nhập m,n
B2: khởi tạo I bằng 1
B3: khởi tạo j bằng 1
B4: nhập giá trị cho dòng I cột j(nhập ma trận A)
B5: nếu j<n thì tằng j thêm 1 và quay lại bước 4
B6: nếu i<m thì tăng I thêm 1 và quay lại bước 3
B7: khởi tạo I bằng 1
B8: khởi tạo j bằng 1
B9: nhập giá trị cho dòng I cột j(nhập ma trận B)
B10: nếu j<n thì tằng j thêm 1 và quay lại bước 9
B11: nếu i<m thì tăng I thêm 1 và quay lại bước 8
B12: khởi tạo I bằng 1
B13: khởi tạo j bằng 1
B14: in giá trị dòng I cột j( in ma trận A)
B15: nếu j<n thì tằng j thêm 1 và quay lại bước 14
B16: nếu i<m thì tăng I thêm 1 và quay lại bước 13
B17: khởi tạo I bằng 1
B18: khởi tạo j bằng 1
B19: in giá trị dòng I cột j(in ma trận B)
B20: nếu j<n thì tằng j thêm 1 và quay lại bước 19
B21: nếu i<m thì tăng I thêm 1 và quay lại bước 18
B22: khởi tạo I bằng 1
B23: khởi tạo j bằng 1
B24: gán giá trị tương ướng của ma trận C bằng ma trận A cộng ma trận B
B25: nếu j<n thì tằng j thêm 1 và quay lại bước 24
B26: nếu i<m thì tăng I thêm 1 và quay lại bước 23
B27: khởi tạo I bằng 1
B28: khởi tạo j bằng 1
B29: in giá trị dòng I cột j(in ma trận C)
B30: nếu j<n thì tằng j thêm 1 và quay lại bước 29
B31: nếu i<m thì tăng I thêm 1 và quay lại bước 28
B32: khởi tạo I bằng 1
B33: khởi tạo j bằng 1
B34: gán giá trị D(I,j) bằng 0,khởi tạo k bằng 1
B35: gán giá trị D(I,j) bằng D(I,j) cộng với A(I,k) nhân B(k,j)
B36: nếu k<n thì tăng k thêm 1 và quay lại bước 35
B37: nếu j<n thì tằng j thêm 1 và quay lại bước 34
B38: nếu i<n thì tăng I thêm 1 và quay lại bước 33
B39: khởi tạo I bằng 1
B40: khởi tạo j bằng 1
B41: in giá trị dòng I cột j(in ma trận D)
B42: nếu j<n thì tằng j thêm 1 và quay lại bước 41
B43: nếu i<m thì tăng I thêm 1 và quay lại bước 40

Code:

program p2b25;
var a,b,c,d:array[1..50,1..50] of integer;
    j,i,k,dem,n,m,x:integer;

begin
    write('so dong  m=');
    readln(m);
    write('so cot  n=');
    readln(n);
    for i:=1 to m do
        for j:=1 to n do begin
                  write('a[',i,',',j,']=');
                  readln(a[i,j]);
                          end;
      for i:=1 to m do
        for j:=1 to n do begin
                  write('b[',i,',',j,']=');
                  readln(b[i,j]);
                          end;
    writeln('in ma tran a vua nhap ra man hinh');
    for  i:=1 to m do begin
          for j:=1 to n do write(' ',a[i,j]:5);
          writeln;
          writeln;
          end;
writeln('in ma tran b vua nhap ra man hinh');
    for  i:=1 to m do begin
          for j:=1 to n do write(' ',b[i,j]:5);
          writeln;
          writeln;
          end;
    writeln('ma tran c la ma tran tong cua ma tran a va ma tran b');
    for i:=1 to m do
        for j:=1 to n do c[i,j]:=a[i,j]+b[i,j];
    writeln('in ma tran c vua nhap ra man hinh');
    for  i:=1 to m do begin
          for j:=1 to n do write(' ',c[i,j]:5);
          writeln;
          writeln;
          end;
    writeln(' gia su m=n, ma tran d la tich cua ma tran a va ma tran b');
for i:=1 to n do
            for j:=1 to n do
            begin
 d[i,j]:=0;
            for k:=1 to n do
            d[i,j]:=d[i,j]+a[i,k]*b[k,j];
            end;
    writeln('in ma tran d vua nhap ra man hinh');
    for  i:=1 to m do begin
          for j:=1 to n do write(' ',d[i,j]:5);
          writeln;
          writeln;
          end;
    readln;
end.

Bài 30: Nhập vào một xâu ký tự (gi thiết xâu nhập vào chỉ chứa các chữ cái, chữ số hoặc dấu cách), đếm xem trong xâu có bao nhiêu từ. Một từ là một d•y ký tự không chứa dấu cách (hai từ cách nhau bởi ít nhất một dấu cách).
Thuật toán:
B1: Nhập xâu x
B2: nếu kí tự đầu tiên của xâu là dấu cách thì gán đếm bằng 0 chuyển tới bước 4
B3: đếm được gán bằng 1
B4: khởi tạo I bằng 1
B5: nếu kí tự thứ I là dấu cách và kí tự thứ i+1 khác dấu cách thì dêm được gán bằng đếm +1
B6: in ra biến đếm
Code:

Code:

program p3b30;
var x:string;
    i, dem:integer;
begin
    write('nhap xau ki tu x:');
    readln(x);
    if x[1] =' ' then dem :=0 else dem:=1;
    for i:=1 to length(x)-1 do
              if (x[i]=' ') and (x[i+1]<>' ') then  dem:=dem+1;
    write('xau co so tu la:',dem);
    readln;
end.

Bài 31: Nhập vào một xâu ký tự, đếm xem trong xâu có bao nhiêu ký tự khác nhau (không phân biệt chữ thường, chữ hoa). In ra màn hình số ký tự khác nhau tìm được và mỗi loại ký tự xuất hiện bao nhiêu lần trong xâu?

Code:

program p3b31;
var x,a,b:string;
    i,j,dem:integer;
    th:boolean;
function bienxau(var x: string):string;
begin
    for i:=1 to length(x) do
        if (ord(x[i]) >96) and (ord(x[i])<123) then x[i]:=upcase(x[i]);
    bienxau:=x;
end;
begin
    write('nhap xau x:');
    readln(x);
    dem:=0;
    a:=x;
    writeln(bienxau(x));
    x:=bienxau(x);
    for i:=1 to length(x) do begin
        th:=true;
        for j:=1 to i-1 do
            if x[j] = x[i] then  th:=false;
        if th=true then dem:=dem+1;
        end;
    writeln('so ki tu khac nhau khong phan biet hoa thuong la:',dem);
    x:=a;
for i:=1 to length(a) do
        for j:=i+1 to length(a) do if a[j]=a[i] then delete(a,j,1);
    writeln(a);
    for i:=1 to length(a) do  begin
        dem:=0;
        for j:=1 to length(x) do

            if x[j] = a[i] then dem:=dem+1;
        writeln('ki tu "',a[i],'" xuat hien ',dem,' lan');
              end;
readln;
end.

Bài 32: Nhập vào một xâu ký tự, đếm xem trong xâu có bao nhiêu ký tự khác nhau (cần phân biệt chữ thường, chữ hoa). In ra màn hình số ký tự khác nhau tìm được và mỗi loại ký tự xuất hiện bao nhiêu lần trong xâu?

Code:

program p3b32;
var x,a,b:string;
    i,j,dem:integer;
    th:boolean;
begin
    write('nhap xau x:');
    readln(x);
    dem:=0;
    a:=x;
    for i:=1 to length(x) do begin
        th:=true;
        for j:=1 to i-1 do
            if x[j] = x[i] then  th:=false;
        if th=true then dem:=dem+1;
        end;
    writeln('so ki tu khac nhau co phan biet hoa thuong la:',dem);
    x:=a;
for i:=1 to length(a) do
        for j:=i+1 to length(a) do if a[j]=a[i] then delete(a,j,1);
    writeln(a);
    for i:=1 to length(a) do  begin
        dem:=0;
        for j:=1 to length(x) do

            if x[j] = a[i] then dem:=dem+1;
        writeln('ki tu "',a[i],'" xuat hien ',dem,' lan');
              end;
readln;
end.

Bài 34: thông tin mỗi học sinh gồm:
-họ tên
-ngày, tháng, năm sinh
-điểm trung bình học tập
a.hãy nhập các thông tin của một lớp gồm n học sinh (1<=n<=60)
b.In danh sách học sinh gồm những thông tin vừa nhập ra màn hình theo dạng cột (thông y=tin mỗi học sinh trên một dòng).
c.Cho biết thông tin của học sinh có điểm trung bình cao nhất.

Code:

program p4b34;
type

    hoc_sinh=record
                  hoten:string[20];
                  ngaysinh:string[10] ;
                  diem_tb:real;
              end;
var a: array[1..60] of hoc_sinh;
    n,i:integer;
    hs_diemtb_max:hoc_sinh;
begin
    write('nhap so hoc sinh n=');
    readln(n);
    for i:=1 to n do
        begin
        writeln('nhap hoc sinh thu:',i);
        Write('nhap ho ten:');
        readln(a[i].hoten);
        write('nhap ngay sinh:');
        readln(a[i].ngaysinh);
        write('nhap diem trung binh:');
        readln(a[i].diem_tb);
    end;
    writeln('danh sach hoc sinh vua nhap la:');
    for i:=1 to n do
        writeln('Ho ten:',a[i].hoten:20,'  Ngay sinh:',a[i].ngaysinh:10,'  Diem tb:',a[i].diem_tb:2:1);

    hs_diemtb_max:=a[1];
    for i:=1 to n do

              if hs_diemtb_max.diem_tb < a[i].diem_tb then hs_diemtb_max:=a[i];
    writeln('hoc sinh co diem trung binh cao nhat la:');
    writeln('Ho ten:',hs_diemtb_max.hoten:20,'  Ngay sinh:',hs_diemtb_max.ngaysinh:10,'  Diem tb:',hs_diemtb_max.diem_tb:2:1);
    readln;
end.

Bài 35: Thông tin mỗi loại sách trong một thư viện gồm:
-Tên sách
-Tên tác giả
-Giá mua
-Số lượng sách
a.Hãy nhập các thông tin sách của một thư viện. Quá trình nhập sẽ kết thúc khi tên sách nhập là một xâu rỗng (hoặc chỉ chứa các dấu cách).
b.Đưa danh sách các cuốn sách trong thư viện ra màn hình theo dạng cột.
c.Nhập vào tên một cuốn sách, đưa ra màn hình thông tin về cuốn sách đó theo dạng cột gồm: tên sách, tên tác giả, số lượng sách đó và giá một cuốn. Nếu không có cuốn sách nào có tên như vừa nhập thì cần đưa ra thông báo “ Không có”.

Code:

program p4b35;
type

    sach=record
                  ten:string[20];
                  tacgia:string[20] ;
                  gia:integer;
                  soluong:integer;
              end;
var a: array[1..1000] of sach;
    x:string;
    n,i,j,k:integer;
    th: boolean;
function kiemtra( x:string):string;
begin
    kiemtra:='true';
    for k:=1 to length(x) do
    if x[i]<>' ' then kiemtra:='false';
end;
begin
    writeln('nhap thong tin sach:');
    i:=0;
    repeat
        i:=i+1;
        writeln('nhap sach thu:',i);
        Write('nhap ten sach:');
        readln(a[i].ten);
        write('nhap ten tac gia:');
        readln(a[i].tacgia);
        write('nhap gia:');
        readln(a[i].gia);
        write('nhap so luong:');
        readln(a[i].soluong);

    until  (a[i].ten='') or( kiemtra(a[i].ten) ='true');
    writeln('danh sach vua nhap la:');
    for j:=1 to i-1 do
        writeln('Tensach:',a[j].ten:10,'  Tacgia:',a[j].tacgia:10,'  Giamua:',a[j].gia:6,' dong  soluong:',a[j].soluong:4);

    write('nhap ten sach:');
    readln(x);
    writeln('thong tin ve sach:');
    th:=false;
    for j:=1 to i-1 do

        if  x=a[j].ten then begin

        writeln('Tensach:',a[j].ten:10,'  Tacgia:',a[j].tacgia:10,'  Giamua:',a[j].gia:6,' dong  soluong:',a[j].soluong:4);
                            th:=true;
                            end;
    if th=false then writeln(' khong co trong thu vien');
    readln;
end.

Bài 36: Thông tin mỗi học sinh gồm:
-Họ và tên
-Điểm trung bình các môn học: PASCAL, VB, CSDL, FOXPRO, PTTKHT
a.Hãy nhập các thông tin trên của một lớp gồm n học sinh (1<=n<=60), n nhập từ bàn phím.
b.In danh sách học sinh gồm những thông tin vừa nhập ra màn hình theo dạng cột
c.Nhập vào họ tên của một học sinh, cho biết trong danh sách có bao nhiêu học sinh có tên như vậy?
dNhập vào họ tên của một học sinh, hãy xóa nhưng học sinh có tên như thế khỏi danh sách ban đầu. In danh sách còn lại ra màn hình theo dạng cột.

Code:

program p4b36;
type

    dtb=record
                  pascal:real;
                  vb:real;
                  csdl:real;
                  foxpro:real;
                  pttkht:real;
              end;
    hoc_sinh=record
                  hoten:string[20];
                  diem_tb:dtb;
              end;
var a: array[1..60] of hoc_sinh;
    n,dem,i:integer;
    x,y:string;

begin
    write('nhap so hoc sinh n=');
    readln(n);
    for i:=1 to n do
        begin
        writeln('nhap hoc sinh thu:',i);
        Write('nhap ho ten:');
        readln(a[i].hoten);
        write('diem pascal:');
        readln(a[i].diem_tb.pascal);
        write('diem vb:');
        readln(a[i].diem_tb.vb);
        write('diem csld:');
        readln(a[i].diem_tb.csdl);
        write('diem foxpro:');
        readln(a[i].diem_tb.foxpro);
        write('diem pttkht:');
        readln(a[i].diem_tb.pttkht);
    end;
    writeln('danh sach hoc sinh vua nhap la:');
    write('        Ho ten      diem_pascal  diem_vb  diem_csdl  diem_foxpro  diem_pttkht');

    for i:=1 to n do  begin
        write(a[i].hoten:23,a[i].diem_tb.pascal:9:2,a[i].diem_tb.vb:9:2,a[i].diem_tb.csdl:11:2);
        writeln(a[i].diem_tb.foxpro:13:1,a[i].diem_tb.pttkht:15:1);
                                                                    end;
    write('nhap ho ten 1 hoc sinh:');
    readln(x);
    dem:=0;
    for i:=1 to n do
        if a[i].hoten =x then dem:=dem+1;
    writeln('so hoc sinh co ten nhu tren la:',dem);
    write('nhap ho ten 1 hoc sinh:');
    readln(y);
    for i:=1 to n do
        if a[i].hoten=y then a[i]:=a[i+1];
    writeln('danh sach hoc sinh vua nhap la:');
    write('        Ho ten      diem_pascal  diem_vb  diem_csdl  diem_foxpro  diem_pttkht');

    for i:=1 to n do begin
        write(a[i].hoten:23,a[i].diem_tb.pascal:9:2,a[i].diem_tb.vb:9:2,a[i].diem_tb.csdl:11:2);
        writeln(a[i].diem_tb.foxpro:13:1,a[i].diem_tb.pttkht:15:1);
                    end;
 readln;
end.