Bài tập pascal

cuong276 · 12 Tháng sáu 2012

Bài 1: Hình chữ nhật trong lưới ô vuông
Trong lưới ô vuông có kích thước N x N (N <= 100) người ta tạo 1 số hình chữ nhật bằng cách xác định vị trí 1 số ô liên tiếp kề nhau, các hình chữ nhật này từng đôi một không giao nhau (việc giao nhau xét tới đơn vị điểm của các đường biên trên các cạnh). Người ta dùng 1 bảng ô vuông A có kích thước N x N để mô tả thông tin về các hình chữ nhật trong lưới ô vuông, giá trị các phần tử này được xác định như sau:
Giá trị phần tử thuộc hàng i, cột j của bảng A bằng 1 nếu ô vuông ở hàng i, cột j của lưới ô vuông đã cho thuộc 1 hình chữ nhật nào đó, bằng 0 nếu ngược lại.
Dữ liệu vào: Tệp HCN.INP có cấu trúc:
- Dòng thứ nhất ghi số nguyên dương N
- N dòng tiếp theo, mooij dòng ghi số 0 hoặc 1 liên tiếp nhau là các giá trị các phần tử của bảng A.
Dữ liệu ra: Tệp HCN.OUT có cấu trúc:
- Dòng thứ nhất ghi số M là số hình chữ nhật có trong lưới ô vuông
- M dòng tiếp theo, mỗi dòng ghi 4 số p,q,r,s cách nhau ít nhất là 1 kí tự trong với ý nghĩa: cặp số p,q là toạ độ đỉnh trái trên và cặp số r,s là toạ độ đỉnh phải dưới của 1 hình chữ nhật nào đó trong M hình chữ nhật trong lưới ô vuông
Ví dụ:
Tệp HCN.INP
0111
0111
0000
1111
Tệp HCN.OUT
2
1 2 2 4
4 1 4 4

Bài 2: Bằng phương pháp chụp không ảnh xác định các vùng lúa đang bị rầy nâu phá hoại, trên ảnh chụp của vùng đất lớn hình chữ nhật, những vùng đất có màu xám là những vùng đất bị rầy nâu phá hoại, những vùng có màu xanh là những vùng đất còn xanh tốt.
Để xác định vị trí của các vùng đất bị rầy nâu phá hoại hay không phá hoại, người ta chia hình chữ nhật trên thành các lưới ô vuông. Hãy lập trình các vùng đất bị rầy nâu phá hoại, chỉ ra các vùng đất gồm các ô nào, tổng diện tích và diện tích các vùng này với mỗi ô là 1 đơn vị diện tích.
Yêu cầu:
Dữ liệu vào cho trong file RAY.INP gồm:
-Dòng đầu tiên là kích thước vùng đất cho bởi 2 biến M,N với (1 \leq M, N \leq 250)
- M dòng tiếp theo, mỗi dòng chứa N cột cho biết ô đất có rầy hay không (1 nếu có rầy, 0 nếu không có rầy)
Dữ liệu ra trong file RAY.OUT gồm:
- Dòng đầu ghi tổng diện tích vùng đất có rầy
- Các dòng tiếp theo: số đầu tiên là diện tích các ô chung cạnh có rầy, kế tiếp là vị trí các ô có rầy.
Ví dụ:
RAY.INP
5 6
1 1 0 0 0 0
0 1 1 0 0 0
0 0 0 0 0 0
0 0 1 1 0 0
1 0 0 0 0 0
RAY.OUT
7
4 [1,1],[1,2],[2,2],[2,3]
2 [4,3],[4,4]
1 [5,1]

mikelhpdatke · 12 Tháng sáu 2012

Bài này dữ liệu từ tệp HCN.INP vào đã có các hình chữ nhật được biểu diễn = cách số 1??
Nếu đã xác định được như thế thì chỉ cần duyệt qua mảng để tìm + kỹ thuật mảng đánh dấu là ok :-?

cuong276 · 12 Tháng sáu 2012

OK! Nhưng kỹ thuật mảng đánh dấu là gì vậy? Mình chưa học cái này

mikelhpdatke · 12 Tháng sáu 2012

