Chủ đề này có 34 trả lời

[Zjkar]

Dưới đây là đề và code của các bài pascal, các bạn có thể tham khảo.

[Zjkar]

Viết chương trình nhập vào một mảng gồm N số nguyên. Sắp xếp lại mảng theo thứ tự tăng dần và in kết quả ra màn hình.

Code:

Uses Crt;

Type Mang = ARRAY[1..50] Of Integer;

Var A:Mang;

N,i,j,Tam:Integer;

Begin

{Nhập mảng}

Write('Nhap N='); Readln(N);

For i:=1 To N Do

Begin

Write('A[',i,']='); Readln(A[i]);

End;

{Sắp xếp}

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;

{In kết quả ra màn hình}

Writeln('Ket qua sau khi sap xep:');

For i:=1 To N Do Write(A[i]:5);

Readln;

End.

 

Nhập vào mảng 1 chiều gồm 1 dãy số nguyên N phần tử. Hãy xóa các phần tử trùng nhau trong mảng và in kết quả ra màn hình. Ý tưởng: Duyệt mảng 1 chiều bằng 2 biến, nếu phát phát hiện phần tử nào trùng thì xóa phần tử ấy ra khỏi mảng.

Code:

Program Bo_so_trung;
   Const
      Max=100;
   Var
   a:Array[1..Max] Of Integer;
   i,j,k,n:Integer;
Begin
   Writeln('XOA BO CAC SO TRUNG NHAU');
   Writeln('------------------------');
   Writeln;
   Write('-Nhap so phan tu mang: ');
   Readln(n);
   For i:=1 To N Do
      Begin
         Write('-Phan tu A[',i,']= ');
         Readln(a[i]);
      End;
   i:=2;
   While i <= N Do
      Begin
         j:=1;
         While a[j] <> a[i] Do
            j:=j+1;
         If j < i Then
            Begin
               For k:=i to n-1 Do
                  a[k]:= a[k+1];
               n:=n-1;
            End
         Else
            i:=i+1;
      End;
   Writeln;
   Write('-Mang con lai: ');
   For i:=1 to n Do
      Write(a[i]:8);
   Writeln;
   Writeln('   Bam phim <Enter> de ket thuc ');
   Readln
End.

 

Đề bài: Nhập ngày tháng năm. Hãy cho biết ngày tháng năm sau đó N ngày.

Code:

program gt;

var d,m,y,n:integer;

Function      Songay(thang,nam: Integer):Integer;
Var             sn:Integer;
Begin
       Case thang of
                1,3,5,7,8,10,12 : sn:= 31;
                4,9,11             : sn:= 30;
                2:   If  (nam MOD 4 = 0) Then
                           sn:= 29
                      Else
                            sn:= 28;
        End;
        Songay:= sn;
End;
BEGIN
     Writeln('Nhap ngay thang nam');Readln(d,m,y);
     Writeln('Nhap N');Readln(N);
     d:=d+N;
     While d > Songay(m,y) Do
     Begin
         d:= d - Songay(m,y);
         m:= m+1;
         IF m > 12 Then
         Begin
              m:= 1;
              y:= y + 1;
         End;
    End;
Writeln('Ket qua ',d,'/',m,'/',y);
Readln;
END.

Dãy FIBONACI là dãy được xác định như sau: F(0) = 0; F(1) = 1 và F(n) = F(n-1) + F(n-2) với n = 2, 3...

Hãy viết chương trình máy tính để nhập từ bàn phím số nguyên dương M (2<M<2000000000), rồi xuất ra màn hình số FIBONACI lớn nhất là nguyên tố và nhỏ hơn M.

Ví dụ: Với M=10 thì các số FIBONACI nhỏ hơn M là: 0, 1, 1, 2, 3, 5, 8. Số 5 là số nguyên tố lớn nhất trong các số FIBONACI nhỏ hơn M. Vậy cần đưa ra màn hình dòng thông báo kết quả: Số cần tìm là: 5.

