This post is PART-2 of two posts. You can jump to the first part at PART-1, which has gone through matrix decomposition using Singular Vector Decomposition (SVD), randomized Singular Vector Decomposition (rSVD) and Nonnegative Matrix Factorization (NMF) mainly for image compression.
This PART-2 will look at video background removal using randomized SVD and robust PCA.
In this post we will try to reproduce the methodology and process learned in python in Chapter 3: Background Removal with Robust PCA, from the free online course: “Computational Linear Algebra for Coders” kindly offered for free by Fast.ai, you can get more info about the course here. All the original material of the Fast.ai course is written in python and can be downloaded here. We will try to reproduce the same results using R code.
This post I will use clear examples about how to use SVD (Singular Value Decomposition), randomized SVD and robust PCA (Principal Component Analysis) applied to the video feed in order to remove video background from surveillance videos.
The main parts of the post include background removal of:
- B/W video using SVD and robust SVD
- B/W video using Randomized robust PCA
- Color video using Randomized robust PCA
You can also get basic ideas about SVD in my previous post.
Reshaping a video file
First of all, for working with video in R we need to install the Rvision package from Github, you can run the code below or follow instructions on Rvision_Github. This package will allow us to work with video files.
1 2 3 |
install.packages("devtools") devtools::install_github("swarm-lab/Rvision") |
For this post, we will use a 350 frames video color file video_example.mp4
that must be located on the working directory.
1 2 3 |
path_to_video <- "video_example.mp4" path_to_video |
1 |
## [1] "video_example.mp4" |
The video dimensions and color space can be obtained using the functions below.
1 2 3 4 5 6 |
library(Rvision) my_video <- video(filename=path_to_video) ## # video dimensions (height x width x frames): dim(my_video) |
1 |
## [1] 240 320 350 |
1 2 3 |
# video codec: codec(my_video) |
1 |
## [1] "" |
1 2 3 |
# framerate: fps(my_video) |
1 |
## [1] 7 |
1 2 3 |
# color space colorspace(readFrame(my_video, 1)) |
1 |
## [1] "BGR" |
Each frame of the video has a dimension of 240 x 320 pixels. There are also 3 images of 240 x 320 pixels for each frame because we loaded a 3 channel video, one for Red channel, another for Green channel, and the last for Blue channel. So the video in total has 350 frames x 3 channels (RGB) x 240 x 320 pixels = 80640000 numeric values.
1 2 3 |
v_height <- dim(my_video)[1] v_width <- dim(my_video)[2] |
Below you can find the video we just loaded.
1 2 |
htmltools::tags$video(src=path_to_video, type="video/mp4", autoplay=NA, controls="controls", height=v_height, width=v_width) |
Next, we will convert each frame into a grayscale in order to simplify the example (you can find the code for video color at the end of this post).
After that, we will reshape each frame of 240 x 320 pixels (grayscale) into a long vector of 240 x 320 = 76800 values.
We will do that along with all the 350 frames, so we will have a vector for each frame.
At the end, we will combine the vectors in order to have a matrix M
of dimensions: 76800 x 350, where each column represents each frame of the video.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
# resheaping all the video frames in a 2D matrix v <- list() num_frames <- nframes(my_video) for(i in 1:num_frames){ if(i/100 == i%/%100) cat("\nframe:",i,"/",num_frames) frame <- readFrame(my_video, i) frame <- changeColorSpace(frame, "GRAY") matrix_frame <- as.matrix(frame) vector_frame <- as.vector(matrix_frame) v[[i]] <- vector_frame #--------------------------------------------------------------------- # if you want to display each frame procesed activate the 3 lines below #frame_temp <- frame #drawText(frame_temp, paste0(i,"/",num_frames), 2, 2, font_scale=1.2, thickness=2, color="red") #Rvision::display(frame_temp, window_name="display", height=200, width=300) } |
1 2 3 4 |
## ## frame: 100 / 350 ## frame: 200 / 350 ## frame: 300 / 350 |
1 2 3 |
Rvision::destroyDisplay("display") # works with: Rvision::display() release(my_video) |
1 |
## Video released successfully. |
1 2 3 4 5 |
M <- do.call("rbind",v) # matrix dimensions (frames | height x width): dim(M) |
1 |
## [1] 350 76800 |
The size in memory of the matrix is:
1 2 3 |
# matrix memory size: print(object.size(M), units="Mb") |
1 |
## 205.1 Mb |
In the above For_Loop code, we have converted a greyscale video (that is a multidimensional matrix of height x width x frames) into a 2D matrix. Let’s see how it looks if we plot this matrix:
1 2 3 4 5 |
# plot all the video frames in a 2D matrix library(imager) D <- as.cimg(M) plot(D, interpolate=FALSE, xlab="frame", ylab="height_x_width") |
In the above image, the axis ‘y’ (height x width) is huge regarding axis ‘x’ (frames). So it’s not possible to have an idea of how looks this 2D matrix. We need to use rasterImage() function in order to expand ‘x’ axis along the page.
The same matrix is plotted below, where the ‘x’ axis represents the time (each frame), and the ‘y’ axis is the vectorized form of each frame. Now you can have an idea of the movement of the people at the video (the parabolic lines), and how the background seems to be the horizontal lines.
1 2 3 |
plot(c(0, dim(M)[1]), c(0, dim(M)[2]), type="n", xlab="frame", ylab="height_x_width") rasterImage(as.raster(D), 0, 0, dim(M)[1], dim(M)[2], interpolate=FALSE) |
We can check the transformation by reverting the process for a specific frame. We can try to recover frame number 250 by reshaping the column 250 of the matrix M
from a vector to a matrix. Next, you will find the example.
1 2 3 4 5 |
# recovering a frame REC <- matrix(M[250,], nrow=v_width, ncol=v_height, byrow=TRUE) library(imager) plot(as.cimg(REC)) |
Randomized SVD (video B/W)
Once we learned to reshape a video file into a 2D matrix, we can now to apply matrix decomposition methods (see PART-1) for video background removal.
We will start applying Randomized SVD on M
matrix, for this example we will use the rsvd package with a low-rank decomposition value of k=2 over matrix M
.
1 2 3 |
library(rsvd) rSVD_k2 <- rsvd(M, k=2) |
The dimensions of the SVD decomposed matrices are:
1 2 |
dim(rSVD_k2$u) |
1 |
## [1] 350 2 |
1 2 |
NROW(rSVD_k2$d) |
1 |
## [1] 2 |
1 2 |
dim(rSVD_k2$v) |
1 |
## [1] 76800 2 |
Now, we will reconstruct the video using the U, D and V decomposed matrices. For that we will apply the formula:
M_recovery = U · d · VT (see PART-1 for details)
Because we used a low-rank value (k=2) it’s not expected that the reconstructed 2D matrix (M_recovery) will match exactly with the original 2D matrix (M). Instead of that, we will get a matrix that generalizes each frame of the video and will focus on static pixels of the matrix, in order words, ‘M_recovery’ will be focused on the video background, and will avoid objects in movement.
1 2 3 |
# reconstructing video using decomposed matrix rSVD_k2_re <- rSVD_k2$u %*% diag(rSVD_k2$d) %*% t(rSVD_k2$v) |
let’s plot the reconstruction of the decomposed matrices, As you can see below, there is no movement on next image:
1 2 3 |
plot(c(0, dim(rSVD_k2_re)[1]), c(0, dim(rSVD_k2_re)[2]), type="n", xlab="frame", ylab="height_x_width") rasterImage(as.raster(as.cimg(rSVD_k2_re)), 0, 0, dim(rSVD_k2_re)[1], dim(rSVD_k2_re)[2], interpolate=FALSE) |
As we can see, the dimensions of the reconstructed 2D matrix rSVD_k2_re
match with the original M
matrix:
1 2 3 |
# M_original dim(M) |
1 |
## [1] 350 76800 |
1 2 3 |
# M_recovery dim(rSVD_k2_re) |
1 |
## [1] 350 76800 |
If we plot a frame (i.e. frame 250) of the recovery matrix, we will get the background without moving objects or people (below at the left side of the image). We can also subtract the recovery matrix to the original matrix, in order to get only the moving objects or people (below at the right side of the image).
1 2 3 4 5 6 7 8 |
# recovering a frame FRAME <- 250 REC_re_bg <- rSVD_k2_re[FRAME,] REC_re_mov <- M[FRAME,] - rSVD_k2_re[FRAME,] REC_re_mov <- REC_re_mov - min(REC_re_mov) # to avoid negative values FRAME_im <- as.cimg(matrix(c(REC_re_bg,REC_re_mov), nrow=v_width*2, ncol=v_height, byrow=TRUE)) plot(as.cimg(FRAME_im)) |
Below we can perform a small analysis of what happens for different k values. As you can see in the images below, the best value for video background removal is k = 2, this is because we don’t want to obtain the reconstructed matrix equal to the original matrix, in fact, we want the opposite effect to remove movement from background, you can go to PART-1 for more details about k value.
1 2 3 4 5 6 7 8 9 10 11 12 13 |
# changing k value FRAME <- 250 par(mfrow=c(3,2), mar=c(2,2,0,0)) for(i in c(2,4,6,10,50,100)){ rSVD_ <- rsvd(M, k=i) rSVD_re <- rSVD_$u %*% diag(rSVD_$d) %*% t(rSVD_$v) REC_re_bg <- matrix(rSVD_re[FRAME,], nrow=v_width, ncol=v_height, byrow=TRUE) REC_re_mov <- matrix(M[FRAME,] - rSVD_re[FRAME,], nrow=v_width, ncol=v_height, byrow=TRUE) REC_re_mov <- REC_re_mov - min(REC_re_mov) # to avoid negative values plot(imappend(list(as.cimg(REC_re_bg), as.cimg(REC_re_mov)), axis="x"), axes=FALSE) text(10,180,paste0("k = ",i), pos=4, col="white", cex=3) } |
Randomized robust PCA (video B/W)
Now we will perform the same procedure but instead of using rSVD we will use randomized robust principal component analysis. Note that there is a mathematical relation between SVD analysis and Principal Component Analysis (PCA), but this is not the scope of this post, you can search about this on the web.
Robust PCA decomposes a matrix into two matrices L and S, the sum of them results the original matrix:
M = L + S
- M is the original matrix
- L is low-rank
- S is sparse
The term low-rank means that the matrix has a lot of redundant information, so in our example that’s the background, whereas sparse refers to the matrix with mostly zero entries, so in our example that’s the foreground or the moving people (in the case of corrupted video data, sparse matrix captures the corrupted data).
Next we will apply to M
original 2D video matrix to the rrpca() function from the rsvd package.
1 2 3 4 5 |
library(rsvd) # rrpca: robust principal component analysis t1 <- Sys.time() rPCA_k2 <- rrpca(M, maxiter=15, tol=1e-9, trace=TRUE) |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
## ## Iteration: 1 predicted rank = 1 target rank k = 2 Fro. error = 0.542590970126589 ## Iteration: 2 predicted rank = 1 target rank k = 2 Fro. error = 0.11882037441536 ## Iteration: 3 predicted rank = 1 target rank k = 2 Fro. error = 0.118820374415341 ## Iteration: 4 predicted rank = 1 target rank k = 2 Fro. error = 0.117552255682024 ## Iteration: 5 predicted rank = 1 target rank k = 2 Fro. error = 0.0777164622844202 ## Iteration: 6 predicted rank = 1 target rank k = 2 Fro. error = 0.0446984074714729 ## Iteration: 7 predicted rank = 2 target rank k = 3 Fro. error = 0.0301993087182703 ## Iteration: 8 predicted rank = 3 target rank k = 4 Fro. error = 0.0230020435092097 ## Iteration: 9 predicted rank = 5 target rank k = 3845 Fro. error = 0.0178484572936533 ## Iteration: 10 predicted rank = 8 target rank k = 9 Fro. error = 0.0139845535144859 ## Iteration: 11 predicted rank = 11 target rank k = 3851 Fro. error = 0.0104068420648371 ## Iteration: 12 predicted rank = 16 target rank k = 17 Fro. error = 0.00770065204336468 ## Iteration: 13 predicted rank = 22 target rank k = 3862 Fro. error = 0.00558375100833253 ## Iteration: 14 predicted rank = 27 target rank k = 28 Fro. error = 0.00403464775460438 ## Iteration: 15 predicted rank = 32 target rank k = 3872 Fro. error = 0.00286332386069142 |
1 2 |
cat("\n",round(difftime(Sys.time(), t1, units="mins"),1)," mins") |
1 2 |
## ## 3.8 mins |
Next, we will recover the same frame number 250 from the recovered matrix. On the left side of the image below, you can observe the Low-rank matrix (background). On the right side, there is the sparse matrix (movement).
1 2 3 4 5 6 7 |
# recovering a split frame FRAME <- 250 REC2_re_bg <- matrix(rPCA_k2$L[FRAME,], nrow=v_width, ncol=v_height, byrow=TRUE) REC2_re_mov <- matrix(rPCA_k2$S[FRAME,], nrow=v_width, ncol=v_height, byrow=TRUE) REC2_re_mov <- REC2_re_mov - min(REC2_re_mov) # to avoid negative values plot(imappend(list(as.cimg(REC2_re_bg), as.cimg(REC2_re_mov)),axis="x")) |
We can also create a video file if we create an image file for each frame using a For-Loop statement, and then we get all the image files for pack into a .mp4 video file. For doing that you must install ffmpeg, in MAC OSX is as easy as writing on the Terminal:
1 2 |
> brew install ffmpeg |
On Windows check out here.
Executing the code below we will create the images of the frames and then the video in black and white:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
# creating a video #---------------------- # needs to install: ffmpeg: you can use "> brew install ffmpeg" on Terminal on MAC OS X # creating frames for(i in 1:dim(rPCA_k2$S)[1]){ if(i/100 == i%/%100) cat("\nframe:",i,"/",num_frames) #FRAME_im <- as.cimg(matrix(c(rPCA_k2$L[i,],rPCA_k2$S[i,]), nrow=v_width*2, ncol=v_height, byrow=TRUE)) FRAME_im_bg <- matrix(rPCA_k2$L[i,], nrow=v_width, ncol=v_height, byrow=TRUE) FRAME_im_mov <- matrix(rPCA_k2$S[i,], nrow=v_width, ncol=v_height, byrow=TRUE) FRAME_im_mov <- FRAME_im_mov - min(FRAME_im_mov) # to avoid negative values FRAME_im <- imappend(list(as.cimg(FRAME_im_bg), as.cimg(FRAME_im_mov)), axis="x") save.image(FRAME_im, file=paste0("./video_out/bw_",i,".png")) } |
1 |
1 2 3 4 5 |
# creating video file # "-pix_fmt yuv420p" args is for Apple Quicktime support library(imager) make.video(dname="./video_out/", fname="./video_out/video_decomposed_bw.mp4", pattern="bw_%d.png", fps=7, extra.args="-pix_fmt yuv420p") |
Finally, here you will find the decomposed video:
1 2 |
htmltools::tags$video(src="./video_out/video_decomposed_bw.mp4", type="video/mp4", autoplay=NA, controls="controls", height=v_height, width=v_width*2) |
Randomized robust PCA (color video)
On the code above we simplify the example by working on a greyscale video. Let’s make it a little complex by working with video color.
In this case, we will have a 2D matrix taller, this means that the dimension of the matrix will be 350 x 230400, instead of the 350 x 76800 of the greyscale example. Note that 230400 comes from 240 x 320 x 3 color channels.
1 2 3 4 5 6 7 8 9 10 11 12 |
library(Rvision) my_video <- video(filename=path_to_video) v <- list() num_frames <- nframes(my_video) for(i in 1:num_frames){ if(i/100 == i%/%100) cat("\nframe:",i,"/",num_frames) frame <- readFrame(my_video, i) matrix_frame <- as.matrix(frame, nrow=240, ncol=320, byrow=FALSE) vector_frame <- as.vector(aperm(matrix_frame, c(2,1,3))) v[[i]] <- vector_frame } |
1 2 3 4 |
## ## frame: 100 / 350 ## frame: 200 / 350 ## frame: 300 / 350 |
1 2 3 |
M <- do.call("rbind",v) release(my_video) |
1 |
## Video released successfully. |
1 2 3 |
# matrix dimensions (frames | height x width x 3color): dim(M) |
1 |
## [1] 350 230400 |
We can see below the movement of people on the new 2D color matrix.
1 2 3 |
# plot all the video dim(M) |
1 |
## [1] 350 230400 |
1 2 3 4 |
library(imager) M2 <- array(M, dim=c(dim(M)[1],v_width*v_height,3)) dim(M2) |
1 |
## [1] 350 76800 3 |
1 2 3 4 |
D <- as.cimg(M2, x=dim(M2)[1], y=dim(M2)[2], cc=3) plot(c(0, dim(M2)[1]), c(0, dim(M2)[2]), type="n", xlab="frame", ylab="height_x_width") rasterImage(as.raster(D), 0, 0, dim(M2)[1], dim(M2)[2], interpolate=FALSE) |
We can also recover any frame from the 2D video matrix in order to check the correct reshaping process.
1 2 3 4 |
# recovering an original frame REC <- array(M2[250,,], dim=c(v_width,v_height,1,3)) dim(REC) |
1 |
## [1] 320 240 1 3 |
1 2 3 |
library(imager) plot(as.cimg(REC)) |
Finally, we will process the rrpca()
function for the full-color version of our matrix. This will create the rPCA_k2
object that will contain the low-rank matrix and the sparse matrix.
1 2 3 4 5 |
library(rsvd) # rrpca: robust principal component analysis t1 <- Sys.time() rPCA_k2 <- rrpca(M, maxiter=15, tol=1e-9, trace=TRUE) |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
## ## Iteration: 1 predicted rank = 1 target rank k = 2 Fro. error = 0.543081549596879 ## Iteration: 2 predicted rank = 1 target rank k = 2 Fro. error = 0.121377101431907 ## Iteration: 3 predicted rank = 1 target rank k = 2 Fro. error = 0.12137710143193 ## Iteration: 4 predicted rank = 1 target rank k = 2 Fro. error = 0.119268896142694 ## Iteration: 5 predicted rank = 1 target rank k = 2 Fro. error = 0.0775172016215707 ## Iteration: 6 predicted rank = 1 target rank k = 2 Fro. error = 0.0456250775118491 ## Iteration: 7 predicted rank = 2 target rank k = 3 Fro. error = 0.03159229215968 ## Iteration: 8 predicted rank = 3 target rank k = 4 Fro. error = 0.0242080663974625 ## Iteration: 9 predicted rank = 5 target rank k = 11525 Fro. error = 0.0186652453361901 ## Iteration: 10 predicted rank = 8 target rank k = 9 Fro. error = 0.0145118074287039 ## Iteration: 11 predicted rank = 12 target rank k = 11532 Fro. error = 0.0108247928491098 ## Iteration: 12 predicted rank = 17 target rank k = 18 Fro. error = 0.0079549172034063 ## Iteration: 13 predicted rank = 22 target rank k = 11542 Fro. error = 0.00581362182550793 ## Iteration: 14 predicted rank = 28 target rank k = 29 Fro. error = 0.00424831948772267 ## Iteration: 15 predicted rank = 34 target rank k = 11554 Fro. error = 0.00304577578151052 |
1 2 |
cat("\n",round(difftime(Sys.time(), t1, units="mins"),1)," mins") |
1 2 |
## ## 12.4 mins |
Next, we can check the background removal and foreground removal for the color frame number 250.
1 2 3 4 5 6 7 |
# recovering a split frame FRAME <- 250 REC2_re_bg <- array(rPCA_k2$L[250,], dim=c(v_width,v_height,1,3)) REC2_re_mov <- array(rPCA_k2$S[250,], dim=c(v_width,v_height,1,3)) REC2_re_mov <- REC2_re_mov - min(REC2_re_mov) # to avoid negative values plot(imappend(list(as.cimg(REC2_re_bg), as.cimg(REC2_re_mov)),axis="x")) |
And finally, we will create for the color version a video including all the frames of the original video.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
# creating a video #---------------------- # creating frames library(abind) for(i in 1:dim(rPCA_k2$S)[1]){ if(i/100 == i%/%100) cat("\nframe:",i,"/",num_frames) REC2_re_bg <- array(rPCA_k2$L[i,], dim=c(v_width,v_height,1,3)) REC2_re_mov <- array(rPCA_k2$S[i,], dim=c(v_width,v_height,1,3)) REC2_re_mov <- REC2_re_mov - min(REC2_re_mov) # to avoid negative values #FRAME_im <- as.cimg(array(abind(X,Y,along=1), dim=c(v_width*2,v_height,1,3))) FRAME_im <- imappend(list(as.cimg(REC2_re_bg), as.cimg(REC2_re_mov)),axis="x") save.image(FRAME_im, file=paste0("./video_out/color_",i,".png")) } |
1 2 3 4 5 |
# creating video file # "-pix_fmt yuv420p" args is for Apple Quicktime support library(imager) make.video(dname="./video_out/", fname="./video_out/video_decomposed_color.mp4", pattern="color_%d.png", fps=7, extra.args="-pix_fmt yuv420p") |
Next, you can find the final video video_decomposed_color.mp4
.
1 2 |
htmltools::tags$video(src="./video_out/video_decomposed_color.mp4", type="video/mp4", autoplay=NA, controls="controls", height=v_height, width=v_width*2) |
That’s the final of the PART-2, I hope it was interesting. Leave some comments if you want!
Session Info:
1 2 3 |
------------------------------------ Total R execution time: 21.9 mins ------------------------------------ |
1 2 3 4 5 6 7 8 9 |
setting value version R version 3.4.3 (2017-11-30) os macOS High Sierra 10.13.5 system x86_64, darwin15.6.0 ui RStudio language (EN) collate es_ES.UTF-8 tz Europe/Madrid date 2018-08-18 |
1 2 |
------------------------------------ Packages: |
1 2 3 4 5 6 7 8 9 10 11 12 |
[1] "abind - 1.4-5 - 2016-07-21 - CRAN (R 3.4.0)" [2] "bitops - 1.0-6 - 2013-08-17 - CRAN (R 3.4.0)" [3] "imager - 0.40.2 - 2017-04-24 - CRAN (R 3.4.0)" [4] "magrittr - 1.5 - 2014-11-22 - CRAN (R 3.4.0)" [5] "plyr - 1.8.4 - 2016-06-08 - CRAN (R 3.4.0)" [6] "RCurl - 1.95-4.11 - 2018-07-15 - cran (@1.95-4.)" [7] "reshape2 - 1.4.2 - 2016-10-22 - CRAN (R 3.4.0)" [8] "rsvd - 0.9 - 2017-12-08 - CRAN (R 3.4.3)" [9] "Rvision - 0.3 - 2018-06-29 - Github (swarm-lab/Rvision@65cee21)" [10] "RWordPress - 0.2-3 - 2018-03-04 - Github (duncantl/RWordPress@ce6d2d6)" [11] "stringr - 1.2.0 - 2017-02-18 - CRAN (R 3.4.0)" [12] "XMLRPC - 0.3-1 - 2018-08-17 - Github (duncantl/XMLRPC@add9496)" |
Appendix, all the code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 |
install.packages("devtools") devtools::install_github("swarm-lab/Rvision") path_to_video <- "video_example.mp4" path_to_video library(Rvision) my_video <- video(filename = path_to_video) ## video dimensions (height x width x frames): dim(my_video) # video codec: codec(my_video) # framerate: fps(my_video) # color space colorspace(readFrame(my_video, 1)) v_height <- dim(my_video)[1] v_width <- dim(my_video)[2] htmltools::tags$video(src = path_to_video, type = "video/mp4", autoplay = NA, controls = "controls", height = v_height, width = v_width) # resheaping all the video frames in a 2D matrix v <- list() num_frames <- nframes(my_video) for (i in 1:num_frames) { if (i/100 == i%/%100) cat("\nframe:", i, "/", num_frames) frame <- readFrame(my_video, i) frame <- changeColorSpace(frame, "GRAY") matrix_frame <- as.matrix(frame) vector_frame <- as.vector(matrix_frame) v[[i]] <- vector_frame #--------------------------------------------------------------------- # if you want to display each frame procesed activate the 3 lines below # frame_temp <- frame drawText(frame_temp, paste0(i,'/',num_frames), 2, 2, # font_scale=1.2, thickness=2, color='red') Rvision::display(frame_temp, # window_name='display', height=200, width=300) } Rvision::destroyDisplay("display") # works with: Rvision::display() release(my_video) M <- do.call("rbind", v) # matrix dimensions (frames | height x width): dim(M) # matrix memory size: print(object.size(M), units = "Mb") # plot all the video frames in a 2D matrix library(imager) D <- as.cimg(M) plot(D, interpolate = FALSE, xlab = "frame", ylab = "height_x_width") plot(c(0, dim(M)[1]), c(0, dim(M)[2]), type = "n", xlab = "frame", ylab = "height_x_width") rasterImage(as.raster(D), 0, 0, dim(M)[1], dim(M)[2], interpolate = FALSE) # recovering a frame REC <- matrix(M[250, ], nrow = v_width, ncol = v_height, byrow = TRUE) library(imager) plot(as.cimg(REC)) library(rsvd) rSVD_k2 <- rsvd(M, k = 2) dim(rSVD_k2$u) NROW(rSVD_k2$d) dim(rSVD_k2$v) # reconstructing video using decomposed matrix rSVD_k2_re <- rSVD_k2$u %*% diag(rSVD_k2$d) %*% t(rSVD_k2$v) plot(c(0, dim(rSVD_k2_re)[1]), c(0, dim(rSVD_k2_re)[2]), type = "n", xlab = "frame", ylab = "height_x_width") rasterImage(as.raster(as.cimg(rSVD_k2_re)), 0, 0, dim(rSVD_k2_re)[1], dim(rSVD_k2_re)[2], interpolate = FALSE) # M_original dim(M) # M_recovery dim(rSVD_k2_re) # recovering a frame FRAME <- 250 REC_re_bg <- rSVD_k2_re[FRAME, ] REC_re_mov <- M[FRAME, ] - rSVD_k2_re[FRAME, ] REC_re_mov <- REC_re_mov - min(REC_re_mov) # to avoid negative values FRAME_im <- as.cimg(matrix(c(REC_re_bg, REC_re_mov), nrow = v_width * 2, ncol = v_height, byrow = TRUE)) plot(as.cimg(FRAME_im)) # changing k value FRAME <- 250 par(mfrow = c(3, 2), mar = c(2, 2, 0, 0)) for (i in c(2, 4, 6, 10, 50, 100)) { rSVD_ <- rsvd(M, k = i) rSVD_re <- rSVD_$u %*% diag(rSVD_$d) %*% t(rSVD_$v) REC_re_bg <- matrix(rSVD_re[FRAME, ], nrow = v_width, ncol = v_height, byrow = TRUE) REC_re_mov <- matrix(M[FRAME, ] - rSVD_re[FRAME, ], nrow = v_width, ncol = v_height, byrow = TRUE) REC_re_mov <- REC_re_mov - min(REC_re_mov) # to avoid negative values plot(imappend(list(as.cimg(REC_re_bg), as.cimg(REC_re_mov)), axis = "x"), axes = FALSE) text(10, 180, paste0("k = ", i), pos = 4, col = "white", cex = 3) } library(rsvd) # rrpca: robust principal component analysis t1 <- Sys.time() rPCA_k2 <- rrpca(M, maxiter = 15, tol = 1e-09, trace = TRUE) cat("\n", round(difftime(Sys.time(), t1, units = "mins"), 1), " mins") # recovering a split frame FRAME <- 250 REC2_re_bg <- matrix(rPCA_k2$L[FRAME, ], nrow = v_width, ncol = v_height, byrow = TRUE) REC2_re_mov <- matrix(rPCA_k2$S[FRAME, ], nrow = v_width, ncol = v_height, byrow = TRUE) REC2_re_mov <- REC2_re_mov - min(REC2_re_mov) # to avoid negative values plot(imappend(list(as.cimg(REC2_re_bg), as.cimg(REC2_re_mov)), axis = "x")) # creating a video #---------------------- # needs to install: ffmpeg: you can use '> brew install ffmpeg' on Terminal # on MAC OS X creating frames for (i in 1:dim(rPCA_k2$S)[1]) { if (i/100 == i%/%100) cat("\nframe:", i, "/", num_frames) # FRAME_im <- as.cimg(matrix(c(rPCA_k2$L[i,],rPCA_k2$S[i,]), nrow=v_width*2, # ncol=v_height, byrow=TRUE)) FRAME_im_bg <- matrix(rPCA_k2$L[i, ], nrow = v_width, ncol = v_height, byrow = TRUE) FRAME_im_mov <- matrix(rPCA_k2$S[i, ], nrow = v_width, ncol = v_height, byrow = TRUE) FRAME_im_mov <- FRAME_im_mov - min(FRAME_im_mov) # to avoid negative values FRAME_im <- imappend(list(as.cimg(FRAME_im_bg), as.cimg(FRAME_im_mov)), axis = "x") save.image(FRAME_im, file = paste0("./video_out/bw_", i, ".png")) } # creating video file '-pix_fmt yuv420p' args is for Apple Quicktime support library(imager) make.video(dname = "./video_out/", fname = "./video_out/video_decomposed_bw.mp4", pattern = "bw_%d.png", fps = 7, extra.args = "-pix_fmt yuv420p") htmltools::tags$video(src = "./video_out/video_decomposed_bw.mp4", type = "video/mp4", autoplay = NA, controls = "controls", height = v_height, width = v_width * 2) library(Rvision) my_video <- video(filename = path_to_video) v <- list() num_frames <- nframes(my_video) for (i in 1:num_frames) { if (i/100 == i%/%100) cat("\nframe:", i, "/", num_frames) frame <- readFrame(my_video, i) matrix_frame <- as.matrix(frame, nrow = 240, ncol = 320, byrow = FALSE) vector_frame <- as.vector(aperm(matrix_frame, c(2, 1, 3))) v[[i]] <- vector_frame } M <- do.call("rbind", v) release(my_video) # matrix dimensions (frames | height x width x 3color): dim(M) # plot all the video dim(M) library(imager) M2 <- array(M, dim = c(dim(M)[1], v_width * v_height, 3)) dim(M2) D <- as.cimg(M2, x = dim(M2)[1], y = dim(M2)[2], cc = 3) plot(c(0, dim(M2)[1]), c(0, dim(M2)[2]), type = "n", xlab = "frame", ylab = "height_x_width") rasterImage(as.raster(D), 0, 0, dim(M2)[1], dim(M2)[2], interpolate = FALSE) # recovering an original frame REC <- array(M2[250, , ], dim = c(v_width, v_height, 1, 3)) dim(REC) library(imager) plot(as.cimg(REC)) library(rsvd) # rrpca: robust principal component analysis t1 <- Sys.time() rPCA_k2 <- rrpca(M, maxiter = 15, tol = 1e-09, trace = TRUE) cat("\n", round(difftime(Sys.time(), t1, units = "mins"), 1), " mins") # recovering a split frame FRAME <- 250 REC2_re_bg <- array(rPCA_k2$L[250, ], dim = c(v_width, v_height, 1, 3)) REC2_re_mov <- array(rPCA_k2$S[250, ], dim = c(v_width, v_height, 1, 3)) REC2_re_mov <- REC2_re_mov - min(REC2_re_mov) # to avoid negative values plot(imappend(list(as.cimg(REC2_re_bg), as.cimg(REC2_re_mov)), axis = "x")) # creating a video #---------------------- # creating frames library(abind) for (i in 1:dim(rPCA_k2$S)[1]) { if (i/100 == i%/%100) cat("\nframe:", i, "/", num_frames) REC2_re_bg <- array(rPCA_k2$L[i, ], dim = c(v_width, v_height, 1, 3)) REC2_re_mov <- array(rPCA_k2$S[i, ], dim = c(v_width, v_height, 1, 3)) REC2_re_mov <- REC2_re_mov - min(REC2_re_mov) # to avoid negative values # FRAME_im <- as.cimg(array(abind(X,Y,along=1), # dim=c(v_width*2,v_height,1,3))) FRAME_im <- imappend(list(as.cimg(REC2_re_bg), as.cimg(REC2_re_mov)), axis = "x") save.image(FRAME_im, file = paste0("./video_out/color_", i, ".png")) } # creating video file '-pix_fmt yuv420p' args is for Apple Quicktime support library(imager) make.video(dname = "./video_out/", fname = "./video_out/video_decomposed_color.mp4", pattern = "color_%d.png", fps = 7, extra.args = "-pix_fmt yuv420p") htmltools::tags$video(src = "./video_out/video_decomposed_color.mp4", type = "video/mp4", autoplay = NA, controls = "controls", height = v_height, width = v_width * 2) |