# ビデオから心拍数を推定する

ビデオのフレームとその時間を取得する．

 In[2]:= XvideoTs = 0.001*{0, 38, 93, ..., 10203, 10258};

すべてのフレームにおける顔の境界ボックスを判別し，最初のフレームの中の顔をハイライトする．

 In[3]:= XfaceBoxes = Map[First@FindFaces[#] &, video]; HighlightImage[video[[1]], Graphics[{EdgeForm[Orange], FaceForm[], Rectangle @@ faceBoxes[[1]]}]]
 Out[3]=

 In[4]:= XavgFaceBoxSize = Round[{1/GoldenRatio, 1} Map[Median, Transpose@Map[Differences, faceBoxes][[All, 1]]], 2];
 In[5]:= XavgFaceBoxPositions = Transpose@ Map[GaussianFilter[#, 4] &, Transpose@Map[Mean, faceBoxes]];
 In[6]:= Xfaces = MapThread[ ImageTrim[#1, {#2}, avgFaceBoxSize/2] &, {video, avgFaceBoxPositions}];

 In[7]:= XfaceShifts = Map[Last@FindGeometricTransform[First@faces, #, Method -> "Linear", TransformationClass -> "Translation"] &, faces];
 In[8]:= XregFaces = MapThread[ ImagePerspectiveTransformation[#1, #2, DataRange -> All, Resampling -> "Cubic"] &, {faces, faceShifts}];

 In[9]:= XskinClassifier = Compile[{{Lab, _Real, 1}}, Exp[-(Lab[[2]] - 0.25)^2/(2 0.06^2)] Exp[-(Lab[[3]] - 0.16)^2/(2 0.04^2)]];
 In[10]:= XLabFaces = Map[ColorConvert[#, "LAB"] &, regFaces];
 Out[11]=

 In[12]:= XLabSignal = Map[ImageMeasurements[#, "Mean", Masking -> skinWeight] &, LabFaces];
 In[13]:= XListLinePlot[Rest@Transpose@LabSignal, PlotLegends -> {"a", "b"}]
 Out[13]=

 In[14]:= Xopt = Last@ FindMinimum[ Total[Differences[{0, Cos[\[Alpha]], Sin[\[Alpha]]}.Transpose[ LabSignal]]^2], {\[Alpha], 0}]
 Out[14]=

 In[15]:= Xsignal = ({0, Cos[\[Alpha]], Sin[\[Alpha]]} /. opt).Transpose[ LabSignal];
 In[16]:= XfilteredSignal = BandpassFilter[signal, 2 \[Pi]/18 {0.5, 3}, 11];
 In[17]:= XListLinePlot[filteredSignal, Axes -> {Automatic, None}]
 Out[17]=

FindPeaksを使って心拍数を抽出する．

 In[18]:= XheartBeats = FindPeaks[filteredSignal, 2, InterpolationOrder -> 3, Padding -> 0.01]
 Out[18]=
 In[19]:= XListLinePlot[filteredSignal, Epilog -> {Gray, Map[Line[{{First[#], 0}, #}] &, heartBeats]}, Axes -> {Automatic, None}]
 Out[19]=

フレーム数を時間に変換し，心拍数の間隔を抽出する．

 In[20]:= XtimeFunction = ListInterpolation[videoTs, InterpolationOrder -> 1]; Ts = Map[timeFunction, heartBeats[[All, 1]]]; \[CapitalDelta]Ts = Differences[Ts]
 Out[20]=

 In[21]:= Xm\[CapitalDelta]T = Quantity[1/Median[\[CapitalDelta]Ts], 1/"Seconds"]
 Out[21]=
 In[22]:= XUnitConvert[m\[CapitalDelta]T, 1/"Minutes"]
 Out[22]=
 In[23]:= Xd\[CapitalDelta]T = Quantity[MedianDeviation[\[CapitalDelta]Ts], "Seconds"]
 Out[23]=

## Mathematica

Questions? Comments? Contact a Wolfram expert »