program gt;

uses crt;
var j,i,m,a,b,t:longint;

{----------------------}

Function kt(n:longint):boolean;
 var i,d:integer;
  begin
  kt:=false;
  d:=0;
   For i:=1 to n do
    if n mod i=0 then inc(d);
  if d=2 then kt:=true;
 end;

{----------------------}

begin
 clrscr;
 Write('Nhap m= ');
 readln(m);
 a:=0;
 b:=1;
  Repeat
   a:=a+b;
   b:=a+b;
  Until (a>=m) and (b>=m);

   if a<b then begin t:=a;a:=b;b:=t;end;

  Repeat
   a:=a-b;
   b:=b-a;
  Until ( (kt(a)) and (a<m))  or ( (kt(b)) and (b<m) );
If a>b then writeln(a);
 if b>a then writeln(b);

{----------------------}

  readln
 end.

Trước hết, chúng ta sẽ tìm hiểu khái niệm về số chính phương. Số chính phương là gì? Số chính phương là một số mà tự nó là căn bậc hai của một số tự nhiên khác, hay nói rõ hơn thì số chính phương là bình phương của một số tự nhiên.

Ví dụ: 289 là một số chính phương vì 289 = 17 bình phương.

Code:

program gt;

 uses crt; 
  type ArrInt = array[1..250] of integer;   
  Var n,i,x : integer;
         a: ArrInt; 
  BEGIN
   clrscr;
   write('Nhap so phan tu: ');
   readln(n);
   for i:=1 to n do
   begin
     write('Phan tu thu ',i,'= ');
     readln(a[i]);
   end;
   writeln('Cac so chinh phuong co trong mang:');
   for i:=1 to n do
   begin
    x:=trunc(sqrt(a[i]));
     if sqr(x)=a[i] then
       write(a[i]:4);
   end;
   readln;
  END.  

 

Trong đó lệnh hàm sqrt để lấy căn và hàm trunc để lấy phần nguyên.

Viết chương trình nhập vào một mảng A gồm N số nguyên và nhập thêm vào một số nguyên X.

var
  n,i,q,k,p,:integer;
  a,b:array [1..1000] of integer;
begin
  write('n= ');readln(n);
  for i:=1 to n do
    begin
      write('a[',i,']= ');
      readln(a[i]);
    end;
  write('-Chen pt va vi tri cua pt do: ');readln(k,p);
  q:=0;
  for i:=1 to n do 
    begin
    inc(q);
    if q=p then begin
      b[q]:=k;
      inc(q);
    end;
    b[q]:=a[i];
  end;
  writeln('-Mang sau khi chen la: ');
  for i:=1 to q do
    write(b[i],' ');
  readln
end.

Viết CT nhập từ bàn phím mảng 1 chiều và xóa 1 phần tử của mảng có n phần tử.
var
  n,i,q,k,p:integer;
  a,b:array [1..1000] of integer;
begin
  write('n= ');readln(n);
  for i:=1 to n do
    begin
      write('a[',i,']= ');
      readln(a[i]);
    end; 
  write('Xoa pt co vi tri la: ');readln(p);
  q:=0;
  for i:=1 to n do
    if q<>p then
      begin
        inc(q);
        b[q]:=a[i];
      end;
  writeln('Mang sau khi xoa la: ');
  for i:=1 to q do
    write(b[i],' ');
  readln
end.

Hai số m,n gọi là bạn của nhau nếu tổng các ước của m bằng n và ngược lại.Tìm tất cả các số là bạn của nahu và nhỏ hơn 10001.

Ý tưởng: Thay vì chạy 2 vòng lặp để xét m và n, ta có thể chỉ cần chạy 1 vòng lặp kiểm tra xem m và uoc(m) có là bạn của nhau không.

