(* 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 (--) m n =
let rec iter i res =
if i >= m then iter (i - 1) (i::res)
else res in
iter n []
let range m n =
let rec iter i res =
if n >= i then iter (i + 1) (i::res)
else res in iter m []
let pr x = print_endline (string_of_int x)
let pr2 x y = print_endline ((string_of_int x) ^ " " ^ (string_of_int y))
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 lines = zero_pad (Hashtbl.create ((h+1) * (w+1))) in
let () = List.iter (fun i ->
let _ = List.fold_left (fun res j ->
let tmp = (b (i,j)) + res in
let () = Hashtbl.add lines (i,j) tmp in tmp) 0 (1--w) in ())
(1--h) in
let () = List.iter (fun j ->
let _ = List.fold_left (fun res i ->
let tmp = (Hashtbl.find lines (i,j)) + res in
let () = Hashtbl.add area (i,j) tmp in tmp) 0 (1--h) in ())
(1--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 rec area_of_pair ((i,j),(k,l)) ((i',j'),(k',l')) =
(* if i' < i && j' < j then
* area_of_pair ((i',j'),(k',l')) ((i,j),(k,l))
* else *)
if i' <= k && j' <= l then
max ((area_of_rect ((i,j),(i'-1,j'-1))) + (area_of_rect ((i',j'),(k',l'))))
((area_of_rect ((i,j),(k,l))) + (area_of_rect ((k+1,l+1),(k',l'))))
else (area_of_rect ((i,j),(k,l))) + (area_of_rect ((i',j'),(k',l')))
let comb2 ls =
let rec iter res = function
| x :: xs -> iter (List.fold_left (fun ls y -> (x,y) :: ls) res xs) xs
| [] -> res in iter [] ls
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
|> List.sort compare
|> comb2
(* |> List.map (fun (x,y) -> let () = print_string (string_of_rect x) in
* let () = print_string (string_of_rect y) in
* let () = pr (area_of_pair x y) in
* let () = print_newline () in
* (x,y)) *)
|> List.map (fun (x,y) -> area_of_pair x y)
|> List.fold_left
(function
| Some x -> fun y -> Some (max x y)
| None -> fun y -> Some y) None
|> exc_of_opt
|> pr