I am having serious trouble coming up with a good algorithm to solve my
current problem.
Hopefully somebody here can help me.
Here is an example of what I am trying to do:
+-------------+
|### $$$|
|### $$$|
|### $$$|
|XXXXX |
|XXXXX |
|XXXXX |
|XXXXX |
+-------------+
This is a graphical depiction of some boxes in a big box.
In my code, these boxes are represented by a list of coordinates (x y
width height), which are in a list, e.g.:
'((1 1 3 3)
(1 4 5 4)
(12 1 3 3)
)
And, of course, the bounding area has a width of 13, and a height of 7.
What I wan to do is find the area shown here with "*"'s:
+-------------+
|###*******$$$|
|###*******$$$|
|###*******$$$|
|XXXXX |
|XXXXX |
|XXXXX |
|XXXXX |
+-------------+
And get a new box:
(4 1 7 3)
The problem is that while it would be very easy to DRAW these boxes, it
becomes difficult to find the empty space between.
This version of the problem is also greatly simplified. In the real
situation we are not really using a grid (although I suppose that could
be an option; it woudl unfortunately not be a happy one), so its not
like we can use a two-dimensional array and then scan across and down in
a slood-filling fashion, I think.
And of course, this algorithm should account for the possiblity the not
all the rooms are on the edges.
If anyone has an algorithm/hueristic or web page that can help me out,
please share!
Thanks
Dobes
Dobes Vandermeer <·····@mindless.com> writes:
> What I wan to do is find the area shown here with "*"'s:
> +-------------+
> |###*******$$$|
> |###*******$$$|
> |###*******$$$|
> |XXXXX |
> |XXXXX |
> |XXXXX |
> |XXXXX |
> +-------------+
It is not clear to me how this area is defined. If you can give a
good answer to that, perhaps an algorithm will suggest itself as well.
Stig Hemmer,
Jack of a Few Trades.
Dobes Vandermeer wrote:
> [... problem description delete ...]
Well, I'm not sure I understand the problem exactly, but here is a solution
to what I think you are looking for. It won't scale particularly well (I
wrote this quickly, not trying to be effienct in the solution). Depending
on exactly what you problem is, you might look at scan-conversion algorithms,
this has the ring of a scan-conversion problem (you can find solutions in
Graphics Gems I).
;;;
;;; USEAGE: (find-empty-areas '((1 1 3 3) (1 4 5 4) (11 1 3 3)) 13 7)
;;;
;;; Note that starting indicies are 1 and not 0!
;;;
(defun find-empty-areas (box-list max-x max-y)
(let ((new-boxes nil))
(loop for y from 1 to max-y do
(loop for x from 1 to max-x do
(when (no-box-here? x y box-list)
(push (create-box x y box-list max-x max-y) new-boxes)
(push (first new-boxes) box-list))))
new-boxes))
(defun no-box-here? (x y box-list)
(not (loop for box in box-list
when (contained? x y box) do (return t))))
(defun contained? (x y box)
(let* ((bx (first box))
(by (second box))
(ex (1- (+ bx (third box))))
(ey (1- (+ by (fourth box)))))
(and (>= x bx) (>= y by) (<= x ex) (<= y ey))))
;;;
;;; this favors horizontal boxes (I'm assumeing that we must have
;;; rectangular shaped boxes, and L-shaped (or other shaped) are not allowed)
;;;
(defun create-box (x y box-list max-x max-y)
(let* ((max-x (find-x-span x y box-list max-x))
(max-y (find-y-span x max-x y box-list max-y)))
(list x y (1+ (- max-x x)) (1+ (- max-y y)))))
(defun find-x-span (x y box-list max-x)
(loop for x from (1+ x) to max-x
while (no-box-here? x y box-list)
finally (return (1- x))))
(defun find-y-span (x max-x y box-list max-y)
(loop for y from (1+ y) to max-y
while (no-box-span? x max-x y box-list)
finally (return (1- y))))
(defun no-box-span? (x max-x y box-list)
(not (loop for x from x to max-x
when (not (no-box-here? x y box-list)) do (return t))))
--
Christopher J. Vogt - Computer Consultant - Solving hard problems since 1979
http://members.home.com/vogt/
Dobes Vandermeer wrote:
[given a bunch of boxes inside a big box like this]
> +-------------+
> |### $$$|
> |### $$$|
> |### $$$|
> |XXXXX |
> |XXXXX |
> |XXXXX |
> |XXXXX |
> +-------------+
[with the bunch of boxes represented like this]
> '((1 1 3 3)
> (1 4 5 4)
> (12 1 3 3)
> )
[how to get the box marked with * in this?]
> +-------------+
> |###*******$$$|
> |###*******$$$|
> |###*******$$$|
> |XXXXX |
> |XXXXX |
> |XXXXX |
> |XXXXX |
> +-------------+
It's not clear what you want. I'm conjecturing that you want
the "largest" box whose top left corner is the "earliest" unfilled
point in your big bounding box, where "largest" gives priority
to the horizontal direction, and so does "earliest".
In that case, here's one approach. It probably isn't optimal.
(Neither is the code; it's intended to be clear rather than fast.
One hideous inefficiency is the gratuitous garbage generation
in the updating of UNOCCUPIED-SEGMENTS. Another is in the fact
that stages 2 and 3 should be combined, avoiding making two passes
over the start of the transition list.)
I have tested the code on your example, but not on any other.
It may be broken in interesting ways. :-)
1. Get a more helpful representation of your input data:
specifically, a list (ordered by y-coordinate, top to
bottom) of places where boxes begin or end, and for each
such place an indication of the left-hand and right-hand
edges of the box, and whether it's starting or finishing.
Add two extra "transitions": one at the start and one at
the end. And, for reasons that will become apparent later,
add a completely bogus extra one past the end.
(defun transition-list (boxes x-size y-size)
(let* ((edges
(mapcan
;; A list of two transition records. MAPCAN will
;; splice these together.
#'(lambda (box)
(destructuring-bind (x0 y0 xs ys) box
(let ((x1 (+ x0 xs))
(y1 (+ y0 ys)))
(list
`(begin ,y0 ,x0 ,x1)
`(end ,y1 ,x0 ,x1)))))
boxes))
(augmented-edges
`((end 1 1 ,(1+ x-size))
(begin ,(1+ y-size) 1 ,(1+ x-size))
(bogus ,(+ 2 y-size) 0 0)
. ,edges)))
;; Now order the transition records by their y-coordinates,
;; putting ENDs before BEGINs.
(sort augmented-edges #'compare-transitions)))
(defun compare-transitions (t1 t2)
(let ((x1 (second t1))
(x2 (second t2)))
(or (< x1 x2)
(and (= x1 x2)
(eq (first t1) 'end)))))
This will turn your list of boxes into
((end 1 1 15)
(begin 1 1 4) ; This line and the next may be swapped.
(begin 1 12 15)
(end 4 1 4) ; This line and the next may be swapped.
(end 4 12 15)
(begin 4 1 6)
(end 8 1 6)
(begin 8 1 15)
(bogus 9 0 0))
2. Now run through your list looking for the earliest unoccupied
point. In the following, X-TRANSITIONS is a list of records
like (begin 3) or (end 5); they indicate the start or end of
occupied space on a given horizontal line. It's the same sort
of thing as one of the transitions output by the previous function,
only simpler. ENDs always come before BEGINs with the same
x-coordinate.
The idea is that as you go through the list you'll be thinking:
(end 1 1 15) "OK, so everything from 1 to 15 is unoccupied."
(begin 1 1 4) "From 1 to 4 is occupied. So now 5..15 is free."
(begin 1 12 15) "From 12 to 15 is occupied. So now 5..12 is free."
(end 4 1 4) "OK, so we're done with y=1. OK! So there's a free
rectangle starting at y=1 with x-values from 5..12."
If the big box is completely full, we'll run off the end of the real
entries and hit the (bogus 9 0 0) one. In that case, we report that
there's nowhere to put another rectangle.
(defun find-unoccupied-segment (tlist)
(let ((x-transitions '())
(last-y -1))
(dolist (transition tlist)
(destructuring-bind (kind y x0 x1) transition
(cond
;; If we've done everything at CURRENT-Y now,
;; "normalise" X-TRANSITIONS and check whether
;; we're finished.
((/= y last-y)
;; (begin x) (begin x) -> (begin x), etc.
;; (end x) (begin x) -> [nothing].
(let ((deleting nil))
(setq x-transitions
(mapcon
#'(lambda (tail)
(cond
(deleting (setq deleting nil) '())
((null (rest tail)) (list (first tail)))
((= (second (first tail))
(second (second tail)))
(setq deleting (not (eq (first (first tail))
(first (second tail)))))
'())
(t (list (first tail)))))
x-transitions)))
;; Look for an END item in X-TRANSITIONS. If we find one,
;; we're done. We use MEMBER, not FIND, because we actually
;; want the next item -- which indicates where the free
;; space at this y-coord ends -- as well. (There should
;; always be one.)
(let ((possible-end (member 'end x-transitions :key #'first)))
(when possible-end
;; Hooray! POSSIBLE-END is the tail of the list, beginning
;; with the END item we want.
(return-from find-unoccupied-segment
(values (second (first possible-end))
(second (second possible-end))
last-y))))
(when (eq kind 'bogus)
;; We've gone through the whole transition list
;; without finding an empty space. We lose.
(return-from find-unoccupied-segment nil)))
((eq kind 'begin)
(setq x-transitions
(merge 'list x-transitions `((begin ,x0) (end ,x1))
#'compare-transitions)))
((eq kind 'end)
(setq x-transitions
(merge 'list x-transitions `((end ,x0) (begin ,x1))
#'compare-transitions))))
(setq last-y y)))
(error "The programmer has screwed up. We aren't supposed to get here.")))
3. OK. So FIND-UNOCCUPIED-SEGMENT has returned something non-NIL,
let's hope. Specifically, it's returned three values, indicating
the top edge of the rectangle we want. Now we continue through the
transition list, starting where we left off -- unfortunately,
because of the way I'm splitting this code up, that means doing
another pass through the first part of the transition list --
and continue until we hit a BEGIN whose range intersects that
of our rectangle. This function calls FIND-UNOCCUPIED-SEGMENT
and then does that.
(defun find-unoccupied-rectangle (tlist)
(multiple-value-bind (x0 x1 y)
(find-unoccupied-segment tlist)
(unless x0 (return-from find-unoccupied-rectangle nil))
(loop while (<= (second (first tlist)) y) doing
(pop tlist))
(dolist (transition tlist)
(destructuring-bind (kind ny nx0 nx1) transition
(when (and (eq kind 'begin)
(and (< nx0 x1)
(> nx1 x0)))
(return-from find-unoccupied-rectangle
(values x0 y x1 ny)))))
(error "The programmer has screwed up. We aren't supposed to get here.")))
4. Putting it all together:
(defun next-rectangle (boxes x-size y-size)
(find-unoccupied-rectangle
(transition-list boxes x-size y-size))))
--
Gareth McCaughan Dept. of Pure Mathematics & Mathematical Statistics,
·····@dpmms.cam.ac.uk Cambridge University, England.