PROGRAM timban;
FUNCTION uoc(k:INTEGER):longint;
VAR i,tong:INTEGER;
BEGIN
tong:=0;
FOR i:=1 TO k DIV 2 DO
IF k MOD i =0 THEN tong:=tong+i;
uoc:=tong;
END;
VAR m:longint;
BEGIN
for m:= 1 to 10001 do
   if uoc(uoc(m)) = m then writeln(m, ' va ', uoc(m),' la ban cua nhau');
readln
END.

Nhập vào 1 số tự nhiên n* và nhập vào m, sau đó tính tổng m các số tận cùng của n.

vd: n = 365 m =2 tổng = 5+6=11.
Cách 1:  
 

uses crt;
var n: longint;
    m,tong,i: integer;
BEGIN
   clrscr;
   write('Nhap n: '); readln(n);
   write('Nhap m: '); readln(m);
   for i:=1 to m do
     begin
        tong:=tong+(n mod 10);
        n:=n div 10;
     end;
   write('Tong ',m,' chu so cuoi cua so vua nhap = ',tong);
   readln;
END.

Cách 2: Sử dụng xâu: Xâu giúp lưu trữ thoải mái hơn kiểu số nguyên, nên ta có thể khái báo N có ở string thay vì Integer. Như vậy, ở những trường hợp lớn (vd N bao gồm 100 chữ số chẳng hạn) thuật toán vẫn có thể hoạt động bình thường. 

uses crt;
var n: string;
    m,i,a,tong: integer;
BEGIN
   clrscr;
   write('Nhap so n: '); readln(n);
   write('Nhap m: '); readln(m);
   for i:= length(n) downto length(n)-m+1 do
     begin
         val(n[i],a);
         tong:=tong+a;
     end;
   write(tong);
   readln;
END.

----- Oài, nếu bạn nào có nhu cầu thì gửi bài cho mình cho mình nhé --------

P/s: Bác nào thấy được thì mình xin ít     nhé  .

[transontung]

Hầu như các bài của ông up lên tôi đc học hết rồi nhưng công nhận là cũng hay đó( Thích hợp cho những người mới học)

[transontung]

À! Nhân tiện cho hỏi 1 bài về xâu:

Bạn phải viết ct đưa ra tất cả các từ có thể có phát sinh từ 1 tập các chữ cái.

VD\

    .INP                                                 .OUT

    Abc                                                   abc

                                                             acb

                                                             bac

                                                             bca
                                                             cab

                                                             cba

Làm tương tự với cả xâu Acba nha 

[Zjkar]

À! Nhân tiện cho hỏi 1 bài về xâu:

Bạn phải viết ct đưa ra tất cả các từ có thể có phát sinh từ 1 tập các chữ cái.

VD\

    .INP                                                 .OUT

    Abc                                                   abc

                                                             acb

                                                             bac

                                                             bca
                                                             cab

                                                             cba

Làm tương tự với cả xâu Acba nha 

Bài này sao giống bài của uyennhi thế....

Mà bài này mình cũng làm rồi nhưng còn 1 bước nữa để hoàn thiện, đó là làm sao để xoa các từ giống nhau trong 1 mảng <vì mình đưa các từ vào trong 1 mảng kiểu xâu mà>.

---->Khi nào làm xong thì post lên cho.

[Zjkar]

Đề:  Tìm chữ số sau số 0 của N!

Ý tưởng:
- Tính n!
- Chuyển kq của n! sang xâu
-Chạy xâu,nếu s[i]=0 thì viết ký tự thứ i+1 ra và thoát ra khỏi vòng lặp.
Code:
program gt;
uses crt;
var i,n,j,k,l:integer;
s,s1,s2:string;
begin
clrscr;
write('Nhap n=');readln(n);
t:=1;
for i:=1 to n do
t:=t*i;
str(t,s);
write('So sau so 0 cua ',n,'! la: ');
for i:=1 to length(s) do
if s[i]='0' then 
begin
write(s[i+1]);
break;
end;
readln
end.
 

Bài viết đã được chỉnh sửa nội dung bởi Zjkar: 06-03-2016 - 15:11

