How to detect path (motion) in a set of images?

ricardo · Post by **ricardo** » Wed Jul 11, 2007 8:25 pm

Hi

I have a set of images.
Lets say a set of webcam shots (bmps), each one is taked each second.

What i need to do is to detect the motion path of one object (a small red figure with a unique color) and save it as coordinates.

For now lets forget how to get the webcam images, thats solved. I have it as bmp on some folder.

Now i need to examine it (lets say i have one minute footage = 60 images) and i have to read them, analize them and write the coordinates of the image on the screen for each image, so at the end i can draw the path of the movement of that object.

The object has a unique color but the shape (as any image on a webcam) can be a little irregular, but its a small red square. The background is a black wall with nothing else (of course need some tolerance to analize colors because of lights the black or red can have variations as its a webcam shot)

Any help or idea? I never work with images on PB so im newbie in this topic.

Thanks in advance.

ricardo · Post by **ricardo** » Wed Jul 11, 2007 8:29 pm

I know that in theory i can read the bmp buffer and when detect the first red pixel i can save that as coordinate.

But when i tried to do that, i fail. So maybe a little code that put me in the right direction could be nice

Trond · Post by **Trond** » Sat Jul 14, 2007 5:53 pm

Read until you find several pixels in a row with more than x% red.

PureLust · Post by **PureLust** » Sun Jul 15, 2007 3:42 pm

Hi ricardo,

I reflected about your problem and found it quite interesting - so I wrote a small procedure for it, including a quick demonstration.
It can find Objects within a specified Color-Range even in a very noisy and blurred image and will give you back the central Position of the Object.
By calling it multiple times it's possible to identify multiple Objects with varying colors (see screenshot):

[Edit] I've added an object-animation and an object trace-routine, so you can see how it's possible to recognice object-movements within a sequence of images.
Furthermore I've added even more dust into the image to show that it will work on very cloudy images as well.

[Rightclick to download the Source.]
[Rightclick to download Windows-EXE.]

Code: Select all

; PB 4.x - should work on all OS-Platforms   -   (tested on Win-XP and XUbuntu_7 in a VirtualBox).

EnableExplicit

CompilerIf #PB_Compiler_OS <> #PB_OS_Windows	; On other OS then Windows the following Structures must be defined seperately:
	Structure Point
		x.l
		y.l
	EndStructure
	Structure RGBQuad
		rgbBlue.b
		rgbGreen.b
		rgbRed.b
		rgbReserved.b
	EndStructure
CompilerEndIf


