Đề thi HSG thành phố (Cargo)

CARGO ( ã ra trong b đ Tin h c tr TP. à N ng 2008 - B ng C (THPT))Đ ộ ề ọ ẻ Đ ẵ ả Bản đồ một kho hàng hình chữ nhật kích thước mxn được chia thành các ô vuông đơn vị (m hàng, n cột: các hàng đánh số từ trên xuống dưới, các cột đánh số từ trái qua phải). Trên các ô của bản đồ có một số ký hiệu: •Các ký hiệu # đánh dấu các ô đã có một kiện hàng xếp sẵn, •Một ký hiệu *: Đánh dấu ô đang có một xe đẩy •Một ký hiệu $: Đánh dấu ô chứa kiện hàng cần xếp •Một ký hiệu @: Đánh dấu vị trí ô mà cần phải xếp kiện hàng B vào ô đó •Các ký hiệu dấu chấm ".": Cho biết ô đó trống Cần phải dùng xe đẩy ở * để đẩy kiện hàng ở $ đến vị trí @ sao cho trong quá trình di chuyển cũng như đẩy hàng, không chạm vào những kiện hàng đã được xếp sẵn. (Xe đẩy có thể di chuyển sang một trong 4 ô chung cạnh với ô đang đứng). Nếu có nhiều phương án thì chỉ ra một phương án sao cho xe đẩy phải di chuyển qua ít bước nhất. Các hướng di chuyển được chỉ ra trong hình dưới đây This image has been resized. Click this bar to view the full image. The original image is sized 774x401 and weights 48KB. Dữ liệu: Vào từ file văn bản CARGO.INP •Dòng 1: Ghi hai số nguyên dương m, n cách nhau một dấu cách (m, n ≤ 80) •m dòng tiếp theo, dòng thứ i ghi đủ n ký hiệu trên hàng thứ i của bản đồ theo đúng thứ tự từ trái qua phải. Các ký hiệu được ghi liền nhau Kết quả: Ghi ra file văn bản CARGO.OUT •Dòng 1: Ghi số bước di chuyển xe đẩy để thực hiện mục đích yêu cầu, nếu không có phương án khả thi thì dòng này ghi số -1 •Dòng 2: Nếu có phương án khả thi thì dòng này ghi các ký tự liền nhau thể hiện hướng di chuyển của xe đẩy R (East, West, South, North). Các chữ cái thường (e,w,s,n) thể hiện bước di chuyển không đẩy hàng, các chữ cái in hoa (E,W,S,N) thể hiện bước di chuyển có đẩy hàng. Ví dụ: This image has been resized. Click this bar to view the full image. The original image is sized 987x274 and weights 31KB. {$M 65520,0,655360} program CargoMove; const InputFile = 'CARGO.IN5'; OutputFile = 'CARGO.OUT'; max = 80; maxC = max * max * 4 + 1; DName: array[1 4] of Char = 'SEWN'; DLName: array[1 4] of Char = 'sewn'; dx: array[1 4] of ShortInt = (1, 0, 0, -1); dy: array[1 4] of ShortInt = (0, 1, -1, 0); type THeapArr = array[1 max * max * 4] of ShortInt; TWBoard = array[1 4, 1 max, 1 max] of Integer; TBBoard = array[1 4, 1 max, 1 max] of ShortInt; var m, n: Integer; a: array[0 max + 1, 0 max + 1] of Char; heapX, heapY, heapK: ^THeapArr; d, pos: ^TWBoard; Trace: ^TBBoard; TraceBFS: array[1 max, 1 max] of ShortInt; nHeap: Integer; XS, YS, kD, XD, YD, XR, YR: Integer; res: LongInt; procedure Enter; var f: Text; i, j: Integer; begin FillChar(a, SizeOf(a), '#'); Assign(f, InputFile); Reset(f); readln(f, m, n); XS := 0; YS := 0; XD := 0; YD := 0; for i := 1 to m do begin for j := 1 to n do begin Read(f, a[i, j]); case a[i, j] of '@': begin XD := i; YD := j; end; '$': begin XS := i; YS := j; end; '*': begin XR := i; YR := j; end; end; end; Readln(f); end; Close(f); end; function NodeValue(iHeap: Integer): Integer; begin NodeValue := d^[heapK^[iHeap], heapX^[iHeap], heapY^[iHeap]]; end; procedure SetNodeValue(iHeap, k, x, y: Integer); begin heapK^[iHeap] := k; heapX^[iHeap] := x; heapY^[iHeap] := y; Pos^[k, x, y] := iHeap; end; procedure Push(k, x, y: Integer); var r, c: Integer; begin c := Pos^[k, x, y]; if c = 0 then begin Inc(nHeap); c := nHeap; end; r := c div 2; while (r > 0) and (NodeValue(r) > d^[k, x, y]) do begin SetNodeValue(c, heapK^[r], heapX^[r], heapY^[r]); c := r; r := c div 2; end; SetNodeValue(c, k, x, y); end; function Valid(k, x, y: Integer): Boolean; begin Valid := a[x + dx[k], y + dy[k]] <> '#'; end; procedure Init; var k, x, y: Integer; begin New(d); for k := 1 to 4 do begin for x := 1 to m do for y := 1 to n do d^[k, x, y] := MaxC; end; New(pos); FillChar(pos^, SizeOf(pos^), 0); New(heapK); New(heapX); New(heapY); nHeap := 0; for k := 1 to 4 do if Valid(k, XD, YD) then begin d^[k, XD, YD] := 0; Push(k, XD, YD); end; New(Trace); end; procedure Pop(var pk, px, py: Integer); var tk, tx, ty: Integer; r, c: Integer; begin pk := heapK^[1]; px := heapX^[1]; py := heapY^[1]; pos^[pk, px, py] := -1; tk := heapK^[nHeap]; tx := heapX^[nHeap]; ty := heapY^[nHeap]; Dec(nHeap); r := 1; while r * 2 <= nHeap do begin c := r * 2; if (c < nHeap) and (NodeValue(c + 1) < NodeValue(c)) then Inc(c); if d^[tk, tx, ty] <= NodeValue(c) then Break; SetNodeValue(r, heapK^[c], heapX^[c], heapY^[c]); r := c; end; SetNodeValue(r, tk, tx, ty); end; function BFS(x1, y1, x2, y2, xC, yC: Integer): Integer; label Done; var Qx, Qy: array[1 max * max] of ShortInt; Layer: array[1 max, 1 max] of Integer; first, last: Integer; d, x, y, newx, newy: Integer; Save: Char; begin Qx[1] := x1; Qy[1] := y1; first := 1; last := 1; Save := a[xC, yC]; a[xC, yC] := '#'; FillChar(Layer, SizeOf(Layer), 0); Layer[x1, y1] := 1; while first <= last do begin x := Qx[first]; y := Qy[first]; Inc(first); for d := 1 to 4 do begin newx := x + dx[d]; newy := y + dy[d]; if (a[newx, newy] <> '#') and (Layer[newx, newy] = 0) then begin Layer[newx, newy] := Layer[x, y] + 1; if (newx = x2) and (newy = y2) then goto Done; Inc(last); Qx[last] := newx; Qy[last] := newy; end; end; end; Done: a[xC, yC] := Save; if Layer[x2, y2] = 0 then BFS := MaxC else BFS := Layer[x2, y2] - 1; end; procedure Update(pk, px, py: Integer); var k, x, y, dis: Integer; FD: Integer; begin FD := d^[pk, px, py]; k := pk; x := px + dx[pk]; y := py + dy[pk]; if Valid(k, x, y) and (FD + 1 < d^[k, x, y]) then begin d^[k, x, y] := FD + 1; Trace^[k, x, y] := 0; Push(k, x, y); end; x := px; y := py; for k := 1 to 4 do if Valid(k, x, y) then begin if FD >= d^[k, x, y] then Continue; dis := BFS(x + dx[pk], y + dy[pk], x + dx[k], y + dy[k], x, y); if FD + dis < d^[k, x, y] then begin d^[k, x, y] := FD + dis; Trace^[k, x, y] := pk; Push(k, x, y); end; end; end; function CanFinish: Boolean; var k: Integer; begin for k :=1 to 4 do if Valid(k, xS, yS) and (pos^[k, xS, yS] >= 0) then begin CanFinish := False; Exit; end; CanFinish := True; end; procedure Dijkstra; var pk, px, py: Integer; begin while nHeap <> 0 do begin Pop(pk, px, py); if CanFinish then Break; Update(pk, px, py); end; end; procedure GetResult; var dis: Integer; k: Integer; begin res := MaxLongInt; for k := 1 to 4 do if Valid(k, xS, yS) then begin dis := BFS(xS + dx[k], yS + dy[k], xR, yR, xS, yS); if d^[k, XS, yS] + dis < res then begin res := d^[k, XS, yS] + dis; kd := k; end; end; end; procedure FindPath(x1, y1, x2, y2, xC, yC: Integer); label Done; var Qx, Qy: array[1 max * max] of ShortInt; Layer: array[1 max, 1 max] of Integer; first, last: Integer; d, x, y, newx, newy: Integer; Save: Char; begin Qx[1] := x1; Qy[1] := y1; first := 1; last := 1; Save := a[xC, yC]; a[xC, yC] := '#'; FillChar(Layer, SizeOf(Layer), 0); Layer[x1, y1] := 1; while first <= last do begin x := Qx[first]; y := Qy[first]; Inc(first); for d := 1 to 4 do begin newx := x + dx[d]; newy := y + dy[d]; if (a[newx, newy] <> '#') and (Layer[newx, newy] = 0) then begin Layer[newx, newy] := Layer[x, y] + 1; TraceBFS[newx, newy] := d; if (newx = x2) and (newy = y2) then goto Done; Inc(last); Qx[last] := newx; Qy[last] := newy; end; end; end; Done: a[xC, yC] := Save; end; procedure Result; var f: Text; t, k, x, y: Integer; procedure WritePath(x1, y1, x2, y2: Integer); var d: Integer; begin while (x1 <> x2) or (y1 <> y2) do begin d := TraceBFS[x2, y2]; Write(f, DLName[5 - d]); x2 := x2 - dx[d]; y2 := y2 - dy[d]; end; end; begin Assign(f, OutputFile); Rewrite(f); if res >= MaxC then Writeln(f, -1) else begin Writeln(f, res); k := kd; x := xs; y := ys; FindPath(x + dx[k], y + dy[k], xR, yR, x, y); WritePath(x + dx[k], y + dy[k], xR, yR); while (x <> XD) or (y <> YD) do begin t := Trace^[k, x, y]; . nhất. Các hướng di chuyển được chỉ ra trong hình dưới đây This image has been resized. Click this bar to view the full image. The original image is sized. hiện mục đích yêu cầu, nếu không có phương án khả thi thì dòng này ghi số -1 •Dòng 2: Nếu có phương án khả thi thì dòng này ghi các ký tự liền nhau thể hiện