[Zjkar]

BT pascal:

Bài 1 (3 điểm): Hai số tự nhiên n, m được gọi là nguyên tố tương đương nếu chúng có chung các ước số nguyên tố. Hãy viết chương trình nhập vào hai số n, m và kiểm tra chúng có là nguyên tố tương đương với nhau hay không.

Ví dụ: số 75 và số 15 là nguyên tố tương đương vì chúng có cùng các ước số nguyên tố là 3 và 5.

Bài 2 (3 điểm): Cho hệ phương trình bậc nhất hai ẩn:

      (I)

Hãy viết chương trình giải hệ phương trình trên, đồng thời xác định vị trí tương đối của hai đường thẳng d: ax+by=c và d’=a’x+b’y =c’ đã tạo nên hệ phương trình (I).

[vanlong12]

BT pascal:

Bài 1 (3 điểm): Hai số tự nhiên n, m được gọi là nguyên tố tương đương nếu chúng có chung các ước số nguyên tố. Hãy viết chương trình nhập vào hai số n, m và kiểm tra chúng có là nguyên tố tương đương với nhau hay không.

Ví dụ: số 75 và số 15 là nguyên tố tương đương vì chúng có cùng các ước số nguyên tố là 3 và 5.

Bài 2 (3 điểm): Cho hệ phương trình bậc nhất hai ẩn:

      (I)

Hãy viết chương trình giải hệ phương trình trên, đồng thời xác định vị trí tương đối của hai đường thẳng d: ax+by=c và d’=a’x+b’y =c’ đã tạo nên hệ phương trình (I).

ban tham khao xem lam  nhu the nay dung k?

program nt_t_d;

uses crt;

var x,y,i,j:word;

function nt(var x:word):boolean;

var i,n,j,s:word;   kt:boolean;

begin

s:=0;

kt:=false;

for i:=1 to x do

if x mod i=0 then s:=s+1;

if s=2 then kt:=true;

nt:=true;

end;

begin

write('nhap x:');readln(x);

write('nhap y:');readln(y);

for i:= 1 to x do

for j:=1 to y do

if (x mod j=0)and(y mod j=0)and(nt(j)) then

write(x,y,'la hai so nt tuong duong')

else write(x,y,'khong lahai so nt tuong duong');

readln

end.

[nghethuat102]

Đề:  Tìm chữ số sau số 0 của N!

Ý tưởng:
- Tính n!
- Chuyển kq của n! sang xâu
-Chạy xâu,nếu s[i]=0 thì viết ký tự thứ i+1 ra và thoát ra khỏi vòng lặp.
Code:
program gt;
uses crt;
var i,n,j,k,l:integer;
s,s1,s2:string;
begin
clrscr;
write('Nhap n=');readln(n);
t:=1;
for i:=1 to n do
t:=t*i;
str(t,s);
write('So sau so 0 cua ',n,'! la: ');
for i:=1 to length(s) do
if s[i]='0' then 
begin
write(s[i+1]);
break;
end;
readln
end.
 

code của bạn ngây thơ vãi      . Muốn tìm hiểu vấn đề này có thể vào page qvluom, có công thức tổng quát cho nó.

[Zjkar]

code của bạn ngây thơ vãi      . Muốn tìm hiểu vấn đề này có thể vào page qvluom, có công thức tổng quát cho nó.

Sao có ý kiến à....

Nếu vậy bạn nois ý tưởng xem nào 

[Zjkar]

À hay bài này phải tìm tìm các chữ số sau n! ?

Này,,, bạn vào gmail mình chat cho dễ

Bài viết đã được chỉnh sửa nội dung bởi Zjkar: 07-03-2016 - 12:18

[nghethuat102]

Sao có ý kiến à....

Nếu vậy bạn nois ý tưởng xem nào 

yahaha, cứ giữ thái độ đó đi, 

[Zjkar]

yahaha, cứ giữ thái độ đó đi, 