Giả sử nha
Tệp HCN.INP
0111
0111
0000
1111
Tệp HCN.OUT
2
1 2 2 4
4 1 4 4

Khởi tạo mảng F[i,j] nhận dữ liệu từ tệp INP. Mảng C có các chỉ số như mảng F, tức là C,F:array[1..100,1..100] of .....
Dùng lệnh FillChar(C,SizeOf(C),True) để thể hiện các phần tử của mảng C còn tự do.
Sau khi duyệt tìm được HCN 1 2 2 4
Các C[i,j] tương ứng với F[i,j] trong HCN 1 2 2 4 ta sẽ gán C[i,j]:=False. Để biết rằng C[i,j] đã được chọn.Để chắc chắn ta đánh đấu cả phần viền ngoài của hình chữ nhật để thỏa mãn lần duyệt sau không "đụng hàng".

) {Như phần màu đỏ mình đánh dấu bên trên. Nên khởi tạo viền của bảng N*N.
Dài dòng hơi khó hiểu thì phải @-)

cuong276 · 12 Tháng sáu 2012

Cái đó thì ai nói nữa. Quan trọng là cách diệt tìm ra hình chữ nhật và viết chỉ số kìa

quanghero100 · 12 Tháng sáu 2012

Bài 1 nếu dữ liệu vào các HCN là riêng biệt như cái ví dụ trên thì dễ quá rồi còn gì
Bài 2 dùng phương pháp loang là ra thôi mà hjhj 2 bài đó có vẻ đơn giản chỉ riêng bài 1 còn hơn nghi ngờ về dữ liệu vào
Nói tóm lại theo tớ cả 2 bài đó đều dùng loang hết

cuong276 · 12 Tháng sáu 2012

Đơn giản???? Trời! cậu siêu thật đó, 2 bài này tớ nghĩ mù đầu rồi mà mới chỉ thoáng qua cái thuật toán thôi, còn cách lập trình thì tớ vẫn chưa nghĩ ra

quanghero100 · 12 Tháng sáu 2012

giờ tớ bận chứ hem post bài lên lun có gì sáng mai tớ post bài giải lên choa nhá nhưng mà tớ làm theo cái ví dụ nên lỡ file in có thay đổi khác với những gì tớ nghĩ thì chạy sai ráng chịu à

mikelhpdatke · 12 Tháng sáu 2012

Bài 1:
Còn bài 2 đang code, ngồi xem Euro code lâu quá @-)

Mã:

 Var F:array[0..100,0..100] Of Integer;
a,b,p,q:array[0..100] Of Integer;
    C:array[0..100,0..100] Of Boolean;
    i,j,n,m,d,k:integer;
      Y,U:Boolean;
Procedure Init;
 Begin
  Write('Nhap N= ');Readln(N);
 { Write('Nhap M= ');Readln(M);  }
  For i:=1 to n do
   For j:=1 to n do
    Readln(F[i,j]);

 For i:=1 to n do
 Begin
  For j:=1 to n do
    Write(F[i,j]:3);
   Writeln;
  End;
  FillChar(C,SizeOf(C),True);
For i:=1 to n do begin F[0,i]:=100;F[i,0]:=F[0,i];end;
For i:=1 to n do begin F[n+1,i]:=100;F[i,n+1]:=F[n+1,i];end;
d:=0;
k:=0;
 End;

