Kết quả 1 đến 3 của 3

Chủ đề: Bài tập gỡ mìn

  1. #1
    Ngày tham gia
    Dec 2015
    Bài viết
    0

    Bài tập gỡ mìn

    Xin Trợ giúp!
    Cho bảng hình chữ nhật kích thước MxN (M số dòng, N số cột) ô vuông. Mỗi ô mang giá trị 0 hoặc 1, nếu ô (i, j) có mìn A[i, j] = 1, ngược lại thì A[i, j] = 0.
    (a) Một người xuất phát từ ô (X1, Y1) không có mìn, kiểm tra xem người này có thể di chuyển đến ô (X2, Y2) được hay không bằng cách di chuyển sang những ô chung cạnh không có mìn.
    (b) Nếu kết quả câu a là người đó không thể di chuyển đến (X2, Y2) được thì hãy chỉ ra cách gỡ ít nhất những quả mìn để anh ta có thể di chuyển đến (X2, Y2).
    Dữ liệu vào: file text GOMIN.INP
    Dòng đầu là 6 số M, N, X1, Y1, X2, Y2 cách nhau bởi khoảng trắng.M dòng tiếp theo, mỗi dòng gồm N số 0/1 tương ứng có mìn hoặc không có mìn, mỗi số cách nhau bởi khoảng trắng.
    Dữ liệu ra: file text GOMIN.OUT
    Dòng đầu chứa số 0/1 tương ứng với đi được / không đi được.
    Nếu là không đi được thì dòng thứ hai là số K tương ứng với số mìn ít nhất cần phải gỡ.
    Nếu có số K ở dòng thứ hai thì K dòng tiếp theo, mỗi dòng i gồm 2 số tương ứng với chỉ số cột và chỉ số dòng của ô thứ i cần phải gỡ mìn.

  2. #2
    Ngày tham gia
    Nov 2015
    Bài viết
    0
    Google có mà bạn:
    Mã:
    PROGRAM Domin;
    Uses crt;
    Const tf=’mine.inp’;
    mx=127;
    Type mang=array[0..151,0..151] of shortint;
    Var a,b:mang;
    m,n,min,max:integer;
    f:text;
    thoat:boolean;
    Procedure doc;
    Var i,j:integer;
    Begin
    Assign(f,tf);
    Reset(f);
    Readln(f,m,n);
    For i:=1 to m do
    for j:=1 to n do
    read(f,a[i,j]);
    Close(f);
    End;
    Procedure xem;
    Var i,j:integer;
    Begin
    Writeln(m, ‘ ‘,n);
    For i:=1 to m do
    begin
    for j:=1 to n do
    if a[i,j]=1 then write(‘* ‘)
    else
    if a[i,j]=0 then write(‘. ‘);
    writeln;
    end;
    End;
    Procedure xem1;
    Var i,j:integer;
    Begin
    Writeln(m, ‘ ‘,n);
    For i:=1 to m do
    begin
    for j:=1 to n do
    write(b[i,j],’ ‘);
    writeln;
    end;
    End;
    Function dem(i,j:byte):byte;
    Var s:integer;
    Begin
    s:=0;
    if (a[i-1,j]=1) then inc(s);
    if (a[i,j-1]=1) then inc(s);
    if (a[i+1,j]=1) then inc(s);
    if (a[i,j+1]=1) then inc(s);
    if (a[i-1,j-1]=1) then inc(s);
    if (a[i-1,j+1]=1) then inc(s);
    if (a[i+1,j+1]=1) then inc(s);
    if (a[i+1,j-1]=1) then inc(s);
    dem:=s;
    End;
    Procedure minso;
    Var i,j:integer;
    Begin
    For i:=1 to m do
    for j:=1 to n do
    b[i,j]:=dem(i,j)
    End;
    Procedure giam(i,j:integer);
    Begin
    dec(b[i-1,j]); dec(b[i+1,j]);dec(b[i,j-1]);dec(b[i,j+1]);
    dec(b[i-1,j-1]);dec(b[i-1,j+1]);dec(b[i+1,j-1]);dec(b[i+1,j+1]);
    if (b[i-1,j]<0)or(b[i+1,j]<0)or(b[i,j-1]<0)or(b[i,j+1]<0)or(b[i-1,j-1]<0) or(b[i-1,j+1]<0) or(b[i+1,j-1]<0) or(b[i+1,j+1]<0) then thoat:=true; End; Procedure tang(i,j:integer); Begin inc(b[i-1,j]); inc(b[i+1,j]);inc(b[i,j-1]);inc(b[i,j+1]); inc(b[i-1,j-1]);inc(b[i-1,j+1]);inc(b[i+1,j-1]);inc(b[i+1,j+1]); End; Procedure loang(i:integer); Var j,t:integer; Begin if i>m then t:=m
    else
    if i>n then t:=n
    else t:=i-1;
    For j:=2 to t do
    Begin
    if (i>n) or (i>m) then
    begin
    if i>m then
    begin
    if (b[j-1,i-1]>1) then begin thoat:=true; exit; end;
    if b[j-1,i-1]=0 then a[j,i]:=0
    else
    if b[j-1,i-1]=1 then begin a[j,i]:=1; giam(j,i); end
    else begin thoat:=true; exit; end
    end
    else
    begin
    if (b[i-1,j-1]>1) then begin thoat:=true; exit; end;
    if b[i-1,j-1]=0 then a[i,j]:=0
    else
    if b[i-1,j-1]=1 then begin a[i,j]:=1; giam(i,j); end
    else begin thoat:=true; exit; end
    end
    end
    else
    begin
    if (b[j-1,i-1]>1) or (b[i-1,j-1]>1) then begin thoat:=true; exit; end;
    if b[j-1,i-1]=0 then a[j,i]:=0
    else begin a[j,i]:=1; giam(j,i); end;
    if b[i-1,j-1]=0 then a[i,j]:=0
    else begin a[i,j]:=1; giam(i,j); end
    end;
    End;
    if i<=min then begin if b[i-1,i-1]>1 then begin thoat:=true; exit; end;
    if b[i-1,i-1]=0 then a[i,i]:=0
    else begin a[i,i]:=1; giam(i,i);end;
    end;
    End;
    Procedure lui(i:integer);
    Var j,t:integer;
    Begin
    if i>m then t:=m
    else
    if i>n then t:=n
    else t:=i;
    For j:=2 to t do
    Begin
    if (i>m) or (i>n) then
    begin
    if i>m then
    begin
    if a[j,i]=1 then begin tang(j,i); a[j,i]:=0; end
    end
    else
    begin
    if a[i,j]=1 then begin tang(i,j); a[i,j]:=0; end
    end;
    end
    else
    begin
    if a[j,i]=1 then begin tang(j,i); a[j,i]:=0; end;
    if a[i,j]=1 then begin tang(i,j); a[i,j]:=0; end
    end;
    End;
    End;
    Function Kt(k:integer):boolean;
    var i,j,m1,n1:integer;
    Begin
    If k>m then m1:=m
    else m1:=k;
    if k>n then m1:=n
    else n1:=k;
    For i:=1 to m1 do
    for j:=1 to n1 do
    if (b[i,j]<0) then begin kt:=false; exit; end; kt:=true; End; Function du:boolean; var i,j:integer; Begin {xem1;readln;} For i:=1 to m do for j:=1 to n{m-1} do if b[i,j]<>0 then
    begin
    du:=false;
    exit;
    end;
    du:=true;
    End;
    Procedure inkq;
    begin
    xem;
    {readln;}
    end;
    Procedure somin(i:integer);
    Begin
    if i={min}max+1 then
    if not thoat then
    if du then inkq ;
    if (i<={min}max) and not thoat {and kt(i-1)} then if i>min then
    Begin
    if m>n then
    begin
    a[i,1]:=0;
    thoat:=false; {xem1;}
    loang(i); {xem;xem1;readln;}
    somin(i+1);
    lui(i);
    a[i,1]:=1;
    thoat:=false;
    giam(i,1); {xem1;}
    loang(i); {xem;xem1;readln;}
    somin(i+1);
    lui(i);
    tang(i,1);
    end
    else
    begin
    {xem;readln;xem1;readln;}
    a[1,i]:=0;
    thoat:=false; {xem1;}
    loang(i); {xem;xem1;readln;}
    somin(i+1);
    lui(i);
    a[1,i]:=1;
    thoat:=false;
    giam(1,i); {xem1;}
    loang(i); {xem;xem1;readln;}
    somin(i+1);
    lui(i);
    tang(1,i);
    end
    End
    else
    Begin
    if i=1 then
    begin
    a[1,1]:=0; {xem;xem1;readln;}
    thoat:=false;
    somin(i+1);
    a[1,1]:=1;
    thoat:=false;
    giam(1,1); {xem;xem1;readln;}
    somin(i+1);
    tang(1,1);
    end
    else
    begin
    {write(i,’ ‘);}
    a[1,i]:=0;a[i,1]:=0;
    thoat:=false;
    loang(i); {xem;xem1;readln;}
    somin(i+1);
    lui(i);
    a[1,i]:=0;a[i,1]:=1;
    thoat:=false;
    giam(i,1);
    loang(i); {xem;xem1;readln;}
    somin(i+1);
    lui(i);
    tang(i,1);
    a[1,i]:=1;a[i,1]:=1;
    thoat:=false;
    giam(1,i);giam(i,1);
    loang(i); {xem;xem1;readln;}
    somin(i+1);
    lui(i);
    tang(1,i);tang(i,1);
    a[1,i]:=1;a[i,1]:=0;
    thoat:=false;
    giam(1,i);
    loang(i); {xem;xem1;readln;}
    somin(i+1);
    lui(i);
    tang(1,i);
    end;
    End;
    End;
    Procedure test;
    Var i,j:integer;
    Begin
    Doc;
    Xem;
    for i:=0 to n+1 do
    begin
    a[0,i]:=0; b[0,i]:=mx;
    a[m+1,i]:=0; b[m+1,i]:=mx;
    end;
    for i:= 0 to m+1 do
    begin
    a[i,0]:=0; b[i,0]:=mx;
    a[i,n+1]:=0; b[i,n+1]:=mx;
    end;
    minso;
    writeln;
    xem1;
    For i:=0 to m+1 do
    for j:=0 to n+1 do
    a[i,j]:=0;
    If n>m then begin min:=m; max:=n; end
    else begin min:=n; max:=m; end;
    thoat:=false;
    somin(1);
    End;
    BEGIN
    ClrScr;
    test;
    readln;
    END.

  3. #3
    Ngày tham gia
    Dec 2015
    Bài viết
    0
    Hình như bạn đã hiểu sai yêu cầu đề, vì đay không phải là bài toán dò mìn (trò chơi)

 

 

Quyền viết bài

  • Bạn Không thể gửi Chủ đề mới
  • Bạn Không thể Gửi trả lời
  • Bạn Không thể Gửi file đính kèm
  • Bạn Không thể Sửa bài viết của mình
  •  
Múi giờ GMT +7. Bây giờ là 01:02 PM.
Diễn đàn sử dụng vBulletin® Phiên bản 4.2.5.
Bản quyền của 2024 vBulletin Solutions, Inc. Tất cả quyền được bảo lưu.
Ban quản trị không chịu trách nhiệm về nội dung do thành viên đăng.