16
$\begingroup$

I am trying to make an automatic handout creator for my courses on edX. It took me a long time to do it...

(If you don't know edX: https://www.edx.org/)

I wrote a program that adds to each slide provided by edX the coressponding subtitiles that were spoken in the video File.

How: I extract the subscripts timestamps -> I use the timestamps to extract a set of frames from the video file (the frame that is shown in the middle of a subscript time range) -> then I compare the frames with the provided slides to find the position of the slides in the video -> then I use this information to add under each slide the coressponding subtitle text.

In the end, each page should look like this: (the grey border, is only placed here to distinguish the page from the white website background)

enter image description here

Now to the code:

  1. I download the videos as ".mov" into a video folder, the subscript text file into a subscript folder and the slides (converted to imgaes ".jpg" ) into a slides folder.

  2. Then I run the following code: (I added comments)

I import the subrib files (subtitiles)

Source : Merge transcript and corresponding slides from video

(**Import SubRib File**)

(*File Path*)

subRibFile = 
  "file_path" <> ".srt";

(*Import as string*)

subRip = ReadList[subRibFile, String];

(*Get Time Intervals [h:min:sec:milliosec]*)

subtitleTimings = 
  StringSplit[
   StringReplace[
    Select[subRip, 
     StringMatchQ[#, {__ ~~ Whitespace ~~ "-->" ~~ 
         Whitespace ~~ __}] &], "," -> "."], 
   Whitespace ~~ "-->" ~~ Whitespace];

(*Convert Time Intervals to seconds*)