Còn lâu....

[transontung]

À! Nhân tiện cho hỏi 1 bài về xâu:

Bạn phải viết ct đưa ra tất cả các từ có thể có phát sinh từ 1 tập các chữ cái.

VD\

    .INP                                                 .OUT

    Abc                                                   abc

                                                             acb

                                                             bac

                                                             bca
                                                             cab

                                                             cba

Làm tương tự với cả xâu Acba nha 

Bài này tôi làm được rồi .Up lên để cho mọi người tham khảo

Bài làm nè:

  PROGRAM Sinh_hoan_vi;

CONST

  MAX = 100;

  INP = 'bai1.inp';

  OUT = 'bai1.out';

TYPE

  STR = array[0..max] of char;

VAR

  s   :str;

  f,g :text;

  n   :longint;  { so luong tu}

  time:longint ;

 

PROCEDURE Nhap_dl;

Begin

  Assign(f,inp);

  Assign(g,out);

  Reset(f);

  Rewrite(g);

  Readln(f,n);

End;

 

PROCEDURE DocDay(var s:str);

Begin

    Fillchar(s,sizeof(s),chr(0));

    While not eoln(f) do

      begin

        s[0]:=chr(ord(s[0])+1);

        read(f,s[ord(s[0])]);

      end;

End;

 

PROCEDURE VietDay(s:str);

Var i   :word;

Begin

  For i:=1 to ord(s[0]) do Write(g,s[i]);

End;

 

PROCEDURE Sap_xep(l,r:word);{ giai thuat Quicksort}

Var i,j    :word;

    tg,tam :char;

Begin

  i:=l;j:=r;

  tg:=s[(l+r) div 2];

  Repeat

     While ord(s[i]) < ord(tg) do inc(i);

     While ord(s[j]) > ord(tg) do dec(j);

     If i<=j then

       begin

          tam:=s[i];

          s[i]:=s[j];

          s[j]:=tam;

          inc(i);

          dec(j);

       end;

  Until i>j;

  If j>l then Sap_xep(l,j);

  If i<r then Sap_xep(i,r);

End;

 

PROCEDURE Sinh_hv(s:str);

Var vti,vtj,i,j:word;

    stop       :boolean;

    tam        :char;

Begin

  Writeln(g);

  VietDay(s);

  Repeat

     Stop:=true;

     For i:= ord(s[0]) downto 2 do

       If s[i] > s[i-1] then

         begin

            vti:=i-1;

            stop:=false;

            For j:=ord(s[0]) downto vti+1 do

              begin

                If (ord(s[j])>ord(s[vti])) then

                  begin

                     vtj:=j;

                     break;

                  end;

              end;

            tam:=s[vtj];

            s[vtj]:=s[vti];

            s[vti]:=tam;

            For j:=1 to ((ord(s[0]) - (vti+1))+1) div 2 do

              begin

                tam:=s[vti+j];

                s[vti+j]:=s[ord(s[0])-j+1];

                s[ord(s[0])-j+1]:=tam;

              end;

            Writeln(g);

            VietDay(s);

            break;

         end;

  Until stop;

End;

 

PROCEDURE Xu_ly;

Var i:longint;

Begin

  For i:=1 to n do

    begin

        DocDay(s);

        readln(f);

        Sap_xep(1,ord(s[0]));

        Sinh_hv(s);

        Writeln(g);

    end;

  Close(f);

  Close(g);

End;

 

BEGIN

  Nhap_dl;

  Xu_ly;

END.

[Zjkar]

Bài này tôi làm được rồi .Up lên để cho mọi người tham khảo

Bài làm nè:

  PROGRAM Sinh_hoan_vi;

CONST

  MAX = 100;

  INP = 'bai1.inp';

  OUT = 'bai1.out';

TYPE

  STR = array[0..max] of char;

VAR

  s   :str;

  f,g :text;

  n   :longint;  { so luong tu}

  time:longint ;

 

