let chan = Scanf.Scanning.from_channel (open_in "input.txt")
let read_int () = Scanf.bscanf chan " %d " (fun x -> x)

let ochan = open_out "output.txt"
let print_string s = Printf.fprintf ochan "%s" s

let () =
  let n = read_int() in
  let c = Array.init n (fun i -> read_int()) in
  let () = Array.sort compare c in

  let rec loop i j ac =
    if i=n then ac else
      if j >= n-1 || c.(j+1) > 2*c.(i) then
	loop (i+1) j (max (j-i+1) ac)
      else loop i (j+1) ac
  in

  let a = loop 0 0 0 in
    print_string (Printf.sprintf "%d\n" (n-a))

open Scanf;;
open Array;;
open Printf;;

(*print_endline "begin";;
 *)

let file_in = "input.txt";;
let file_out = "output.txt";;

let ic = open_in file_in;;
let n = Scanf.bscanf (Scanf.Scanning.from_channel ic) "%d " (fun x -> x);;
let a = Array.make n 0;;

(*print_endline "xx";;
 *)
let () =
  for i = 0 to n-1 do
    let x = Scanf.bscanf (Scanf.Scanning.from_channel ic) "%d " (fun x -> x) in
    a.(i) <- x
  done in
    Array.sort (fun x y -> y - x) a
;;

(*Array.iter (fun x -> print_int x; print_endline "") a;;
 *)

close_in ic;;

let my_min x y = if x < y then x else y;;

exception Found;;

let nrow =
  let row = ref 0 in
  let i = ref (n - 1) in
  try
    while (!i >=0) do
      if a.(0) <= (2*a.(!i)) then raise Found;
      row := !row + 1;
      i:=!i-1
    done; !row+1
  with Found -> !row+1;;

let ncol =
  let col = ref 0 in
  let i = ref 0 in
  try
    while (!i < n) do
      if 2*a.(n-1) >= a.(!i) then raise Found;
      col := !col + 1;
      i:=!i+1
    done; !col+1
  with Found -> !col+1;;

let biggest = max_int;;
let b = Array.make_matrix nrow ncol 0;;
(*Initialize the matrix*)
let () =
  for i = ncol-1 downto 1 do
    b.(nrow-1).(i) <- biggest
  done;
  for i = nrow-1 downto 1 do
    b.(i).(ncol-1) <- biggest
  done
;;

let () =
  b.(nrow-1).(0) <- nrow - 1;
  b.(0).(ncol-1) <- ncol -1
;;

let my_min x y z = min (min x y) (min y z);;

  (*
for i = ncol-2 downto 0 do
  for j = nrow -2 downto 0 do
    let x = b.(j+1).(i) in
    let y = b.(j).(i+1) in
    let z = if a.(nrow - 1 - j) > 2*a.(n-1 - (ncol-1 - i)) then biggest else (ncol-1-i)+(nrow-1-j)
    in
    b.(j).(i) <- (my_min x y z)
  done
done; let oc = open_out file_out in
      if b.(0).(0) = biggest then
	Printf.fprintf oc "%d\n" 1
      else
	Printf.fprintf oc "%d\n" b.(0).(0);;
   *)

let ncold = ncol -1 in
let nrowd = nrow -1 in
let rec find_b00 i j =
  match i,j with
    (0, ncold) -> nrowd
   |(x, ncold) when x>0 -> biggest
   |(nrowd, 0) -> ncold
   |(nrowd, x) when x>0 -> nrowd
   |_ ->
     begin
       let x = find_b00 (j+1) (i) in
       let y = find_b00 (j) (i+1) in
       let z = if a.(nrow - 1 - j) > 2*a.(n-1 - (ncol-1 - i)) then biggest else (ncol-1-i)+(nrow-1-j)
       in
       my_min x y z
     end
    in let rslt = find_b00 0 0 in
       let oc = open_out file_out in
       Printf.fprintf oc "%d\n" rslt;;

open Scanf;;
open Array;;
open Printf;;

(* This version uses binary search and rec
 *)

let file_in = "input.txt";;
let file_out = "output.txt";;

let ic = open_in file_in;;
let oc = open_out file_out;;

let n = Scanf.bscanf (Scanf.Scanning.from_channel ic) "%d " (fun x -> x);;
let a = Array.make n 0;;

let () =
  for i = 0 to n-1 do
    let x = Scanf.bscanf (Scanf.Scanning.from_channel ic) "%d " (fun x -> x) in
    a.(i) <- x
  done in
    Array.sort (fun x y -> y - x) a
;; (*array a is from large to small*)

(*
Array.iter (fun x -> print_int x; print_string " ") a;;
print_endline "\n-------";;
 *)

close_in ic;;

let my_min x y z = min (min x y ) (min y z )

exception Found;;

let rec b1search x ii jj =
  let mid = (ii+jj)/2 in
  if mid = ii then ii
  else
    if x > 2*a.(mid) then b1search x (mid+1) jj
    else b1search x ii mid
;;

let rec b2search x ii jj =
let mid = (ii+jj)/2 in
if mid = ii then ii
else
  if 2*x < a.(mid) then b2search x (mid+1) jj
  else b2search x ii mid
;;

(*let y = b1search 8 0 5 in
print_int y;;
 *)

let rec solve i j =
  if i >= j then 0
  else if
    a.(i) <= 2*a.(j)
  then i+(n-1-j)
  else
    begin
      let x = j-(b1search a.(i) i j) in (*b1search search for small value*)
      let y = (b2search a.(j) i j)-i in  (*b2 search searchh for large value*)
      let z = 2 + (solve (i+1) (j-1)) in
      my_min x y z;
    end
;;

let rslt = solve 0 (n-1)
    in
    Printf.fprintf oc "%d\n" rslt
;;

(*amazing: this version uses the technique of two pointers*)

let chan = Scanf.Scanning.from_channel (open_in "input.txt")
let read_int () = Scanf.bscanf chan " %d " (fun x -> x)

let ochan = open_out "output.txt"
let print_string s = Printf.fprintf ochan "%s" s

let () =
  let n = read_int() in
  let c = Array.init n (fun i -> read_int()) in
  let () = Array.sort compare c in

  let rec loop i j ac =
    if i=j then ac else
      if c.(j) <= 2*c.(i) then
	loop (i+1) j (max (j-i+1) ac)
      else loop i (j-1) ac
  in

  let a = loop 0 (n-1) 0 in
    print_string (Printf.sprintf "%d\n" (n-a))


open Printf
open Scanf

let rec fold i j f init = if i>j then init else fold (i+1) j f (f i init)
let sum i j f = fold i j (fun i a -> (f i) + a) 0

let read_int () = bscanf Scanning.stdib " %d " (fun x -> x)
let read_string () = bscanf Scanning.stdib " %s " (fun x -> x)
let () =
  let n = read_int () in
  let adj = Array.init n (fun _ -> read_string()) in
  let a = Array.init n (fun _ -> read_int()) in

  let set = Array.make n false in
  let count = Array.make n 0 in

  let compute_count () =
    Array.fill count 0 n 0;
    for i=0 to n-1 do
      if set.(i) then
	for j=0 to n-1 do
	  if adj.(i).[j] = '1' then count.(j) <- count.(j) + 1
	done
    done
  in

  let rec find_correct_item i = if i=n then -1 else
      if a.(i) = count.(i) then i else find_correct_item (i+1)
  in

  let rec loop () =
    compute_count ();
    let k = find_correct_item 0 in
    if k >= 0 then (
      set.(k) <- true;
      loop ()
    )
  in

  loop ();

  let c = sum 0 (n-1) (fun i -> if set.(i) then 1 else 0) in

  printf "%d\n" c;

  for i=0 to n-1 do
    if set.(i) then printf "%d " (i+1)
  done;

  print_newline();

open Printf
open Scanf

let rec fold i j f init = if i>j then init else fold (i+1) j f (f i init)
let sum i j f = fold i j (fun i a -> (f i) + a) 0
let read_int() = bscanf Scanning.stdib " %d " (fun x->x)
let read_string() = bscanf Scanning.stdib " %s " (fun x->x)
let () =
  let n = read_int() in
  let adj = Array.init n (fun _-> read_string()) in
  let a = Array.init n (fun _-> read_int()) in
  (* set.(i) = true means excluse i from party*)
  let set = Array.make n false in
  let count = Array.make n 0 in

  (* compute each person get how many msgs*)
  let compute() =
	Array.fill count 0 n 0;
	for i=0 to n-1 do
	  if set.(i) then
		for j=0 to n-1 do
		  if adj.(i).[j]='1' then count.(j)<-count.(j)+1
		done
	done
  in

  let rec find_bad_person i =
	if i>=n then i
	else
	  if a.(i)=count.(i) then i else find_bad_person (i+1)
  in

  let rec loop() =
	compute();
	let i = find_bad_person 0 in
	if i<n then (
	  set.(i)<-true;
	  loop()
	)
  in

  loop();
  let c = sum 0 (n-1) (fun i -> if set.(i) then 1 else 0) in
  printf "%d\n" c;

  for i=0 to n-1 do
	if set.(i) then printf "%d " (i+1)
  done;
  print_newline();

open Printf
open Scanf

let read_int () = bscanf Scanning.stdib " %d " (fun x -> x)
let read_string () = bscanf Scanning.stdib " %s " (fun x -> x)
let () =
  let n = read_int () in
  let _ = Array.init n (fun _ -> read_string()) in
  let a = Array.init n (fun _ -> read_int()) in

  if a.(0) = 0 then (
    printf "1\n";
    printf "1\n"
  ) else (
    printf "0\n";
    printf "\n";
  )

open Printf
open Scanf

let read_int () = bscanf Scanning.stdib " %d " (fun x -> x)
let read_string () = bscanf Scanning.stdib " %s " (fun x -> x)
let () =
  let n = read_int () in
  let _ = Array.init n (fun _ -> read_string()) in
  let a = Array.init n (fun _ -> read_int()) in

  if a.(0) = 0 then (
    printf "1\n";
    printf "1\n"
  ) else (
    printf "0\n"
  )


