What’s New in Wolfram Video

Shadi Ashnai, Wolfram Research, Inc.

(RowDefault[, (Spacer1), , (Spacer1), ])  #WolframTechConf

ABSTRACT

In this talk I will show the state of the Video object in the Wolfram Language as well as all the computational power developed around it in order to create, process or analyze videos.

Video Object

The Video object as a first-class citizen in the Wolfram Language.

Create a Video from a remote file:

Video["http://exampledata.wolfram.com/musician.ogg"]

Video[CloudObject[(HyperlinkURL["https://www.wolframcloud.com/obj/documentation/dog", https://www.wolframcloud.com/obj/documentation/dog])]]

Create a Video from a local file:

video=Video["ExampleData/fish.mp4"]

Information[video]

Duration[video]

ImageDimensions[video]

AudioChannels[video]

Generating Video

From a Manipulate...

https://demonstrations.wolfram.com/

Manipulate[Plot[Sin[x(1+a x)],{x,0,6}],{a,0,2}]

Video[%]

From an evolving expression...

Manipulate[Plot[Sin[x(1+a x)],{x,0,6}],{a,0,2}]

AnimationVideo[Plot[Sin[x(1+a x)],{x,0,6}],{a,0,2}]

From webcams

Capture from any connected camera:

$ImagingDevices

VideoCapture[]

VideoCapture[Dynamic[video]]

From screens

VideoScreenCapture[]

VideoScreenCapture[Dynamic[video]]

From navigating on a 2D Scene...

Pan & zoom on a large image

i=ExampleData[{"TestImage","Volubilis"}]

ImageDimensions[i]

TourVideo[i,{\[LeftAssociation]"Position"->{5000,2000},"Width"->3000\[RightAssociation],\[LeftAssociation]"Position"->{2700,1800},"Width"->200\[RightAssociation]},RasterSize->250]

Spiral tour

path=t|-><|"Position"->{1220,630}+{55,35} t {Cos[t],Sin[t]},"Width"->180+80 t|>;
ParametricPlot[path[(10-2 t)]["Position"],{t,0,5}]

TourVideo[, path[10 - 2 #] &, RasterSize->300]

Visit everyone

image=;

faces=FindFaces[image,{"Position","BoundingBox"},PaddingSize->20];
faces=faces[[Last@FindShortestTour[faces[[All,"Position"]]]]];

HighlightImage[image,faces[[All,"BoundingBox"]]]

facetour=TourVideo[image,faces[[All,"BoundingBox"]],DefaultDuration->Length@faces]

Add an audio track

audio=AudioPad[ExampleData[{"Audio","Bee"}],Length[faces],"Periodic"]

VideoCombine[{facetour,audio}]

Video Editing

Temporal Editing

Trim, split, join delete in the time axis:

video=Video["ExampleData/bullfinch.mkv"]

Information[video]

VideoTrim[video,{1,2}]

Image Editing

Crop, resize, reflect, etc using image functions:

ImageCrop[video,{300,300},Right]

ImageRotate[video,20°]

Make the video darker, add effects:

ColorNegate[video]

ImageEffect[video,"Stippling"]

Time Varying Editing

dur=QuantityMagnitude[Duration[video]];

ImageRotate[video,2π #/dur&,Full]

ImageEffect[video,{"NestedComposition",Round[#/3],1-#/(2dur),2# °}&]

ImageTransformation[video,Function[t,FractionalPart[(1+t)#]&],DataRange->{{0,1},{0,1}}]

Audio Editing & Processing

AudioTrackApply[HighpassFilter[#,(Quantity[4000, "Hz", hertz, "Hertz"]),101]&,video]

Spectrogram[Audio[%]]

Combining Videos

v=Video["ExampleData/rule30.mp4"];

OverlayVideo[v,]

Overlay of a rotating spikey:

OverlayVideo[v,ImageRotate[,2Pi#/QuantityMagnitude[Duration[v]],All]&]

Overlay of a moving text:

OverlayVideo[v,Placed[Text["hello"],#/QuantityMagnitude[Duration[v]] ImageDimensions[v]]&]

Generic Functions

VideoFrameMap

v=Video["ExampleData/rule30.mp4"]

ColorNegate[v]

Blend[v,5]

VideoFrameMap[Blend,v,5,VideoPadding->"Fixed"]

VideoMap

VideoMap[ColorConvert[#Image,"HSB"]+{Max[#Audio],0,0}&,v]

VideoMap[<|"Image"->(ColorConvert[#Image,"HSB"]+{Max[#Audio],0,0}&),"Audio"->Identity|>,v]

VideoMapTimeSeries

ts=VideoMapTimeSeries[ImageMeasurements[ColorNegate[#Image],"IntensityCentroid"]&,v]

OverlayVideo[v,Graphics[{Magenta,AbsolutePointSize[8],Point[ts[#]]},PlotRange->Transpose[{{0,0},ImageDimensions[v]}]]&]

VideoMapList

v=Video["ExampleData/fish.mp4"]

VideoMapTimeSeries[DominantColors[#Image]&,v]

TimeSeries[{{1,{}},{2,{,}}}]

VideoMapList[DominantColors[#Image]&,v]

Some more fun

Adding a bouncy beach ball to a beach video

v=Video@CloudObject[(HyperlinkURL["https://www.wolframcloud.com/obj/carlogico/beach", https://www.wolframcloud.com/obj/carlogico/beach])]

sol=y/.First[NDSolve[{y''[t]==-9.81,y[0]==1,y'[0]==0,WhenEvent[y[t]==0,y'[t]->-0.91y'[t]]},y,{t,0,5}]]

Plot[sol[t],{t,0,5}]

OverlayVideo[v,Placed[ImageRotate[,-3#],Scaled[{#/5,sol[#]}]]&]

Tracing a trajectory of a detected object

v=Video[CloudObject["https://www.wolframcloud.com/obj/documentation/dog"]];

findDog[assoc_]:=ImagePosition[assoc["Image"],(Entity["domestic dog", Entity["Concept","CanisFamiliaris::597qc"], "Entity[\"Concept\", \"CanisFamiliaris::597qc\"]", "concept"])]/.{{}->{Missing[],Missing[]},{x_}:>x}

pos=VideoMapTimeSeries[findDog,v]

OverlayVideo[v,ParametricPlot[pos[t],{t,0,#},PlotRange->{{0,640},{0,360}},Axes->False,PlotStyle->Red]&]

Video of creating hand drawn images

Utility functions

Based on an example:
https://www.wolfram.com/language/12/new-in-image-processing/use-contours-to-make-hand-drawings.html?product=mathematica

contourFourierDescriptors[Line[contour_],n_]:=Module[{z,k},z=Fourier[Complex@@@contour];
k=Max[Ceiling[1/2 Min[Length[contour]/2,n]],1];
z[[k;;-k]]=0;
z]

reconstructContour[descriptors_]:=Module[{rc},rc=ReIm[InverseFourier[descriptors]];
Line[Append[rc,rc[[1]]]]]

smoothContour[contour_,n_]:=reconstructContour[contourFourierDescriptors[contour,n]]

Draw the car

car = ; mask = ;

contours=ImageMeasurements[EdgeDetect[Blur[ImageMultiply[car,mask],2],1],"Contours"];

imgs=FoldList[Rasterize[HighlightImage[#1,{AbsoluteThickness[3],smoothContour[#2,21]}],RasterSize->ImageDimensions[car]]&,car,contours];

FrameListVideo[imgs]

Machine Learning for Videos

The WNNR has some video specific nets.

Process videos frame-by-frame using image nets.

Utility function

labels=;

netevaluate[model_,img_,detectionThreshold_:.5,overlapThreshold_:.5]:=Module[{imgSize,classes,coords,obj,scores,bestClass,probable,probableClasses,probableScores,probableBoxes,h,w,max,scale,padding,nms,finals},imgSize=Last@NetExtract[model,{"Input","Output"}];
{obj,classes,coords}=Values@model[img];
(*each class probability is rescaled with the box objectness*)scores=classes*obj;
bestClass=Last@*Ordering/@scores;
(*filter by probability*)(*very small probability are thresholded*)probable=UnitStep[obj-detectionThreshold];{probableClasses,probableBoxes,probableScores}=Map[Pick[#,probable,1]&,{labels[[bestClass]],coords,obj}];
If[Length[probableBoxes]==0,Return[{}]];
(*transform coordinates into rectangular boxes*){w,h}=ImageDimensions[img];
max=Max[{w,h}];
scale=max/imgSize;
padding=imgSize*(1-{w,h}/max);
padding[[1]]=padding[[1]]/2;
probableBoxes=Apply[Rectangle[scale*({#1-#3/2,imgSize-#2-#4/2}-padding),scale*({#1+#3/2,imgSize-#2+#4/2}-padding)]&,probableBoxes,1];
(*gather the boxes of the same class and perform non-max suppression*)nms=ResourceFunction["NonMaximumSuppression"][probableBoxes->probableScores,"Index"];
finals=Transpose[{probableBoxes,probableClasses,probableScores}];
Part[finals,nms]];

Example

net=NetModel["YOLOX Trained on MS-COCO Data"]

video=Video["~/Downloads/brown-dog-running-free-2796077.mp4",RasterSize->1028]

testImage=VideoExtractFrames[video,1]

HighlightImage[testImage,GroupBy[netevaluate[net,testImage][[All, ;;2]],Last->First]]

VideoFrameMap[HighlightImage[#,GroupBy[netevaluate[net,#][[All, ;;2]],Last->First]]&,video]

Before we go...

Video functionality will greatly benefit from FFmpeg installation

Video and all video functions continue to be under active development.

They all remain "Experimental" in 13.2 to allow for design updates.

... DO SEND US FEEDBAK :)

Video objects link to local or remote files. In order to share assets while sharing notebooks, consider saving video files in the cloud.

Video["ExampleData/fish.mp4"]

Thank You!

https://wolfr.am/video

Office Hour: Sound & Vision
3:30-4:30pm – Lower Level