Analyze Random Walks from Video

Track randomly moving particles and classify their trajectories

In this example we are going to track a set of randomly moving particles. We will analyze and classify the particles according to whether their motion is purely Brownian.

Import the video and extract the particles displaying motion:

In[1]:=

video=ResourceData["Example""Analyze Random Walks from Video","Video"]

Out[1]=

In[2]:=

findCentroid[frame_]:=Point@Values@ComponentMeasurements[Binarize[frame,.5],"Centroid",CornerNeighborsFalse];particles=VideoMapList[findCentroid[#Image]&,video];

Track the moving particles and obtain timeseries of their positions:

In[3]:=

tracks=VideoObjectTracking[particles,Method{"RunningBuffer","OcclusionThreshold"4}];

Create and plot trajectories for the particles:

In[4]:=

allTrajectories=DeleteMissing/@Values[tracks["Position"]];

In[5]:=

ListLinePlotallTrajectories,



Out[5]=

Classify trajectories according to the mean-squared displacement (MSD):

In[6]:=

MSD[pos_,t_:30]:=Module{transposedlist,length,listreshape,lr},transposedlist=Table[Thread[{pos,RotateLeft[pos,i]}]〚1;;-(i+1)〛,{i,t}];length=Dimensions/@transposedlist;Mean/@Tablelistreshape=ArrayReshape[transposedlist〚i〛,length〚i〛];lr=Function[x,

Apply[EuclideanDistance][Reverse[x]]

]/@listreshape1;;All,{i,t};

The time lag (second argument of MSD) is chosen as 1/3 of the trajectory length. Moreover, only longer trajectories with a length > 35 are selected for computing the mean-squared-displacement:

In[7]:=

trajlength=35;longertrajectories=Select[allTrajectories,Length[#]≥trajlength&];msd=MSD[#,Floor[1/3*Length[#]]]&/@longertrajectories;

Plot the MSDs of the particles:

In[8]:=

ListLinePlot[msd,AxesLabel{"TimeStep","Mean Square Displacement"}]

Out[8]=

Most trajectories for mean-squared displacement exhibit a linear trend, implying a Brownian motion, while a few trajectories deviate away from the straight line and possibly imply a super-diffusive regime. Moreover, for some trajectories the horizontal slope at larger timestep may also point to particles following a sub-diffusive motion.

Plot a few of the longer trajectories:

In[9]:=

paths=MaximalBy[longertrajectories,Length,100];

In[10]:=

ListLinePlot[#,AxesFalse,PlotStyleRandomColor[]]&/@paths//Multicolumn

Out[36]=

Perform a linear fit to the MSDs of the particles to acquire gradients:

In[11]:=

gradients=a/.FindFit[#,ax+b,{a,b},x]&/@msd;

Cluster the gradients to define the different regimes of the particle motion, most likely linked to super diffusive, Brownian and sub-diffusive regimes:

In[12]:=

FeatureSpacePlot[Thread[ClusteringComponents[gradients]gradients],PlotStylePointSize[0.01]]

Out[12]=

Compute the Hurst exponent to analyze any memory effects in the motion process:

In[13]:=

eproc=Quiet@EstimatedProcess[#,FractionalBrownianMotionProcess[h]]&/@allTrajectories;

In[14]:=

hurstinds=Chop[Cases[DeleteCases[eproc,_EstimatedProcess],FractionalBrownianMotionProcess[__,hurst_]hurst],10^-8];

In[15]:=

Histogram[hurstinds]

Out[15]=

Classify trajectories according to the Hurst exponent criterion.

Get the number of particles following the process in which the future increments are negatively correlated. The Hurst exponent between 0-0.5 suggest that particles having larger spatial shift at time 't' will likely have smaller step at 't+1' and subsequently larger spatial shift at 't+2':

In[16]:=

Count[hurstinds,x_/;0≤x<0.5]

Out[16]=

793

Get the number of particles exhibiting a Wiener Process or following Brownian motion. The autocorrelation decays exponentially towards 0. There is no memory effect in such cases:

In[17]:=

Count[hurstinds,x_/;x0.5]

Out[17]=

Get the number of particles following a process wherein the future increments are positively correlated. This implies that particles that have larger spatial steps now will tend to retain larger spatial steps in the future:

In[18]:=

Count[hurstinds,x_/;x>0.5]

Out[18]=

1263

Publisher Information

Contributed by: Ali Hashmi