open Printf open Scanf
module Lib = struct
  let i32,i64,ist = Int64.(to_int,of_int,to_string)
  let (+$) = (+) let (-$) = (-) let (/$) = (/) let ( *$) = ( * ) let (%$) = (mod)
  let labs = Int64.abs
  let (+),(-),( * ),(/),(mod),(%) = Int64.(add,sub,mul,div,rem,rem)
  let (+=) r v = r := !r + v
  let (-=) r v = r := !r - v
  let ( *= ) r v = r := !r * v
  let (/=) r v = r := !r / v
  let (%=) r v = r := !r % v
  let max_i64,min_i64 = Int64.(max_int,min_int)
  (* math *)
  let ceildiv p q = (p+q-1L) / q
  let rec gcd m n = match m,n with | m,0L -> m | m,n -> gcd n (m mod n)
  let lcm m n = m / gcd m n * n
  module I64_infix = struct
    let (land),(lor),(lxor),lnot,(lsl),(lsr),(asr) =
      let open Int64 in
      (logand),(logor),(logxor),lognot,
      (fun u v -> shift_left u (i32 v)),
      (fun u v -> shift_right u (i32 v)),
      (fun u v -> shift_right_logical u (i32 v))
  end
  (* input *)
  let input_i64_array n = Array.init (i32 n) (fun _ -> Scanf.scanf " %Ld" (fun v -> v))
  let get_i64 _ = Scanf.scanf " %Ld" (fun v -> v)
  let get_2_i64 _ = Scanf.scanf " %Ld %Ld" (fun u v -> u,v)
  let get_3_i64 _ = Scanf.scanf " %Ld %Ld %Ld" (fun u v w -> u,v,w)
  let get_4_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld" (fun u v w x -> u,v,w,x)
  let get_5_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld %Ld" (fun u v w x y -> u,v,w,x,y)
  let i32_get_int _ = Scanf.scanf " %d" (fun v -> v) let i32_get_2_ints _ = Scanf.scanf " %d %d" (fun u v -> u,v) let i32_get_3_ints _ = Scanf.scanf " %d %d %d" (fun u v w -> u,v,w) let i32_get_4_ints _ = Scanf.scanf " %d %d %d %d" (fun u v w x -> u,v,w,x) let i32_get_5_ints _ = Scanf.scanf " %d %d %d %d %d" (fun u v w x y -> u,v,w,x,y)
  (* utils *)
  external id : 'a -> 'a = "%identity"
  let ( *< ) f g x = f (g x)
  let ( *> ) f g x = g (f x)
  let rv f p q = f q p (* ex. 24 |> rv (/) 6 *)
  let alen a = i64 @@ Array.length a
  let llen l = i64 @@  List.length l
  let string_of_list ?(separator=" ") f ls = ls |> List.map f |> String.concat separator
  let string_of_array ?(separator=" ") f a = a |> Array.to_list |> string_of_list ~separator f
  let char_list_of_string str = let rec f0 i a = if i<0 then a else f0 (i-$1) (str.[i]::a) in f0 (String.length str -$ 1) []
  let string_of_char_list ls = List.fold_left (fun u v -> u ^ (String.make 1 v)) "" ls
  let fail _ = failwith "fail"
  let dx,dy = [|1;0;-1;0|],[|0;1;0;-1|]
  let range l r = let ls = ref [] in for i=i32 l to i32 r do ls := i :: !ls done;!ls |> List.rev
  let cartesian_product u v = u |> List.map (fun p -> List.map (fun q -> p,q) v) |> List.flatten
  let shuffle a = Array.sort (fun _ _ -> (Random.int 3) -$ 1) a
  let binary_search ng ok f = let d = if ng < ok then 1L else -1L in
    let rec f0 ng ok =
      if labs (ok - ng) <= 1L then ok
      else let mid = ng + (ok - ng) / 2L in if f mid then f0 ng mid else f0 mid ok
    in f0 (ng-1L*d) (ok+1L*d)
  let lower_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >= v)
  let upper_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >  v)
  let equal_range a v = lower_bound a v, upper_bound a v (* #=snd-fst *)
  let rec fix f x = f (fix f) x
  let fix_memo ?(size=10000) f x =
    let tb = Hashtbl.create ~random:true size in
    let rec f0 x =
      try Hashtbl.find tb x with
      | Not_found -> (let v = f f0 x in Hashtbl.add tb x v; v)
    in f0 x
  (* imperative *)
  let rep f t ?(stride=1L) fbod = let i = ref f in while !i <= t do fbod !i; i := !i + stride done
  let repb f t ?(stride=1L) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i + stride done
  let repm f t ?(stride=1L) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i + stride done; !m
  let repi f t ?(stride=1) fbod = let i = ref f in while !i <= t do fbod !i; i := !i +$ stride done
  let repib f t ?(stride=1) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i +$ stride done
  let repim f t ?(stride=1) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i +$ stride done; !m
  let rep_rev f t ?(stride=1L) fbod = rep t f ~stride @@ fun v -> fbod @@ f + t - v
  let repb_rev f t ?(stride=1L) fbod = repb t f ~stride @@ fun v -> fbod @@ f + t - v
  let repm_rev f t ?(stride=1L) m0 fbod = repm f t ~stride m0 @@ fun u v -> fbod u @@ f + t - v
  let repi_rev f t ?(stride=1) fbod = repi t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repib_rev f t ?(stride=1) fbod = repib t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repim_rev f t ?(stride=1) m0 fbod = repim f t ~stride m0 @@ fun u v -> fbod u @@ f +$ t -$ v
  (* output *)
  let print_list_mle f ls = string_of_list f ls |> print_endline
  let print_array_mle f a = string_of_array f a |> print_endline
  let print_list f ls = ls |> List.iter (fun v -> printf "%s " @@ f v); print_newline ()
  let print_array f a = a |> Array.iter (fun v -> printf "%s " @@ f v); print_newline ()
  (* debug *)
  let dump_2darr f a = a |> Array.iter (fun b -> print_array f b)
  let dump_i64_list ls = print_list ist ls
  let dump_i64_array a = print_array ist a
end open Lib open Array

module CumulSumArray = struct
  let make a =
    let ln = Array.length a
    in let a1 = Array.make (ln+$1) 0L in for i=1 to ln do a1.(i) <- a1.(i-$1) + a.(i-$1) done; a1
  let sum l r a = (* 0-origin,closed *)
    if l>r then 0L else (a.(r+$1) - a.(l))
  let sum_1orig l r a = sum (l-$1) (r-$1) a
end

module ModCalc = struct
  let md = 1000000007L
  (* let md = 998244353L *)
  let validate v =
    (v + (labs(v) / md + 1L) * md) mod md
  let _add_mod md u v = u mod md + v mod md |> validate
  let _sub_mod md u v = u mod md - v mod md |> validate
  let _mul_mod md u v = u mod md * v mod md |> validate
  (* let rec pw u v =
    if v=0L then 1L
    else if v=1L then u mod md
    else let p = pw u (v/2L) in
      if v mod 2L = 0L then _mul_mod md p p
      else _mul_mod md (_mul_mod md p p) u *)
  let rec pow_mod n k = (* to be tested *)
    let rec f a n = function
    | 0L -> a mod md
    | 1L -> _mul_mod md a n
    | k when k mod 2L = 0L -> f a (_mul_mod md n n) (k/2L)
    | k -> f (_mul_mod md a n) n (k-1L)
    in f 1L n k
  let _inv md v = pow_mod v (md-2L) (* md must be prime; otherwise use extended Euclidean algorithm *)
  let _div_mod md u v =
    _mul_mod md u (_inv md v)
  let (+%)  u v = _add_mod md u v
  let (-%)  u v = _sub_mod md u v
  let ( *%) u v = _mul_mod md u v
  let (/%)  u v = _div_mod md u v
  let rec pow x n = if n = 0L then 1L
    else if n mod 2L = 1L then x *% pow x (n-1L)
    else let w = pow x (n/2L) in w *% w
  let fact_simple n = let rec f0 n v = if n = 0L then v else f0 (n-1L) (n*%v) in f0 n 1L
  type fact = Fact of int64 array * int64 array
  let fact_make n =
    let m = i32 n in
    let fact,invf = Array.make m 0L,Array.make m 0L in
    fact.(0) <- 1L;
    for i=1 to m-$1 do fact.(i) <- fact.(i-$1) *% (i64 i); done;
    invf.(m-$1) <- pow fact.(m-$1) (md-2L);
    for i=m-$2 downto 0 do invf.(i) <- invf.(i+$1) *% (i64 i + 1L); done; Fact (fact,invf)
  let fact_get i (Fact (fact,_)) = fact.(i)
  (* let fact_inv_get i (Fact (_,invf)) = invf.(i) (* not tested yet *) *)
  let ncr n r (Fact (fact,invf)) = fact.(n) *% invf.(r) *% invf.(n-$r)
end open ModCalc
let tp k = pow 2L k
let () =
  let n,q = get_2_i64 0 in
  let a =
    let s = scanf " %s"@@id in
    let a = make (String.length s) 0L in
    String.iteri (fun i c -> a.(i) <- i64 @@ (int_of_char c) -$ (int_of_char '0')) s;
    a in
  let ones = CumulSumArray.make a in
  rep 1L q (fun _ ->
    let l,r = get_2_i64 0 in
    let one = CumulSumArray.sum_1orig (i32 l) (i32 r) ones in
    let zero = r - l + 1L - one in
    let sum_one = tp one - 1L in
    let sum_zero = sum_one * (tp zero - 1L) in
    printf "%Ld\n" (sum_one +% sum_zero)
  )

open Printf open Scanf
module Lib = struct
  let i32,i64,ist = Int64.(to_int,of_int,to_string)
  let (+$) = (+) let (-$) = (-) let (/$) = (/) let ( *$) = ( * ) let (%$) = (mod)
  let labs = Int64.abs
  let (+),(-),( * ),(/),(mod),(%) = Int64.(add,sub,mul,div,rem,rem)
  let (+=) r v = r := !r + v
  let (-=) r v = r := !r - v
  let ( *= ) r v = r := !r * v
  let (/=) r v = r := !r / v
  let (%=) r v = r := !r % v
  let max_i64,min_i64 = Int64.(max_int,min_int)
  (* math *)
  let ceildiv p q = (p+q-1L) / q
  let rec gcd m n = match m,n with | m,0L -> m | m,n -> gcd n (m mod n)
  let lcm m n = m / gcd m n * n
  module I64_infix = struct
    let (land),(lor),(lxor),lnot,(lsl),(lsr),(asr) =
      let open Int64 in
      (logand),(logor),(logxor),lognot,
      (fun u v -> shift_left u (i32 v)),
      (fun u v -> shift_right u (i32 v)),
      (fun u v -> shift_right_logical u (i32 v))
  end
  (* input *)
  let input_i64_array n = Array.init (i32 n) (fun _ -> Scanf.scanf " %Ld" (fun v -> v))
  let get_i64 _ = Scanf.scanf " %Ld" (fun v -> v)
  let get_2_i64 _ = Scanf.scanf " %Ld %Ld" (fun u v -> u,v)
  let get_3_i64 _ = Scanf.scanf " %Ld %Ld %Ld" (fun u v w -> u,v,w)
  let get_4_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld" (fun u v w x -> u,v,w,x)
  let get_5_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld %Ld" (fun u v w x y -> u,v,w,x,y)
  let i32_get_int _ = Scanf.scanf " %d" (fun v -> v) let i32_get_2_ints _ = Scanf.scanf " %d %d" (fun u v -> u,v) let i32_get_3_ints _ = Scanf.scanf " %d %d %d" (fun u v w -> u,v,w) let i32_get_4_ints _ = Scanf.scanf " %d %d %d %d" (fun u v w x -> u,v,w,x) let i32_get_5_ints _ = Scanf.scanf " %d %d %d %d %d" (fun u v w x y -> u,v,w,x,y)
  (* utils *)
  external id : 'a -> 'a = "%identity"
  let ( *< ) f g x = f (g x)
  let ( *> ) f g x = g (f x)
  let rv f p q = f q p (* ex. 24 |> rv (/) 6 *)
  let alen a = i64 @@ Array.length a
  let llen l = i64 @@  List.length l
  let string_of_list ?(separator=" ") f ls = ls |> List.map f |> String.concat separator
  let string_of_array ?(separator=" ") f a = a |> Array.to_list |> string_of_list ~separator f
  let char_list_of_string str = let rec f0 i a = if i<0 then a else f0 (i-$1) (str.[i]::a) in f0 (String.length str -$ 1) []
  let string_of_char_list ls = List.fold_left (fun u v -> u ^ (String.make 1 v)) "" ls
  let fail _ = failwith "fail"
  let dx,dy = [|1;0;-1;0|],[|0;1;0;-1|]
  let range l r = let ls = ref [] in for i=i32 l to i32 r do ls := i :: !ls done;!ls |> List.rev
  let cartesian_product u v = u |> List.map (fun p -> List.map (fun q -> p,q) v) |> List.flatten
  let shuffle a = Array.sort (fun _ _ -> (Random.int 3) -$ 1) a
  let binary_search ng ok f = let d = if ng < ok then 1L else -1L in
    let rec f0 ng ok =
      if labs (ok - ng) <= 1L then ok
      else let mid = ng + (ok - ng) / 2L in if f mid then f0 ng mid else f0 mid ok
    in f0 (ng-1L*d) (ok+1L*d)
  let lower_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >= v)
  let upper_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >  v)
  let equal_range a v = lower_bound a v, upper_bound a v (* #=snd-fst *)
  let rec fix f x = f (fix f) x
  let fix_memo ?(size=10000) f x =
    let tb = Hashtbl.create ~random:true size in
    let rec f0 x =
      try Hashtbl.find tb x with
      | Not_found -> (let v = f f0 x in Hashtbl.add tb x v; v)
    in f0 x
  (* imperative *)
  let rep f t ?(stride=1L) fbod = let i = ref f in while !i <= t do fbod !i; i := !i + stride done
  let repb f t ?(stride=1L) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i + stride done
  let repm f t ?(stride=1L) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i + stride done; !m
  let repi f t ?(stride=1) fbod = let i = ref f in while !i <= t do fbod !i; i := !i +$ stride done
  let repib f t ?(stride=1) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i +$ stride done
  let repim f t ?(stride=1) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i +$ stride done; !m
  let rep_rev f t ?(stride=1L) fbod = rep t f ~stride @@ fun v -> fbod @@ f + t - v
  let repb_rev f t ?(stride=1L) fbod = repb t f ~stride @@ fun v -> fbod @@ f + t - v
  let repm_rev f t ?(stride=1L) m0 fbod = repm f t ~stride m0 @@ fun u v -> fbod u @@ f + t - v
  let repi_rev f t ?(stride=1) fbod = repi t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repib_rev f t ?(stride=1) fbod = repib t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repim_rev f t ?(stride=1) m0 fbod = repim f t ~stride m0 @@ fun u v -> fbod u @@ f +$ t -$ v
  (* output *)
  let print_list_mle f ls = string_of_list f ls |> print_endline
  let print_array_mle f a = string_of_array f a |> print_endline
  let print_list f ls = ls |> List.iter (fun v -> printf "%s " @@ f v); print_newline ()
  let print_array f a = a |> Array.iter (fun v -> printf "%s " @@ f v); print_newline ()
  (* debug *)
  let dump_2darr f a = a |> Array.iter (fun b -> print_array f b)
  let dump_i64_list ls = print_list ist ls
  let dump_i64_array a = print_array ist a
end open Lib open Array

module CumulSumArray = struct
  let make a =
    let ln = Array.length a
    in let a1 = Array.make (ln+$1) 0L in for i=1 to ln do a1.(i) <- a1.(i-$1) + a.(i-$1) done; a1
  let sum l r a = (* 0-origin,closed *)
    if l>r then 0L else (a.(r+$1) - a.(l))
  let sum_1orig l r a = sum (l-$1) (r-$1) a
end

module ModCalc = struct
  let md = 1000000007L
  (* let md = 998244353L *)
  let validate v =
    (v + (labs(v) / md + 1L) * md) mod md
  let _add_mod md u v = u mod md + v mod md |> validate
  let _sub_mod md u v = u mod md - v mod md |> validate
  let _mul_mod md u v = u mod md * v mod md |> validate
  let rec pw u v =
    if v=0L then 1L
    else if v=1L then u mod md
    else let p = pw u (v/2L) in
      if v mod 2L = 0L then _mul_mod md p p
      else _mul_mod md (_mul_mod md p p) u
  let _inv md v = pw v (md-2L) (* md must be prime; otherwise use extended Euclidean algorithm *)
  let _div_mod md u v =
    _mul_mod md u (_inv md v)
  let (+%)  u v = _add_mod md u v
  let (-%)  u v = _sub_mod md u v
  let ( *%) u v = _mul_mod md u v
  let (/%)  u v = _div_mod md u v
  let rec pow x n = if n = 0L then 1L
    else if n mod 2L = 1L then x *% pow x (n-1L)
    else let w = pow x (n/2L) in w *% w
  let fact_simple n = let rec f0 n v = if n = 0L then v else f0 (n-1L) (n*%v) in f0 n 1L
  type fact = Fact of int64 array * int64 array
  let fact_make n =
    let m = i32 n in
    let fact,invf = Array.make m 0L,Array.make m 0L in
    fact.(0) <- 1L;
    for i=1 to m-$1 do fact.(i) <- fact.(i-$1) *% (i64 i); done;
    invf.(m-$1) <- pow fact.(m-$1) (md-2L);
    for i=m-$2 downto 0 do invf.(i) <- invf.(i+$1) *% (i64 i + 1L); done; Fact (fact,invf)
  let fact_get i (Fact (fact,_)) = fact.(i)
  (* let fact_inv_get i (Fact (_,invf)) = invf.(i) (* not tested yet *) *)
  let ncr n r (Fact (fact,invf)) = fact.(n) *% invf.(r) *% invf.(n-$r)
end open ModCalc

let tp i =
  let i = ref i in
  let x = ref 2L in
  let r = ref 1L in
  while !i > 0L do
    if !i mod 2L = 1L then (
      r := !r *% !x;
    );
    x := !x *% !x;
    i /= 2L;
  done; !r

let () =
  let n,q = get_2_i64 0 in
  let a =
    let s = scanf " %s"@@id in
    let a = make (String.length s) 0L in
    String.iteri (fun i c -> a.(i) <- i64 @@ (int_of_char c) -$ (int_of_char '0')) s;
    a in
  let ones = CumulSumArray.make a in
  rep 1L q (fun _ ->
    let l,r = get_2_i64 0 in
    let one = CumulSumArray.sum_1orig (i32 l) (i32 r) ones in
    let zero = r - l + 1L - one in
    (* printf "%Ld %Ld\n" one zero; *)
    let sum_one = tp one - 1L in
    (* printf "%Ld\n" sum_one; *)
    let sum_zero = sum_one * (tp zero - 1L) in
    (* printf "%Ld\n" sum_zero; *)
    printf "%Ld\n" (sum_one +% sum_zero)
  )

open Printf open Scanf
module Lib = struct
  let i32,i64,ist = Int64.(to_int,of_int,to_string)
  let (+$) = (+) let (-$) = (-) let (/$) = (/) let ( *$) = ( * ) let (%$) = (mod)
  let labs = Int64.abs
  let (+),(-),( * ),(/),(mod),(%) = Int64.(add,sub,mul,div,rem,rem)
  let (+=) r v = r := !r + v
  let (-=) r v = r := !r - v
  let ( *= ) r v = r := !r * v
  let (/=) r v = r := !r / v
  let (%=) r v = r := !r % v
  let max_i64,min_i64 = Int64.(max_int,min_int)
  (* math *)
  let ceildiv p q = (p+q-1L) / q
  let rec gcd m n = match m,n with | m,0L -> m | m,n -> gcd n (m mod n)
  let lcm m n = m / gcd m n * n
  module I64_infix = struct
    let (land),(lor),(lxor),lnot,(lsl),(lsr),(asr) =
      let open Int64 in
      (logand),(logor),(logxor),lognot,
      (fun u v -> shift_left u (i32 v)),
      (fun u v -> shift_right u (i32 v)),
      (fun u v -> shift_right_logical u (i32 v))
  end
  (* input *)
  let input_i64_array n = Array.init (i32 n) (fun _ -> Scanf.scanf " %Ld" (fun v -> v))
  let get_i64 _ = Scanf.scanf " %Ld" (fun v -> v)
  let get_2_i64 _ = Scanf.scanf " %Ld %Ld" (fun u v -> u,v)
  let get_3_i64 _ = Scanf.scanf " %Ld %Ld %Ld" (fun u v w -> u,v,w)
  let get_4_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld" (fun u v w x -> u,v,w,x)
  let get_5_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld %Ld" (fun u v w x y -> u,v,w,x,y)
  let i32_get_int _ = Scanf.scanf " %d" (fun v -> v) let i32_get_2_ints _ = Scanf.scanf " %d %d" (fun u v -> u,v) let i32_get_3_ints _ = Scanf.scanf " %d %d %d" (fun u v w -> u,v,w) let i32_get_4_ints _ = Scanf.scanf " %d %d %d %d" (fun u v w x -> u,v,w,x) let i32_get_5_ints _ = Scanf.scanf " %d %d %d %d %d" (fun u v w x y -> u,v,w,x,y)
  (* utils *)
  external id : 'a -> 'a = "%identity"
  let ( *< ) f g x = f (g x)
  let ( *> ) f g x = g (f x)
  let rv f p q = f q p (* ex. 24 |> rv (/) 6 *)
  let alen a = i64 @@ Array.length a
  let llen l = i64 @@  List.length l
  let string_of_list ?(separator=" ") f ls = ls |> List.map f |> String.concat separator
  let string_of_array ?(separator=" ") f a = a |> Array.to_list |> string_of_list ~separator f
  let char_list_of_string str = let rec f0 i a = if i<0 then a else f0 (i-$1) (str.[i]::a) in f0 (String.length str -$ 1) []
  let string_of_char_list ls = List.fold_left (fun u v -> u ^ (String.make 1 v)) "" ls
  let fail _ = failwith "fail"
  let dx,dy = [|1;0;-1;0|],[|0;1;0;-1|]
  let range l r = let ls = ref [] in for i=i32 l to i32 r do ls := i :: !ls done;!ls |> List.rev
  let cartesian_product u v = u |> List.map (fun p -> List.map (fun q -> p,q) v) |> List.flatten
  let shuffle a = Array.sort (fun _ _ -> (Random.int 3) -$ 1) a
  let binary_search ng ok f = let d = if ng < ok then 1L else -1L in
    let rec f0 ng ok =
      if labs (ok - ng) <= 1L then ok
      else let mid = ng + (ok - ng) / 2L in if f mid then f0 ng mid else f0 mid ok
    in f0 (ng-1L*d) (ok+1L*d)
  let lower_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >= v)
  let upper_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >  v)
  let equal_range a v = lower_bound a v, upper_bound a v (* #=snd-fst *)
  let rec fix f x = f (fix f) x
  let fix_memo ?(size=10000) f x =
    let tb = Hashtbl.create ~random:true size in
    let rec f0 x =
      try Hashtbl.find tb x with
      | Not_found -> (let v = f f0 x in Hashtbl.add tb x v; v)
    in f0 x
  (* imperative *)
  let rep f t ?(stride=1L) fbod = let i = ref f in while !i <= t do fbod !i; i := !i + stride done
  let repb f t ?(stride=1L) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i + stride done
  let repm f t ?(stride=1L) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i + stride done; !m
  let repi f t ?(stride=1) fbod = let i = ref f in while !i <= t do fbod !i; i := !i +$ stride done
  let repib f t ?(stride=1) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i +$ stride done
  let repim f t ?(stride=1) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i +$ stride done; !m
  let rep_rev f t ?(stride=1L) fbod = rep t f ~stride @@ fun v -> fbod @@ f + t - v
  let repb_rev f t ?(stride=1L) fbod = repb t f ~stride @@ fun v -> fbod @@ f + t - v
  let repm_rev f t ?(stride=1L) m0 fbod = repm f t ~stride m0 @@ fun u v -> fbod u @@ f + t - v
  let repi_rev f t ?(stride=1) fbod = repi t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repib_rev f t ?(stride=1) fbod = repib t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repim_rev f t ?(stride=1) m0 fbod = repim f t ~stride m0 @@ fun u v -> fbod u @@ f +$ t -$ v
  (* output *)
  let print_list_mle f ls = string_of_list f ls |> print_endline
  let print_array_mle f a = string_of_array f a |> print_endline
  let print_list f ls = ls |> List.iter (fun v -> printf "%s " @@ f v); print_newline ()
  let print_array f a = a |> Array.iter (fun v -> printf "%s " @@ f v); print_newline ()
  (* debug *)
  let dump_2darr f a = a |> Array.iter (fun b -> print_array f b)
  let dump_i64_list ls = print_list ist ls
  let dump_i64_array a = print_array ist a
end open Lib open Array

module CumulSumArray = struct
  let make a =
    let ln = Array.length a
    in let a1 = Array.make (ln+$1) 0L in for i=1 to ln do a1.(i) <- a1.(i-$1) + a.(i-$1) done; a1
  let sum l r a = (* 0-origin,closed *)
    if l>r then 0L else (a.(r+$1) - a.(l))
  let sum_1orig l r a = sum (l-$1) (r-$1) a
end

let md = 1000000007L
let ( *$ ) p q = ((p mod md) * (q mod md)) mod md
let pow n k =
  let rec f a n = function
  | 0L -> a
  | 1L -> n*$a
  | k when k mod 2L = 0L -> f a (n*$n) (k/2L)
  | k -> f (a*$n) (n*$n) (k/2L)
  in f 1L n k

let () =
  let n,q = get_2_i64 0 in
  let a =
    let s = scanf " %s"@@id in
    let a = make (String.length s) 0L in
    String.iteri (fun i c -> a.(i) <- i64 @@ (int_of_char c) -$ (int_of_char '0')) s;
    a in
  let ones = CumulSumArray.make a in
  rep 1L q (fun _ ->
    let l,r = get_2_i64 0 in
    let one = CumulSumArray.sum_1orig (i32 l) (i32 r) ones in
    let zero = r - l + 1L - one in
    let sum_one = pow 2L one - 1L in
    let sum_zero = sum_one * (pow 2L zero - 1L) in
    printf "%Ld\n" @@ (sum_one + sum_zero) mod md
  )

open Printf open Scanf
module Lib = struct
  let i32,i64,ist = Int64.(to_int,of_int,to_string)
  let (+$) = (+) let (-$) = (-) let (/$) = (/) let ( *$) = ( * ) let (%$) = (mod)
  let labs = Int64.abs
  let (+),(-),( * ),(/),(mod),(%) = Int64.(add,sub,mul,div,rem,rem)
  let (+=) r v = r := !r + v
  let (-=) r v = r := !r - v
  let ( *= ) r v = r := !r * v
  let (/=) r v = r := !r / v
  let (%=) r v = r := !r % v
  let max_i64,min_i64 = Int64.(max_int,min_int)
  (* math *)
  let ceildiv p q = (p+q-1L) / q
  let rec gcd m n = match m,n with | m,0L -> m | m,n -> gcd n (m mod n)
  let lcm m n = m / gcd m n * n
  module I64_infix = struct
    let (land),(lor),(lxor),lnot,(lsl),(lsr),(asr) =
      let open Int64 in
      (logand),(logor),(logxor),lognot,
      (fun u v -> shift_left u (i32 v)),
      (fun u v -> shift_right u (i32 v)),
      (fun u v -> shift_right_logical u (i32 v))
  end
  (* input *)
  let input_i64_array n = Array.init (i32 n) (fun _ -> Scanf.scanf " %Ld" (fun v -> v))
  let get_i64 _ = Scanf.scanf " %Ld" (fun v -> v)
  let get_2_i64 _ = Scanf.scanf " %Ld %Ld" (fun u v -> u,v)
  let get_3_i64 _ = Scanf.scanf " %Ld %Ld %Ld" (fun u v w -> u,v,w)
  let get_4_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld" (fun u v w x -> u,v,w,x)
  let get_5_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld %Ld" (fun u v w x y -> u,v,w,x,y)
  let i32_get_int _ = Scanf.scanf " %d" (fun v -> v) let i32_get_2_ints _ = Scanf.scanf " %d %d" (fun u v -> u,v) let i32_get_3_ints _ = Scanf.scanf " %d %d %d" (fun u v w -> u,v,w) let i32_get_4_ints _ = Scanf.scanf " %d %d %d %d" (fun u v w x -> u,v,w,x) let i32_get_5_ints _ = Scanf.scanf " %d %d %d %d %d" (fun u v w x y -> u,v,w,x,y)
  (* utils *)
  external id : 'a -> 'a = "%identity"
  let ( *< ) f g x = f (g x)
  let ( *> ) f g x = g (f x)
  let rv f p q = f q p (* ex. 24 |> rv (/) 6 *)
  let alen a = i64 @@ Array.length a
  let llen l = i64 @@  List.length l
  let string_of_list ?(separator=" ") f ls = ls |> List.map f |> String.concat separator
  let string_of_array ?(separator=" ") f a = a |> Array.to_list |> string_of_list ~separator f
  let char_list_of_string str = let rec f0 i a = if i<0 then a else f0 (i-$1) (str.[i]::a) in f0 (String.length str -$ 1) []
  let string_of_char_list ls = List.fold_left (fun u v -> u ^ (String.make 1 v)) "" ls
  let fail _ = failwith "fail"
  let dx,dy = [|1;0;-1;0|],[|0;1;0;-1|]
  let range l r = let ls = ref [] in for i=i32 l to i32 r do ls := i :: !ls done;!ls |> List.rev
  let cartesian_product u v = u |> List.map (fun p -> List.map (fun q -> p,q) v) |> List.flatten
  let shuffle a = Array.sort (fun _ _ -> (Random.int 3) -$ 1) a
  let binary_search ng ok f = let d = if ng < ok then 1L else -1L in
    let rec f0 ng ok =
      if labs (ok - ng) <= 1L then ok
      else let mid = ng + (ok - ng) / 2L in if f mid then f0 ng mid else f0 mid ok
    in f0 (ng-1L*d) (ok+1L*d)
  let lower_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >= v)
  let upper_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >  v)
  let equal_range a v = lower_bound a v, upper_bound a v (* #=snd-fst *)
  let rec fix f x = f (fix f) x
  let fix_memo ?(size=10000) f x =
    let tb = Hashtbl.create ~random:true size in
    let rec f0 x =
      try Hashtbl.find tb x with
      | Not_found -> (let v = f f0 x in Hashtbl.add tb x v; v)
    in f0 x
  (* imperative *)
  let rep f t ?(stride=1L) fbod = let i = ref f in while !i <= t do fbod !i; i := !i + stride done
  let repb f t ?(stride=1L) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i + stride done
  let repm f t ?(stride=1L) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i + stride done; !m
  let repi f t ?(stride=1) fbod = let i = ref f in while !i <= t do fbod !i; i := !i +$ stride done
  let repib f t ?(stride=1) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i +$ stride done
  let repim f t ?(stride=1) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i +$ stride done; !m
  let rep_rev f t ?(stride=1L) fbod = rep t f ~stride @@ fun v -> fbod @@ f + t - v
  let repb_rev f t ?(stride=1L) fbod = repb t f ~stride @@ fun v -> fbod @@ f + t - v
  let repm_rev f t ?(stride=1L) m0 fbod = repm f t ~stride m0 @@ fun u v -> fbod u @@ f + t - v
  let repi_rev f t ?(stride=1) fbod = repi t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repib_rev f t ?(stride=1) fbod = repib t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repim_rev f t ?(stride=1) m0 fbod = repim f t ~stride m0 @@ fun u v -> fbod u @@ f +$ t -$ v
  (* output *)
  let print_list_mle f ls = string_of_list f ls |> print_endline
  let print_array_mle f a = string_of_array f a |> print_endline
  let print_list f ls = ls |> List.iter (fun v -> printf "%s " @@ f v); print_newline ()
  let print_array f a = a |> Array.iter (fun v -> printf "%s " @@ f v); print_newline ()
  (* debug *)
  let dump_2darr f a = a |> Array.iter (fun b -> print_array f b)
  let dump_i64_list ls = print_list ist ls
  let dump_i64_array a = print_array ist a
end open Lib open Array
module CumulSumArray = struct
  let make a =
    let ln = Array.length a
    in let a1 = Array.make (ln+$1) 0L in for i=1 to ln do a1.(i) <- a1.(i-$1) + a.(i-$1) done; a1
  let sum l r a = (* 0-origin,closed *)
    if l>r then 0L else (a.(r+$1) - a.(l))
  let sum_1orig l r a = sum (l-$1) (r-$1) a
end
module ModCalc_test = struct
  let md = 1000000007L
  (* let md = 998244353L *)
  (* be careful of negative int *)
  let (+%) p q = ((p mod md) + (q mod md)) mod md
  let (-%) p q = ((p mod md) - (q mod md)) mod md
  let ( *% ) p q = ((p mod md) * (q mod md)) mod md
  let rec pow_mod n k = (* to be tested *)
    let rec f a n = function
    | 0L -> a mod md
    | 1L -> a *% n
    | k when k mod 2L = 0L -> f a (n *% n) (k/2L)
    | k -> f (a *% n) n (k-1L)
    in f 1L n k
  let inv v = pow_mod v (md-2L) (* md must be prime; otherwise use extended Euclidean algorithm *)
  let (/%) p q = p *% (inv q)
  let fact_simple n = let rec f0 n v = if n = 0L then v else f0 (n-1L) (n*%v) in f0 n 1L
  type fact = Fact of int64 array * int64 array
  let fact_make n =
    let m = i32 n in
    let fact,invf = Array.make m 0L,Array.make m 0L in
    fact.(0) <- 1L;
    for i=1 to m-$1 do fact.(i) <- fact.(i-$1) *% (i64 i); done;
    invf.(m-$1) <- pow_mod fact.(m-$1) (md-2L);
    for i=m-$2 downto 0 do invf.(i) <- invf.(i+$1) *% (i64 i + 1L); done; Fact (fact,invf)
  let fact_get i (Fact (fact,_)) = fact.(i)
  let ncr n r (Fact (fact,invf)) = fact.(n) *% invf.(r) *% invf.(n-$r)
end
open ModCalc_test
let () =
  let n,q = get_2_i64 0 in
  let a =
    let s = scanf " %s"@@id in
    let a = make (String.length s) 0L in
    String.iteri (fun i c -> a.(i) <- i64 @@ (int_of_char c) -$ (int_of_char '0')) s;
    a in
  let ones = CumulSumArray.make a in
  rep 1L q (fun _ ->
    let l,r = get_2_i64 0 in
    let one = CumulSumArray.sum_1orig (i32 l) (i32 r) ones in
    let zero = r - l + 1L - one in
    let sum_one = pow_mod 2L one - 1L in
    let sum_zero = sum_one * (pow_mod 2L zero - 1L) in
    printf "%Ld\n" @@ sum_one +% sum_zero
  )

open Printf open Scanf
module Lib = struct
  let i32,i64,ist = Int64.(to_int,of_int,to_string)
  let (+$) = (+) let (-$) = (-) let (/$) = (/) let ( *$) = ( * ) let (%$) = (mod)
  let labs = Int64.abs
  let (+),(-),( * ),(/),(mod),(%) = Int64.(add,sub,mul,div,rem,rem)
  let (+=) r v = r := !r + v
  let (-=) r v = r := !r - v
  let ( *= ) r v = r := !r * v
  let (/=) r v = r := !r / v
  let (%=) r v = r := !r % v
  let max_i64,min_i64 = Int64.(max_int,min_int)
  (* math *)
  let ceildiv p q = (p+q-1L) / q
  let rec gcd m n = match m,n with | m,0L -> m | m,n -> gcd n (m mod n)
  let lcm m n = m / gcd m n * n
  module I64_infix = struct
    let (land),(lor),(lxor),lnot,(lsl),(lsr),(asr) =
      let open Int64 in
      (logand),(logor),(logxor),lognot,
      (fun u v -> shift_left u (i32 v)),
      (fun u v -> shift_right u (i32 v)),
      (fun u v -> shift_right_logical u (i32 v))
  end
  (* input *)
  let input_i64_array n = Array.init (i32 n) (fun _ -> Scanf.scanf " %Ld" (fun v -> v))
  let get_i64 _ = Scanf.scanf " %Ld" (fun v -> v)
  let get_2_i64 _ = Scanf.scanf " %Ld %Ld" (fun u v -> u,v)
  let get_3_i64 _ = Scanf.scanf " %Ld %Ld %Ld" (fun u v w -> u,v,w)
  let get_4_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld" (fun u v w x -> u,v,w,x)
  let get_5_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld %Ld" (fun u v w x y -> u,v,w,x,y)
  let i32_get_int _ = Scanf.scanf " %d" (fun v -> v) let i32_get_2_ints _ = Scanf.scanf " %d %d" (fun u v -> u,v) let i32_get_3_ints _ = Scanf.scanf " %d %d %d" (fun u v w -> u,v,w) let i32_get_4_ints _ = Scanf.scanf " %d %d %d %d" (fun u v w x -> u,v,w,x) let i32_get_5_ints _ = Scanf.scanf " %d %d %d %d %d" (fun u v w x y -> u,v,w,x,y)
  (* utils *)
  external id : 'a -> 'a = "%identity"
  let ( *< ) f g x = f (g x)
  let ( *> ) f g x = g (f x)
  let rv f p q = f q p (* ex. 24 |> rv (/) 6 *)
  let alen a = i64 @@ Array.length a
  let llen l = i64 @@  List.length l
  let string_of_list ?(separator=" ") f ls = ls |> List.map f |> String.concat separator
  let string_of_array ?(separator=" ") f a = a |> Array.to_list |> string_of_list ~separator f
  let char_list_of_string str = let rec f0 i a = if i<0 then a else f0 (i-$1) (str.[i]::a) in f0 (String.length str -$ 1) []
  let string_of_char_list ls = List.fold_left (fun u v -> u ^ (String.make 1 v)) "" ls
  let fail _ = failwith "fail"
  let dx,dy = [|1;0;-1;0|],[|0;1;0;-1|]
  let range l r = let ls = ref [] in for i=i32 l to i32 r do ls := i :: !ls done;!ls |> List.rev
  let cartesian_product u v = u |> List.map (fun p -> List.map (fun q -> p,q) v) |> List.flatten
  let shuffle a = Array.sort (fun _ _ -> (Random.int 3) -$ 1) a
  let binary_search ng ok f = let d = if ng < ok then 1L else -1L in
    let rec f0 ng ok =
      if labs (ok - ng) <= 1L then ok
      else let mid = ng + (ok - ng) / 2L in if f mid then f0 ng mid else f0 mid ok
    in f0 (ng-1L*d) (ok+1L*d)
  let lower_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >= v)
  let upper_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >  v)
  let equal_range a v = lower_bound a v, upper_bound a v (* #=snd-fst *)
  let rec fix f x = f (fix f) x
  let fix_memo ?(size=10000) f x =
    let tb = Hashtbl.create ~random:true size in
    let rec f0 x =
      try Hashtbl.find tb x with
      | Not_found -> (let v = f f0 x in Hashtbl.add tb x v; v)
    in f0 x
  (* imperative *)
  let rep f t ?(stride=1L) fbod = let i = ref f in while !i <= t do fbod !i; i := !i + stride done
  let repb f t ?(stride=1L) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i + stride done
  let repm f t ?(stride=1L) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i + stride done; !m
  let repi f t ?(stride=1) fbod = let i = ref f in while !i <= t do fbod !i; i := !i +$ stride done
  let repib f t ?(stride=1) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i +$ stride done
  let repim f t ?(stride=1) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i +$ stride done; !m
  let rep_rev f t ?(stride=1L) fbod = rep t f ~stride @@ fun v -> fbod @@ f + t - v
  let repb_rev f t ?(stride=1L) fbod = repb t f ~stride @@ fun v -> fbod @@ f + t - v
  let repm_rev f t ?(stride=1L) m0 fbod = repm f t ~stride m0 @@ fun u v -> fbod u @@ f + t - v
  let repi_rev f t ?(stride=1) fbod = repi t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repib_rev f t ?(stride=1) fbod = repib t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repim_rev f t ?(stride=1) m0 fbod = repim f t ~stride m0 @@ fun u v -> fbod u @@ f +$ t -$ v
  (* output *)
  let print_list_mle f ls = string_of_list f ls |> print_endline
  let print_array_mle f a = string_of_array f a |> print_endline
  let print_list f ls = ls |> List.iter (fun v -> printf "%s " @@ f v); print_newline ()
  let print_array f a = a |> Array.iter (fun v -> printf "%s " @@ f v); print_newline ()
  (* debug *)
  let dump_2darr f a = a |> Array.iter (fun b -> print_array f b)
  let dump_i64_list ls = print_list ist ls
  let dump_i64_array a = print_array ist a
end open Lib open Array

module CumulSumArray = struct
  let make a =
    let ln = Array.length a
    in let a1 = Array.make (ln+$1) 0L in for i=1 to ln do a1.(i) <- a1.(i-$1) + a.(i-$1) done; a1
  let sum l r a = (* 0-origin,closed *)
    if l>r then 0L else (a.(r+$1) - a.(l))
  let sum_1orig l r a = sum (l-$1) (r-$1) a
end

let md = 1000000007L
let ( +$ ) p q = ((p mod md) + (q mod md)) mod md
let ( *$ ) p q = ((p mod md) * (q mod md)) mod md
let pow n k =
  let rec f a n = function
  | 0L -> a
  | 1L -> n*$a
  | k when k mod 2L = 0L -> f a (n*$n) (k/2L)
  | k -> f (a*$n) (n*$n) (k/2L)
  in f 1L n k

let () =
  let n,q = get_2_i64 0 in
  let a =
    let s = scanf " %s"@@id in
    let a = make (String.length s) 0L in
    String.iteri (fun i c -> a.(i) <- i64 @@ (int_of_char c) -$ (int_of_char '0')) s;
    a in
  let ones = CumulSumArray.make a in
  rep 1L q (fun _ ->
    let l,r = get_2_i64 0 in
    let one = CumulSumArray.sum_1orig (i32 l) (i32 r) ones in
    let zero = r - l + 1L - one in
    let sum_one = pow 2L one - 1L in
    let sum_zero = sum_one * (pow 2L zero - 1L) in
    printf "%Ld\n" @@ sum_one +$ sum_zero
  )

open Printf open Scanf
module Lib = struct
  let i32,i64,ist = Int64.(to_int,of_int,to_string)
  let (+$) = (+) let (-$) = (-) let (/$) = (/) let ( *$) = ( * ) let (%$) = (mod)
  let labs = Int64.abs
  let (+),(-),( * ),(/),(mod),(%) = Int64.(add,sub,mul,div,rem,rem)
  let (+=) r v = r := !r + v
  let (-=) r v = r := !r - v
  let ( *= ) r v = r := !r * v
  let (/=) r v = r := !r / v
  let (%=) r v = r := !r % v
  let max_i64,min_i64 = Int64.(max_int,min_int)
  (* math *)
  let ceildiv p q = (p+q-1L) / q
  let rec gcd m n = match m,n with | m,0L -> m | m,n -> gcd n (m mod n)
  let lcm m n = m / gcd m n * n
  module I64_infix = struct
    let (land),(lor),(lxor),lnot,(lsl),(lsr),(asr) =
      let open Int64 in
      (logand),(logor),(logxor),lognot,
      (fun u v -> shift_left u (i32 v)),
      (fun u v -> shift_right u (i32 v)),
      (fun u v -> shift_right_logical u (i32 v))
  end
  (* input *)
  let input_i64_array n = Array.init (i32 n) (fun _ -> Scanf.scanf " %Ld" (fun v -> v))
  let get_i64 _ = Scanf.scanf " %Ld" (fun v -> v)
  let get_2_i64 _ = Scanf.scanf " %Ld %Ld" (fun u v -> u,v)
  let get_3_i64 _ = Scanf.scanf " %Ld %Ld %Ld" (fun u v w -> u,v,w)
  let get_4_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld" (fun u v w x -> u,v,w,x)
  let get_5_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld %Ld" (fun u v w x y -> u,v,w,x,y)
  let i32_get_int _ = Scanf.scanf " %d" (fun v -> v) let i32_get_2_ints _ = Scanf.scanf " %d %d" (fun u v -> u,v) let i32_get_3_ints _ = Scanf.scanf " %d %d %d" (fun u v w -> u,v,w) let i32_get_4_ints _ = Scanf.scanf " %d %d %d %d" (fun u v w x -> u,v,w,x) let i32_get_5_ints _ = Scanf.scanf " %d %d %d %d %d" (fun u v w x y -> u,v,w,x,y)
  (* utils *)
  external id : 'a -> 'a = "%identity"
  let ( *< ) f g x = f (g x)
  let ( *> ) f g x = g (f x)
  let rv f p q = f q p (* ex. 24 |> rv (/) 6 *)
  let alen a = i64 @@ Array.length a
  let llen l = i64 @@  List.length l
  let string_of_list ?(separator=" ") f ls = ls |> List.map f |> String.concat separator
  let string_of_array ?(separator=" ") f a = a |> Array.to_list |> string_of_list ~separator f
  let char_list_of_string str = let rec f0 i a = if i<0 then a else f0 (i-$1) (str.[i]::a) in f0 (String.length str -$ 1) []
  let string_of_char_list ls = List.fold_left (fun u v -> u ^ (String.make 1 v)) "" ls
  let fail _ = failwith "fail"
  let dx,dy = [|1;0;-1;0|],[|0;1;0;-1|]
  let range l r = let ls = ref [] in for i=i32 l to i32 r do ls := i :: !ls done;!ls |> List.rev
  let cartesian_product u v = u |> List.map (fun p -> List.map (fun q -> p,q) v) |> List.flatten
  let shuffle a = Array.sort (fun _ _ -> (Random.int 3) -$ 1) a
  let binary_search ng ok f = let d = if ng < ok then 1L else -1L in
    let rec f0 ng ok =
      if labs (ok - ng) <= 1L then ok
      else let mid = ng + (ok - ng) / 2L in if f mid then f0 ng mid else f0 mid ok
    in f0 (ng-1L*d) (ok+1L*d)
  let lower_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >= v)
  let upper_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >  v)
  let equal_range a v = lower_bound a v, upper_bound a v (* #=snd-fst *)
  let rec fix f x = f (fix f) x
  let fix_memo ?(size=10000) f x =
    let tb = Hashtbl.create ~random:true size in
    let rec f0 x =
      try Hashtbl.find tb x with
      | Not_found -> (let v = f f0 x in Hashtbl.add tb x v; v)
    in f0 x
  (* imperative *)
  let rep f t ?(stride=1L) fbod = let i = ref f in while !i <= t do fbod !i; i := !i + stride done
  let repb f t ?(stride=1L) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i + stride done
  let repm f t ?(stride=1L) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i + stride done; !m
  let repi f t ?(stride=1) fbod = let i = ref f in while !i <= t do fbod !i; i := !i +$ stride done
  let repib f t ?(stride=1) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i +$ stride done
  let repim f t ?(stride=1) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i +$ stride done; !m
  let rep_rev f t ?(stride=1L) fbod = rep t f ~stride @@ fun v -> fbod @@ f + t - v
  let repb_rev f t ?(stride=1L) fbod = repb t f ~stride @@ fun v -> fbod @@ f + t - v
  let repm_rev f t ?(stride=1L) m0 fbod = repm f t ~stride m0 @@ fun u v -> fbod u @@ f + t - v
  let repi_rev f t ?(stride=1) fbod = repi t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repib_rev f t ?(stride=1) fbod = repib t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repim_rev f t ?(stride=1) m0 fbod = repim f t ~stride m0 @@ fun u v -> fbod u @@ f +$ t -$ v
  (* output *)
  let print_list_mle f ls = string_of_list f ls |> print_endline
  let print_array_mle f a = string_of_array f a |> print_endline
  let print_list f ls = ls |> List.iter (fun v -> printf "%s " @@ f v); print_newline ()
  let print_array f a = a |> Array.iter (fun v -> printf "%s " @@ f v); print_newline ()
  (* debug *)
  let dump_2darr f a = a |> Array.iter (fun b -> print_array f b)
  let dump_i64_list ls = print_list ist ls
  let dump_i64_array a = print_array ist a
end open Lib open Array
module CumulSumArray = struct
  let make a =
    let ln = Array.length a
    in let a1 = Array.make (ln+$1) 0L in for i=1 to ln do a1.(i) <- a1.(i-$1) + a.(i-$1) done; a1
  let sum l r a = (* 0-origin,closed *)
    if l>r then 0L else (a.(r+$1) - a.(l))
  let sum_1orig l r a = sum (l-$1) (r-$1) a
end
module ModCalc_test = struct
  let md = 1000000007L
  (* let md = 998244353L *)
  (* be careful of negative int *)
  let (+%) p q = ((p mod md) + (q mod md)) mod md
  let (-%) p q = ((p mod md) - (q mod md)) mod md
  let ( *% ) p q = ((p mod md) * (q mod md)) mod md
  let rec pow_mod n k = (* to be tested *)
    let rec f a n = function
    | 0L -> a mod md
    | 1L -> a *% n
    | k when k mod 2L = 0L -> f a (n *% n) (k/2L)
    | k -> f (a *% n) n (k-1L)
    in f 1L n k
  (* let inv v = pow_mod v (md-2L) (* md must be prime; otherwise use extended Euclidean algorithm *)
  let (/%) p q = p *% (inv q)
  let fact_simple n = let rec f0 n v = if n = 0L then v else f0 (n-1L) (n*%v) in f0 n 1L
  type fact = Fact of int64 array * int64 array
  let fact_make n =
    let m = i32 n in
    let fact,invf = Array.make m 0L,Array.make m 0L in
    fact.(0) <- 1L;
    for i=1 to m-$1 do fact.(i) <- fact.(i-$1) *% (i64 i); done;
    invf.(m-$1) <- pow_mod fact.(m-$1) (md-2L);
    for i=m-$2 downto 0 do invf.(i) <- invf.(i+$1) *% (i64 i + 1L); done; Fact (fact,invf)
  let fact_get i (Fact (fact,_)) = fact.(i)
  let ncr n r (Fact (fact,invf)) = fact.(n) *% invf.(r) *% invf.(n-$r) *)
end
open ModCalc_test
let () =
  let n,q = get_2_i64 0 in
  let a =
    let s = scanf " %s"@@id in
    let a = make (String.length s) 0L in
    String.iteri (fun i c -> a.(i) <- i64 @@ (int_of_char c) -$ (int_of_char '0')) s;
    a in
  let ones = CumulSumArray.make a in
  rep 1L q (fun _ ->
    let l,r = get_2_i64 0 in
    let one = CumulSumArray.sum_1orig (i32 l) (i32 r) ones in
    let zero = r - l + 1L - one in
    let sum_one = pow_mod 2L one - 1L in
    let sum_zero = sum_one * (pow_mod 2L zero - 1L) in
    printf "%Ld\n" @@ sum_one +% sum_zero
  )

open Printf open Scanf
module Lib = struct
  let i32,i64,ist = Int64.(to_int,of_int,to_string)
  let (+$) = (+) let (-$) = (-) let (/$) = (/) let ( *$) = ( * ) let (%$) = (mod)
  let labs = Int64.abs
  let (+),(-),( * ),(/),(mod),(%) = Int64.(add,sub,mul,div,rem,rem)
  let (+=) r v = r := !r + v
  let (-=) r v = r := !r - v
  let ( *= ) r v = r := !r * v
  let (/=) r v = r := !r / v
  let (%=) r v = r := !r % v
  let max_i64,min_i64 = Int64.(max_int,min_int)
  (* math *)
  let ceildiv p q = (p+q-1L) / q
  let rec gcd m n = match m,n with | m,0L -> m | m,n -> gcd n (m mod n)
  let lcm m n = m / gcd m n * n
  module I64_infix = struct
    let (land),(lor),(lxor),lnot,(lsl),(lsr),(asr) =
      let open Int64 in
      (logand),(logor),(logxor),lognot,
      (fun u v -> shift_left u (i32 v)),
      (fun u v -> shift_right u (i32 v)),
      (fun u v -> shift_right_logical u (i32 v))
  end
  (* input *)
  let input_i64_array n = Array.init (i32 n) (fun _ -> Scanf.scanf " %Ld" (fun v -> v))
  let get_i64 _ = Scanf.scanf " %Ld" (fun v -> v)
  let get_2_i64 _ = Scanf.scanf " %Ld %Ld" (fun u v -> u,v)
  let get_3_i64 _ = Scanf.scanf " %Ld %Ld %Ld" (fun u v w -> u,v,w)
  let get_4_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld" (fun u v w x -> u,v,w,x)
  let get_5_i64 _ = Scanf.scanf " %Ld %Ld %Ld %Ld %Ld" (fun u v w x y -> u,v,w,x,y)
  let i32_get_int _ = Scanf.scanf " %d" (fun v -> v) let i32_get_2_ints _ = Scanf.scanf " %d %d" (fun u v -> u,v) let i32_get_3_ints _ = Scanf.scanf " %d %d %d" (fun u v w -> u,v,w) let i32_get_4_ints _ = Scanf.scanf " %d %d %d %d" (fun u v w x -> u,v,w,x) let i32_get_5_ints _ = Scanf.scanf " %d %d %d %d %d" (fun u v w x y -> u,v,w,x,y)
  (* utils *)
  external id : 'a -> 'a = "%identity"
  let ( *< ) f g x = f (g x)
  let ( *> ) f g x = g (f x)
  let rv f p q = f q p (* ex. 24 |> rv (/) 6 *)
  let alen a = i64 @@ Array.length a
  let llen l = i64 @@  List.length l
  let string_of_list ?(separator=" ") f ls = ls |> List.map f |> String.concat separator
  let string_of_array ?(separator=" ") f a = a |> Array.to_list |> string_of_list ~separator f
  let char_list_of_string str = let rec f0 i a = if i<0 then a else f0 (i-$1) (str.[i]::a) in f0 (String.length str -$ 1) []
  let string_of_char_list ls = List.fold_left (fun u v -> u ^ (String.make 1 v)) "" ls
  let fail _ = failwith "fail"
  let dx,dy = [|1;0;-1;0|],[|0;1;0;-1|]
  let range l r = let ls = ref [] in for i=i32 l to i32 r do ls := i :: !ls done;!ls |> List.rev
  let cartesian_product u v = u |> List.map (fun p -> List.map (fun q -> p,q) v) |> List.flatten
  let shuffle a = Array.sort (fun _ _ -> (Random.int 3) -$ 1) a
  let binary_search ng ok f = let d = if ng < ok then 1L else -1L in
    let rec f0 ng ok =
      if labs (ok - ng) <= 1L then ok
      else let mid = ng + (ok - ng) / 2L in if f mid then f0 ng mid else f0 mid ok
    in f0 (ng-1L*d) (ok+1L*d)
  let lower_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >= v)
  let upper_bound a v = binary_search 0L (alen a - 1L) (fun i -> a.(i32 i) >  v)
  let equal_range a v = lower_bound a v, upper_bound a v (* #=snd-fst *)
  let rec fix f x = f (fix f) x
  let fix_memo ?(size=10000) f x =
    let tb = Hashtbl.create ~random:true size in
    let rec f0 x =
      try Hashtbl.find tb x with
      | Not_found -> (let v = f f0 x in Hashtbl.add tb x v; v)
    in f0 x
  (* imperative *)
  let rep f t ?(stride=1L) fbod = let i = ref f in while !i <= t do fbod !i; i := !i + stride done
  let repb f t ?(stride=1L) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i + stride done
  let repm f t ?(stride=1L) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i + stride done; !m
  let repi f t ?(stride=1) fbod = let i = ref f in while !i <= t do fbod !i; i := !i +$ stride done
  let repib f t ?(stride=1) fbod = let i,c = ref f,ref true in while !i <= t && !c do
    match fbod !i with | `Break -> c := false | `Ok -> i := !i +$ stride done
  let repim f t ?(stride=1) m0 fbod =
    let i,c,m = ref f,ref true,ref m0 in
    while !i<=t && !c do match fbod !m !i with
    | `Break -> c := false | `Break_m m' -> (c := false; m := m') | `Ok m' -> m := m'; i := !i +$ stride done; !m
  let rep_rev f t ?(stride=1L) fbod = rep t f ~stride @@ fun v -> fbod @@ f + t - v
  let repb_rev f t ?(stride=1L) fbod = repb t f ~stride @@ fun v -> fbod @@ f + t - v
  let repm_rev f t ?(stride=1L) m0 fbod = repm f t ~stride m0 @@ fun u v -> fbod u @@ f + t - v
  let repi_rev f t ?(stride=1) fbod = repi t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repib_rev f t ?(stride=1) fbod = repib t f ~stride @@ fun v -> fbod @@ f +$ t -$ v
  let repim_rev f t ?(stride=1) m0 fbod = repim f t ~stride m0 @@ fun u v -> fbod u @@ f +$ t -$ v
  (* output *)
  let print_list_mle f ls = string_of_list f ls |> print_endline
  let print_array_mle f a = string_of_array f a |> print_endline
  let print_list f ls = ls |> List.iter (fun v -> printf "%s " @@ f v); print_newline ()
  let print_array f a = a |> Array.iter (fun v -> printf "%s " @@ f v); print_newline ()
  (* debug *)
  let dump_2darr f a = a |> Array.iter (fun b -> print_array f b)
  let dump_i64_list ls = print_list ist ls
  let dump_i64_array a = print_array ist a
end open Lib open Array

module CumulSumArray = struct
  let make a =
    let ln = Array.length a
    in let a1 = Array.make (ln+$1) 0L in for i=1 to ln do a1.(i) <- a1.(i-$1) + a.(i-$1) done; a1
  let sum l r a = (* 0-origin,closed *)
    if l>r then 0L else (a.(r+$1) - a.(l))
  let sum_1orig l r a = sum (l-$1) (r-$1) a
end

let md = 1000000007L
let pow n k =
  let rec f a n = function
  | 0L -> a
  | 1L -> (n*a) mod md
  | k when k mod 2L = 0L -> f a (n*n) (k/2L) mod md
  | k -> f (a*n) (n*n) (k/2L) mod md
  in f 1L n k

let () =
  let n,q = get_2_i64 0 in
  let a =
    let s = scanf " %s"@@id in
    let a = make (String.length s) 0L in
    String.iteri (fun i c -> a.(i) <- i64 @@ (int_of_char c) -$ (int_of_char '0')) s;
    a in
  let ones = CumulSumArray.make a in
  rep 1L q (fun _ ->
    let l,r = get_2_i64 0 in
    let one = CumulSumArray.sum_1orig (i32 l) (i32 r) ones in
    let zero = r - l + 1L - one in
    let sum_one = pow 2L one - 1L in
    let sum_zero = sum_one * (pow 2L zero - 1L) in
    printf "%Ld\n" @@ (sum_one + sum_zero) mod md
  )


let sum_vec (x1,y1,z1) (x2,y2,z2) =
	(x1+x2, y1+y2, z1+z2)
;;

let read_vec _ = Scanf.scanf "%d %d %d\n" (fun x y z -> (x,y,z));;

let () =
	let n = read_int () in
	let forces = Array.init n read_vec in
	let f = Array.fold_left sum_vec (0,0,0) forces in
		print_string (if f = (0,0,0) then "YES" else "NO")
;;

let solve n =
  let rec loop n x y z =
    if n <= 0
    then
      if x == 0 && y == 0 && z == 0
      then "YES"
      else "NO"
    else Scanf.scanf "%d %d %d\n" (fun a b c -> loop (n-1) (x+a) (y+b) (z+c))
  in
  loop n 0 0 0

let _ =
  Printf.printf "%s\n" (Scanf.scanf "%d\n" solve)

(* Codeforces 69A *)

type coordinate = { x: int; y: int; z: int }

let zero = { x = 0; y = 0; z = 0 }

let make_coordinate x y z = { x = x; y = y; z = z }

let add a b =
  { x = a.x + b.x; y = a.y + b.y; z = a.z + b.z }

let rec solve accu = function
  | 0 -> if accu = zero then "YES" else "NO"
  | n ->
    let c =
      Scanf.scanf "%d %d %d\n" (fun x y z -> make_coordinate x y z) in
    solve (add accu c) (n-1)

let _ =
  let n = read_int() in
  print_endline (solve zero n)

let list_init n f =
    let rec read_vectors n vectors =
        if n > 0
        then
            let coordinates = f() in
            read_vectors (n - 1) (coordinates :: vectors)
        else
            List.rev vectors
    in read_vectors n []

let vectors n = list_init n (fun i -> Scanf.scanf "%d %d %d " (fun s0 s1 s2 -> [s0; s1; s2]))

let input () =
    let number_of_vectors = Scanf.scanf "%d " (fun n -> n) in
    vectors number_of_vectors

let add_vectors [x; y; z] [xs; ys; zs] = [x + xs; y + ys; z + zs]

let get_sum list = List.fold_left(fun a b -> add_vectors a b) [0; 0; 0] list

let solve input =
    if get_sum input = [0; 0; 0]
    then
        "YES"
    else
        "NO"

let print result = Printf.printf "%s\n" result

let () = print (solve (input()))


let main =
  let (s,n) = Scanf.scanf "%d %d" (fun s n -> (s,n)) in
  let rec read_all acc n =
    if n = 0 then acc
    else Scanf.scanf " %d %d" (fun x y -> read_all ((x,y)::acc) (n-1)) in
  let dragons = read_all [] n in
  let sorted = List.sort compare dragons in
  let rec walk s dragons =
    match dragons with
    | [] -> "YES"
    | ((x,y) :: t) ->
	if s > x then walk (s+y) t
        else "NO" in
  Printf.printf "%s\n" (walk s sorted)

let read () = Scanf.scanf "%d %d " (fun n m -> (n, m))

let input () =
    let (hero_power, total) = read () in
    let rec loop dragons i =
        if i < total
        then
            let dragon = read () in
            loop (dragon :: dragons) (i + 1)
        else
            (hero_power, dragons)
    in loop [] 0

let fight hero_power (dragon_power, reward) =
    if hero_power > dragon_power
    then
        `victory (hero_power + reward)
    else
        `defeat

let tuple_compare (power_1, reward_1) (power_2, reward_2) =
    Pervasives.compare power_1 power_2

let solve (hero_power, dragons) =
    let dragons = List.sort (tuple_compare) dragons in
    let rec loop power list =
        match list with
        | (dragon :: tail) ->
            (match fight power dragon with
            | `victory (upd_power) -> loop upd_power tail
            | `defeat -> "NO")
        | [] -> "YES"
    in loop hero_power dragons

let print result = Printf.printf "%s\n" result
let () = print (solve (input ()))

let main =
  let (s,n) = Scanf.scanf "%d %d" (fun s n -> (s,n)) in
  let rec read_all acc n =
    if n = 0 then acc
    else Scanf.scanf " %d %d" (fun x y -> read_all ((x,y)::acc) (n-1)) in
  let dragons = read_all [] n in
  let pcompare (_,y1) (_,y2) = - (compare y1 y2) in
  let sorted = List.sort pcompare dragons in
  let rec walk s dragons =
    match dragons with
    | [] -> "YES"
    | ((x,y) :: t) ->
	if s > x then walk (s+y) t
        else "NO" in
  Printf.printf "%s\n" (walk s sorted)


(** https://codeforces.com/contest/1472/problem/B *)

let get_candies () =
    let tbl = Array.make 2 0 in
    let candy_list =
        read_line ()
        |> Str.split (Str.regexp " ")
        |> List.map int_of_string in
    List.iter
        (fun candy -> tbl.(candy-1) <- tbl.(candy-1) + 1)
        candy_list;
    tbl

let fair_share tbl_candies =
    if tbl_candies.(1) mod 2 = 0
    then tbl_candies.(0) mod 2 = 0
    else tbl_candies.(0) - 2 >= 0 && (tbl_candies.(0) - 2) mod 2 = 0

let solve_n nb_cases =
    let rec helper i =
        if i > 0
        then (
            let _ = read_line () in
            let tbl_candies = get_candies () in
            (if fair_share tbl_candies then "YES" else "NO")
            |> print_endline;
            helper (i-1)
        ) in
    helper nb_cases

let () =
    let nb_cases = read_int () in
    solve_n nb_cases

(* #load "str.cma" *)
module Stdlib = Pervasives;;
(* let std_inp = Stdlib.open_in "input.txt";; *)
let std_inp = Stdlib.stdin;;
let std_outp = Stdlib.stdout;;

let identity x = x;;

let recogn (ones, twos) item =
  if item == 1 then (ones + 1, twos)
  else (ones, twos + 1);;

let rec solve (ones, twos) n =
if n > twos / 2 then false
else
  let ones_debt = (twos - n * 2) * 2 in
  (* let _ = Printf.printf "Debt: %d\n" ones_debt in *)
  if ones >= ones_debt && (ones - ones_debt) mod 2 == 0 then true
  else solve (ones, twos) (n + 1);;

let solution inp outp =
  let _ = input_line inp in
  let (ones, twos)=
    input_line inp
      |> Str.split @@ Str.regexp " "
      |> List.map int_of_string
      |> List.fold_left recogn (0, 0)
  in
  (* let _ = Printf.printf "Ones: %d; Twos: %d\n" ones twos in *)
  let result = solve (ones, twos) 0 in
  let _ =
    if result then Printf.printf "YES\n"
    else Printf.printf "NO\n"
  in
  ();;

let rec run_test = function
| (0, _, _) -> ()
| (t, inp, outp) ->
  let _ = solution inp outp in
  run_test (t - 1, inp, outp);;

let (_:unit) =
  let inp = std_inp and outp = std_outp in
  let tests_count = let line = input_line inp in Scanf.sscanf line "%d" identity in
  let _ = run_test (tests_count, inp, outp) in
  ();;

(* #load "str.cma" *)
module Stdlib = Pervasives;;
(* let std_inp = Stdlib.open_in "input.txt";; *)
let std_inp = Stdlib.stdin;;
let std_outp = Stdlib.stdout;;

let identity x = x;;

let recogn (ones, twos) item =
  if item == 1 then (ones + 1, twos)
  else (ones, twos + 1);;

let rec solve (ones, twos) n =
if n > twos then false
else
  let ones_debt = (twos - n) * 2 in
  (* let _ = Printf.printf "Debt: %d\n" ones_debt in *)
  if ones > ones_debt && (ones - ones_debt) mod 2 == 0 then true
  else solve (ones, twos) (n + 1);;

let solution inp outp =
  let _ = input_line inp in
  let (ones, twos)=
    input_line inp
      |> Str.split @@ Str.regexp " "
      |> List.map int_of_string
      |> List.fold_left recogn (0, 0)
  in
  (* let _ = Printf.printf "Ones: %d; Twos: %d\n" ones twos in *)
  let result = solve (ones, twos) 0 in
  let _ =
    if result then Printf.printf "YES\n"
    else Printf.printf "NO\n"
  in
  ();;

let rec run_test = function
| (0, _, _) -> ()
| (t, inp, outp) ->
  let _ = solution inp outp in
  run_test (t - 1, inp, outp);;

let (_:unit) =
  let inp = std_inp and outp = std_outp in
  let tests_count = let line = input_line inp in Scanf.sscanf line "%d" identity in
  let _ = run_test (tests_count, inp, outp) in
  ();;


(* 0 = rien; 1= fantome ; 2 = bougie finie de brulée ; bougie et fantome *)

let f tab dure besoin =
	let bug = ref false in
	for i= 600 downto 300 do
		if (tab.(i) = 1) || (tab.(i) = 3)
			then begin
				let compte = ref 0 in
				for j= i - dure + 1 to i do
					if tab.(j) > 1
						then incr compte

				done;
				let manque = ref (besoin - !compte) in
				for j = i - dure + 1 to i do
					if (!manque > 0) && (tab.(j) < 2)
						then (decr manque; tab.(j) <- tab.(j) + 2);
				done;
				if !manque > 0 then bug := true;
			     end
	done;
	if !bug
		then -1
		else (let compte = ref 0 in
			for i = 0 to Array.length tab - 1 do
				if tab.(i) > 1 then incr compte;
			done; !compte);;
let final () =
	let (m,t,r) = Scanf.scanf "%d %d %d " (fun i j k -> (i,j,k)) in
	let tab = Array.make 601 0 in
	for i=1 to m do
		tab.(300 + Scanf.scanf "%d " (fun i -> i)) <- 1;
	done;
	Printf.printf "%d " (f tab t r);;

final ();;

exception Not_possible
let () =
  Scanf.scanf "%d %d %d\n" (fun m t r ->
    (* array of ghost times *)
    let g = Array.init m (fun _ -> Scanf.scanf "%d%_c" (fun x -> x)) in
    (* queue of candles *)
    let q = Queue.create () in
    (* number of candles *)
    let c = ref r in
    (* maximum timeslot at which a candle was lit *)
    let m = ref (g.(0) - 1) in
    (* light r candles before the first ghost *)
    for i = g.(0) - r to g.(0) - 1 do
      Queue.add i q
    done;
    try
      Array.iter (fun w ->
        (* remove stale candles *)
        while not (Queue.is_empty q) && Queue.peek q + t < w do
          ignore (Queue.take q)
        done;
        let l = Queue.length q in
        (* add more candles if necessary *)
        for i = w - r + l to w - 1 do
          if i <= !m then
            raise Not_possible
          else begin
            Queue.add i q;
            incr c;
            m := i
          end
        done
      ) g;
      Printf.printf "%d\n" !c
    with Not_possible -> print_endline "-1"
  )

(* 0 = rien; 1= fantome ; 2 = bougie finie de posée ; bougie et fantome *)

let f tab dure besoin =
	let bug = ref false in
	for i= 820 downto 400 do
		if tab.(i) mod 3 = 1
			then begin
				let compte = ref 0 in
					for j= i - dure + 1 to i do
						if tab.(j) > 1
							then incr compte
					done;
				let manque = ref (besoin - !compte) in
				for j = i - dure + 1 to i do
					if (!manque > 0) && (tab.(j) < 2)
						then (decr manque; tab.(j) <- tab.(j) + 2);
				done;
				if !manque > 0 then bug := true;
			     end
	done;
	if !bug
		then -1
		else (let compte = ref 0 in
			for i = 0 to Array.length tab - 1 do
				if tab.(i) > 1 then incr compte;
			done; !compte);;
let final () =
	let (m,t,r) = Scanf.scanf "%d %d %d " (fun i j k -> (i,j,k)) in
	let tab = Array.make 821 0 in
	for i=1 to m do
		tab.(400 + Scanf.scanf "%d " (fun i -> i)) <- 1;
	done;
	Printf.printf "%d " (f tab t r);;

final ();;

(* 0 = rien; 1= fantome ; 2 = bougie finie de posée ; bougie et fantome *)

let f tab dure besoin =
	let bug = ref false in
	for i= 620 downto 300 do
		if tab.(i) mod 3 = 1
			then begin
				let compte = ref 0 in
					for j= i - dure + 1 to i do
						if tab.(j) > 1
							then incr compte
					done;
				let manque = ref (besoin - !compte) in
				for j = i - dure + 1 to i do
					if (!manque > 0) && (tab.(j) < 2)
						then (decr manque; tab.(j) <- tab.(j) + 2);
				done;
				if !manque > 0 then bug := true;
			     end
	done;
	if !bug
		then -1
		else (let compte = ref 0 in
			for i = 0 to Array.length tab - 1 do
				if tab.(i) > 1 then incr compte;
			done; !compte);;
let final () =
	let (m,t,r) = Scanf.scanf "%d %d %d " (fun i j k -> (i,j,k)) in
	let tab = Array.make 621 0 in
	for i=1 to m do
		tab.(300 + Scanf.scanf "%d " (fun i -> i)) <- 1;
	done;
	Printf.printf "%d " (f tab t r);;

final ();;

(* 0 = rien; 1= fantome ; 2 = bougie finie de posée ; bougie et fantome *)

let f tab dure besoin =
	let bug = ref false in
	for i= 620 downto 300 do
		if tab.(i) mod 3 = 1
			then begin
				let compte = ref 0 in
					for j= i - dure + 1 to i do
						if tab.(j) > 1
							then incr compte
					done;
				let manque = ref (besoin - !compte) in
				for j = i - dure + 1 to i do
					if (!manque > 0) && (tab.(j) < 2)
						then (decr manque; tab.(j) <- tab.(j) + 2);
				done;
				if !manque > 0 then bug := true;
			     end
	done;
	if !bug
		then -1
		else (let compte = ref 0 in
			for i = 0 to Array.length tab - 1 do
				if tab.(i) > 1 then incr compte;
			done; !compte);;
let final () =
	let (m,t,r) = Scanf.scanf "%d %d %d " (fun i j k -> (i,j,k)) in
	let tab = Array.make 621 0 in
	for i=1 to m do
		tab.(Scanf.scanf "%d " (fun i -> i)) <- 1;
	done;
	Printf.printf "%d " (f tab t r);;

final ();;

(* 0 = rien; 1= fantome ; 2 = bougie finie de posée ; bougie et fantome *)

let f tab dure besoin =
	let bug = ref false in
	for i= 820 downto 400 do
		if (tab.(i) = 1) || (tab.(i) = 3)
			then begin
				let compte = ref 0 in
				for j= i - dure + 1 to i do
					if tab.(j) > 1
						then incr compte

				done;
				let manque = ref (besoin - !compte) in
				for j = i - dure to i do
					if (!manque > 0) && (tab.(j) < 2)
						then (decr manque; tab.(j) <- tab.(j) + 2);
				done;
				if !manque > 0 then bug := true;
			     end
	done;
	if !bug
		then -1
		else (let compte = ref 0 in
			for i = 0 to Array.length tab - 1 do
				if tab.(i) > 1 then incr compte;
			done; !compte);;
let final () =
	let (m,t,r) = Scanf.scanf "%d %d %d " (fun i j k -> (i,j,k)) in
	let tab = Array.make 821 0 in
	for i=1 to m do
		tab.(400 + Scanf.scanf "%d " (fun i -> i)) <- 1;
	done;
	Printf.printf "%d " (f tab t r);;
(*
final ();;
*)

let test l dure besoin =
	let tab = Array.make 821 0 in
		List.iter (fun i -> tab.(400 + i) <- 1) l;
		f tab dure besoin;;

(test [10] 8 3 = 3,
test [5;8] 10 1 = 1,
test [10] 1 3 = -1);;

(* 0 = rien; 1= fantome ; 2 = bougie finie de posée ; bougie et fantome *)

let f tab dure besoin =
	let bug = ref false in
	for i= 620 downto 300 do
		if tab.(i) mod 3 = 1
			then begin
				let compte = ref 0 in
					for j= i - dure + 1 to i do
						if tab.(j) > 1
							then incr compte
					done;
				let manque = ref (besoin - !compte) in
				for j = i - dure + 1 to i do
					if (!manque > 0) && (tab.(j) < 3)
						then (decr manque; tab.(j) <- tab.(j) + 2);
				done;
				if !manque > 0 then bug := true;
			     end
	done;
	if !bug
		then -1
		else (let compte = ref 0 in
			for i = 0 to Array.length tab - 1 do
				if tab.(i) > 1 then incr compte;
			done; !compte);;
let final () =
	let (m,t,r) = Scanf.scanf "%d %d %d " (fun i j k -> (i,j,k)) in
	let tab = Array.make 621 0 in
	for i=1 to m do
		tab.(Scanf.scanf "%d " (fun i -> i)) <- 1;
	done;
	Printf.printf "%d " (f tab t r);;

final ();;

(* 0 = rien; 1= fantome ; 2 = bougie finie de brulée ; bougie et fantome *)

let f tab dure besoin =
	let bug = ref false in
	for i= 600 downto 300 do
		if (tab.(i) = 1) || (tab.(i) = 3)
			then begin
				let compte = ref 0 in
				for j= i - dure to i do
					if tab.(j) > 1
						then incr compte

				done;
				let manque = ref (besoin - !compte) in
				for j = i - dure to i do
					if (!manque > 0) && (tab.(j) < 2)
						then (decr manque; tab.(j) <- tab.(j) + 2);
				done;
				if !manque > 0 then bug := true;
			     end
	done;
	if !bug
		then -1
		else (let compte = ref 0 in
			for i = 0 to Array.length tab - 1 do
				if tab.(i) > 1 then incr compte;
			done; !compte);;
let final () =
	let (m,t,r) = Scanf.scanf "%d %d %d " (fun i j k -> (i,j,k)) in
	let tab = Array.make 601 0 in
	for i=1 to m do
		tab.(300 + Scanf.scanf "%d " (fun i -> i)) <- 1;
	done;
	Printf.printf "%d " (f tab t r);;

final ();;

exception Not_possible
let () =
  Scanf.scanf "%d %d %d\n" (fun m t r ->
    (* array of ghost times *)
    let g = Array.init m (fun _ -> Scanf.scanf "%d%_c" (fun x -> x)) in
    (* queue of candles *)
    let q = Queue.create () in
    (* number of candles *)
    let c = ref r in
    (* maximum timeslot at which a candle was lit *)
    let m = ref (g.(0) - 1) in
    (* light r candles before the first ghost *)
    for i = g.(0) - r - 1 to g.(0) - 1 do
      Queue.add i q
    done;
    try
      Array.iter (fun w ->
        (* remove stale candles *)
        while not (Queue.is_empty q) && Queue.peek q + t < w do
          ignore (Queue.take q)
        done;
        let l = Queue.length q in
        (* add more candles if necessary *)
        for i = w - r + l - 1 to w - 1 do
          if i <= !m then
            raise Not_possible
          else begin
            Queue.add i q;
            incr c;
            m := i
          end
        done
      ) g;
      Printf.printf "%d\n" !c
    with Not_possible -> print_endline "-1"
  )


let scan_int () = Scanf.scanf " %d" (fun x -> x);;
let scan_string () = Scanf.scanf " %s" (fun x -> x);;
let psp () = print_string " ";; let pnl () = print_newline ();;
let b2i x = if x == true then 1 else 0;;
let dbg x = print_int(x); pnl();;

module PSet = struct
  type 'k set =
    | Empty
    | Node of 'k set * 'k * 'k set * int

  type 'k t =
    {
      cmp : 'k -> 'k -> int;
      set : 'k set;
    }

  let height = function
    | Node (_, _, _, h) -> h
    | Empty -> 0

  let make l k r = Node (l, k, r, max (height l) (height r) + 1)

  let bal l k r =
    let hl = height l in
    let hr = height r in
    if hl > hr + 2 then
      match l with
      | Node (ll, lk, lr, _) ->
          if height ll >= height lr then make ll lk (make lr k r)
          else
            (match lr with
            | Node (lrl, lrk, lrr, _) ->
                make (make ll lk lrl) lrk (make lrr k r)
            | Empty -> assert false)
      | Empty -> assert false
    else if hr > hl + 2 then
      match r with
      | Node (rl, rk, rr, _) ->
          if height rr >= height rl then make (make l k rl) rk rr
          else
            (match rl with
            | Node (rll, rlk, rlr, _) ->
                make (make l k rll) rlk (make rlr rk rr)
            | Empty -> assert false)
      | Empty -> assert false
    else Node (l, k, r, max hl hr + 1)

  let rec min_elt = function
    | Node (Empty, k, _, _) -> k
    | Node (l, _, _, _) -> min_elt l
    | Empty -> raise Not_found

  let rec remove_min_elt = function
    | Node (Empty, _, r, _) -> r
    | Node (l, k, r, _) -> bal (remove_min_elt l) k r
    | Empty -> invalid_arg "PSet.remove_min_elt"

  let merge t1 t2 =
    match t1, t2 with
    | Empty, _ -> t2
    | _, Empty -> t1
    | _ ->
        let k = min_elt t2 in
        bal t1 k (remove_min_elt t2)

  let create cmp = { cmp = cmp; set = Empty }
  let empty = { cmp = compare; set = Empty }

  let is_empty x =
    x.set = Empty

  let rec add_one cmp x = function
    | Node (l, k, r, h) ->
        let c = cmp x k in
        if c = 0 then Node (l, x, r, h)
        else if c < 0 then
          let nl = add_one cmp x l in
          bal nl k r
        else
          let nr = add_one cmp x r in
          bal l k nr
    | Empty -> Node (Empty, x, Empty, 1)

  let add x { cmp = cmp; set = set } =
    { cmp = cmp; set = add_one cmp x set }

  let rec join cmp l v r =
    match (l, r) with
      (Empty, _) -> add_one cmp v r
    | (_, Empty) -> add_one cmp v l
    | (Node(ll, lv, lr, lh), Node(rl, rv, rr, rh)) ->
        if lh > rh + 2 then bal ll lv (join cmp lr v r) else
        if rh > lh + 2 then bal (join cmp l v rl) rv rr else
        make l v r

  let split x { cmp = cmp; set = set } =
    let rec loop x = function
        Empty ->
          (Empty, false, Empty)
      | Node (l, v, r, _) ->
          let c = cmp x v in
          if c = 0 then (l, true, r)
          else if c < 0 then
            let (ll, pres, rl) = loop x l in (ll, pres, join cmp rl v r)
          else
            let (lr, pres, rr) = loop x r in (join cmp l v lr, pres, rr)
    in
    let setl, pres, setr = loop x set in
    { cmp = cmp; set = setl }, pres, { cmp = cmp; set = setr }

  let remove x { cmp = cmp; set = set } =
    let rec loop = function
      | Node (l, k, r, _) ->
          let c = cmp x k in
          if c = 0 then merge l r else
          if c < 0 then bal (loop l) k r else bal l k (loop r)
      | Empty -> Empty in
    { cmp = cmp; set = loop set }

  let mem x { cmp = cmp; set = set } =
    let rec loop = function
      | Node (l, k, r, _) ->
          let c = cmp x k in
          c = 0 || loop (if c < 0 then l else r)
      | Empty -> false in
    loop set

  let exists = mem

  let iter f { set = set } =
    let rec loop = function
      | Empty -> ()
      | Node (l, k, r, _) -> loop l; f k; loop r in
    loop set

  let fold f { cmp = cmp; set = set } acc =
    let rec loop acc = function
      | Empty -> acc
      | Node (l, k, r, _) ->
            loop (f k (loop acc l)) r in
    loop acc set

  let elements { set = set } =
    let rec loop acc = function
        Empty -> acc
      | Node(l, k, r, _) -> loop (k :: loop acc r) l in
    loop [] set
end;;

module type GRAPH_LABELS =
  sig
    type label
  end;;

(* Typ modułu implementującego grafy o wierzchołkach numerowanych od 0 do n-1. *)
module type GRAPH =
  sig
    (* Etykiety krawędzi. *)
    type label

    (* Typ grafów o wierzchołkach typu 'a. *)
    type graph

    (* Pusty graf. *)
    val init : int -> graph

    (* Rozmiar grafu *)
    val size : graph -> int

    (* Dodanie krawędzi skierowanej łączącej dwa wierzchołki. *)
    val insert_directed_edge : graph -> int -> int -> label -> unit

    (* Dodanie krawędzi nieskierowanej (dwukierunkowej) łączącej dwa wierzchołki. *)
    val insert_edge : graph -> int -> int -> label -> unit

    (* Lista incydencji danego wierzchołka. *)
    val neighbours :  graph -> int -> (int*label) list
  end;;

module Graph = functor (L : GRAPH_LABELS) ->
(struct
  (* Etykiety krawędzi. *)
  type label = L.label

  (* Typ grafów - tablica list sąsiedztwa. *)
  type graph = {n : int; e : (int*label) list array}

  (* Pusty graf. *)
  let init s = {n = s; e = Array.make s []}

  (* Rozmiar grafu. *)
  let size g = g.n

  (* Dodanie krawędzi skierowanej łączącej dwa wierzchołki. *)
  let insert_directed_edge g x y l =
    assert ((x<>y)  && (x >= 0) && (x < size g) && (y >= 0) && (y < size g));
    g.e.(x) <- (y,l)::g.e.(x)

  (* Dodanie krawędzi łączącej dwa (istniejące) wierzchołki. *)
  let insert_edge g x y l =
    insert_directed_edge g x y l;
    insert_directed_edge g y x l

  (* Lista incydencji danego wierzchołka. *)
  let neighbours g x =
    g.e.(x)
end : GRAPH with type label = L.label);;

module IntLabel =
  struct
    type label = int
  end;;

module G = Graph(IntLabel);;

open G;;
open PSet;;
let n = scan_int() and m = scan_int() and k = scan_int();;
let g = G.init n;;

let zbior = ref empty;;

for i = 1 to m do
  let a = scan_int() - 1 and b = scan_int() - 1 and c = scan_int() in
  (*dbg a; pnl(); dbg b; pnl(); pnl(); *)
  G.insert_edge g a b c;
done;;

for i = 1 to k do
  let a = scan_int() - 1 and b = scan_int() in
  zbior := add (Int64.of_int(b), 1, a) !zbior;
done;;

zbior := add (Int64.zero, 0, 0) !zbior;;
let dis = Array.make n Int64.max_int;;

let przydatne = ref 0;;

while is_empty !zbior = false do
  let (odl, czy, u) = min_elt (!zbior).set in
  zbior := {cmp = (!zbior).cmp; set = remove_min_elt (!zbior).set};
  if odl < dis.(u) then begin
    (* dbg (Int64.to_int odl); psp(); dbg czy; psp(); dbg u; pnl(); *)
    dis.(u) <- odl;
    if czy = 1 then incr przydatne;
    List.iter (fun (v, w) ->
      let waga = Int64.add odl (Int64.of_int(w)) in
      if waga < dis.(v) then begin
        zbior := add (waga, 0, v) !zbior;
      end;
    ) (neighbours g u);
  end;
done;;

print_int (k - !przydatne);;

(* codeforces 103.  Danny Sleator *)
let read_int () = Scanf.bscanf Scanf.Scanning.stdib " %d " (fun x -> x)

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

let long x = Int64.of_int x

let ( ** ) a b = Int64.mul a b
let ( ++ ) a b = Int64.add a b
let ( -- ) a b = Int64.sub a b

let n = read_int ()
let m = read_int ()
let k = read_int ()
let ne = m + k

let ss = Array.make (2*ne) 0
let ff = Array.make (2*ne) 0
let ww = Array.make (2*ne) 0L
let first = Array.make n (-1)
let next = Array.make (2*ne) 0
let reg_edge = Array.make (2*ne) false
let parent_edge = Array.make n (-1)
let start = 0

let () =
  for i=0 to m-1 do
    let vi = read_int() -1 in
    let ui = read_int() -1 in
    let xi = long (read_int()) in
    ss.(i) <- vi;
    ff.(i+ne) <- vi;
    ff.(i) <- ui;
    ss.(i+ne) <- ui;
    ww.(i) <- xi;
    ww.(i+ne) <- xi;
    reg_edge.(i) <- true;
    reg_edge.(i+ne) <- true;
  done;

  for i=m to ne-1 do
    let vi = read_int() -1 in
    let ui = start in
    let xi = long (read_int()) in
    ss.(i) <- vi;
    ff.(i+ne) <- vi;
    ff.(i) <- ui;
    ss.(i+ne) <- ui;
    ww.(i) <- xi;
    ww.(i+ne) <- xi;
  done;

  for i=0 to 2*ne-1 do
    next.(i) <- first.(ss.(i));
    first.(ss.(i)) <- i;
  done

let inf = 1_000_000_000_000_000_000L
let dist = Array.make n inf
let () = dist.(start) <- 0L

let rec dijkstra s = if Pset.is_empty s then () else
  let (d, v) = Pset.min_elt s in
  let s = Pset.remove (d, v) s in
  let rec loop e s = if e = -1 then s else
    let w = ff.(e) in
      (* processing edge v,w *)
      if dist.(w) = inf then (
	dist.(w) <- dist.(v) ++ ww.(e);
	parent_edge.(w) <- e;
	loop (next.(e)) (Pset.add (dist.(w), w) s)
      ) else if dist.(v) ++ ww.(e) < dist.(w) then (
	let s = Pset.remove (dist.(w), w) s in
	dist.(w) <- dist.(v) ++ ww.(e);
	parent_edge.(w) <- e;
	loop (next.(e)) (Pset.add (dist.(w), w) s)
      ) else if dist.(v) ++ ww.(e) = dist.(w) && reg_edge.(e) then (
	parent_edge.(w) <- e;
	loop (next.(e)) s
      ) else (
	loop (next.(e)) s
      )
  in
    dijkstra (loop first.(v) s)

let () = dijkstra (Pset.singleton (0L,start))

let ecount = ref 0

let () =
  for i=1 to n-1 do
    if parent_edge.(i) < 0 then failwith "graph not connected";
    if not (reg_edge.(parent_edge.(i))) then ecount := !ecount + 1
  done;

  Printf.printf "%d\n" (k - !ecount)

let scan_int () = Scanf.scanf " %d" (fun x -> x);;
let scan_string () = Scanf.scanf " %s" (fun x -> x);;
let psp () = print_string " ";; let pnl () = print_newline ();;
let b2i x = if x == true then 1 else 0;;
let dbg x = print_int(x); pnl();;

module PSet = struct
  type 'k set =
    | Empty
    | Node of 'k set * 'k * 'k set * int

  type 'k t =
    {
      cmp : 'k -> 'k -> int;
      set : 'k set;
    }

  let height = function
    | Node (_, _, _, h) -> h
    | Empty -> 0

  let make l k r = Node (l, k, r, max (height l) (height r) + 1)

  let bal l k r =
    let hl = height l in
    let hr = height r in
    if hl > hr + 2 then
      match l with
      | Node (ll, lk, lr, _) ->
          if height ll >= height lr then make ll lk (make lr k r)
          else
            (match lr with
            | Node (lrl, lrk, lrr, _) ->
                make (make ll lk lrl) lrk (make lrr k r)
            | Empty -> assert false)
      | Empty -> assert false
    else if hr > hl + 2 then
      match r with
      | Node (rl, rk, rr, _) ->
          if height rr >= height rl then make (make l k rl) rk rr
          else
            (match rl with
            | Node (rll, rlk, rlr, _) ->
                make (make l k rll) rlk (make rlr rk rr)
            | Empty -> assert false)
      | Empty -> assert false
    else Node (l, k, r, max hl hr + 1)

  let rec min_elt = function
    | Node (Empty, k, _, _) -> k
    | Node (l, _, _, _) -> min_elt l
    | Empty -> raise Not_found

  let rec remove_min_elt = function
    | Node (Empty, _, r, _) -> r
    | Node (l, k, r, _) -> bal (remove_min_elt l) k r
    | Empty -> invalid_arg "PSet.remove_min_elt"

  let merge t1 t2 =
    match t1, t2 with
    | Empty, _ -> t2
    | _, Empty -> t1
    | _ ->
        let k = min_elt t2 in
        bal t1 k (remove_min_elt t2)

  let create cmp = { cmp = cmp; set = Empty }
  let empty = { cmp = compare; set = Empty }

  let is_empty x =
    x.set = Empty

  let rec add_one cmp x = function
    | Node (l, k, r, h) ->
        let c = cmp x k in
        if c = 0 then Node (l, x, r, h)
        else if c < 0 then
          let nl = add_one cmp x l in
          bal nl k r
        else
          let nr = add_one cmp x r in
          bal l k nr
    | Empty -> Node (Empty, x, Empty, 1)

  let add x { cmp = cmp; set = set } =
    { cmp = cmp; set = add_one cmp x set }

  let rec join cmp l v r =
    match (l, r) with
      (Empty, _) -> add_one cmp v r
    | (_, Empty) -> add_one cmp v l
    | (Node(ll, lv, lr, lh), Node(rl, rv, rr, rh)) ->
        if lh > rh + 2 then bal ll lv (join cmp lr v r) else
        if rh > lh + 2 then bal (join cmp l v rl) rv rr else
        make l v r

  let split x { cmp = cmp; set = set } =
    let rec loop x = function
        Empty ->
          (Empty, false, Empty)
      | Node (l, v, r, _) ->
          let c = cmp x v in
          if c = 0 then (l, true, r)
          else if c < 0 then
            let (ll, pres, rl) = loop x l in (ll, pres, join cmp rl v r)
          else
            let (lr, pres, rr) = loop x r in (join cmp l v lr, pres, rr)
    in
    let setl, pres, setr = loop x set in
    { cmp = cmp; set = setl }, pres, { cmp = cmp; set = setr }

  let remove x { cmp = cmp; set = set } =
    let rec loop = function
      | Node (l, k, r, _) ->
          let c = cmp x k in
          if c = 0 then merge l r else
          if c < 0 then bal (loop l) k r else bal l k (loop r)
      | Empty -> Empty in
    { cmp = cmp; set = loop set }

  let mem x { cmp = cmp; set = set } =
    let rec loop = function
      | Node (l, k, r, _) ->
          let c = cmp x k in
          c = 0 || loop (if c < 0 then l else r)
      | Empty -> false in
    loop set

  let exists = mem

  let iter f { set = set } =
    let rec loop = function
      | Empty -> ()
      | Node (l, k, r, _) -> loop l; f k; loop r in
    loop set

  let fold f { cmp = cmp; set = set } acc =
    let rec loop acc = function
      | Empty -> acc
      | Node (l, k, r, _) ->
            loop (f k (loop acc l)) r in
    loop acc set

  let elements { set = set } =
    let rec loop acc = function
        Empty -> acc
      | Node(l, k, r, _) -> loop (k :: loop acc r) l in
    loop [] set
end;;

module type GRAPH_LABELS =
  sig
    type label
  end;;

(* Typ modułu implementującego grafy o wierzchołkach numerowanych od 0 do n-1. *)
module type GRAPH =
  sig
    (* Etykiety krawędzi. *)
    type label

    (* Typ grafów o wierzchołkach typu 'a. *)
    type graph

    (* Pusty graf. *)
    val init : int -> graph

    (* Rozmiar grafu *)
    val size : graph -> int

    (* Dodanie krawędzi skierowanej łączącej dwa wierzchołki. *)
    val insert_directed_edge : graph -> int -> int -> label -> unit

    (* Dodanie krawędzi nieskierowanej (dwukierunkowej) łączącej dwa wierzchołki. *)
    val insert_edge : graph -> int -> int -> label -> unit

    (* Lista incydencji danego wierzchołka. *)
    val neighbours :  graph -> int -> (int*label) list
  end;;

module Graph = functor (L : GRAPH_LABELS) ->
(struct
  (* Etykiety krawędzi. *)
  type label = L.label

  (* Typ grafów - tablica list sąsiedztwa. *)
  type graph = {n : int; e : (int*label) list array}

  (* Pusty graf. *)
  let init s = {n = s; e = Array.make s []}

  (* Rozmiar grafu. *)
  let size g = g.n

  (* Dodanie krawędzi skierowanej łączącej dwa wierzchołki. *)
  let insert_directed_edge g x y l =
    assert ((x<>y)  && (x >= 0) && (x < size g) && (y >= 0) && (y < size g));
    g.e.(x) <- (y,l)::g.e.(x)

  (* Dodanie krawędzi łączącej dwa (istniejące) wierzchołki. *)
  let insert_edge g x y l =
    insert_directed_edge g x y l;
    insert_directed_edge g y x l

  (* Lista incydencji danego wierzchołka. *)
  let neighbours g x =
    g.e.(x)
end : GRAPH with type label = L.label);;

module IntLabel =
  struct
    type label = int
  end;;

module G = Graph(IntLabel);;

open G;;
open PSet;;
let n = scan_int() and m = scan_int() and k = scan_int();;
let g = G.init n;;

let zbior = ref empty;;

for i = 1 to m do
  let a = scan_int() - 1 and b = scan_int() - 1 and c = scan_int() in
  (*dbg a; pnl(); dbg b; pnl(); pnl(); *)
  G.insert_edge g a b c;
done;;

for i = 1 to k do
  let a = scan_int() - 1 and b = scan_int() in
  zbior := add (Int64.of_int(b), 1, a) !zbior;
done;;

zbior := add (Int64.zero, 0, 0) !zbior;;
let dis = Array.make n Int64.max_int;;

let przydatne = ref 0;;

while is_empty !zbior = false do
  let (odl, czy, u) = min_elt (!zbior).set in
  zbior := {cmp = (!zbior).cmp; set = remove_min_elt (!zbior).set};
  if odl < dis.(u) then begin
    dis.(u) <- odl;
    if czy = 1 then incr przydatne;
    List.iter (fun (v, w) ->
      let waga = Int64.add odl (Int64.of_int(w)) in
      if waga < dis.(v) then begin
        dis.(v) <- waga;
        zbior := add (waga, 0, v) !zbior;
      end;
    ) (neighbours g u);
  end;
done;;

print_int (k - !przydatne);;

let scan_int () = Scanf.scanf " %d" (fun x -> x);;
let scan_string () = Scanf.scanf " %s" (fun x -> x);;
let psp () = print_string " ";; let pnl () = print_newline ();;
let b2i x = if x == true then 1 else 0;;
let dbg x = print_int(x); pnl();;

module PSet = struct
  type 'k set =
    | Empty
    | Node of 'k set * 'k * 'k set * int

  type 'k t =
    {
      cmp : 'k -> 'k -> int;
      set : 'k set;
    }

  let height = function
    | Node (_, _, _, h) -> h
    | Empty -> 0

  let make l k r = Node (l, k, r, max (height l) (height r) + 1)

  let bal l k r =
    let hl = height l in
    let hr = height r in
    if hl > hr + 2 then
      match l with
      | Node (ll, lk, lr, _) ->
          if height ll >= height lr then make ll lk (make lr k r)
          else
            (match lr with
            | Node (lrl, lrk, lrr, _) ->
                make (make ll lk lrl) lrk (make lrr k r)
            | Empty -> assert false)
      | Empty -> assert false
    else if hr > hl + 2 then
      match r with
      | Node (rl, rk, rr, _) ->
          if height rr >= height rl then make (make l k rl) rk rr
          else
            (match rl with
            | Node (rll, rlk, rlr, _) ->
                make (make l k rll) rlk (make rlr rk rr)
            | Empty -> assert false)
      | Empty -> assert false
    else Node (l, k, r, max hl hr + 1)

  let rec min_elt = function
    | Node (Empty, k, _, _) -> k
    | Node (l, _, _, _) -> min_elt l
    | Empty -> raise Not_found

  let rec remove_min_elt = function
    | Node (Empty, _, r, _) -> r
    | Node (l, k, r, _) -> bal (remove_min_elt l) k r
    | Empty -> invalid_arg "PSet.remove_min_elt"

  let merge t1 t2 =
    match t1, t2 with
    | Empty, _ -> t2
    | _, Empty -> t1
    | _ ->
        let k = min_elt t2 in
        bal t1 k (remove_min_elt t2)

  let create cmp = { cmp = cmp; set = Empty }
  let empty = { cmp = compare; set = Empty }

  let is_empty x =
    x.set = Empty

  let rec add_one cmp x = function
    | Node (l, k, r, h) ->
        let c = cmp x k in
        if c = 0 then Node (l, x, r, h)
        else if c < 0 then
          let nl = add_one cmp x l in
          bal nl k r
        else
          let nr = add_one cmp x r in
          bal l k nr
    | Empty -> Node (Empty, x, Empty, 1)

  let add x { cmp = cmp; set = set } =
    { cmp = cmp; set = add_one cmp x set }

  let rec join cmp l v r =
    match (l, r) with
      (Empty, _) -> add_one cmp v r
    | (_, Empty) -> add_one cmp v l
    | (Node(ll, lv, lr, lh), Node(rl, rv, rr, rh)) ->
        if lh > rh + 2 then bal ll lv (join cmp lr v r) else
        if rh > lh + 2 then bal (join cmp l v rl) rv rr else
        make l v r

  let split x { cmp = cmp; set = set } =
    let rec loop x = function
        Empty ->
          (Empty, false, Empty)
      | Node (l, v, r, _) ->
          let c = cmp x v in
          if c = 0 then (l, true, r)
          else if c < 0 then
            let (ll, pres, rl) = loop x l in (ll, pres, join cmp rl v r)
          else
            let (lr, pres, rr) = loop x r in (join cmp l v lr, pres, rr)
    in
    let setl, pres, setr = loop x set in
    { cmp = cmp; set = setl }, pres, { cmp = cmp; set = setr }

  let remove x { cmp = cmp; set = set } =
    let rec loop = function
      | Node (l, k, r, _) ->
          let c = cmp x k in
          if c = 0 then merge l r else
          if c < 0 then bal (loop l) k r else bal l k (loop r)
      | Empty -> Empty in
    { cmp = cmp; set = loop set }

  let mem x { cmp = cmp; set = set } =
    let rec loop = function
      | Node (l, k, r, _) ->
          let c = cmp x k in
          c = 0 || loop (if c < 0 then l else r)
      | Empty -> false in
    loop set

  let exists = mem

  let iter f { set = set } =
    let rec loop = function
      | Empty -> ()
      | Node (l, k, r, _) -> loop l; f k; loop r in
    loop set

  let fold f { cmp = cmp; set = set } acc =
    let rec loop acc = function
      | Empty -> acc
      | Node (l, k, r, _) ->
            loop (f k (loop acc l)) r in
    loop acc set

  let elements { set = set } =
    let rec loop acc = function
        Empty -> acc
      | Node(l, k, r, _) -> loop (k :: loop acc r) l in
    loop [] set
end;;

module type GRAPH_LABELS =
  sig
    type label
  end;;

(* Typ modułu implementującego grafy o wierzchołkach numerowanych od 0 do n-1. *)
module type GRAPH =
  sig
    (* Etykiety krawędzi. *)
    type label

    (* Typ grafów o wierzchołkach typu 'a. *)
    type graph

    (* Pusty graf. *)
    val init : int -> graph

    (* Rozmiar grafu *)
    val size : graph -> int

    (* Dodanie krawędzi skierowanej łączącej dwa wierzchołki. *)
    val insert_directed_edge : graph -> int -> int -> label -> unit

    (* Dodanie krawędzi nieskierowanej (dwukierunkowej) łączącej dwa wierzchołki. *)
    val insert_edge : graph -> int -> int -> label -> unit

    (* Lista incydencji danego wierzchołka. *)
    val neighbours :  graph -> int -> (int*label) list
  end;;

module Graph = functor (L : GRAPH_LABELS) ->
(struct
  (* Etykiety krawędzi. *)
  type label = L.label

  (* Typ grafów - tablica list sąsiedztwa. *)
  type graph = {n : int; e : (int*label) list array}

  (* Pusty graf. *)
  let init s = {n = s; e = Array.make s []}

  (* Rozmiar grafu. *)
  let size g = g.n

  (* Dodanie krawędzi skierowanej łączącej dwa wierzchołki. *)
  let insert_directed_edge g x y l =
    assert ((x<>y)  && (x >= 0) && (x < size g) && (y >= 0) && (y < size g));
    g.e.(x) <- (y,l)::g.e.(x)

  (* Dodanie krawędzi łączącej dwa (istniejące) wierzchołki. *)
  let insert_edge g x y l =
    insert_directed_edge g x y l;
    insert_directed_edge g y x l

  (* Lista incydencji danego wierzchołka. *)
  let neighbours g x =
    g.e.(x)
end : GRAPH with type label = L.label);;

module IntLabel =
  struct
    type label = int
  end;;

module G = Graph(IntLabel);;

open G;;
open PSet;;
let n = scan_int() and m = scan_int() and k = scan_int();;
let g = G.init n;;

let zbior = ref empty;;

for i = 1 to m do
  let a = scan_int() - 1 and b = scan_int() - 1 and c = scan_int() in
  (*dbg a; pnl(); dbg b; pnl(); pnl(); *)
  G.insert_edge g a b c;
done;;

for i = 1 to k do
  let a = scan_int() - 1 and b = scan_int() in
  zbior := add (Int64.of_int(b), 1, a) !zbior;
done;;

zbior := add (Int64.zero, 0, 0) !zbior;;
let dis = Array.make n Int64.max_int;;

let przydatne = ref 0;;

while is_empty !zbior = false do
  let (odl, czy, u) = min_elt (!zbior).set in
  zbior := {cmp = (!zbior).cmp; set = remove_min_elt (!zbior).set};
  if odl < dis.(u) then begin
    dis.(u) <- odl;
    if czy = 1 then incr przydatne;
    List.iter (fun (v, w) ->
      let waga = Int64.add odl (Int64.of_int(w)) in
      if waga < dis.(v) then begin
        zbior := remove (dis.(v), 0, v) !zbior;
        zbior := remove (dis.(v), 1, v) !zbior;
        dis.(v) <- waga;
        zbior := add (waga, 0, v) !zbior;
      end;
    ) (neighbours g u);
  end;
done;;

print_int (k - !przydatne);;