Message Boards

GROUPS:

Staff Picks Education Physics Dynamic Interactivity Graphics and Visualization Interface Construction Wolfram Language Video Processing

Douglas Leite

Tracking: video-analysis for Physics experiments

Douglas Leite, ITA

Posted 7 months ago

1930 Views

4 Replies

13 Total Likes

Follow this post

Here I bring a notebook that I developed for precisely track objects in motion in a video. The context here is getting accurate data from video-captured Physics experiments. This YouTube video (Portuguese) helps to understand its use. Please feel free to use and improve.

Tracking: video-analysis for Physics experiments
Prof. Douglas M G Leite - ITA
www.lpp.ita.br/leite

Introduction

This notebook was developed for the purpose of accurately tracking a moving object in a video (mp4 or avi). At the end, position data are obtained in rectangular and polar coordinates as a function of the shooting time. This notebook is especially useful for analyzing physics experiments (kinematics, mechanics, dynamics, etc...) as it allows the use and positioning of reference and scale axes, and also estimates the uncertainties in each variable (first numerical line from the data table).
Below some examples of the outputs

In[]:=

ListAnimate[animf,SaveDefinitionsTrue]

Out[]=

1- Initialization and definitions

This section defines some options, variable and functions . It defines the working directory as the directory where this notebook is saved, from where it looks for and import video files (mp4 and avi) and to where it will export the final data file (txt)
>> Only execute the cell bellow

In[]:=

