Code archives/Algorithms/Box Packing
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
An ultra fast method of packing boxes/rectangles. Could be used to pack several images into one big image, or pack a lightmap, or your suitcase! It works best with a large amount of boxes with little variation in size, as it can waste a bit of space otherwise. If the boxes vary a lot in size, it might be an idea to rotate them so that they are all wider than they are tall, or vice versa. Packs a million boxes/rects in 4-5 seconds. That's 1000000 boxes!!! The QuickSort is modified from Noel Cowers code archive entry! | |||||
Type box Field id,x,y,w,h End Type Dim qSortBox.box(0) Function QuickSortBoxes(l=-1,r=-1) If l = -1 count = 0 For box.box = Each box count = count + 1 Next Dim qSortBox(count-1) box.box = First box For i = 0 To count-1 qSortBox(i) = box box = After box Next l = 0 r = count-1 EndIf Local A, B, SwapA#, SwapB#, Middle# A = L B = R Middle = qSortBox( (L+R)/2 )\h While True While qSortBox( A )\h < Middle A = A + 1 If A > R Then Exit Wend While Middle < qSortBox( B )\h B = B - 1 If B < 0 Then Exit Wend If A > B Then Exit box.box = qSortBox( A ) qSortBox( A ) = qSortBox( B ) qSortBox( B ) = box A = A + 1 B = B - 1 If B < 0 Then Exit Wend If L < B Then QuickSortBoxes( L, B ) If A < R Then QuickSortBoxes( A, R ) If count>0 Insert qSortBox(0) Before First box box.box = First box For i = 1 To count-1 Insert qSortBox(i) After box box = qSortBox(i) Next EndIf End Function Dim AlignMinY(0) Function boxAlign() ;Purpose: align boxes ;Parameters: None ;return: None QuickSortBoxes() maxx = GraphicsWidth() maxy = GraphicsHeight() Dim AlignMinY(maxx) For box.box = Each box box2.box = After box If box2<>Null box2\x = box\x+box\w If box2\x+box2\w>maxx box2\x = 0 EndIf EndIf Next For box.box = Each box ; Find the minimum y position for this box miny = 0 For x = box\x To box\x+box\w-1 If AlignMinY(x)>miny Then miny = AlignMinY(x) Next box\y = miny ; Set the minimum y to the bottom edge of the box, for it's entire width miny = box\y+box\h For x = box\x To box\x+box\w-1 AlignMinY(x) = miny Next Next End Function .MAIN Graphics 800,800,16,2 SetBuffer(BackBuffer()) SeedRnd MilliSecs() ;make some random sized boxes For loop = 1 To 10000 box.box = New box box\id=loop box\w=Rnd(50)+10 box\h=Rnd(50)+10 Next starttime=MilliSecs() boxAlign() stoptime=MilliSecs()-starttime ;display the boxes boxarea# = 0 maxy = 0 maxx = 0 For box.box = Each box Color 63,127,255 Rect box\x,box\y+16,box\w,box\h,False boxarea = boxarea + box\w*box\h If box\y+box\h>maxy Then maxy = box\y+box\h If box\x+box\w>maxx Then maxx = box\x+box\w Next totarea# = maxx*maxy Color 0,0,0 Rect 0,0,GraphicsWidth(),10,True Color 255,255,255 Text GraphicsWidth()/2,0,"Boxes - "+(loop-1)+" | Time - "+stoptime+"ms | Area usage - "+((boxarea*100)/totarea)+"%",True Flip() WaitKey() End |
Comments
| ||
In some cases it is better to sort from the largest to the smallest box. As in my case, sorting large images last resulted in undesired clipping. To sort from large to small, you simply change a couple of lines in the QuickSortBoxes Function. Change Lines While qSortBox( A )\h < Middle While Middle < qSortBox( B )\h To While qSortBox( A )\h > Middle While Middle > qSortBox( B )\h |
Code Archives Forum