結果

問題 No.424 立体迷路
コンテスト
ユーザー ichibanshibori
提出日時 2016-09-24 07:07:54
言語 OCaml
(5.2.1)
結果
WA  
実行時間 -
コード長 2,903 bytes
コンパイル時間 385 ms
コンパイル使用メモリ 21,120 KB
実行使用メモリ 6,820 KB
最終ジャッジ日時 2024-10-08 23:49:08
合計ジャッジ時間 1,423 ms
ジャッジサーバーID
（参考情報） 		judge5 / judge1
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample AC * 1 WA * 4
other AC * 21
権限があれば一括ダウンロードができます

ソースコード

diff # 

open Str

module ISet = Set.Make(
    struct
        let compare = compare
        type t = int * int
    end)

let () =
    let ( @! ) lst n = List.nth lst n
    and ( @> ) arr (i ,j) = arr.(i - 1).(j - 1)
    in
    let h, w = read_line () |>
        Str.split (regexp_string " ") |>
        fun lst -> (int_of_string (lst @! 0), int_of_string (lst @! 1))
    and sx, sy, gx, gy = read_line () |>
        Str.split (regexp_string " ") |>
        fun lst -> (int_of_string (lst @! 0), int_of_string (lst @! 1), int_of_string (lst @! 2), int_of_string (lst @! 3))
    in
    let mapArr = Array.make_matrix w h 0 in
    let readB (x, (line:string)) =
        for y = 1 to w do
            mapArr.(y - 1).(x - 1) <- int_of_char line.[y - 1] - int_of_char '0'
        done
    in
    for x = 1 to h do
        readB (x, read_line ())
    done;
    let searchPath sy sx =
        let dxy = [(1, 0); (0, 1); (-1, 1); (0, -1)] in
        
        let canMove1 (cy, cx) (dy, dx) =
            let y, x = cy + dy, cx + dx in
            
            (*Printf.printf "!%d, %d\n" y x;*)
            y >= 1 && y <= w && x >= 1 && x <= h &&
            abs((mapArr @> (y, x)) - (mapArr @> (cy, cx))) <= 1
            
        and canMove2 (cy, cx) (dy, dx) = 
            let y1, y2 = cy + dy, cy + dy * 2
            and x1, x2 = cx + dx, cx + dx * 2
            in
            y2 >= 1 && y2 <= w && x2 >= 1 && x2 <= h &&
            mapArr @> (cy, cx) = mapArr @> (y2, x2) &&
            mapArr @> (cy, cx) > mapArr @> (y1, x1)
        in
        let rec searchPath' lst chkedSet =
            match lst with
            | [] -> false
            |  pos::rest ->
                    let cy, cx = pos in

                    (*Printf.printf "%d %d\n" cy cx;*)
                    
                    let cand1 = List.filter (canMove1 (cy, cx)) dxy
                    and cand2 = List.filter (canMove2 (cy, cx)) dxy |>
                        List.map (fun (dy, dx) -> (dy * 2, dx * 2))
                    in
                    let cand = List.append cand1 cand2 in
                    let candLst = List.map (fun (dy, dx) -> (cy + dy, cx + dx)) cand in
                    
                    (*candLst |> List.iter (fun (y, x) -> Printf.printf "%d, %d\n" y x);*)
                    
                    if List.exists (fun (y, x) -> y = gy && x = gx) candLst then true
                    else
                        let nextLst = List.append candLst rest |>
                            List.filter (fun pos -> not (ISet.mem pos chkedSet))
                        and nextChkedSet = ISet.add (cy, cx) chkedSet
                        in
                        searchPath' nextLst nextChkedSet
        in
        if sy = gy && sx = gx then true
        else searchPath' [(sy, sx)] ISet.empty
    in
    searchPath sy sx |> (function | true -> "YES" | false -> "NO") |> print_endline
0