Procedure Install(i,j:integer);
 Begin
 If C[i,j] then
  Begin

   If (i>p[k]) or (j>q[k]) then Y:=True;
      If (Y) then  begin p[k]:=i;q[k]:=j;end;
      Y:=False;
    If U then  begin a[k]:=i;b[k]:=j;end;

   U:=False;
     If (F[i,j]=1) and C[i,j] then
           Begin
                C[i,j]:=False;
                If (F[i+1,j]=1) and (C[i+1,j]) then Install(i+1,j);
                If (F[i,j+1]=1) and (C[i,j+1]) then Install(i,j+1);
                If (F[i-1,j]=1) and (C[i-1,j]) then Install(i-1,j);
                If (F[i,j-1]=1) and (C[i,j+1]) then Install(i,j-1);
               exit;
          End;
   End;
 End;

 Function searchx:Integer;
  Var i,j:integer;
   Begin
    searchx:=0;
    For i:=1  to n do
     For j:=1 to n do
      If C[i,j] and (F[i,j]=1) then
       begin
          searchx:=i;
          exit;
       End;
   End;

  Function searchy:Integer;
  Var i,j:integer;
   Begin
    searchy:=0;
    For i:=1  to n do
     For j:=1 to n do
      If C[i,j] and (F[i,j]=1) then
       Begin
        searchy:=j;
        exit;
       End;
   End;

 BEGIN
  Init;
  While (searchx<>0) or (searchy<>0) do
  Begin
   U:=True;
   Y:=True;
   inc(d);
   inc(k);
   Install(searchx,searchy);
   End;
     Writeln(d);
     For i:=1 to k do
    Writeln(a[i],' ',b[i],' ',p[i],' ',q[i]);





  readln
  end.

mikelhpdatke · 13 Tháng sáu 2012

Bài 2 nếu áp dụng thuật toán bài 1 của mình thì chỉnh sửa chút là ok. 2 bài gần tương tự

Mã:

Var F:array[0..100,0..100] Of Integer;
    C:array[0..100,0..100] Of Boolean;
    a,b,p,q,dem:array[0..100] Of integer;
    i,j,n,m,d,k,g,h:integer;
      Y,U:Boolean;
Procedure Init;
 Begin
  Write('Nhap N= ');Readln(N);
  write('Nhap M= ');Readln(M);
  For i:=1 to n do
   For j:=1 to m do
    Readln(F[i,j]);

 For i:=1 to n do
 Begin
  For j:=1 to m do
    Write(F[i,j]:3);
   Writeln;
  End;
  FillChar(C,SizeOf(C),True);
For i:=1 to n do begin F[0,i]:=100;F[i,0]:=F[0,i];end;
For i:=1 to n do begin F[n+1,i]:=100;F[i,n+1]:=F[n+1,i];end;
d:=0;
k:=0;
 End;

Procedure Install(i,j:integer);
 Begin
 If C[i,j] then
  Begin

   If (i>p[k]) or (j>q[k]) then Y:=True;
      If (Y) then  begin p[k]:=i;q[k]:=j;end;
      Y:=False;
    If U then  begin a[k]:=i;b[k]:=j;end;

   U:=False;
     If (F[i,j]=1) and C[i,j] then
           Begin
                C[i,j]:=False;
                If (F[i+1,j]=1) and (C[i+1,j]) then Install(i+1,j);
                If (F[i,j+1]=1) and (C[i,j+1]) then Install(i,j+1);
                If (F[i-1,j]=1) and (C[i-1,j]) then Install(i-1,j);
                If (F[i,j-1]=1) and (C[i,j+1]) then Install(i,j-1);
               exit;
          End;
   End;
 End;

 Function searchx:Integer;
  Var i,j:integer;
   Begin
    searchx:=0;
    For i:=1  to n do
     For j:=1 to n do
      If C[i,j] and (F[i,j]=1) then
       begin
          searchx:=i;
          exit;
       End;
   End;

  Function searchy:Integer;
  Var i,j:integer;
   Begin
    searchy:=0;
    For i:=1  to n do
     For j:=1 to n do
      If C[i,j] and (F[i,j]=1) then
       Begin
        searchy:=j;
        exit;
       End;
   End;

 BEGIN
  Init;
  While (searchx<>0) or (searchy<>0) do
  Begin
   U:=True;
   Y:=True;
   inc(k);
   Install(searchx,searchy);
   End;
     For i:=1 to k do
    Begin
     For g:=a[i] to p[i] do
      For h:=b[i] to q[i] do
       If F[g,h]=1 then begin inc(d);inc(dem[i]);end;
       Writeln;
     End;

             writeln(d);
   For i:=1 to k do
    Begin
     For g:=a[i] to p[i] do
      For h:=b[i] to q[i] do
      begin
       write(dem[i],' ');
       If F[g,h]=1 then   write('[',g,',',h,']');
      end;
       Writeln;
     End;

  readln
  end.

quanghero100 · 13 Tháng sáu 2012

