Fundamentals of Computational Mathematics - Homework 4

Libraries

Load needed libraries:

library(doParallel)
library(foreach)
library(jpeg)
library(kableExtra)
library(OpenImageR)
library(EBImage)

Use of Graphics

Put the images together on a single object files

num=17

files=list.files("D:/Jered/Images/jpg",pattern="\\.jpg")[1:num]

View Shoes Functions

Read the file & get the resolution

height=1200; width=2500;scale=20
plot_jpeg = function(path, add=FALSE)
{ jpg = readJPEG(path, native=T) # read the file
  res = dim(jpg)[2:1] # get the resolution, [x, y]
  if (!add) # initialize an empty plot area if add==FALSE
    plot(1,1,xlim=c(1,res[1]),ylim=c(1,res[2]),asp=1,type='n',xaxs='i',yaxs='i',xaxt='n',yaxt='n',xlab='',ylab='',bty='n')
  rasterImage(jpg,1,1,res[1],res[2])
}

Load the Data into an Array

im=array(rep(0,length(files)*height/scale*width/scale*3), dim=c(length(files), height/scale, width/scale,3))

for (i in 1:17){
  temp=resize(readJPEG(paste0("D:/Jered/Images/jpg/", files[i])),height/scale, width/scale)
  im[i,,,]=array(temp,dim=c(1, height/scale, width/scale,3))}

Vectorize

flat=matrix(0, 17, prod(dim(im))) 
for (i in 1:17) {
  newim <- readJPEG(paste0("D:/Jered/Images/jpg/", files[i]))
  r=as.vector(im[i,,,1]); g=as.vector(im[i,,,2]);b=as.vector(im[i,,,3])
  flat[i,] <- t(c(r, g, b))
}
shoes=as.data.frame(t(flat))

Actual Plots

par(mfrow=c(3,3))
par(mai=c(.3,.3,.3,.3))
for (i in 1:17){  #plot the first images only
plot_jpeg(writeJPEG(im[i,,,]))
}

Get eigencompents for correlation structure

scaled=scale(shoes, center = TRUE, scale = TRUE)
mean.shoe=attr(scaled, "scaled:center") #saving for classification
std.shoe=attr(scaled, "scaled:scale")  #saving for classification...later

Calculate Covariance (Correlation)

Sigma_=cor(scaled)

Get eigencomponents

myeigen=eigen(Sigma_)
cumsum(myeigen$values) / sum(myeigen$values)

##  [1] 0.6928202 0.7940449 0.8451072 0.8723847 0.8913841 0.9076337 0.9216282
##  [8] 0.9336889 0.9433871 0.9524454 0.9609037 0.9688907 0.9765235 0.9832209
## [15] 0.9894033 0.9953587 1.0000000

About 80% of variability can be represented within 2 first eigenvalues and about 90% of variability can be represented within 5 first eigenvalues

Eigenshoes

Eigenshoes with about 80% of variability: 2 first eigenvalues

scaling=diag(myeigen$values[1:2]^(-1/2)) / (sqrt(nrow(scaled)-1))
eigenshoes=scaled%*%myeigen$vectors[,1:2]%*%scaling
imageShow(array(eigenshoes[,1], c(60,125,3)))

Eigenshoes with about 90% of variability: 5 first eigenvalues

scaling1=diag(myeigen$values[1:5]^(-1/2)) / (sqrt(nrow(scaled)-1))
eigenshoes1=scaled%*%myeigen$vectors[,1:5]%*%scaling1
imageShow(array(eigenshoes1[,1], c(60,125,3)))

Generate Principal Components

Transform the images

height=1200
width=2500
scale=20
newdata=im
dim(newdata)=c(length(files),height*width*3/scale^2)
mypca=princomp(t(as.matrix(newdata)), scores=TRUE, cor=TRUE)

Summary of components

summary(mypca)

## Importance of components:
##                           Comp.1    Comp.2     Comp.3     Comp.4     Comp.5
## Standard deviation     3.4319009 1.3118000 0.93169738 0.68096781 0.56832205
## Proportion of Variance 0.6928202 0.1012247 0.05106235 0.02727748 0.01899941
## Cumulative Proportion  0.6928202 0.7940449 0.84510722 0.87238470 0.89138411
##                            Comp.6     Comp.7     Comp.8     Comp.9     Comp.10
## Standard deviation     0.52558864 0.48775558 0.45280468 0.40604197 0.392417779
## Proportion of Variance 0.01624961 0.01399444 0.01206071 0.00969824 0.009058336
## Cumulative Proportion  0.90763372 0.92162816 0.93368887 0.94338711 0.952445449
##                            Comp.11     Comp.12     Comp.13   Comp.14
## Standard deviation     0.379195884 0.368483202 0.360218987 0.3374253
## Proportion of Variance 0.008458207 0.007987051 0.007632807 0.0066974
## Cumulative Proportion  0.960903656 0.968890707 0.976523514 0.9832209
##                            Comp.15     Comp.16     Comp.17
## Standard deviation     0.324191464 0.318186594 0.280894368
## Proportion of Variance 0.006182359 0.005955453 0.004641273
## Cumulative Proportion  0.989403273 0.995358727 1.000000000

Provides same values on cumulative proportion as calculated earlier with cumsum

Eigenshoes

Generate Eigenshoes

mypca2=t(mypca$scores)
dim(mypca2)=c(length(files),height/scale,width/scale,3)
par(mfrow=c(5,5))
par(mai=c(.001,.001,.001,.001))
for (i in 1:17){
plot_jpeg(writeJPEG(mypca2[i,,,], bg="white"))  #complete without reduction
}

Variance capture

a=round(mypca$sdev[1:17]^2/ sum(mypca$sdev^2),3)
cumsum(a)

##  Comp.1  Comp.2  Comp.3  Comp.4  Comp.5  Comp.6  Comp.7  Comp.8  Comp.9 Comp.10 
##   0.693   0.794   0.845   0.872   0.891   0.907   0.921   0.933   0.943   0.952 
## Comp.11 Comp.12 Comp.13 Comp.14 Comp.15 Comp.16 Comp.17 
##   0.960   0.968   0.976   0.983   0.989   0.995   1.000

New data set

x = t(t(eigenshoes)%*%scaled)