Compressing list of rectangles

I have an unsorted list of rectangles (described as pair of lower left and upper right coordinates). I am looking for an efficient algorithm to compress this list by replacing neighboring or overlapping bboxes.

Here are my code, I am sorting all bboxes along vertical axis, try to compress and sorting result along horizontal axis and compress again. This is suboptimal 开发者_如何学编程but fast enough.

(** boundingbox, (x0,y0) means left down, (x1,y1) right upper edge *)
type bbox_t = { x0 : int; y0 : int; x1 : int; y1 : int; }

let _test_if_compressable a b =
  assert(a.x0 >= 0);
  assert(a.y0 >= 0);
  assert(b.x0 >= 0);
  assert(b.y0 >= 0);
  assert(a.x1 >= a.x0);
  assert(a.y1 >= a.y0);
  assert(b.x1 >= b.x0);
  assert(b.y1 >= b.y0);
  let same_x_ab = (a.x0 == b.x0) && (a.x1 == b.x1) in
  let same_y_ab = (a.y0 == b.y0) && (a.y1 == b.y1) in
  (same_x_ab && same_y_ab) ||
  (same_x_ab && (a.y1 >= (b.y0-1)) && (a.y0 <= b.y0)) ||
  (same_x_ab && (b.y1 >= (a.y0-1)) && (b.y0 <= a.y0)) ||
  (same_y_ab && (a.x1 >= (b.x0-1)) && (a.x0 <= b.x0)) ||
  (same_y_ab && (b.x1 >= (a.x0-1)) && (b.x0 <= a.x0)) 
;;

(* compresses list of bboxes by joining bboxes of same dimension
  * @param sort1 primary sorting function (hsort)
  * @param sort2 secondary sorting function (vsort)
  * @param bboxlst list of bboxes
  * @return list of bboxes
  *)
let compress_bboxes sort1 sort2 bboxlst =
  let rec compr lst newlst =
    let _calc_new bbox1 bbox2 = 
      let miny = min bbox1.y0 bbox2.y0
      and maxy = max bbox1.y1 bbox2.y1
      and minx = min bbox1.x0 bbox2.x0
      and maxx = max bbox1.x1 bbox2.x1
      in
        {x0=minx; y0=miny; x1=maxx; y1=maxy}
    in
      match lst with
          [] -> List.rev newlst
        | hd::[] -> List.rev (hd::newlst)
        | hd1::hd2::tl when hd1 = hd2 ->  compr tl (hd1::newlst)
        | hd1::hd2::tl when _test_if_compressable hd1 hd2 -> let b = _calc_new hd1 hd2 in compr tl (b::newlst)
        | hd1::hd2::tl ->
            compr (hd2::tl) (hd1::newlst)
    in
  let newxlst = compr (sort1 bboxlst) [] in
  let newylst = compr (sort2 newxlst) [] in
    newylst
;;

Another solution is a greedy one, but very low:

let first_partition e lst =
    let rec _first_partition accu =
      function
          [] -> None
        | hd::tl when not (_test_if_compressable hd e) ->
            _first_partition (hd::accu) tl
        | hd::tl -> Some (hd, (List.rev_append accu tl))
    in
      _first_partition [] lst
  in
  let rec _compr accu =
    function
        [] -> List.rev accu
      | hd::tl ->
            match (first_partition hd tl) with
              None -> _compr (hd::accu) tl
            | Some (c,r) -> let newbbox = get_surrounding_bbox [c;hd] in  
                _compr (newbbox::accu) r
  in
 _compr [] lst (* call this repeately to improve compression *)

Do you have additional hints? The algorithm must not compress perfectly, but should be fast and reduce the size of resulting rectangles (bboxes). Could anybody help?

I would look into using a kd tree. Basically you build a binary tree where at each level you split the plane on a point. You alternate whether you split in the x or y direction.

If you use the bottom left coordinate as your key, then the only rectangles that could be contained by a rectangle in a given node are those in the right sub-tree.

Edit: actually this might not work quite like that. It's possible that a rectangle could be contained by a rectangle in its left subtree.

During my lunch break I did a quick implementation of a kd tree. It runs in comparable time to your first function but appears to achieve better results. I haven't checked it for correctness (although I'm using the same test and compress code that you're using), but on 100000 random rectangles (with x,y values going from (0,0) to (99,99) the kd tree approach compressed this to 47539 rects while the sorted list approach got it down to 68393. The kd tree was slightly slower, especially on smaller inputs (for 100 rects it took twice as long, for 100,000 it was only 4% slower). Here is my code:

type 'a kdtree = Empty | Node of 'a kdtree * 'a * 'a kdtree

let rect_comp d a b =
    if d mod 2 = 0 then
        a.x0 < b.x0
    else
        a.y0 < b.y0

let kd_of_list l =
    let rec kdl n = function [] -> Empty
    | h::t ->
        let right, left = List.partition (rect_comp n h) t in
        Node (kdl (n+1) left, h, kdl (n+1) right)
    in
    kdl 0 l

let rec kd_compress boxes =
    let rec compress elt rest = function [] -> elt::rest
        | h::t when _test_if_compressable elt h -> let b = _calc_new elt h in compress b rest t
        | h::t when h = elt -> compress elt rest t
        | h::t -> h::(compress elt rest t)
    in
    match boxes with Empty -> []
    | Node (l, m, r) ->
        let left = kd_compress l in
        let right = kd_compress r in
        (compress m left right)

There is some obvious room for improvement (for one thing, I'm partition the kd tree using the first element instead of the median element)