STAT3000 111824

Image Compression

An attractive application is dimensionwise reconstruction with a selection of \(k\leq p\) dimensions of the original data.

library(jpeg)
img0 <- readJPEG("cm11.jpg")
dim(img0)

## [1] 256 256   3

img1 <- apply(img0,c(1,2),sum)
img2 <- t(img1)[,nrow(img1):1]
dim(img2)

## [1] 256 256

image(1:nrow(img2), 1:ncol(img2),img2,col=gray((0:255)/255),xlab="",ylab="",xaxt="n",yaxt="n")

pca <- prcomp(img2,center=T) 
## try first PC
npc=77
restr <- pca$x[,1:npc] %*% t(pca$rotation[,1:npc])
image(1:nrow(img2),1:ncol(img2),restr,col=gray((0:255)/255),xlab="",ylab="",xaxt="n",yaxt="n")

(cumsum(pca$sdev^2)/sum(pca$sdev^2))

##   [1] 0.6245556 0.7394871 0.8068906 0.8688228 0.9072607 0.9286430 0.9482374
##   [8] 0.9589202 0.9669302 0.9724974 0.9757831 0.9788509 0.9813811 0.9831592
##  [15] 0.9848026 0.9863322 0.9875777 0.9887804 0.9898714 0.9907928 0.9917033
##  [22] 0.9924307 0.9929941 0.9935476 0.9940230 0.9944717 0.9948671 0.9952343
##  [29] 0.9955936 0.9958874 0.9961598 0.9964213 0.9966453 0.9968566 0.9970534
##  [36] 0.9972413 0.9974198 0.9975841 0.9977282 0.9978619 0.9979862 0.9981085
##  [43] 0.9982140 0.9983154 0.9984120 0.9985073 0.9985913 0.9986705 0.9987407
##  [50] 0.9988092 0.9988699 0.9989280 0.9989828 0.9990359 0.9990867 0.9991342
##  [57] 0.9991804 0.9992234 0.9992645 0.9993026 0.9993386 0.9993723 0.9994055
##  [64] 0.9994353 0.9994644 0.9994915 0.9995183 0.9995431 0.9995670 0.9995894
##  [71] 0.9996107 0.9996310 0.9996503 0.9996691 0.9996872 0.9997043 0.9997210
##  [78] 0.9997369 0.9997519 0.9997659 0.9997790 0.9997915 0.9998034 0.9998149
##  [85] 0.9998253 0.9998352 0.9998446 0.9998531 0.9998612 0.9998691 0.9998765
##  [92] 0.9998836 0.9998905 0.9998971 0.9999030 0.9999087 0.9999141 0.9999193
##  [99] 0.9999242 0.9999287 0.9999331 0.9999370 0.9999408 0.9999444 0.9999478
## [106] 0.9999510 0.9999540 0.9999569 0.9999596 0.9999620 0.9999643 0.9999664
## [113] 0.9999685 0.9999704 0.9999723 0.9999741 0.9999757 0.9999773 0.9999787
## [120] 0.9999799 0.9999811 0.9999823 0.9999833 0.9999843 0.9999853 0.9999861
## [127] 0.9999869 0.9999876 0.9999882 0.9999888 0.9999894 0.9999900 0.9999905
## [134] 0.9999909 0.9999913 0.9999917 0.9999921 0.9999924 0.9999928 0.9999931
## [141] 0.9999933 0.9999936 0.9999938 0.9999940 0.9999942 0.9999944 0.9999946
## [148] 0.9999948 0.9999950 0.9999952 0.9999953 0.9999955 0.9999957 0.9999958
## [155] 0.9999960 0.9999961 0.9999963 0.9999964 0.9999965 0.9999967 0.9999968
## [162] 0.9999969 0.9999970 0.9999971 0.9999972 0.9999973 0.9999974 0.9999975
## [169] 0.9999976 0.9999977 0.9999978 0.9999979 0.9999980 0.9999981 0.9999981
## [176] 0.9999982 0.9999983 0.9999984 0.9999984 0.9999985 0.9999986 0.9999986
## [183] 0.9999987 0.9999987 0.9999988 0.9999989 0.9999989 0.9999990 0.9999990
## [190] 0.9999991 0.9999991 0.9999991 0.9999992 0.9999992 0.9999993 0.9999993
## [197] 0.9999993 0.9999994 0.9999994 0.9999994 0.9999995 0.9999995 0.9999995
## [204] 0.9999996 0.9999996 0.9999996 0.9999996 0.9999997 0.9999997 0.9999997
## [211] 0.9999997 0.9999997 0.9999998 0.9999998 0.9999998 0.9999998 0.9999998
## [218] 0.9999998 0.9999999 0.9999999 0.9999999 0.9999999 0.9999999 0.9999999
## [225] 0.9999999 0.9999999 0.9999999 0.9999999 0.9999999 1.0000000 1.0000000
## [232] 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000
## [239] 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000
## [246] 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000
## [253] 1.0000000 1.0000000 1.0000000 1.0000000

Face Recognization (eignface)

Load the Olivetti faces datasets

Formerly Olivetti Research Limited (ORL) Database of Faces, contains a set of face images taken between April 1992 and April 1994 at the lab. The database was used in the context of a face recognition project carried out in collaboration with the Speech, Vision and Robotics Group of the Cambridge University Engineering Department.

There are ten different images of each of 40 distinct subjects. For some subjects, the images were taken at different times, varying the lighting, facial expressions (open / closed eyes, smiling / not smiling) and facial details (glasses / no glasses).

400 total images, 64x64 size.

library(loon.data)
data(faces)
image(matrix(faces[,2],nrow=64),col=gray((0:255)/255),xlab="",ylab="",xaxt="n",yaxt="n")

require(dplyr)

Compute the Mean vector: Average faces

Take average of each person’s photo and Display the average faces image

plt_img <- function(x){ image(x, col=grey(seq(0, 1, length=256)))}
par(mfrow=c(2,2))
par(mar=c(0.1,0.1,0.1,0.1))


AV1=rowMeans(data.matrix(faces[,1:10]))
plt_img(t(apply(matrix(AV1,nrow=64,byrow=F),2,rev)))

AV2=rowMeans(data.matrix(faces[,11:20]))
plt_img(t(apply(matrix(AV2,nrow=64,byrow=F),2,rev)))

AV39=rowMeans(data.matrix(faces[,381:390]))
plt_img(t(apply(matrix(AV39,nrow=64,byrow=F),2,rev)))

AV40=rowMeans(data.matrix(faces[,391:400]))
plt_img(t(apply(matrix(AV40,nrow=64,byrow=F),2,rev)))

library(RSpectra)
D <- data.matrix(faces)
average_face=rowMeans(D)
AVF=matrix(average_face,nrow=1,byrow=T)
plt_img(t(apply(matrix(AVF,nrow=64,byrow=F),2,rev)))

pr.out <- prcomp(D)
D_new <- pr.out$x

Plot of Eigenfaces (Eigenvectors)

Eigenvectors are a special set of vectors associated with a linear system of equations (i.e., a matrix equation) that are sometimes also known as characteristic vectors, proper vectors, or latent vectors

par(mfrow=c(3,2))
par(mar=c(0.2,0.2,0.2,0.2))
for (i in 1:6){
  plt_img(t(apply(matrix(D_new[, i],nrow=64,byrow=F),2,rev)))
}

Background Subtraction modeling

Backgroud Modeling

Data Initialization