Solution to "Prefix-Suffix Queries"

open Printf
open Scanf

let read_int _ = bscanf Scanning.stdin " %d " (fun x -> x)
let read_str _ = bscanf Scanning.stdin " %s " (fun x -> x)
let read_str_pair _ = bscanf Scanning.stdin " %s %s " (fun x y -> (x,y))
let () =
  let n = read_int () in
  let str = Array.init n read_str in
  let q = read_int () in
  let query = Array.init q read_str_pair in

  let rev s =
    let l = String.length s in
    String.init l (fun i -> s.[l-1-i])
  in

  let stx = Array.init n (fun i -> rev str.(i)) in

  let perm = Array.init n (fun i -> i) in
  let perx = Array.copy perm in

  Array.sort (fun i j -> compare str.(i) str.(j)) perm;
  Array.sort (fun i j -> compare stx.(i) stx.(j)) perx;

  let perxinv = Array.make n 0 in
  for i=0 to n-1 do
    perxinv.(perx.(i)) <- i
  done;

  let match_range str perm s =
  (* Returns None if s is a previx of none of the strings in str.
     returns Some (i,j) if the range [i,j] all match.
  *)
    let get i = str.(perm.(i)) in
    let l = String.length s in

    let compl a = (* compares a to s up to the length of s *)
      let m = String.length a in
      if m < l then compare a s else compare (String.sub a 0 l) s
    in

    let rec bsearch0 lo hi =
    (* know that compl str.(lo) = -1 and compl str.(hi) >= 0 *)
      if hi = lo+1 then hi else
    let m = (lo+hi)/2 in
    if compl (get m) >= 0 then bsearch0 lo m else bsearch0 m hi
    in
    let rec bsearch1 lo hi =
    (* know that compl str.(lo) = 0 and compl str.(hi) > 0 *)
      if hi = lo+1 then lo else
    let m = (lo+hi)/2 in
    if compl (get m) > 0 then bsearch1 lo m else bsearch1 m hi
    in

    let c0 = compl (get 0) in
    if c0 > 0 then None
    else if c0 = 0 then (
      if compl (get (n-1)) = 0 then Some (0, n-1)
      else Some (0, bsearch1 0 (n-1))
    ) else (
      if compl (get (n-1)) < 0 then None else
    let lo = bsearch0 0 (n-1) in
    if compl (get lo) > 0 then None
    else if compl (get (n-1)) <= 0 then Some (lo, n-1)
    else Some (lo, bsearch1 lo (n-1))
    )
  in

  (* Fenwick trees, adjusted to work from 0 to n-1 *)
  let f = Array.make (n+1) 0 in

  let increment i x =
    let rec loop i = if i <= n then (
      f.(i) <- f.(i) + x;
      loop (i + (i land (-i)))
    ) in
    loop (i+1)
  in

  let sum_to_left i =
    let rec loop i ac = if i = 0 then ac else
    loop (i - (i land (-i))) (ac + f.(i))
    in
    loop (i+1) 0
  in

  let range_sum i j =
    let to_remove = if i <= 0 then 0 else sum_to_left (i-1) in
    (sum_to_left j) - to_remove
  in

  let answer = Array.make q 0 in
  let start_events = Array.make n [] in
  let end_events = Array.make n [] in
  (* These event lists are lists of (query numbers,i,j)
      that happen at that point in time *)

  for q1 = 0 to q-1 do
    let (pre,suf) = query.(q1) in
    match (match_range str perm pre, match_range stx perx (rev suf)) with
      | (None, None) -> ()
      | (None, Some (i,j)) | (Some (i,j), None) -> answer.(q1) <- j-i+1
      | (Some (i,j), Some (i',j')) ->
    answer.(q1) <- j-i+1 + j'-i'+1;
    start_events.(i) <- (q1,i',j') :: start_events.(i);
    end_events.(j) <- (q1,i',j') :: end_events.(j)
  done;

  for x=0 to n-1 do
    let y = perxinv.(perm.(x)) in
    List.iter (fun (q1, i', j') ->
      answer.(q1) <- answer.(q1) + (range_sum i' j')
    ) start_events.(x);

    increment y 1;

    List.iter (fun (q1, i', j') ->
      answer.(q1) <- answer.(q1) - (range_sum i' j')
    ) end_events.(x);
  done;

  for q1 = 0 to q-1 do
    printf "%d\n" answer.(q1)
  done