Off[General::"spell1"];Off[General::"spell"];Off[General::sysffmpeg];Off[Remove::rmnsm];SetSystemOptions["VideoProcessingOptions"{"TryUsingSystemFFmpeg"False}];scrsize=AbsoluteOptions[EvaluationNotebook[],WindowSize][[1,2,1]];tam=1.5;dtam=0.001;frame=1;grand={"t (s)","x (m)","y (m)","r (m)","θ (rad)"};PointInPoly[{x_,y_},poly_List]:=Module[{i,j,c=False,npol=Length[poly]},For[i=1;j=npol,i<=npol,j=i++,If[((((poly[[i,2]]<=y)&&(y<poly[[j,2]]))||((poly[[j,2]]<=y)&&(y<poly[[i,2]])))&&(x<(poly[[j,1]]-poly[[i,1]])*(y-poly[[i,2]])/(poly[[j,2]]-poly[[i,2]])+poly[[i,1]])),c=¬c];];c]stilo={FontFamily->"Arial",16,Plain};opt=SetOptions[{ListPlot,Plot},PlotStyle{Green,PointSize[0.01]},PlotRangeAll,ImageSizescrsize/4,FrameTrue,GridLinesAutomatic,BaseStylestilo,FrameStyleDirective[stilo],LabelStylestilo];ParallelEvaluate[SetOptions[ListPlot,opt[[1]]]];ParallelEvaluate[SetOptions[Plot,opt[[2]]]];ParallelEvaluate[opt];diretorio=DirectoryName[ToFileName["FileName"/.NotebookInformation[EvaluationNotebook[]]]];$Path=Append[$Path,diretorio];Print["Working Directory = ",SetDirectory[diretorio]]file=Flatten[Join[FileNames["*.mp4"],FileNames["*.avi"]]];Print[Column[{"Video Files in the Working Directory:",Transpose[{Range[Length[file]],file}]//TableForm}]]

Working Directory = D:\work\Docencia\Disciplinas\FIS1XL\tracking-mathematica

Video Files in the Working Directory:

1	20180828_150818.mp4
2	20180830_153051.mp4
3	20180830_155747.mp4
4	20210520_171809.mp4
5	2021-08-30 09.51.14.mp4
6	2021-08-30 10.17.39.mp4
7	Project 1.mp4
8	VID_20210831_135031.mp4
9	Video - movimento pendular.mp4
10	video-pendulo-amortecido-alto-angulo.mp4
11	Video_Pendulo.mp4
12	agosto 2011 047.AVI
13	VID_20210224_093457.avi
14	VID_20210224_093457-claro.avi
15	WIN_20190829_11_10_40_Pro_xvid.avi

2 - Choose video

This section serves only to choose the video file and get some properties of it
>> Choose the file from the output above and type its corresponding number (integer) for the variable “narquivo” bellow and then execute the cell (can take some seconds)

In[]:=

narquivo=6;(*chooseavideofromtheabovelistbytypingthecorrespondingnumber*)nomevideo=file[[narquivo]];video0=Video[nomevideo];info=Flatten[Information[video0,{"Duration","FrameCount","FrameRate","OriginalRasterSize"}]];{dur,num,frate,size0}={QuantityMagnitude[UnitConvert[info[[1]]]],(info[[2]]//Values)[[1]],QuantityMagnitude[(info[[3]]//Values)[[1]]]*1.0,Flatten[info[[4]]//Values]};Print[Column[{"Dados do Arquivo:",Row[{"name = ",nomevideo}],Row[{"resolution = ",size0," pixels"}],Row[{"duration = ",dur," seconds"}],Row[{"frame rate = ",frate," frames/s"}],Row[{"total frames = ",num}],Framed[Thumbnail[VideoExtractFrames[video0,1]]]}]]

Dados do Arquivo:

name = 2021-08-30 10.17.39.mp4

resolution = {1280,720} pixels

duration = 162.711 seconds

frame rate = 30.0225 frames/s

total frames = 4885

3 - Import video

This section imports the chosen video, converting it into a list of frames. The resolution of the resulting frames is set in the first line of the following cell. The routine slices the video in a number of parts in order to not overflow the available system memory.
>> Choose the resolution (integer number for “size1” variable - first line) and the fraction of the available memory (real number < 1 for “usom” variable - second line), and then execute the cell (can take minutes depending on the video)

In[]:=

size1=1280;(*maximumresolution-horizontalpixels*)usom=1/2;(*maximumuseofavailablesystemmemmory*)mem=MemoryAvailable[];mrot=IntegerPart[(mem*Min[1,usom])/(size0[[1]]*size0[[2]]*4)];rot=IntegerPart[num/IntegerPart[(num/mrot)+1]+1];Clear[fun];If[size1<size0[[1]],fun[x_]:=ExportString[ImageResize[x,size1],"JPEG"],fun[x_]:=ExportString[x,"JPEG"]];PrintTemporary["Wait..."];Clear[imgs];imgs={};Monitor[tempo=Round[AbsoluteTiming[Do[imgimp=VideoExtractFrames[video0,Quantity[Interval[{i,Min[i+rot-1,Round[num]]}],"Frames"]];imgst=Flatten[ParallelMap[fun,imgimp]];Clear[imgimp];imgs=Flatten[Join[imgs,imgst]];Clear[imgst],{i,1,num,rot}];][[1]]],Dynamic[Column[{ProgressIndicator[i,{0,num}],Row[{">>>>>>> memory in use / memory available = ",IntegerPart[MemoryInUse[]/1000000],"MB / ",IntegerPart[MemoryAvailable[]/1000000],"MB"}]}]]];Print[Length[imgs]," frames imported in ",tempo," seconds"]size=ImageDimensions[img0=ImportString[imgs[[1]],"JPEG"]];imgq=imgi=img0;framef=num=Length[imgs];imgf=ImportString[imgs[[num]],"JPEG"];

4885 frames imported in 86 seconds

4 - Control Panel

This section shows an dynamic output panel where some important details need to be set as: firs and last frame to analyse; position of the coordinate system; reference image (object to track); reference scale (ruler); and search area
>> Only execute the cell and interact with the controls and locators

In[]:=

Out[]=

5 - Tracking

This section execute the automatic tracking
>> Choose if all frames selected above should be analysed 1 by 1 (set step variable “passo” = 1) or should be analysed by skipping frames (“passo” = 2 or 3 .... ) and execute the cell (can take some minutes). At any time the button “STOP” can be pressed and the

In[]:=

453 points colected from a total of 492 frames analised in 82 seconds

Out[]=

6 - Removing bad points using confidence limit

This section allow the selection of the tracked points considering the confidence value. The confidence value (0 to 100%) is determined by the similarity of the tracked image with the reference image. There is no need to execute this section before go to the next one
>> Only execute the cell and interact with the controls. Click “Finish” before go to the next section. To undo, evaluate the cell again.

In[]:=

rdat3=rdat2=rdat=data;Manipulate[limq=lq;If[ValueQ[rdat],Row[{{Map[Show[#,PlotRange->All]&,grafs[[1;;2,1;;lq]]],Map[Show[#,PlotRange->All]&,grafs[[3;;4,1;;lq]]]}//TableForm," ",Column[{"Confidence (%)",Column[escala]},AlignmentCenter]}]],{{lq,Length[escala],"Confidence Limit"},Table[i->escala[[i]],{i,Length[escala],1,-1}],Setter},Button["Finish",rdat3=rdat2=rdat=SortBy[Flatten[cdata[[1;;limq]],1],First]]]

Out[]=

7 - Removing bad points manually from graphs

This section allow the manual removal of the tracked points directly from the graph of the chosen variable. The locator onto the graphs are used to form a polygon that encloses the points to be removed (turns red). The “Set t = 0” button set the first tracked point to t = 0. There is no need to execute this section before go to the next one
>> Only execute the cell and interact with the controls and locators. Press “Remove” and “Set t=0” as many times as necessary. To undo, evaluate the cell again

In[]:=

vbot1=vbot2=False;rdat3=rdat=rdat2;ndat={};are=0;Manipulate[If[ValueQ[are],If[vbot1,rdat3=rdat=Delete[rdat,Flatten[Map[Position[art,#]&,ndat],1]];vbot1=False];If[vbot2,rdat3=rdat=Map[#-{rdat[[1,1]],0,0,0,0,0,0}&,rdat];are=0;vbot2=False];art=rdat[[All,{1,var}]];If[are≠var,are=var;ndat={};range={MinMax[art[[All,1]]],MinMax[art[[All,2]]]};midp=Midpoint[Transpose[range]]];Manipulate[ndat=Select[art,PointInPoly[#,{p1,p2,p3,p4}]==True&];Show[ListPlot[art,PlotRange->range,PlotRangePadding->Scaled[0.1],FrameLabel{grand[[1]],grand[[var]]},PlotStyle->Green],ListPlot[ndat,PlotStyle{PointSize[0.01],Darker[Red]}],Graphics[{EdgeForm[{Dashed,Red}],Blue,Opacity[0.1],Polygon[{p1,p2,p3,p4}]}],ImageSize->scrsize/3],{{p1,midp},Locator},{{p2,midp},Locator},{{p3,midp},Locator},{{p4,midp},Locator},Button["Remove",vbot1=True],Button["Set t = 0",vbot2=True]]],{{var,2,"Choose the variable"},{2" x ",3" y ",4" r ",5" θ "}},AutoActionFalse]

Out[]=

8 - Removing bad points from the video

This section allow the manual removal of the tracked points directly from the video, frame by frame. There is no need to execute this section before go to the next one
>> Only execute the cell and interact with the controls

In[]:=

rdat=rdat3;torem={};inds=Flatten[Map[Position[data[[All,6]],#]&,rdat[[All,6]]]];Manipulate[If[ValueQ[torem],imgr=ImageTrim[ImportString[imgs[[rdat[[fi,6]]]],"JPEG"],limits0];Column[{Row[{"points to be removed= ",torem}],Show[imgr,If[MemberQ[torem,fi],Graphics[{Red,Text[Style["X",rt*2,Red],pontos[[inds[[fi]],2,1]]-limits0[[1]]]}],ident[[inds[[fi]]]]],Graphics[{Text[Style[fi,Round[rt/1.5],Green,BackgroundBlack],pontos[[inds[[fi]],2,1]]-{0,rt*1.2}-limits0[[1]]]}],ImageSize->scrsize/3]}]],{{fi,1,"ponto"},1,Dynamic[Length[rdat]],1,Appearance"Open",AnimationRate->frate*skip},Button["Remove",torem=AppendTo[torem,fi]],Button["Clear",torem={}],Button["Finish",rdat2=rdat=Delete[rdat,Map[{#}&,torem]];inds=Flatten[Map[Position[data[[All,6]],#]&,rdat[[All,6]]]];torem={}]]

Out[]=

9 - Exporting data

This section exports the resulting data to a txt file. The name of the file and the first 10 lines of the file is shown as output. The first line of the file consists on the variable and units, the second line consists on the systematic uncertainty of each variable, and the tracking data starts on the 4th line.
>> Only execute the cell

In[]:=

inc=Norm[{tam/reg,dtam,(rt/8)*0.5*tam/reg}];medr=Mean[rdat[[All,4]]]-Norm[{StandardDeviation[rdat[[All,4]]],inc}];incertezas={0.5/frate,inc,inc,inc,ArcTan[medr,inc],0,0};decdig=-Map[MantissaExponent[#][[2]]-If[MantissaExponent[#][[1]]>0.35,1,2]&,incertezas];precdig=decdig+Max[3,MantissaExponent[size1*tam/reg][[2]]+1];edat=Transpose[Table[Map[NumberForm[#,{precdig[[i]],decdig[[i]]},NumberPadding{" ","0"}]&,Transpose[Join[{incertezas},rdat]][[i]]],{i,1,Length[rdat[[1]]]}]];(nedat=Join[{{"t(s) ","x(m) ","y(m) ","r(m) ","θ(rad)","Frame ","Conf(%)"}},{edat[[1]]},{"-----"},edat[[2;;All]]])[[1;;Min[10,Length[edat]]]]//TableFormExport["track_"<>FileBaseName[nomevideo]<>".txt",nedat,"Table"]

Out[]//TableForm=

t(s)	x(m)	y(m)	r(m)	θ(rad)	Frame	Conf(%)
0.017	0.017	0.017	0.017	0.009	0	0
-----
0.000	-0.224	-1.619	1.634	-1.708	141	60
0.033	-0.249	-1.620	1.639	-1.723	142	60
0.067	-0.283	-1.621	1.645	-1.743	143	60
0.100	-0.321	-1.622	1.653	-1.766	144	60
0.133	-0.355	-1.621	1.660	-1.787	145	60
0.167	-0.403	-1.616	1.665	-1.815	146	60
0.200	-0.443	-1.619	1.678	-1.838	147	60

Out[]=

track_2021-08-30 10.17.39.txt

POSTED BY: Douglas Leite

4 Replies

Sort By:

Moderation Team

Moderation Team, WOLFRAM

Posted 6 months ago

-- you have earned *Featured Contributor Badge* Your exceptional post has been selected for our editorial column *Staff Picks* http://wolfr.am/StaffPicks and Your Profile is now distinguished by a *Featured Contributor Badge* and is displayed on the Featured Contributor Board. Thank you!

POSTED BY: Moderation Team

Brad Klee

Brad Klee, Wolfram Research

Posted 6 months ago

Ultimately video data will probably replace motion sensors in undergrad mechanics labs, especially because it is easy to go to higher precision. While image processing is a useful skill to learn, it's just one skill of many need to master (or barely survive) the physics lab. The success of your experiment will be judged in terms of results. How well can you fit the shape of non-linear period vs. energy data? I don't know anyone who has done better than Chapter 2, Section 5, Figure 2.19 of this dissertation: https://www.proquest.com/docview/2489352408.

POSTED BY: Brad Klee

Douglas Leite

Douglas Leite, ITA

Posted 6 months ago

1) Ultimately video data will probably replace motion sensors in undergrad mechanics labs, especially because it is easy to go to higher precision. R: yes, no doubt 2) While image processing is a useful skill to learn, it's just one skill of many need to master (or barely survive) the physics lab. R: I don't think you get the idea here. The notebook I developed serves more as a tool, as well as a sensor or a caliper, to acquire accurate data from physics experiments, the latter being the real target of study. In other words, after capturing the movement data, the student must perform all the analysis, which, in my course, involves curve fitting from mathematical models to experimental data. The case illustrated in the notebook outputs is just an example applied to the case of the damped pendulum launched from high angles. But this notebook can be used for many other experiments. 3) The success of your experiment will be judged in terms of results. R: Sure. But once again, the notebook stands for capturing precise data from moving objects in a video. The results are quite good. Please try and let me know. 4) How well can you fit the shape of non-linear period vs. energy data? I don't know anyone who has done better than Chapter 2, Section 5, Figure 2.19 of this dissertation: https://www.proquest.com/docview/2489352408. R: I still need to get into this subject. Seems interesting

POSTED BY: Douglas Leite

Brad Klee

Brad Klee, Wolfram Research

Posted 6 months ago

The notebook I developed serves more as a tool, as well as a sensor or a caliper, to acquire accurate data from physics experiments, the latter being the real target of study. In other words, after capturing the movement data, the student must perform all the analysis, which, in my course, involves curve fitting from mathematical models to experimental data. The case illustrated in the notebook outputs is just an example applied to the case of the damped pendulum launched from high angles. But this notebook can be used for many other experiments. A: Of course versatility of automated analysis is desirable, but I found that refinement of experimental design was also necessary to get good results beyond simple harmonic oscillation. To be clear: There really is no point in extracting a damping coefficient, because it is only relevant to engineering and fault tolerance. Aside from characteristic frequency, the period-energy function has about one more degree of freedom, so I think you should study my Chapter 2 to see an example how shape parameter extraction can be done. If the shape parameter is extracted correctly, we say that we have verified Euler's monumental elliptic integral. So you also have to worry should it be a bob on a string or a weight on a solid rod. I found a cheap solution with a fidget spinner worked well enough. Here's one run, not necessarily the best. In my notebooks I have some neat tricks that I haven't shown off, which have to do with data extraction and transformation to get such a pretty result at the end. If you are studying my dissertation--I request and encourage that you do--please make sure to understand the figures 2.15 thru 2.19. Try to surpass that if you can, because it is as high or higher than whatever European standards. In the end we could hope to get data for the three other special cases in Chapter 3, but that is going to take some creative thinking and creative experimental design... could be a good PhD project for a fan of Caetano Veloso.

POSTED BY: Brad Klee

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Group Abstract

Feedback