Ooops
October 17, 2021, 11:01:12

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

#### BlitzBot

• Jr. Member
•  • Posts: 1 ##### [bb] Box Packing by fredborg [ 1+ years ago ]
« on: June 29, 2017, 00:28:41 »
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

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