Procedure FindObjectInPicture(Image.l, ColRangeMin.l, ColRangeMax.l, *pt.Point)
	;
   ; Description: 
   ; This Routine analyses an image for pixels within an given ColorRange. 
   ; Furthermore it does a weighting of all found points. 
   ; So it is possible to identify an object within the image and get the position of its central point - even if the Image is very noisy.
   ; By calling this routine multiple times with different ColorRanges, it is possible to identify multiple objects within the same Image. 
   ; Limitations: So far it cannot identify more than one object whithin the same ColorRange. 
   ;              In this Case the result will be a weighted middle position of all objects found within this ColorRange. 
	;
	; Parameters:
	; - Image				:	#Image of the Image to be analysed
	; - ColRangeMin		:	specifies the minimum Range for the RGB-Filter
	; - ColRangeMax		:	specifies the maximum Range for the RGB-Filter
	;								Only the Colorchannels are filtered, which have a value in ColRangeMin or ColRangeMax
	;								So setting ColRangeMin=$000088 and ColRangeMax=$6600ff means, that
	;								the valid Range for blue is from $00-$66 and the valid Range for red is from $88-$ff
	;								Because there is no range set for the green-channel, green could have any value.
	;
	; - *pt.Point	[out]	:	Pointer to a POINT-Structure
	;								The x/y-coordinates (center point) of a found Object will be written to this Structure
	;
	; Results				:	The Procedure returns a #True if an Object with the specified Range was found - otherwise it returns #False.
	
	Global FindObjectInPicture_StartDrawingActive.l = #False
	Structure AnalysePicture_Weighting
		Weight.RGBQuad
		Pos.w
	EndStructure
	Protected Result.l = #False
	Protected x.l, y.l, ColInRange.l, ActCol.l, *ActCol.RGBQuad
	Protected ActRed.w, ActGreen.w, ActBlue.w, MinRed.w, MinGreen.w, CheckBlue.w
	Protected xWeight.l, yWeight.l, xMark.l, yMark.l
	Protected *ColMin.RGBQuad = @ColRangeMin
	Protected *ColMax.RGBQuad = @ColRangeMax
	Protected CheckColors.l = ColRangeMin | ColRangeMax
	Protected *ColCheck.RGBQuad = @CheckColors
	If IsImage(Image)
		Protected Dim xWeighting(ImageWidth(Image)-1)
		Protected Dim yWeighting(ImageHeight(Image)-1)
		CompilerSelect #PB_Compiler_OS
			CompilerCase #PB_OS_Windows, #PB_OS_Linux
				!extrn _PB_2DDrawing_GlobalStructure 		; This little ASM-Code (intel CPU only) just checks, if StartDrawing() is already active or not
				!PUSH eax
				!MOV eax,[_PB_2DDrawing_GlobalStructure]
				!MOV [v_FindObjectInPicture_StartDrawingActive],eax
				!POP eax
		CompilerEndSelect
		If Not FindObjectInPicture_StartDrawingActive
			If CheckColors > 0 And StartDrawing(ImageOutput(Image))
				; Image ColorRange-Analysis
				For y = 0 To ImageHeight(Image)-1
					For x = 0 To ImageWidth(Image)-1
						ActCol = Point(x,y)	; <== This could be speeded up by an API-Guru if required.  ;)
						*ActCol = @ActCol
						ColInRange = #True
						If *ColCheck\rgbRed And (*ActCol\rgbRed & 255 < *ColMin\rgbRed & 255 Or *ActCol\rgbRed & 255 > *ColMax\rgbRed& 255 )									; red channel
							ColInRange = #False
						EndIf
						If ColInRange And *ColCheck\rgbGreen And (*ActCol\rgbGreen & 255 < *ColMin\rgbGreen & 255 Or *ActCol\rgbGreen & 255 > *ColMax\rgbGreen & 255)	; green channel
							ColInRange = #False
						EndIf
						If ColInRange And *ColCheck\rgbBlue And (*ActCol\rgbBlue & 255 < *ColMin\rgbBlue & 255 Or *ActCol\rgbBlue & 255 > *ColMax\rgbBlue & 255)			; blue channel
							ColInRange = #False
						EndIf
						If ColInRange
							xWeighting(x) + 1
							yWeighting(y) + 1
; 							Debug Str(x)+","+Str(y)+"  "+Hex(ActCol)+" "+Hex(CheckColors)
						EndIf
					Next x
				Next y
				StopDrawing()
				; Calculating horizontal Weight
				xMark		= 0
				xWeight	= 0
				For x = 0 To ImageWidth(Image)-1
					xMark		= xMark		+ (x+1) * xWeighting(x)
					xWeight	= xWeight	+ xWeighting(x)
				Next x
				; Calculating vertical Weight
				yMark		= 0
				yWeight	= 0
				For y = 0 To ImageHeight(Image)-1
					yMark		= yMark		+ (y+1) * yWeighting(y)
					yWeight	= yWeight	+ yWeighting(y)
				Next y
				; Write Results to Structure
				If xWeight > 0 And yWeight > 0
					*pt\x = xMark / xWeight - 1
					*pt\y = yMark / yWeight - 1
					Result = #True
				EndIf
			EndIf
		Else
			MessageRequester("FindObjectInPicture()-Error",Chr(34)+"StopDrawing()"+Chr(34)+" must be called before using FindObjectInPicture().")
		EndIf
	EndIf
	ProcedureReturn Result
EndProcedure

