(* let read_from = Scanf.Scanning.open_in "test4.txt" *)
let read_from = Scanf.Scanning.stdin
let tbl_of_line tbl h w_max =
let rec iter n =
if n <= w_max then let () = Scanf.bscanf read_from "%d " (fun x -> Hashtbl.add tbl (h,n) x) in iter (n + 1)
else () in iter 1
let rec range m n =
if n >= m then n :: range m (n - 1)
else []
let pr x = print_endline (string_of_int x)
let tbl_of_stdin tbl h_max w_max =
let rec iter n =
if n <= h_max then
let () = tbl_of_line tbl n w_max in iter (n+1)
else () in iter 1
let exc_of_opt = function
| Some x -> x
| None -> failwith "error"
let h,w = Scanf.bscanf read_from "%d %d\n" (fun x y -> (x,y))
let garden = Hashtbl.create ((h+1) * (w+1))
let () = tbl_of_stdin garden h w
let b ij = Hashtbl.find garden ij
let arbitary_neg = Hashtbl.fold (fun _ v res -> if v >= 0 then false
else res) garden true
let arbitary_pos = Hashtbl.fold (fun _ v res -> if v <= 0 then false
else res) garden true
let negative_case () =
match Hashtbl.fold
(fun p v -> function
| Some (_,res) as x -> if v < res then x else Some (p,v)
| None -> Some (p,v)) garden None with
| None -> failwith "negative_case"
| Some (p,max1) ->
match Hashtbl.fold
(fun q v -> function
| Some res as x -> if p = q then x else Some (max v res)
| None -> Some v) garden None with
| None -> failwith "negative_case"
| Some max2 -> max1 + max2
let fixed_search b j w =
let tbl = Hashtbl.create (w+2) in
let _ = List.fold_left (fun res i ->
let tmp = (b (j,i)) + res in
let () = Hashtbl.add tbl i tmp in tmp) 0 (range 1 w) in
let () = Hashtbl.add tbl (w+1) 0 in
let () = Hashtbl.add tbl 0 0 in
let sum_i i = Hashtbl.find tbl i in
match List.fold_left
(fun x' len ->
match x',
(List.fold_left
(fun x i ->
let tmp = (sum_i (i-len)) - (sum_i (i+1)) in
match x with
| Some (s,p) -> if s < tmp
then Some (tmp,(i,len))
else x
| None -> Some (tmp,(i,len))) None (range (1 + len) w))
with
| Some (s',p'),Some (s,p) ->
if s > s' then Some (s,p)
else Some (s',p')
| None,x -> x
| x,None -> x) None (range 0 (w - 1))
with
| Some (s,(i,len)) -> ((i-len),i)
| None -> failwith "fixed_search"
let slice_horz i w = fixed_search b i w
let slice_vert j h =
let trnp (i,j) = b (j,i) in
fixed_search trnp j h
let search_vert h w = List.map (fun x -> slice_horz x w) (range 1 h)
let search_horz h w = List.map (fun x -> slice_vert x h) (range 1 w)
let calc_area h w =
let zero_pad area =
let rec iter j =
if j <= w then
let () = Hashtbl.add area (0,j) 0 in iter (j + 1)
else () in
let rec iter' i =
if i <= h then
let () = Hashtbl.add area (i,0) 0 in iter' (i + 1)
else () in
let () = iter 0 in
let () = iter' 0 in area in
let area = zero_pad (Hashtbl.create ((h+1) * (w+1))) in
let rec iter i j =
try
Hashtbl.find area (i,j)
with _ ->
match i,j with
| 1,1 -> let () = Hashtbl.add area (1,1) (b (1,1)) in b (1,1)
| 1,_ -> let tmp = (iter 1 (j - 1)) + (b (1,j)) in
let () = Hashtbl.add area (1,j) tmp in tmp
| _,1 -> let tmp = (iter (i - 1) 1) + (b (i,1)) in
let () = Hashtbl.add area (i,1) tmp in tmp
| _ -> let tmp = (b (i,j)) + (iter (i - 1) j)
+ (iter i (j - 1)) - (iter (i - 1) (j - 1)) in
let () = Hashtbl.add area (i,j) tmp in tmp in
let _ = iter h w in
let area = Hashtbl.find area in
let area_of_rect ((i,j),(k,l)) =
(area (k,l)) + (area ((i - 1),(j - 1)))
- (area ((i - 1),l)) - (area (k,(j - 1))) in area_of_rect
let area_of_rect = calc_area h w
let string_of_rect ((i,j),(k,l)) =
(string_of_int i) ^ " " ^ (string_of_int j) ^ " " ^ (string_of_int k) ^ " " ^ (string_of_int l) ^ "\n"
module VSet = Set.Make (
struct
type t = int * int
let compare = (fun (x,x') (y,y') ->
if compare x y = 0 then compare x' y'
else compare x y)
end)
let remove_dup ls = VSet.fold (fun x ls -> x :: ls) (VSet.of_list ls) []
let merge f = List.fold_left (fun ls x -> (f x ls)) []
let merge_append f xs ls' = List.fold_left (fun ls x -> (f x ls)) ls' xs
let map2 f xs = merge (fun y -> merge_append (fun x ls -> (f x y) :: ls) xs)
let generate_rects h w =
let cand_v = remove_dup (search_vert h w) in
let cand_h = remove_dup (search_horz h w) in
map2 (fun (i,k) (j,l) -> ((i,j),(k,l))) cand_h cand_v
let intersection ((i,j),(k,l)) ((i',j'),(k',l')) =
if i' > k || j' > l then None
else Some ((max i i',max j j'),(min k k',min l l'))
let comb rects = map2 (fun x y -> (x,y)) rects rects
let positive_case h w =
area_of_rect ((1,1),(h,w))
let () = if arbitary_neg then
negative_case ()
|> pr
else if arbitary_pos then
positive_case h w
|> pr
else
generate_rects h w
|> comb
|> List.map (fun (x,y) ->
match intersection x y with
| Some r -> (area_of_rect x) + (area_of_rect y) - (area_of_rect r)
| None -> (area_of_rect x) + (area_of_rect y))
|> List.fold_left
(function
| Some x -> fun y -> Some (max x y)
| None -> fun y -> Some y) None
|> exc_of_opt
|> pr