Tìm ước chung lớn nhất trong mảng Pascal

 by pkt_zz 24/5/2010, 3:54 am

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]    writeln('ucln la: ',ucln(a,n,min));
    writeln('bcnn la: ',bcnn(a,n,max));
    readln;
end.

Được sửa bởi khac_tuy ngày 24/5/2010, 3:58 am; sửa lần 2.

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike

 

 by pkt_zz 24/5/2010, 3:55 am

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 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 iB5: 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.

Được sửa bởi khac_tuy ngày 24/5/2010, 4:06 am; sửa lần 1.

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike

 

 by pkt_zz 24/5/2010, 3:58 am

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.

Được sửa bởi khac_tuy ngày 24/5/2010, 4:07 am; sửa lần 1.

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike

 

 by pkt_zz 24/5/2010, 3:58 am

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

Được sửa bởi khac_tuy ngày 24/5/2010, 4:07 am; sửa lần 1.

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike

 

 by pkt_zz 24/5/2010, 3:59 am

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 iCode:
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.1Bà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 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.2

Được sửa bởi khac_tuy ngày 24/5/2010, 4:08 am; sửa lần 1.

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike

 

 by pkt_zz 24/5/2010, 4:00 am

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 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.3Bà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 iB12: 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 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.4

Được sửa bởi khac_tuy ngày 24/5/2010, 4:09 am; sửa lần 1.

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike

 

 by pkt_zz 24/5/2010, 4:00 am

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 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.5Bà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 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.6

Được sửa bởi khac_tuy ngày 24/5/2010, 4:10 am; sửa lần 1.

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike

 

 by pkt_zz 24/5/2010, 4:00 am

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

Được sửa bởi khac_tuy ngày 24/5/2010, 4:10 am; sửa lần 1.

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike

 

 by pkt_zz 24/5/2010, 4:01 am

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 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.8Bà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 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.9

Được sửa bởi khac_tuy ngày 24/5/2010, 4:11 am; sửa lần 1.

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike

 

 by pkt_zz 24/5/2010, 4:01 am

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 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: 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 jB17: nếu iB18: in ra giá trị biến đếm
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]    writeln('ucln la: ',ucln(a,n,min));
    writeln('bcnn la: ',bcnn(a,n,max));
    readln;
end.0
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 jB6: nếu iB7: 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 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( in ma trận A)
B15: nếu jB16: nếu iB17: 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 jB21: nếu iB22: 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 jB26: nếu iB27: 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 jB31: nếu iB32: 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 kB37: nếu jB38: nếu iB39: 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 jB43: nếu iCode: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]    writeln('ucln la: ',ucln(a,n,min));
    writeln('bcnn la: ',bcnn(a,n,max));
    readln;
end.1

Được sửa bởi khac_tuy ngày 24/5/2010, 4:11 am; sửa lần 1.

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike

 

 by pkt_zz 24/5/2010, 4:01 am

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 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]    writeln('ucln la: ',ucln(a,n,min));
    writeln('bcnn la: ',bcnn(a,n,max));
    readln;
end.2
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 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]    writeln('ucln la: ',ucln(a,n,min));
    writeln('bcnn la: ',bcnn(a,n,max));
    readln;
end.3

Được sửa bởi khac_tuy ngày 24/5/2010, 4:03 am; sửa lần 1.

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike

 

 by pkt_zz 24/5/2010, 4:02 am

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 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]    writeln('ucln la: ',ucln(a,n,min));
    writeln('bcnn la: ',bcnn(a,n,max));
    readln;
end.4
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 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]    writeln('ucln la: ',ucln(a,n,min));
    writeln('bcnn la: ',bcnn(a,n,max));
    readln;
end.5

Được sửa bởi khac_tuy ngày 24/5/2010, 4:04 am; sửa lần 1.

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike

 

 by pkt_zz 24/5/2010, 4:02 am

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 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]    writeln('ucln la: ',ucln(a,n,min));
    writeln('bcnn la: ',bcnn(a,n,max));
    readln;
end.6

Được sửa bởi khac_tuy ngày 24/5/2010, 4:04 am; sửa lần 1.

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike

 

 by pkt_zz 24/5/2010, 4:02 am

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 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]    writeln('ucln la: ',ucln(a,n,min));
    writeln('bcnn la: ',bcnn(a,n,max));
    readln;
end.7

pkt_zzTHƯỢNG TƯỚNG V


Tổng số bài gửi : 1029
Join date : 15/12/2009
Age : 31
Đến từ : MẠC XÁ-QUANG PHỤC

LikeDislike