'Pimp My Boxes' Contest

Blitz3D Forums/Blitz3D Programming/'Pimp My Boxes' Contest

Techlord

(Posted 2004) [#1]

Just a lil contest for fun to see who can align random sized boxes the fastest.

Rules:

1. Align boxes next to one another without overlaping on screen.

2. Waste minimum screen space.

Heres my super fast boxAlign Entry:

Type box
	Field id,x,y,w,h
End Type

Function boxAlign()
	;Purpose: align boxes
	;Parameters: None
	;return: None
	For box.box = Each box
		Repeat
			;reset overlap counter and test against all boxes, except self
			boxesoverlap=0
			For box2.box = Each box
				If box<>box2
					boxesoverlap=boxesoverlap+RectsOverlap(box\x,box\y,box\w,box\h,box2\x,box2\y,box2\w,box2\h)  	
				End If
			Next
			
			;if box overlaps any of the others, move it and check again	
			If boxesoverlap
				box\x=box\x+1
				If box\x>(GraphicsWidth()-box\w) 
					box\y=box\y+1
					box\x=0
				EndIf 	
			EndIf

		Until Not boxesoverlap
	Next

End Function

.MAIN
Graphics 800,600,16,2
SetBuffer(BackBuffer())

;make some random sized boxes
For loop = 1 To 48
	box.box = New box
	box\id=loop
	box\w=Rnd(112)+12
	box\h=Rnd(112)+12			
Next

starttime=MilliSecs()
boxAlign()
stoptime=MilliSecs()-starttime

;display the boxes
Color 63,127,255	
For boxd.box = Each box
	Text boxd\x,boxd\y,boxd\id		
	Rect boxd\x,boxd\y,boxd\w,boxd\h,0	
Next
Flip()

Color 255,255,255
Print stoptime
WaitKey()

BlackD

(Posted 2004) [#2]

Hehe.. this sounds like a Halo-esque "I need a routine to do (x) efficiently.. I know, I'll get Blitzer's to do it and call it a competition".

+BlackD :)

Techlord

(Posted 2004) [#3]

Hehe.. this sounds like a Halo-esque "I need a routine to do (x) efficiently.. I know, I'll get Blitzer's to do it and call it a competition".

BlackD,

True. So the question remains can you write a faster routine?

Who was John Galt?

(Posted 2004) [#4]

i'm not going to try it, but I think the trick is to order the boxes by size. place the largest one in a corner (probably got a choice of 2 dirs) and try permuations from there.

Damien Sturdy

(Posted 2004) [#5]

Speed? Christ man, were in 3ghz machines now! speed doesnt matter!???? :P hehehe

fredborg

(Posted 2004) [#6]

Add this line after the boxesoverlap = boxesoverlap + blabla

If boxesoverlap Then Exit

And it's about 6 times faster. It's not hard to make it a lot faster but I'm not telling :)

Techlord

(Posted 2004) [#7]

Fredborg,

Come on be a sport and let the cat out of the bag:)

fredborg

(Posted 2004) [#8]

Ok, ok, I will tell:

Function boxAlign()
	;Purpose: align boxes
	;Parameters: None
	;return: None

	For box.box = Each box
		box\area = box\w*box\h
	Next

	For box.box = Each box
		Repeat
			;reset overlap counter and test against all boxes, except self
			boxesoverlap = False
			box2.box = First box
			While box2<>box
				If box<>box2
					If RectsOverlap(box\x,box\y,box\w,box\h,box2\x,box2\y,box2\w,box2\h) 
						box\x = box2\x+box2\w
						boxesoverlap = True
						Exit
					EndIf
				End If
				box2.box = After box2
			Wend
			
			;if box overlaps any of the others, move it and check again	
			If boxesoverlap
				If box\x>(GraphicsWidth()-box\w) 
					box\y=box\y+1
					box\x=0
				EndIf 	
			EndIf

		Until Not boxesoverlap
	Next

End Function

Still fairly slow and wasting a lot of space :D

With a few small modifications I got it down to 30ms for 120 boxes with an area usage of 90% on average (this version takes 730ms and has an area usage of 84% for the same boxes)

jfk EO-11110

(Posted 2004) [#9]

So you're both working on a Lightmapper or what? :P

Techlord

(Posted 2004) [#10]

So far, Fredborg "Pimpin Box' code is the fastest. Any other challengers???

fredborg

(Posted 2004) [#11]

I believe this is close to the fastest possible:

Function SortBoxes()

    cb.box = First box
    flag=True
    While flag
        flag=False
        cbb.box = Last box
        While cbb<>cb
            cbbb.box = Before cbb
            If cbbb=Null Then Exit
		
            If cbb\h>cbbb\h

				prea.box = Before cbb
				preb.box = Before cbbb
				If prea = Null
					Insert cbbb Before First box		
				Else
					Insert cbbb After prea
				EndIf
				
				If preb = Null
					Insert cbb Before First box		
				Else
					Insert cbb After preb
				EndIf

			    flag=True
            Else
                cbb=cbbb
            EndIf

        Wend
        cb=After cbb
    Wend

End Function

Function boxAlign()
	;Purpose: align boxes
	;Parameters: None
	;return: None
	
	SortBoxes()
	
	maxx = GraphicsWidth()
	maxy = GraphicsHeight()
	
	id = 0
	For box.box = Each box
		DebugLog box\w
		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
		Repeat
			;reset overlap counter and test against all boxes, except self
			boxesoverlap = False
			box2.box = First box
			While box2<>box
				If box<>box2
					If RectsOverlap(box\x,box\y,box\w,box\h,box2\x,box2\y,box2\w,box2\h) 
						box\y=box2\y+box2\h
						boxesoverlap = True
						Exit
					EndIf
				End If
				box2.box = After box2
			Wend
		Until Not boxesoverlap
	Next
	
End Function

But not always very effecient :) It's best with a large number of boxes, with little size variation.

Techlord

(Posted 2004) [#12]

WOW

fredborg

(Posted 2004) [#13]

The slow part is obviously the sorting...Anybody got a quicksort that works with types?

3 ms for 120 boxes, while the original took 133702 ms...LOL!

fredborg

(Posted 2004) [#14]

The fastest possible method:

Type box
	Field id,x,y,w,h,area
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

The QuickSort is modified from Noel Cower's Code Archives entry.

24ms (or less) for 10000 boxes! Beat that monkeys!

Techlord

(Posted 2004) [#15]

10000 Boxes PIMP'd!