Procedure GenerateNoisyTestImage(Image, Move=#False)
	Structure TestImageObject
		x.w
		y.w
		width.w
		height.w
		shape.b
		angle.f
		speed.f
		anglestep.f
		steps.b
		dots.w
	EndStructure
	Static Dim Object.TestImageObject(5)
	Protected n, x, y
	Protected x1, y1, x2, y2, angle.f
	Protected rMin, rMax, gMin, gMax, bMin, bMax
	If StartDrawing(ImageOutput(Image))
		If Not Move Or Object(0)\x = 0		; Set new random position and attributes to objects
			For n = 0 To 5
				Object(n)\x = Random(ImageWidth(Image)-57)+28
				Object(n)\y = Random(ImageHeight(Image)-57)+28
				Object(n)\width	= Random(10)+10
				Object(n)\height	= Random(10)+10
				Object(n)\shape 	= Random(1)
				Object(n)\angle		= Random(64000)/10000
				Object(n)\speed		= Random(3000)/1000 + 3
				Object(n)\anglestep	= (Random(5000)-2500)/10000
				Object(n)\steps		= Random(10)+5
				Object(n)\dots			= Random(50)+100
			Next n
		Else											; Move Objects
			For n = 0 To 5
				Object(n)\angle - Object(n)\anglestep
				Object(n)\x + Sin(Object(n)\angle) * Object(n)\speed
				Object(n)\y + Cos(Object(n)\angle) * Object(n)\speed
				If Object(n)\x < 28 Or Object(n)\x > ImageWidth(Image)-28 Or Object(n)\y < 28 Or Object(n)\y > ImageHeight(Image) - 28
					Object(n)\angle - 3.2
					Object(n)\x + Sin(Object(n)\angle) * Object(n)\speed
					Object(n)\y + Cos(Object(n)\angle) * Object(n)\speed
				EndIf
				Object(n)\steps - 1
				If Object(n)\steps < 1
					Object(n)\speed		= Random(3000)/1000 + 3
					Object(n)\anglestep	= (Random(5000)-2500)/10000
					Object(n)\steps		= Random(10)+5
				EndIf
				Object(n)\width	= Random(10)+10
				Object(n)\height	= Random(10)+10
				Object(n)\dots		= Random(50)+100
			Next n
		EndIf
		Box(0,0,ImageWidth(Image),ImageHeight(Image),0)		; blank image
		For y = 0 To ImageHeight(Image)-1						; Fill Image with dust
			For x = 0 To ImageWidth(Image)-1
				If Random(1) : Plot(x,y,RGB(Random($30),Random($30),Random($30))) : EndIf
			Next x
		Next y
		For n = 0 To 5													; draw Objects
			rMin = 0 : rMax = $30
			gMin = 0 : gMax = $30
			bMin = 0 : bMax = $30
			If n = 0 Or n = 3 Or n = 4 : rMin = $40 : rMax = $5f : EndIf
			If n = 1 Or n = 3 Or n = 5 : gMin = $40 : gMax = $5f : EndIf
			If n = 2 Or n = 4 Or n = 5 : bMin = $40 : bMax = $5f : EndIf
			If Object(n)\shape		 ; draw a colored square
				For x = 1 To Object(n)\dots
						Plot(Object(n)\x+Random(Object(n)\width)-Object(n)\width/2,Object(n)\y+Random(Object(n)\height)-Object(n)\height/2,RGB(Random(rMax-rMin)+rMin,Random(gMax-gMin)+gMin,Random(bMax-bMin)+bMin))
				Next x
			Else					; draw a round shape
				For x = 1 To Object(n)\dots
						angle = Random(6400)/1000
						Plot(Object(n)\x+Sin(angle)*Random(Object(n)\width),Object(n)\y+Cos(angle)*Random(Object(n)\height),RGB(Random(rMax-rMin)+rMin,Random(gMax-gMin)+gMin,Random(bMax-bMin)+bMin))
				Next x
			EndIf
		Next n
		StopDrawing()
	EndIf
EndProcedure

Structure MultiPoint
	pt.Point[3]
EndStructure
NewList ObjectPath.MultiPoint()
Define Event
Define tStart, tStop, n, x, y, iCount, Animate
Dim Square.Point(2)

If CreateImage(0,280,200)
	If OpenWindow(0,0,0,ImageWidth(0)+20,ImageHeight(0)+80,"Filtering red, green and cyan Objects", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
		If CreateGadgetList(WindowID(0))
			ImageGadget(0,10,10,0,0,ImageID(0))
			ButtonGadget(1,20,WindowHeight(0)-60,WindowWidth(0)-40,20,"Create and analyse single Image")
			ButtonGadget(2,20,WindowHeight(0)-30,WindowWidth(0)-40,20,"Continuously animate and trace Objects")
			Repeat
				Event = WaitWindowEvent(Animate)
				If Event = #PB_Event_Gadget Or Animate
					If EventGadget() = 2 Or Animate
						If Animate
							If Event = #PB_Event_Gadget											; stop tracing objects
								Animate = #False
								SetGadgetText(2,"Continuously animate and trace Objects")
								DisableGadget(1,#False)
							Else
								GenerateNoisyTestImage(0, #True)
								FindObjectInPicture(0,RGB($40,$00,$00),RGB($7f,$30,$30),@Square(0))	; find red     : red-Range        $40-$7f - green and blue is only valid upto a noiselevel of $30
								FindObjectInPicture(0,RGB($00,$40,$00),RGB($30,$7f,$30),@Square(1))	; find green   : green Range      $40-$7f -  red  and blue is only valid upto a noiselevel of $30
								FindObjectInPicture(0,RGB($00,$40,$40),RGB($30,$7f,$7f),@Square(2))	; find cyan    : green&blue Range $40-$7f -  red  is only valid upto a noiselevel of $30
								If  StartDrawing(ImageOutput(0))
									If CountList(ObjectPath()) > 20		; if Path is longer than 20 steps -> cut it
										FirstElement(ObjectPath())
										DeleteElement(ObjectPath())
										LastElement(ObjectPath())
									EndIf
									AddElement(ObjectPath())
									For n = 0 To 2
										Line(Square(n)\x-10,Square(n)\y,20,0,$ffffff)		; draw cross to show object center point
										Line(Square(n)\x,Square(n)\y-10,0,20,$ffffff)
										ObjectPath()\pt[n]\x = Square(n)\x						; write new center to path
										ObjectPath()\pt[n]\y = Square(n)\y
										ForEach ObjectPath()										; draw path
											x = ObjectPath()\pt[n]\x
											y = ObjectPath()\pt[n]\y
											If NextElement(ObjectPath())
												LineXY(x,y,ObjectPath()\pt[n]\x,ObjectPath()\pt[n]\y,RGB((0 Or n=0)*$5f,(0 Or n>0) *$5f,(0 Or n=2)*$5f))
												PreviousElement(ObjectPath())
											EndIf
										Next
									Next n
									StopDrawing()
									SetGadgetState(0,ImageID(0))
								EndIf
							EndIf
						Else																				; start tracing objects
							Animate = #True
							SetGadgetText(2,"Stop Object tracing")
							DisableGadget(1,#True)
						EndIf
					ElseIf EventGadget() = 1
						GenerateNoisyTestImage(0)
						SetGadgetState(0,ImageID(0))
						iCount = 0
						tStart = ElapsedMilliseconds()
						iCount + FindObjectInPicture(0,RGB($40,$00,$00),RGB($ff,$30,$30),@Square(0))	; find red     : red-Range        $40-$7f - green and blue is only valid upto a noiselevel of $30
						iCount + FindObjectInPicture(0,RGB($00,$40,$00),RGB($30,$7f,$30),@Square(1))	; find green   : green Range      $40-$7f -  red  and blue is only valid upto a noiselevel of $30
						iCount + FindObjectInPicture(0,RGB($00,$40,$40),RGB($30,$7f,$7f),@Square(2))	; find cyan    : green&blue Range $40-$7f -  red  is only valid upto a noiselevel of $30
; 						iCount + FindObjectInPicture(0,RGB($00,$00,$40),RGB($30,$30,$7f),@Square(0))	; find blue    : blue-Range       $40-$7f - green and red  is only valid upto a noiselevel of $30
; 						iCount + FindObjectInPicture(0,RGB($40,$40,$00),RGB($7f,$7f,$30),@Square(1))	; find yellow  : red&green Range  $40-$7f -  blue is only valid upto a noiselevel of $30
; 						iCount + FindObjectInPicture(0,RGB($40,$00,$40),RGB($7f,$30,$7f),@Square(2))	; find magenta : red&blue  Range  $40-$7f - green is only valid upto a noiselevel of $30
						tStop = ElapsedMilliseconds()
						StartDrawing(ImageOutput(0))
							For n = 0 To 2
								Line(Square(n)\x-10,Square(n)\y,20,0,$ffffff)				; draw cross to show object center point
								Line(Square(n)\x,Square(n)\y-10,0,20,$ffffff)
							Next n
							DrawingMode(#PB_2DDrawing_Transparent)
							DrawText(1,1,Str(iCount)+" Objects identified in "+Str(tStop - tStart)+"ms",$ffffff)
						StopDrawing()
						SetGadgetState(0,ImageID(0))
						ClearList(ObjectPath())
					EndIf
				EndIf
			Until Event = #PB_Event_CloseWindow
		EndIf
		CloseWindow(0)
	EndIf
	FreeImage(0)
EndIf

I hope this will work for you.

Greets, PureLust.

ricardo · Post by **ricardo** » Sun Jul 15, 2007 5:25 pm

PureLust wrote: I reflected about your problem and found it quite interesting - so I wrote a small procedure for it, including a quick demonstration.

Exact!!

I think you understand (no matter my poor english) what i was trying to do.
I just download and start palying with your code, looks great!!

If i find questions or comments about it i will post it here later.

Really thanks for you help

ricardo · Post by **ricardo** » Sun Jul 15, 2007 5:36 pm

One question: Imagine there is more than one object with same color, what to do about it?

Imagine wee have 4 pairs of objects, each pair with same color. How to achieve that?

PureLust · Post by **PureLust** » Sun Jul 15, 2007 6:27 pm

In theory you can identify dozens of objects within the same ColorRange, but this will require another analyse-method.

At the moment I create two 2-dimensional histograms (a vertical and a horizontal) of points which match with the Range.
After that I "weight" these two histograms to find the center of mass.

To identify more than one object you'll need a 3-dimensional histogramm and a slightly diffent way to analyse it.
Further the Pathtracking will be more difficult and you'll get some problems if 2 Objects will overlap.

So ... it is possible to do this (e.g. Motiontracking for Computeranimations), but the question is: Is it worth the work for your needs?

ricardo · Post by **ricardo** » Sun Jul 15, 2007 6:28 pm

This are 2 example frames (divided by a line)

In this case there are 2 yellow blocks, one orange and one red.

But there could be more pairs.

*This are fake examples that i made myself last night, but are very similar of the ones we will have

ricardo · Post by **ricardo** » Sun Jul 15, 2007 6:33 pm

PureLust wrote:In theory you can identify dozens of objects within the same ColorRange, but this will require another analyse-method.

At the moment I create two 2-dimensional histograms (a vertical and a horizontal) of points which match with the Range.
After that I "weight" these two histograms to find the center of mass.

To identify more than one object you'll need a 3-dimensional histogramm and a slightly diffent way to analyse it.
Further the Pathtracking will be more difficult and you'll get some problems if 2 Objects will overlap.

So ... it is possible to do this (e.g. Motiontracking for Computeranimations), but the question is: Is it worth the work for your needs?

I only need X and Y axis, but may have more than one object with same color (if its very difficult i could try to avoid this).

Im helping my brother with a research (with plants and insects) and he need to let the webcam working all night long (taking a shot every minute)trying to figure paths.

ricardo · Post by **ricardo** » Sun Jul 15, 2007 6:44 pm

PureLust wrote: To identify more than one object you'll need a 3-dimensional histogramm and a slightly diffent way to analyse it.
Further the Pathtracking will be more difficult and you'll get some problems if 2 Objects will overlap.

So ... it is possible to do this (e.g. Motiontracking for Computeranimations), but the question is: Is it worth the work for your needs?

Thats ver interesting too!!

Could worth very much too.

ricardo · Post by **ricardo** » Sun Jul 15, 2007 8:14 pm

I was using some percent to calculate range color.
Im trying to understand yours to improve mine.

Factor.f = 1+(GetGadgetState(3)/100)
Factor1.f = 1- (GetGadgetState(3)/100)

StartDrawing(ImageOutput(ImageNum))

xRed = Red(ColorToFind)
xMinRed = xRed * Factor1
xMaxRed = xRed * Factor

xGreen = Green(ColorToFind)
xMinGreen = xGreen * Factor1
xMaxGreen = xGreen * Factor

xBlue = Blue(ColorToFind)
xMinBlue = xBlue * Factor1
xMaxBlue = xBlue * Factor

Nik · Post by **Nik** » Sun Jul 15, 2007 10:15 pm

@PureLust
You are sure this part in your FindObject procedure is correct?

Code: Select all

      Protected Dim xWeighting(ImageWidth(Image)-1)
      Protected Dim yWeighting(ImageWidth(Image)-1)

Shouldnt yWeighting use ImageHeigth?

btw: Could you maybe point us to an article about the wighting process you do? I haven quite understood it yet.

PureLust · Post by **PureLust** » Mon Jul 16, 2007 6:39 am

ricardo wrote:I only need X and Y axis, ....

Using a 3-dimensional histogram doesn't mean to get 3-dimensional coordinates. You still just get x/y-coordinates, but you are able to identify more then one Object then.

ricardo wrote:... (if its very difficult i could try to avoid this).

YES !!! If you can avoid it ... do it.

Changing from a 2-dimensional to a 3-dimensional historgam means to rethink and rewrite the whole thing.
Further the Object-Tracking will be much more difficult and has to work in a total diffent way because it cannot identify a specific object by his color in any single frame.
So ... if you can avoid it ... just do it.

ricardo wrote:I was using some percent to calculate range color.
Im trying to understand yours to improve mine.

A tip to find the right ColorRange settings:

If you want to find a red object, you have to set the range of the red channel to a higher value (e.g. between $80 and $b0 - depending of the brightness of your red).
If you don't set a Min/Max to the other colorchannels (green & blue) it will accept any value for these channels which will get you in trouble.
Because in this case, it will find valid "red"-points also if there are "white"-points - because the red-channel is a part of white color.
So ... to filter red and eliminate white (or any other color combined with red) you have to set a range to the other colors to exclude them.
But because the image could have a lot of noise, you have to set a range which still includes the bottom-noise.

As you can see in my demo - I've set the red-range to $40-$7f and the range of the other colors to $00-$30 to accept the buttom-noise of the Image.

To find the right Filterrange, have a look at the color you want to filter and find out which colorchannel it's using at which level. Then set the Min/Max Range +/- $20 around this level to allow som noise.
For the not used colorchannel use a range from $00-$30 to accept the dark bottom noise.

(I hope you can understand what I try to say. It's really a pain in the a** phrasing things like this in a not native language. :roll: )

PureLust · Post by **PureLust** » Mon Jul 16, 2007 6:39 am

Nik wrote:@PureLust
You are sure this part in your FindObject procedure is correct?
Code: Select all
      Protected Dim xWeighting(ImageWidth(Image)-1)
      Protected Dim yWeighting(ImageWidth(Image)-1) 
Shouldnt yWeighting use ImageHeigth?

You are right. I've allready recogniced that a while ago when I've checked the Arrays in the debuggers VariableList - but then I've forgotten to change it. Thanks for remembering me.

Fixed it (see above).

Nik wrote:btw: Could you maybe point us to an article about the wighting process you do? I haven quite understood it yet.

As you may have seen in the german PB-Forum I was looking for a weighting routine. [Link]
In my Post in the German Forum you can see what I was trying to do and what the Routine does now.
I found the right idea to do it at Wikipedia under the term "Gewichtung" or "Wichtung". [Link]

The Formula I've used is called "gewichteter Mittelwert".
The numbers of the Array-Elements are the "Noten" and the Values in the x/yWeighting()-Arrays are the "Gewichte".

Any questions?

PureLust · Post by **PureLust** » Mon Jul 16, 2007 3:29 pm

ricardo wrote:I was using some percent to calculate range color.
Im trying to understand yours to improve mine.

Sorry ... I did find a mayor bug in the filtering routine, caused by the fact, that PB allways uses signed variables.
If you've tried to use color-ranges above $7f the filtering was not working correctly.

>fixed< (see corrected code and link above).