PROCEDURE Nhap_dl;

Begin

  Assign(f,inp);

  Assign(g,out);

  Reset(f);

  Rewrite(g);

  Readln(f,n);

End;

 

PROCEDURE DocDay(var s:str);

Begin

    Fillchar(s,sizeof(s),chr(0));

    While not eoln(f) do

      begin

        s[0]:=chr(ord(s[0])+1);

        read(f,s[ord(s[0])]);

      end;

End;

 

PROCEDURE VietDay(s:str);

Var i   :word;

Begin

  For i:=1 to ord(s[0]) do Write(g,s[i]);

End;

 

PROCEDURE Sap_xep(l,r:word);{ giai thuat Quicksort}

Var i,j    :word;

    tg,tam :char;

Begin

  i:=l;j:=r;

  tg:=s[(l+r) div 2];

  Repeat

     While ord(s[i]) < ord(tg) do inc(i);

     While ord(s[j]) > ord(tg) do dec(j);

     If i<=j then

       begin

          tam:=s[i];

          s[i]:=s[j];

          s[j]:=tam;

          inc(i);

          dec(j);

       end;

  Until i>j;

  If j>l then Sap_xep(l,j);

  If i<r then Sap_xep(i,r);

End;

 

PROCEDURE Sinh_hv(s:str);

Var vti,vtj,i,j:word;

    stop       :boolean;

    tam        :char;

Begin

  Writeln(g);

  VietDay(s);

  Repeat

     Stop:=true;

     For i:= ord(s[0]) downto 2 do

       If s[i] > s[i-1] then

         begin

            vti:=i-1;

            stop:=false;

            For j:=ord(s[0]) downto vti+1 do

              begin

                If (ord(s[j])>ord(s[vti])) then

                  begin

                     vtj:=j;

                     break;

                  end;

              end;

            tam:=s[vtj];

            s[vtj]:=s[vti];

            s[vti]:=tam;

            For j:=1 to ((ord(s[0]) - (vti+1))+1) div 2 do

              begin

                tam:=s[vti+j];

                s[vti+j]:=s[ord(s[0])-j+1];

                s[ord(s[0])-j+1]:=tam;

              end;

            Writeln(g);

            VietDay(s);

            break;

         end;

  Until stop;

End;

 

PROCEDURE Xu_ly;

Var i:longint;

Begin

  For i:=1 to n do

    begin

        DocDay(s);

        readln(f);

        Sap_xep(1,ord(s[0]));

        Sinh_hv(s);

        Writeln(g);

    end;

  Close(f);

  Close(g);

End;

 

BEGIN

  Nhap_dl;

  Xu_ly;

END.

Dài vãi...... .

Đây là làm được hay copy zậy

[transontung]

Làm chuẩn đấy (Mất 2 ngày liền  chứ copy ở đâu được ) Ông xem thử đi, nếu có j góp ý thì cứ nói

[Zjkar]

Làm chuẩn đấy (Mất 2 ngày liền  chứ copy ở đâu được ) Ông xem thử đi, nếu có j góp ý thì cứ nói

Xài tệp vb à ?

Mà bạn viết ý tưởng nghe xem nha... .

chi tiết vào...

[Zjkar]

Làm chuẩn đấy (Mất 2 ngày liền  chứ copy ở đâu được ) Ông xem thử đi, nếu có j góp ý thì cứ nói

Bài có vấn đề hay do máy zậy mà sao mình copy vào ct free pascal mà chạy thì nó báo lỗi:

exited with

exitcode=2

[transontung]

Bài có vấn đề hay do máy zậy mà sao mình copy vào ct free pascal mà chạy thì nó báo lỗi:

exited with

exitcode=2

mình làm bằng turbo pascal mà

[transontung]

Xài tệp vb à ?

Mà bạn viết ý tưởng nghe xem nha... .

chi tiết vào...

Còn cái này để mai tôi up cho. Giờ tui phải ôn bài mai kiểm tra