Bài 1:

Mã:

uses crt;
var a,c:array[1..100,1..100] of integer;
    b:array[1..100,1..100] of boolean;
    x1,y1,x2,y2,n:integer;
    f1,f2:text;
procedure loang(x,y:integer);
begin
 if a[x,y]=1 then
  begin
    a[x,y]:=0;
    b[x,y]:=false;
    if x>1 then loang(x-1,y);
    if y>1 then loang(x,y-1);
    if x<n then loang(x+1,y);
    if y<n then loang(x,y+1);
  end;
end;
procedure doc;
var i,j:integer;
begin
  assign(f1,'HCN.INP');
  reset(f1);
  readln(f1,n);
  for i:=1 to n do
   begin
    for j:=1 to n do
      read(f1,a[i,j]);
      readln(f1);
   end;
   c:=a;
  close(f1);
end;
procedure xuli;
var i,j,d:integer;
begin
  assign(f2,'HCN.OUT');
  rewrite(f2);
  d:=0;
  for i:=1 to n do
    for j:=1 to n do
      if a[i,j]=1 then
        begin
           inc(d);
           loang(i,j);
        end;
  writeln(f2,d);
  a:=c;
  for i:=1 to n do
    for j:=1 to n do
      begin
         if a[i,j]=1 then
           begin
              fillchar(b,sizeof(b),true);
              loang(i,j);
              x1:=0;
              repeat
                   inc(x1);
                   y1:=0;
                   repeat
                        inc(y1);
                   until (b[x1,y1]=false) or (y1=n);
              until (b[x1,y1]=false) or (x1=n);
              x2:=n+1;
              repeat
                   dec(x2);
                   y2:=n+1;
                   repeat
                        dec(y2);
                   until (b[x2,y2]=false) or (y2=1);
              until (b[x2,y2]=false) or (x2=1);
              writeln(f2,x1,' ',y1,' ',x2,' ',y2);
           end;
      end;
  close(f2);
end;
begin
 doc;
 xuli;
end.

quanghero100 · 13 Tháng sáu 2012

Bài 2:

Mã:

uses crt;
var a:array[1..100,1..100] of integer;
    b:array[1..100,1..100] of boolean;
    m,n,d1,d2:integer;
    f1,f2:text;
procedure doc;
var i,j:integer;
begin
  assign(f1,'RAY.INP');
  reset(f1);
  readln(f1,m,n);
  for i:=1 to m do
    begin
       for j:=1 to n do
          read(f1,a[i,j]);
          readln(f1);
    end;
  close(f1);
end;
procedure loang(x,y:integer);
begin
  if a[x,y]=1 then
    begin
       a[x,y]:=0;
       inc(d2);
       b[x,y]:=false;
       if x>1 then loang(x-1,y);
       if y>1 then loang(x,y-1);
       if x<m then loang(x+1,y);
       if y<n then loang(x,y+1);
    end;
end;
procedure xuli;
var i,j,z,t:integer;
begin
  assign(f2,'RAY.OUT');
  rewrite(f2);
  d1:=0; d2:=0;
  for i:=1 to m do
     for j:=1 to n do
       if a[i,j]=1 then inc(d1);
  writeln(f2,d1);
  for i:=1 to m do
    for j:=1 to n do
      if a[i,j]=1 then
        begin
          d2:=0;
          fillchar(b,sizeof(b),true);
          loang(i,j);
          write(f2,d2,' ');
          for z:=1 to m do
             for t:=1 to n do
                if b[z,t]=false then write(f2,'[',z,',',t,']; ');
          writeln(f2);
        end;
  close(f2);
end;
begin
   doc;
   xuli;
end.

chinhngocpro · 6 Tháng tám 2012

Bài 2 đây bạn, bạn dùng code của bài 1 chỉnh sửa lại một tí là được ngay

Mã:

uses crt;
var a,c:array[1..100,1..100] of integer;
    b:array[1..100,1..100] of boolean;
    d,x1,x2,n,m:integer;
    f1,f2:text;
