Сжатие списка прямоугольников

Question

У меня есть несортированный список прямоугольников (описывается как пара нижних левых и верхних правых координат). Я ищу эффективный алгоритм для сжатия этого списка путем замены соседних или перекрывающихся bbox.

Вот мой код, я сортирую все поля bbox по вертикальной оси, пытаюсь сжимать и сортировать результаты по горизонтальной оси и снова сжимать. Это неоптимально, но достаточно быстро.

(** 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
;;

Другое решение является жадным, но очень низким:

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 *)

У вас есть дополнительные советы? Алгоритм не должен сжиматься идеально, но должен быть быстрым и уменьшать размер получаемых прямоугольников (bbox). Кто-нибудь может помочь?

Answer 1

Я хотел бы изучить использование дерева kd . По сути, вы строите двоичное дерево, где на каждом уровне вы разделяете плоскость на точку. Вы чередуетесь, разделяете ли вы в направлении x или y.

Если вы используете нижнюю левую координату в качестве ключа, то единственными прямоугольниками, которые могут содержаться в данном узле, являются прямоугольники в правом поддереве.

Редактировать: на самом деле это может работать не совсем так. Вполне возможно, что прямоугольник может содержаться прямоугольником в его левом поддереве.

Во время обеденного перерыва я быстро внедрил дерево kd. Он работает в сопоставимое время с вашей первой функцией, но, кажется, для достижения лучших результатов. Я не проверял его на корректность (хотя я использую тот же код теста и сжатия, который вы используете), но на 100000 случайных прямоугольников (при значениях x, y от (0,0) до (99,99) ) подход дерева kd сжал это до 47539 ритов, в то время как подход отсортированного списка уменьшил его до 68393. Дерево kd было немного медленнее, особенно при меньших входах (для 100 ритов это заняло вдвое больше, для 100 000 это было только на 4% медленнее) ). Вот мой код:

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)

Существует некоторая очевидная возможность для улучшения (во-первых, я делю дерево kd, используя первый элемент вместо медианного элемента)