kết quả từ 1 tới 3 trên 3

Bài tập gỡ mìn

  1. #1
    Ðến Từ
    Quảng Nam
    Thành Viên Thứ: 333174
    Giới tính: Nam
    Bài gửi
    2

    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.
    Quick reply to this message Trả lời       


  2. #2
    Ðến Từ
    Hà Nội
    Thành Viên Thứ: 247344
    Giới tính: Nữ
    Bài gửi
    10.098

    Reply: Bài tập gỡ mìn

    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.
    Thực sự thì mình chưa thấy ai lại hiền lành, dễ thương và tốt bụng như bạn Khách vậy

  3. Đã cảm ơn VSupport:


  4. #3
    Ðến Từ
    Quảng Nam
    Thành Viên Thứ: 333174
    Giới tính: Nam
    Bài gửi
    2

    Reply: Bài tập gỡ mìn

    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)