DouKaku?

let normalize_string str = Str.global_replace (Str.regexp "^\n") "" str

let array_of_string str =
   let len = String.length str in
   let ary = Array.make len '\000' in
   for i = 0 to len - 1 do
      ary.(i) <- str.[i]
   done;
   ary

let matrix_of_string str =
   match Str.split (Str.regexp "\n") (normalize_string str) with
   | (x::xs) as lst
        when List.for_all (fun s -> String.length x = String.length s) xs
     ->
        Array.map array_of_string (Array.of_list lst)
   | _ -> failwith "invalid input"

type direction =
| Upper | Lower | Left | Right
| UpperLeft | UpperRight
| LowerLeft | LowerRight

let tuple_add (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)

let rec index_of_direction dir =
   let add  = tuple_add in
   let self = index_of_direction in
   match dir with
   | Upper -> (-1, 0)
   | Lower -> ( 1, 0)
   | Left  -> (0, -1)
   | Right -> (0,  1)
   | UpperLeft  -> add (self Upper) (self Left)
   | UpperRight -> add (self Upper) (self Right)
   | LowerLeft  -> add (self Lower) (self Left)
   | LowerRight -> add (self Lower) (self Right)

let string_of_direction dir =
   match dir with
   | Upper -> "上"
   | Lower -> "下"
   | Left  -> "左"
   | Right -> "右"
   | UpperLeft  -> "左上"
   | UpperRight -> "右上"
   | LowerLeft  -> "左下"
   | LowerRight -> "右下"

let get matrix (x, y) =
   try Some matrix.(x).(y)
   with Invalid_argument _ -> None

exception Not_exists
let exists matrix ch_ary base_pos dir =
   let inc = index_of_direction dir in
   let next pos = tuple_add pos inc in
   try
      let _ =
         Array.fold_left begin fun pos ch ->
            match get matrix pos with
            | Some c when c = ch -> next pos
            | _ -> raise Not_exists
         end base_pos ch_ary
      in
      true
   with Not_exists -> false

let dirs_map matrix ch_ary base_pos =
   let dirs =
      [Upper; Lower; Left; Right; UpperLeft; UpperRight; LowerLeft; LowerRight]
   in
   List.fold_left begin fun acc dir ->
      if exists matrix ch_ary base_pos dir
      then (base_pos, string_of_direction dir)::acc
      else acc
   end [] dirs

let search search_base search_str =
   let matrix = matrix_of_string search_base in
   let ch_ary = array_of_string search_str in
   let ch     = ch_ary.(0) in
   let dmap   = dirs_map matrix ch_ary in
   let result = ref [] in
   let _ =
      Array.mapi begin fun x ary ->
         Array.mapi begin fun y c ->
            if c = ch then
               result := List.rev_append (dmap (x, y)) !result
         end ary
      end matrix
   in
   !result

let sample_input = "
LOUULU
UOLUOL
OLLOLU
LLOOUO
"
let sample_search_string = "UOL"

let rec print_result result =
   match result with
   | [] -> print_newline ()
   | ((x, y), dir)::rest ->
        Printf.printf "(%d, %d), %s\n" y x dir;
        print_result rest

let test () =
   let result = search sample_input sample_search_string in
   print_result (List.rev result)

let () = if not !Sys.interactive then test ()

(*二次元arrayのsub*)
let matrix_sub arr course x y len =
  let get (b,a) = arr.(a).(b) in
  Array.init len (fun i -> get
    (match course with
    | `Upper  -> (x),(y-i)
    | `Lower  -> (x),(y+i)
    | `Right -> (x+i),(y)
    | `Left  -> (x-i),(y)
    | `UpperRight -> (x+i),(y-i)
    | `UpperLeft -> (x-i),(y-i)
    | `LowerRight -> (x+i),(y+i)
    | `LowerLeft -> (x-i),(y+i)
  ));;

(*a.(x).(y)から八方向検索。sと同じなら位置と方角をprint*)
let scan8_print a x y s =
  List.iter2 (fun course str ->
    try
      if s = matrix_sub a course x y 3 
      then Printf.printf "(%d, %d), %s\n" x y str
    with _ -> () )
    [`Left; `Right; `LowerLeft; `LowerRight;
    `Lower; `Upper; `UpperLeft; `UpperRight]
    ["左"; "右"; "左下"; "右下"; "下"; "上"; "左上"; "右下"];;

(*Array.of_listのrev版*)
let array_of_rev_list = function
  | [] -> [||]
  | [hd] -> [|hd|]
  | hd::x::tl ->
      let len = List.length tl + 2 in
      let res = Array.make len hd in
      let rec loop i = function
        | [] -> res
        | hd::tl -> (res.(i) <- hd; loop (i-1) tl)
      in loop (len-2) (x::tl);;
      
(*マルチバイト混じりの文字列を,一字ごとに分けたlistに*)
let list_of_mbstr n s =
  let len = String.length s in
  let rec loop i acc =
    if i>=len then acc else
    match s.[i] with
    | '\000'..'\127' -> loop (i+1) ((String.sub s i 1)::acc)
    |  _ -> loop (i+n) ((String.sub s i n)::acc)
  in loop 0 [];;
  
(*sをchで分けた二次元arrayにする*)
let matrix_of_mbstr n ch s = 
  let len = String.length s in
  let rec loop i acc =
    if i>=len then acc else
    let j = try String.index_from s i ch 
            with Not_found -> len in
    loop (j+1) (array_of_rev_list 
      (list_of_mbstr n (String.sub s i (j-i)))::acc)
  in array_of_rev_list (loop 0 []);;

let matrix_for f a =
  for i=0 to Array.length a - 1 do  
    for j=0 to Array.length a.(i) - 1 do f j i done;
  done;;
  
let matrix_index s1 s2 =
  let s1 = matrix_of_mbstr 3 '\n' s1 in
  let s2 = array_of_rev_list (list_of_mbstr 3 s2) in
  matrix_for (fun x y -> scan8_print s1 x y s2) s1;;