## Packing rectangles

DB asked the following question on Ask, and it shall be given # 7:

Given a set of rectangles (representing images) of various sizes I'm trying to best fit them on a given canvas area. Allowing for rotation of the rectangles if desired.

Lars H: This was what I wrote to address a similar problem a couple of years ago. The code is documented using docstrip and tclldoc, so all the comments are in LaTeX code, but I switched to # comments here so it should be directly sourcable.

The problem to solve here is not the general packing problem, but rather the problem of where to place a rectangle on top of a given arrangement of rectangles so that it obscures as little as possible (no attempt to rotate). By assigning a weight, that decreases over time, to each of the existing rectangles, one can introduce an incentive for the routine to pick a placement that mostly covers old material.

#   This procedure computes a position for a new rectangle with given
#   width and height that such that the weight of the covered area is
#   minimised.
#   The call syntax is
#   \begin{quote}
#     |best_rectangle_position| \word{boundary} \word{old rectangles}
#     \word{width} \word{height} \word{visible-var}\regopt
#   \end{quote}
#   and the return value is the pair $(x,y)$ of coordinates for the
#   new value. The \word{boundary} is a rectangle in the form of a
#   list
#   \begin{quote}
#     \word{min-x} \word{min-y} \word{max-x} \word{max-y}
#   \end{quote}
#   within which the new rectangle should be positioned. The
#   \word{old rectangles} is a list of lists with the structure
#   \begin{quote}
#     \word{min-x} \word{min-y} \word{max-x} \word{max-y}
#     \word{weight}
#   \end{quote}
#   where the first four elements are integer coordinates of the
#   sides of the rectangle, and the \word{weight} is a double that will
#   be multiplied by the area of this rectangle. The order of the
#   rectangles is assumed to be from bottom to top, so that later
#   rectangles cover earlier ones. The \word{width} and \word{height}
#   are of course the sides of the new rectangle to position.
#
#   The \word{visible-var} is, if specified,
#   the name of a variable in the calling context that will be set to
#   the list of indices of those \word{old rectangles} which are not
#   completely covered by other rectangles. A |-1| in this list means
#   that some part of the window is not covered by any rectangle.
#
#   From a strictly mathematical prespective, the problem considered
#   here is to find a global minimum of covered area counted with
#   weight'' seen as a function of position. This function is
#   piecewise bilinear and thus possible to optimise through the
#   general method of checking all critical points, all singular
#   points, and all boundary points, but in view of (i) the
#   bilinearity and (ii) the rather large number of singular points
#   (typically, every boundary of a rectangle will be a set of
#   singular points), it seems unlikely that there will be any
#   minimum in a critical point that is not attained also in some
#   boundary point. (Possibly this can even be proved, but I don't
#   really have the patience to work it out right now.) Hence the
#   procedure follows the simpler algorithm of locating all
#   coordinate values where there may be a boundary and finds the
#   minimum among these; maybe it isn't completely optimal, but I
#   suspect it will be good enough.

