January 26, 2021, 06:10:50 AM

Author Topic: [bb] Box Packing by fredborg [ 1+ years ago ]  (Read 428 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bb] Box Packing by fredborg [ 1+ years ago ]
« on: June 29, 2017, 12:28:41 AM »
Title : Box Packing
Author : fredborg
Posted : 1+ years ago

Description : 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!


Code :
Code: BlitzBasic
  1. Type box
  2.         Field id,x,y,w,h
  3. End Type
  4.  
  5. Dim qSortBox.box(0)
  6. Function QuickSortBoxes(l=-1,r=-1)
  7.  
  8.         If l = -1
  9.                 count = 0
  10.                 For box.box = Each box
  11.                         count = count + 1
  12.                 Next
  13.                 Dim qSortBox(count-1)
  14.                 box.box = First box
  15.                 For i = 0 To count-1
  16.                         qSortBox(i) = box
  17.                         box = After box
  18.                 Next
  19.                 l = 0
  20.                 r = count-1
  21.         EndIf
  22.  
  23.         Local A, B, SwapA#, SwapB#, Middle#
  24.         A = L
  25.         B = R
  26.        
  27.         Middle = qSortBox( (L+R)/2 )h
  28.        
  29.         While True
  30.                
  31.                 While qSortBox( A )h < Middle
  32.                         A = A + 1
  33.                         If A > R Then Exit
  34.                 Wend
  35.                
  36.                 While  Middle < qSortBox( B )h
  37.                         B = B - 1
  38.                         If B < 0 Then Exit
  39.                 Wend
  40.                
  41.                 If A > B Then Exit
  42.                
  43.                 box.box = qSortBox( A )
  44.                 qSortBox( A ) = qSortBox( B )
  45.                 qSortBox( B ) = box
  46.                
  47.                 A = A + 1
  48.                 B = B - 1
  49.                
  50.                 If B < 0 Then Exit
  51.                
  52.         Wend
  53.        
  54.         If L < B Then QuickSortBoxes( L, B )
  55.         If A < R Then QuickSortBoxes( A, R )
  56.        
  57.         If count>0
  58.                 Insert qSortBox(0) Before First box
  59.                 box.box = First box
  60.                 For i = 1 To count-1
  61.                         Insert qSortBox(i) After box
  62.                         box = qSortBox(i)
  63.                 Next
  64.         EndIf
  65.        
  66. End Function
  67.  
  68. Dim AlignMinY(0)
  69. Function boxAlign()
  70.         ;Purpose: align boxes
  71.         ;Parameters: None
  72.         ;return: None
  73.        
  74.         QuickSortBoxes()
  75.        
  76.         maxx = GraphicsWidth()
  77.         maxy = GraphicsHeight()
  78.        
  79.         Dim AlignMinY(maxx)
  80.        
  81.         For box.box = Each box
  82.                 box2.box = After box
  83.                 If box2<>Null
  84.                         box2x = boxx+boxw
  85.                         If box2x+box2w>maxx
  86.                                 box2x = 0
  87.                         EndIf
  88.                 EndIf
  89.         Next
  90.  
  91.         For box.box = Each box
  92.                 ; Find the minimum y position for this box
  93.                 miny = 0
  94.                 For x = boxx To boxx+boxw-1
  95.                         If AlignMinY(x)>miny Then miny = AlignMinY(x)
  96.                 Next
  97.                 boxy = miny
  98.                
  99.                 ; Set the minimum y to the bottom edge of the box, for it's entire width
  100.                 miny = boxy+boxh
  101.                 For x = boxx To boxx+boxw-1
  102.                         AlignMinY(x) = miny
  103.                 Next
  104.         Next
  105.        
  106. End Function
  107.  
  108. .MAIN
  109. Graphics 800,800,16,2
  110. SetBuffer(BackBuffer())
  111.  
  112. SeedRnd MilliSecs()
  113.  
  114. ;make some random sized boxes
  115. For loop = 1 To 10000
  116.         box.box = New box
  117.         boxid=loop
  118.         boxw=Rnd(50)+10
  119.         boxh=Rnd(50)+10        
  120. Next
  121.  
  122. starttime=MilliSecs()
  123. boxAlign()
  124. stoptime=MilliSecs()-starttime
  125.  
  126. ;display the boxes
  127. boxarea# = 0
  128. maxy = 0
  129. maxx = 0
  130. For box.box = Each box
  131.         Color 63,127,255
  132.         Rect boxx,boxy+16,boxw,boxh,False
  133.         boxarea = boxarea + boxw*boxh
  134.         If boxy+boxh>maxy Then maxy = boxy+boxh
  135.         If boxx+boxw>maxx Then maxx = boxx+boxw
  136. Next
  137. totarea# = maxx*maxy
  138.  
  139. Color 0,0,0
  140. Rect 0,0,GraphicsWidth(),10,True
  141. Color 255,255,255
  142. Text GraphicsWidth()/2,0,"Boxes - "+(loop-1)+" | Time - "+stoptime+"ms | Area usage - "+((boxarea*100)/totarea)+"%",True
  143.  
  144. Flip()
  145. WaitKey()
  146. End


Comments :


Techlord(Posted 1+ years ago)

 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
Code: [Select]
While qSortBox( A )h < Middle
Code: [Select]
While  Middle < qSortBox( B )hTo
Code: [Select]
While qSortBox( A )h > Middle
Code: [Select]
While  Middle > qSortBox( B )h

 

SimplePortal 2.3.6 © 2008-2014, SimplePortal