結果

問題 No.424 立体迷路
コンテスト
ユーザー ichibanshibori
提出日時 2016-09-25 02:49:28
言語 OCaml
(5.2.1)
結果
AC  
実行時間 12 ms / 2,000 ms
コード長 3,054 bytes
コンパイル時間 227 ms
コンパイル使用メモリ 21,120 KB
実行使用メモリ 5,376 KB
最終ジャッジ日時 2024-10-08 23:49:22
合計ジャッジ時間 1,107 ms
ジャッジサーバーID
（参考情報） 		judge3 / judge2
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample AC * 5
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)
    and choose f lst =
        let rec choose' f lst result =
            match lst with
            | [] -> result
            | x::xs ->
                let nextResult =
                    match f x with
                    | Some v -> v::result
                    | None -> result 
                in
                choose' f xs nextResult
        in
        choose' f lst []
    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, 0); (0, -1)] in
        
        let canMove1 chkedSet (cy, cx) (dy, dx) =
            let y, x = cy + dy, cx + dx in
            
            if y >= 1 && y <= w && x >= 1 && x <= h &&
                abs((mapArr @> (y, x)) - (mapArr @> (cy, cx))) <= 1 &&
                not (ISet.mem (y, x) chkedSet)
            then Some (y, x)
            else None
            
        and canMove2 chkedSet (cy, cx) (dy, dx) = 
            let y1, y2 = cy + dy, cy + dy * 2
            and x1, x2 = cx + dx, cx + dx * 2
            in
            if y2 >= 1 && y2 <= w && x2 >= 1 && x2 <= h &&
                mapArr @> (cy, cx) = mapArr @> (y2, x2) &&
                mapArr @> (cy, cx) > mapArr @> (y1, x1) &&
                not (ISet.mem (y2, x2) chkedSet)
            then Some (y2, x2)
            else None
        in
        let rec searchPath' lst chkedSet =
            match lst with
            | [] -> false
            |  pos::rest ->
                    let cy, cx = pos in
                    
                    if cy = gy && cx = gx then true
                    else
                        let cand1 = choose (canMove1 chkedSet (cy, cx)) dxy
                        and cand2 = choose (canMove2 chkedSet (cy, cx)) dxy
                        in
                        let nextLst = cand1 @ cand2 @ rest
                        and nextChkedSet = ISet.add (cy, cx) chkedSet
                        in
                        searchPath' nextLst nextChkedSet
        in
        searchPath' [(sy, sx)] ISet.empty
    in
    (* let stime = Unix.gettimeofday () in *)
    searchPath sy sx |> (function | true -> "YES" | false -> "NO") |> print_endline (*;
     let etime = Unix.gettimeofday () in
    print_float (etime -. stime) *)
0