timesSeconds = 
  Partition[
   UnitConvert[
    Total[DateValue[
        DateObject[#], {"Hour", "Minute", "Second", "Millisecond"}, 
        Quantity]] & /@ Flatten[subtitleTimings], "Seconds"], {2}];

Then I import the video file:

videoFile = 
  "file_path" <> ".mov";

(*Get Frame Rate*)

frameRate = Quantity[Import[videoFile, "FrameRate"], 1/"Seconds"];

(*Get frame number of the start and end of a subtitile *)

framesStartEnd = Round[timesSeconds*frameRate];

(*Get Frmae Numbers in between start and end of each subtitile*)

frameList = 
  Round[(First /@ framesStartEnd + Last /@ framesStartEnd)/2];

(*Import those frames*)

frames = Import[videoFile, {"ImageList", frameList}];

Then I Import the images of the slides:

SetDirectory["path to folder of images"];

(* Extract all images from folder*)

images = FileNames["*.jpg"];
slides = Import[#] & /@ images;

Print["Got all slides!"];

Now I find the position of each slide within the frames of the video -> Recognizing the slides in the video frame. Source:Extract timestamp of specific frames in video

(**Analyze the frames to find position of the slides in the video**)
(*Scale Down the images for faster image analysis*)

res = 48; smallframes = 
 Flatten[ImageData[ImageResize[#, {res, res}]], 1] & /@ 
  frames; smallslides = 
 Flatten[ImageData[ImageResize[#, {res, res}]], 1] & /@ slides;
Print["Resized all images for immage analysis!"];

(*Create Comparaison (slides/frames) metrics*)

SimilarColor[a_, b_] := If[And @@ ((# < 0.05) & /@ ((a - b)^2)), 1, 0];

(*Label each frame according to the most likly slide number*)

Print["Comparing all frames with all slides: "];
labels = Monitor[Table[
    With[
      {score = 
        Total@MapThread[SimilarColor, {#, smallframes[[i]]}] & /@ 
         smallslides},
      Position[score, Max[score]]][[1, 1]], {i, Length[frames]}], i];

Now I find the range of frames which show the same slide -> To know the range of subtiles to add to the specific slide. Source: List of same images -> Find intervals of same images

similarFrames = 
  SplitBy[Transpose[{#, Range@Length@#}], First][[;; , {1, -1}, 2]] &@
   labels;

I remove slides which were not shown in the video (can happen):

(**Remove Unseen Slides**)

(*Sometimes there are more slides given than do appear in the video, \
therefore one makes a new list of slides with only the slides which \
appear in the video*)

slidesToKeep = DeleteDuplicates[labels];
(*Extracts only those slides*)
slidesKeeped = Part[slides, slidesToKeep ];

I extract the text blocks for each slide from the subtitles:

(**Extract Text for each slide**)

(*Get Timestaps of the beginning of each subscript*)

timeStamps = First /@ timesSeconds;
(*Extract the transcript \[Rule] {{slideNumber,text}}*)
transcripts = 
  Split[Select[
    subRip, ! 
      StringMatchQ[#, {__ ~~ Whitespace ~~ "-->" ~~ 
         Whitespace ~~ __}] &], DigitQ[#] &];

(*Extract all text for each slide*)

onlyText = transcripts[[All, 2]];
text = Map[ToString, 
   onlyText[[#[[1]] ;; # [[2]] ]] & /@ similarFrames];

I filter a bit the text:

(**Clean Text**)

filter1 = StringReplace[text, "," -> ""];
filter2 = StringReplace[filter1, "<i>" -> ""];
textProccessed = StringReplace[filter2, "</i>" -> ""];
textSlide = 
  StringReplace[StringReplace[#, "{" -> ""], "}" -> ""] & /@ 
   textProccessed;

I create two lists.

  1. The images: the slides

  2. The text: which goes with every slide.

images = Image[#, ImageSize -> Full] & /@ slidesKeeped;
text = textSlide;

I create the Layout. Source: Layout: Images and Text

exportIm = Panel[Style[Grid[{
        {images[[#]], SpanFromLeft},
        {TextCell[Row[{text[[#]]}], TextJustification -> 1, 
          Hyphenation -> False], SpanFromLeft}, {}, {"Notes: "}}, 
       Frame -> {{False, False}, {True, True, True, False}, {False}}, 
       BaseStyle -> ImageSizeMultipliers -> 1], 7, 
      FontFamily -> "Helvetica", Background -> White], 
     Background -> White, ImageSize -> {210, 297}*2] & /@ 
   Range[Length[images]];

Finally, I export the individual slides (I do not merge them into one PDF because MA is quiet slow with that -> do it with external software):

SetDirectory[
   "path_to_export"];

 Export[ToString[#] <> ".pdf", exportIm[[#]]] & /@ 
   Range[Length[exportIm]];

The program works, but is still not reliable. Sometimes it does not identify the slides in the correct order or there is text missing.

Therefore, I would be awesome, if you could help me to make it more robust !

Here are two MOOC courses to test the program and improve it: https://www.dropbox.com/sh/raajt9qetqnj7p9/AACEV3PhjhRmwTDjvdtcnEc3a?dl=0

The first one (2) has the tricky part, that within the mooc video they show not only slides, but also at a certain time a short video, which messes up the result.

There are also some difficulties with the second (3), as it fails to indentify the slides in the correct order and the text also has some problems.

I looking forward seeing your suggestions and improvements ! :)

DOWNLOAD complete code (thanks to @jjc385) here: https://github.com/jjc385/mmase-159065_annotated-lecture-slides/blob/master/pasted-OP-code.m

Check Your Code

To check that your code works correctly, I have created a pdf for video 2, which shows the slide number, the slide and the start and end subtitles for each slide. Please download it here: https://www.dropbox.com/s/hdxajnfve0nzf5i/Slides%20and%20Subtitles%20Start_End%20for%202.pdf?dl=0

The correct identification of the slides of the later video should be: 1,2,3,4,5,4,6,7,8,9,10,11,12,13,12,13,14,13,15,16,17,18

Be careful: There are repeating slides !

$\endgroup$
  • 2
    $\begingroup$ A few days ago I copied all the code into a .m file. Since that involves copying and pasting several code blocks, I've put this on github, in case anybody else abhors copying and pasting as much as I do. I added a way of managing the input/output files/directories at the top as well. (I considered editing the question, but I didn't want to remove OP's helpful comments in between blocks of code.) $\endgroup$ – jjc385 Nov 4 '17 at 2:29
  • $\begingroup$ Note that the code takes ~1300 seconds to run on my machine, with ~1200 seconds taken to import the video. Importing the video frames takes ~700 seconds. Curiously, it takes ~400 seconds just to find the framerate, so hopefully that can be improved. $\endgroup$ – jjc385 Nov 4 '17 at 2:30
  • $\begingroup$ Thanks a lot for making it easier to copy! $\endgroup$ – james Nov 4 '17 at 5:59
  • $\begingroup$ @jjc385 Have you tried anything ? $\endgroup$ – james Nov 5 '17 at 14:32
  • $\begingroup$ Not yet. It just takes too long to run, especially when I'm on a skype video call (which is most of the time, as I'm in a long distance relationship), which slows mathematica down by about a factor of 10. $\endgroup$ – jjc385 Nov 5 '17 at 14:57
7
+300
$\begingroup$

I'll start with two improvements:

Extracting frames

I couldn't import .mov files the way you do, because I don't have QuickTime. It turns out using ffmpeg is much faster. Another nice feature is that we can pass the time of the frame we want to get, so we do not need to bother about the frame number. I denote the number of the video videoNumber (would be 2 or 3). The following function converts a time in seconds into a string in the required format:

TimeString[s_] := DateString[s, {"Hour",":","Minute",":","Second",".","Millisecond"}];

Then we go through each time in timeSeconds, extract the frame and load it.

SetDirectory[NotebookDirectory[] <> "Videos"];
frames = Monitor[Table[
    ReadList["!ffmpeg -y -ss " <> 
      TimeString[(timesSeconds[[i, 1, 1]] + timesSeconds[[i, 2, 1]])/2]
      <> " -i " <> ToString[videoNumber] <> ".mov -frames:v 1 tmp.jpg"];
    Import["tmp.jpg"], {i, Length[timesSeconds]}], 
  ToString[i] <> "/" <> ToString@Length[timesSeconds]];
DeleteFile["tmp.jpg"];

Recognizing the slides

I implement your suggestion to use the knowledge that the slides have to appear in a given order, enhance the images before comparison and additionally use a text based comparison for difficult cases.

By pixel color

The slides you show in the video and the slides that you provided can be quite different. In particular the brightness can differ significantly. One way around this is to preprocess the images before comparison. One could try many different functions here, I use ImageExposureCombine and a Gamma correction to better see the details for different brightness.

enhance[img_] := Sharpen@ImageExposureCombine[{img, ImageAdjust[img, {0, 0, 4}]}];

As in your question, we scale down the images for the analysis to speed it up:

res = 48;
smallSlides = enhance@ImageResize[#, {res, res}] & /@ slides;
smallFrames = enhance@ImageResize[#, {res, res}] & /@ frames;

The similarity of two images is measured by the function score, where, in contrast to the first version of this answer, I use ColorDistance to judge how similar two images are. This is still the same idea, but now relying on a built-in function.

score[frame_, slide_] := score[frame, slide] = 
  If[slide <= 0 || slide > Length[slides], 0,
    1 - ImageData[ImageResize[ColorDistance[smallSlides[[slide]], 
      smallFrames[[frame]]], {1, 1}]][[1, 1]]^0.1];

The exponent of 0.1 is only a rescaling of the score, which makes it "more strict" and thus more comparable to the following text-based comparision.

By text

Sometimes the arrangement of the provided slides differs from the slides in the video. In this case the similarity test will not be helpful. We use a comparison based on TextRecognize in these cases, which is slow but handles different arrangements well.
To give an idea of what we have to distinguish in the data: This is one of the video frames.

frame of one of the movies

Is it the following slide?
slide 18

Or is it maybe this slide:
slide 19

The text-based score is basically the percentage of english words (as given in WordList[]) that are found in both the frame and the slide. Restricting to english words filters out garbage of TextRecognize. In the given example it actually detects that the second slide is "shown" in the video. The code:

Clear[textscore];
Clear[slidewords];
Clear[framewords];
slidewords[slide_] := slidewords[slide] = 
   Intersection[ToUpperCase[WordList[]], 
    ToUpperCase@StringSplit@
      TextRecognize[LocalAdaptiveBinarize[slides[[slide]], 50], Language -> "English"]];
framewords[frame_] := framewords[frame] = 
    Intersection[ToUpperCase[WordList[]], 
     ToUpperCase@StringSplit@
       TextRecognize[LocalAdaptiveBinarize[frames[[frame]],50], Language -> "English"]];;
textscore[frame_, slide_] := 
  If[slide <= 0 || slide > Length[slides], 0,
   Length@Intersection[framewords[frame], slidewords[slide]]/
    Max[Length[framewords[frame]], Length[slidewords[slide]]]];

And when to use which method

We go through all frames to label them by the slide they are showing. While we do this, we keep track of the currentSlide. We can allow jumps between the slides up to a given step size, for example two. This is useful, because sometimes there are videos and then we go back to the previous slide. We always pick the step with the highest score, but we stay if all scores are below some threshold (for example 10%). By default we use the color comparison by pixel, because it is fast. But if the two best scores are close (for example 95%), and the frame has text on it, we choose to use the TextRecognize-based scoring. This is the code:

currentSlide = 1;
labels = Monitor[Table[
    stepscores = 
     Append[Table[{step,score[i, currentSlide + step]}, {step, {-1, 0, 1, 2}}], {0,0.1}];
    If[(Max[stepscores[[All, 2]]] <= 0.1 || 
        Sort[stepscores[[All, 2]], Greater][[2]] > 
         0.95 Max[stepscores[[All, 2]]]) && Length[framewords[i]] > 0,
      stepscores = (stepscores + 
          Append[Table[{step, textscore[i, currentSlide + step]},
                  {step, {-1, 0, 1, 2}}], {0, 0.1}])/2;
     ];
    {bestStep, bestScore} = TakeLargestBy[stepscores, Last, 1][[1]];
    currentSlide += bestStep;
    currentSlide, {i, Length[frames]}], 
   ProgressIndicator[i/Length[frames]]];

The code seems to be pretty robust, but I'm happy to discuss further improvements.

Manual correction

If the slides would look completely different than what is shown in the video, or for some other reason we want to enforce a different association, the following code allows to conveniently change it by hand.

Manipulate[Dynamic[
  If[correction == 1, 
   With[{l = labels[[frame]]}, 
    If[l < Length[slides], 
     For[j = 0, 
      j <= Length[labels] - frame && labels[[frame + j]] == l, 
      labels[[frame + j]]++; j++]]]; correction = 0];
  If[correction == -1, 
   With[{l = labels[[frame]]}, 
    If[l >= 2, 
     For[j = 0, 
      j <= Length[labels] - frame && labels[[frame + j]] == l, 
      labels[[frame + j]]--; j++]]]; correction = 0];
  {{"frame " <> ToString[frame] <> ":", 
     "slide " <> ToString[labels[[frame]]] <> ":"}, {Quiet@
      Show[frames[[frame]], ImageSize -> 320], 
     Quiet@Show[slides[[labels[[frame]]]], ImageSize -> 320]}} // 
   TableForm, TrackedSymbols -> activ],
  {{activ, {}}, {All -> "ON", {} -> "OFF"}}, {frame, 1, 
  Length[frames], 1, AnimationRate -> 2, RefreshRate -> 60, 
  Appearance -> "Open"}, {{correction, 0}, {1 -> "+", -1 -> "-"}}]

picture of manipulate output used to change frame<->slides association

$\endgroup$
  • $\begingroup$ Thank you very much ! I have not yet been able to implement your ffmeg solution, but I have tried your slide recognization. Unfortunatly, the text was not always in accordance with the slides. Would it be able to upload on Dropbox or etc. your optained PDF slides and share a link here ? I have also added a PDF to the question such that one can easily check the correct working of the code. Do you think that one could implement a method to detect repeated slides automatically without having to add them manually ? This would be very helpful, because I have a lot of mooc videos to process. Thanks! $\endgroup$ – james Nov 6 '17 at 8:47
  • $\begingroup$ does the folder slides/2 exist? are the frame pictures created there? $\endgroup$ – M. Stern Nov 6 '17 at 13:01
  • $\begingroup$ Please tell me if I did not understand you correctly... For the moment I am not storing the frames, because I have not yet implemented ffmpeg. In the folder slides/2, I am storing the images of the slides (like in the dropbox folder). The data structure looks like that: 3 Folders: "video" -> all the video files, named 1,2,3,4,5,..., then the second folder: "subtitles" -> the subtitle files corresponding to the video files and named the same (1,2,3,4 etc.), and finally the third folder: "slides" -> this folder has n subfolders, named 1,2,3,4 etc. , which contain the images of the slides. $\endgroup$ – james Nov 6 '17 at 13:37
  • $\begingroup$ I edited the code, so now you do not have to insert slides by hand. Let's start by getting ffmpeg to work, because it will save you hours. ffmpeg tries to create jpg files in the folder frames/2, but it does not create the folder. That's why you should create it. We could change the code to do that... $\endgroup$ – M. Stern Nov 6 '17 at 14:04
  • $\begingroup$ Could you try the updated code? It does not use the folder frames anymore. $\endgroup$ – M. Stern Nov 6 '17 at 14:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.