procedure loang(x,y:integer);
begin
 if a[x,y]=1 then
  begin
    a[x,y]:=0;
    b[x,y]:=false;
    inc(d);
    if x>1 then loang(x-1,y);
    if y>1 then loang(x,y-1);
    if x<n then loang(x+1,y);
    if y<m then loang(x,y+1);
  end;
end;
procedure doc;
var i,j:integer;
begin
  assign(f1,'ray.INP');
  reset(f1);
  read(f1,n);
  readln(f1,m);
  for i:=1 to n do
   begin
    for j:=1 to m do
      read(f1,a[i,j]);
      readln(f1);
   end;
  c:=a;
  close(f1);
end;
procedure timkiemvaghi;
var i,j:integer;
begin
  assign(f2,'ray.OUT');
  rewrite(f2);
  for i:=1 to n do
    for j:=1 to m do
      if a[i,j]=1 then
        begin
           loang(i,j);
        end;
  writeln(f2,d);
  a:=c;
  for i:=1 to n do
    for j:=1 to m do
      begin
         if a[i,j]=1 then
           begin
              d:=0;
	      fillchar(b,sizeof(b),true);
              loang(i,j);
	      write(f2,d);
              for x1:=1 to n do
	          for x2:= 1 to m do
			if b[x1,x2] = false then write(f2,'(',x1,',',x2,') ');
	      writeln(f2);
           end;
      end;
  close(f2);
end;
begin
 doc;
 timkiemvaghi;
end.

tutinit · 9 Tháng mười hai 2013

Rep

Cảm thấy làm như vậy cũng ngắn gọn.
Mong mọi người chỉ bảo thêm

Mã:

VAR a:ARRAY[1..10,1..10] OF INTEGER;
dem,i,j,m,n,k:INTEGER;
BEGIN          
    randomize;   
    write('nhap dong, cot '); readln(m,n);
    FOR i:=1 TO m DO
    FOR j:=1 TO n DO
        a[i,j]:=random(2)-random(1);
    FOR i:=1 TO m DO
    begin
        FOR j:=1 TO n DO
    write(a[i,j]:6);
        writeln;
    END;                           
    dem:=0;
    FOR i:=1 TO m DO
    FOR j:=1 TO n DO
    IF a[i,j]=1 THEN 
    BEGIN
        writeln('vt ',i,' ',j,' ');
        dem:=dem+1;
    END;
    write('dien tich ray ',dem);            
readln
END.

Chú ý cho code vào tag
Đã sửa

lamdetien36 · 10 Tháng mười hai 2013

tutinit said:
Cảm thấy làm như vậy cũng ngắn gọn.
Mong mọi người chỉ bảo thêm

VAR a:ARRAY[1..10,1..10] OF INTEGER;
dem,i,j,m,n,k:INTEGER;
BEGIN
randomize;
write('nhap dong, cot '); readln(m,n);
FOR i:=1 TO m DO
FOR j:=1 TO n DO
a[i,j]:=random(2)-random(1);
FOR i:=1 TO m DO
begin
FOR j:=1 TO n DO
write(a[i,j]:6);
writeln;
END;
dem:=0;
FOR i:=1 TO m DO
FOR j:=1 TO n DO
IF a[i,j]=1 THEN
BEGIN
writeln('vt ',i,' ',j,' ');
dem:=dem+1;
END;
write('dien tich ray ',dem);
readln
END.

Thứ nhất, dữ liệu là nhập từ file / bàn phím, sao lại cho random :|
Thứ hai, thuật toán của bạn cũng chưa đúng

Nếu không tin bạn cứ thử chạy test ở đầu bài

Kết quả khác nhau hoàn toàn đấy

tuandang930@gmail.com · 3 Tháng hai 2016

Bài 2 nếu áp dụng thuật toán bài 1 của mình thì chỉnh sửa chút là ok. 2 bài gần tương tự

anh ơi vậy thì chèn cái file vô làm sao

Tìm kiếm

Tìm kiếm

Bài tập pascal

cuong276

mikelhpdatke

cuong276

mikelhpdatke

cuong276

quanghero100

cuong276

quanghero100

mikelhpdatke

mikelhpdatke

quanghero100

quanghero100

chinhngocpro

tutinit

lamdetien36

tuandang930@gmail.com