proc best_rectangle_position {boundary oldL width height {visiblevar ""}} {
#   The first step is to find the $x$- and $y$-coordinates of points
#   where there may be a boundary. This is (surprisingly?) simple.
set xL [list [lindex $boundary 0] [lindex$boundary 2]]
set yL [list [lindex $boundary 1] [lindex$boundary 3]]
foreach rect $oldL { foreach {x1 y1 x2 y2 w}$rect break
lappend xL $x1$x2; lappend yL $y1$y2
}
set xL [lsort -integer -unique $xL] set yL [lsort -integer -unique$yL]
#   The next step is to construct a description of the existing
#   tiling. Since all boundaries are present in |xL| and |yL|, the
#   cartesian product of these two contain not only all corners of
#   the rectangles, but also all corners of the visible parts of the
#   rectangles. This means |xL| and |yL| induce a partition of the
#   container rectangle into smaller rectangles such that each of
#   these are visible as part of precisely one of the rectangles from
#   |oldL|. This means that the weights of different parts of the
#   plane can be conveniently stored in a matrix.
#
#   It is also convenient to precompute lists of the interval lengths
#   in the $x$- and $y$-axis partitions.
set dxL [list]; set x0 [lindex $xL 0] foreach x1 [lrange$xL 1 end] {
lappend dxL [expr {$x1-$x0}]
set x0 $x1 } set dyL [list]; set y0 [lindex$yL 0]
foreach y1 [lrange $yL 1 end] { lappend dyL [expr {$y1-$y0}] set y0$y1
}
#   In order to be consistent about the order of indices, let it be
#   so that |lindex $weightM |$i$| |$j$returns the weight associated # with points$(x,y)$such that |lindex$xL |$i$$${}\leqslant x # \leqslant{}$$|lindex $xL |$i$|+1| and |lindex$yL |$j$$${} # \leqslant x \leqslant{}$$|lindex $yL |$j$|+1|. set weightM [lrepeat [llength$dxL] [lrepeat [llength $dyL] 0.0]] set visM [lrepeat [llength$dxL] [lrepeat [llength $dyL] -1]] # Now go through the list of rectangles and update the weight for # those elements which are covered (here is thus where we rely on # the stacking order). A trick that is used (and will be reused # below) is to first compile lists of the index elements which are # of interest here, and then |foreach| over these lists, rather # than to use a |for|. set rcount 0 foreach old_rect$oldL {
foreach {x1 y1 x2 y2 weight} $old_rect break set iL [list]; set i 0 foreach x$xL {
if {$x >=$x1 && $x <$x2} then {lappend iL $i} incr i } set jL [list]; set j 0 foreach y$yL {
if {$y >=$y1 && $y <$y2} then {lappend jL $j} incr j } foreach i$iL {
foreach j $jL { lset weightM$i $j$weight
lset visM $i$j $rcount } } incr rcount } # As an optimisation, a second matrix giving the weighted areas for # each little rectangle is computed as well. These will be needed # comparatively often. set wgtaM [list] foreach column$weightM dx $dxL { set c2 [list] foreach w$column dy $dyL { lappend c2 [expr {$w * $dx *$dy}]
}
lappend wgtaM $c2 } # Now we get to the loop over all possible placements of the # rectangle and the evaluation of which is best. An important part # of this work is carried out by |interval_positions|, which is # first used to find all possible positions on each axis. The parts # of computing weighted areas can then be handled by two nested # loops. # # In case several positions would cover the same minimal weighted # area (which is not entirely unlikely if the rectangles being # covered are large in comparison to the rectangle to position), # then the area of the smallest rectangle with one corner at a # boundary corner and containing the postitioned rectangle is used # as a tie-breaker. This has the effect of choosing more peripheral # positions whenever possible. The so far best weighted area is # kept in |best|, whereas the associated peripherial area is kept # in |best2|. set ipL [interval_positions$xL $width] set jpL [interval_positions$yL $height] set best infinity; set best2 infinity set midx [expr { ([lindex$boundary 2] - $width + [lindex$boundary 0]) / 2
}]
set midy [expr {
([lindex $boundary 3] -$height + [lindex $boundary 1]) / 2 }] foreach ip$ipL {
foreach jp $jpL { set area 0 foreach i [lindex$ip 2] {
foreach j [lindex $jp 2] { set area [expr {$area + [lindex $wgtaM$i $j]}] } foreach {j dy} [lindex$jp 3] {
set area [expr {$area + [lindex$weightM $i$j] * [lindex $dxL$i] * $dy }] } } foreach {i dx} [lindex$ip 3] {
foreach j [lindex $jp 2] { set area [expr {$area +
[lindex $weightM$i $j] *$dx * [lindex $dyL$j]
}]
}
foreach {j dy} [lindex $jp 3] { set area [expr {$area +
[lindex $weightM$i $j] *$dx * $dy }] } } if {$area <= $best} then { set area2 [expr { ( [lindex$ip 0]<$midx ? [lindex$ip 1] - [lindex $boundary 0] : [lindex$boundary 2] - [lindex $ip 0] ) * ( [lindex$jp 0]<$midy ? [lindex$jp 1] - [lindex $boundary 1] : [lindex$boundary 3] - [lindex $jp 0] ) }] if {$area < $best ||$area==$best &&$area2<$best2} then { set ip0$ip; set jp0 $jp set best$area
set best2 $area2 } } } } # Finally, if visibility information is requested then the # positioned rectangle is imposed here and the result is returned. if {$visiblevar ne ""} then {
foreach i [lindex $ip0 2] { foreach j [lindex$jp0 2] {
lset visM $i$j [llength $oldL] } } uplevel 1 [list ::set$visiblevar [
lsort -unique -integer [eval [list concat] $visM] ]] } return [list [lindex$ip0 0] [lindex $jp0 0]] } # The |interval_positions| procedure is a helper for # |best_rectangle_position| that determines all the intervals of a # given length that have one endpoint in a given partition. This is # the one-dimensional analogue of placing a rectangle with one # corner in one of the given points, and is applied separately to # the$x$- and$y$-coordinates. # # The call syntax is # \begin{quote} # |interval_positions| \word{partition} \word{length} # \end{quote} # where \word{partition} is a (sorted) list of points (numbers) # in the partition and \word{length} is the length of the interval # which should be positioned. The return value is the list of all # possible positions. A position is a list # \begin{quote} # \word{lower endpoint} \word{upper endpoint} # \word{fully covered} \word{partially covered} # \end{quote} # where \word{lower endpoint} and \word{upper endpoint} are the # endpoints of the interval at this position. # \word{fully covered} is a list of indices (of intervals # in the partition, i.e., indices into \word{partition}) for those # intervals which are completely covered in this position, and # \word{partially covered} is a list with the structure # \begin{quote} # \begin{regblock}[\regstar]\word{index} \word{width}\end{regblock} # \end{quote} # where each \word{index} is an index of a partially covered # interval and the \word{width} is the width of the covered part of # that interval. There are typically zero or one such pair in this # list. # # The main loop simply goes through all the points of the # partition, first looking backwards from and point and then # forwards. In between, the index counter |n| of the interval in # the partition that contains the current end of the positioned # interval is incremented. Positions without a partial overlap # interval are only added when looking forward. proc interval_positions {partL length} { set min [lindex$partL 0]
set max [lindex $partL end] set res [list] set n -1 foreach p$partL {
if {$p -$length >= $min} then { set fullL [list] set c_prev 0 for {set m$n} {[
set covered [expr {$p - [lindex$partL $m]}] ] <$length} {incr m -1} {
lappend fullL $m set c_prev$covered
}
if {$covered >$length} then {
lappend res [list [expr {$p-$length}] $p$fullL\
[list $m [expr {$length - $c_prev}]]] } } incr n if {$p + $length <=$max} then {
set fullL [list]
set covered 0
for {set m $n}\ {[set q [lindex$partL [expr {$m+1}]]] <$p + $length}\ {incr m} { lappend fullL$m
set covered [expr {$q -$p}]
}
lappend res [list $p [expr {$p+$length}] {} {}] if {$q == $p +$length} then {
lappend fullL $m } else { lset res end 3 [list$m [expr {$length -$covered}]]
}
lset res end 2 \$fullL
}
}
set res
}