Data 605-Assignment 4
Hazal Gunduz
With the attached data file, build and visualize eigenimagery that accounts for 80% of the variability. Provide full R code and discussion.
Loading Libraries
library(foreach)
library(jpeg)
library(EBImage)
library(OpenImageR)##
## Attaching package: 'OpenImageR'## The following objects are masked from 'package:EBImage':
##
## readImage, writeImageWe have 17 shoes images in the .jpg folder.
files<-list.files("/Users/otheraccount/Downloads/jpg/", pattern="\\.jpg")[1:17] Shoes images function
height = 1200;
width = 2500;
scale = 20
plot_jpeg = function(path, add=FALSE) {
jpg = readJPEG(path, native=T)
res = dim(jpg)[2:1]
if (!add)
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])
}Loading the data into an array and resizing function scales.
images<-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("/Users/otheraccount/Downloads/jpg/", files[i])), height/scale, width/scale)
images[i,,,]=array(temp, dim=c(1, height/scale, width/scale, 3))
}
dim(images)## [1] 17 60 125 3Vectorizing
flat<-matrix(0, 17, prod(dim(images)))
for (i in 1:17) {
newimages<-readJPEG(paste0("/Users/otheraccount/Downloads/jpg/", files[i]))
r=as.vector(images[i,,,1]); g=as.vector(images[i,,,2]); b=as.vector(images[i,,,3])
flat[i,] <- t(c(r, g, b))
}
shoes<-as.data.frame(t(flat))Visualize the actual plots
Let’s look at the shoes, using the ‘plot_jpeg’ function to see the images.
par(mfrow=c(6,3))
par(mai=c(.03,.03,.03,.03))
for (i in 1:17) {
plot_jpeg(writeJPEG(images[i,,,]))
}
Structure of Eigencomponents
We need to scale and center data with using the scale function.
scaled<-scale(shoes, center=TRUE, scale=TRUE)
mean.shoe<-attr(scaled, "scaled:center")
std.shoe<-attr(scaled, "scaled:scale")
dim(scaled)## [1] 382500 17Calculate Covariance (Correlation)
We are using the Correlation matrix. And correlation matrix will be used to determine the eigencomponents.
Sigma_<-cor(scaled)
dim(Sigma_)## [1] 17 17Get the Eigencomponents
myeigen<-eigen(Sigma_)
myeigen## eigen() decomposition
## $values
## [1] 11.77794388 1.72081925 0.86806022 0.46371734 0.32298978 0.27624335
## [7] 0.23790552 0.20503228 0.16487012 0.15399147 0.14378933 0.13577975
## [13] 0.12975748 0.11385581 0.10510016 0.10124270 0.07890155
##
## $vectors
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] -0.2515577 -0.05962807 -0.14114605 0.379564498 0.328384491 0.063548478
## [2,] -0.2564669 0.22970932 -0.09482706 0.230635627 -0.032641499 0.118423122
## [3,] -0.1974907 -0.34526438 -0.24576573 0.652153338 -0.171726622 0.244730346
## [4,] -0.2391458 0.30516320 -0.13606194 -0.123183806 -0.327267101 0.337264863
## [5,] -0.2525203 0.23895414 -0.06096558 -0.015140135 0.320237763 -0.134084234
## [6,] -0.2096918 -0.34776361 -0.42324640 -0.330938410 0.005186903 -0.204506297
## [7,] -0.2220439 -0.32176935 -0.36923615 -0.258761028 0.032948289 -0.251123643
## [8,] -0.2597468 0.13861061 -0.27362524 -0.147491638 -0.159303710 0.115445148
## [9,] -0.2242754 0.39008169 -0.17677165 -0.152415293 -0.239805816 0.083991770
## [10,] -0.2523894 0.26939880 0.02645111 0.078843036 0.269266509 -0.257207906
## [11,] -0.2504276 0.23813195 0.14578328 0.073261747 0.226873600 -0.269224686
## [12,] -0.2541524 -0.16064493 0.16973475 0.126756162 -0.260586173 -0.363831380
## [13,] -0.2374627 -0.25443032 0.18739393 -0.231917619 0.363004533 0.477340146
## [14,] -0.2431988 -0.17131145 0.34992145 -0.146263113 -0.265657288 0.024086423
## [15,] -0.2531910 -0.06188346 0.32463869 0.002861056 -0.331362672 -0.006033122
## [16,] -0.2571186 -0.11980858 0.24383184 -0.183679152 0.245239312 0.313599800
## [17,] -0.2513643 -0.10507094 0.30609685 0.063192679 -0.061516569 -0.259276337
## [,7] [,8] [,9] [,10] [,11]
## [1,] 0.52472561 0.462775915 0.08089722 -0.028688435 -0.082671317
## [2,] 0.18685650 0.102633577 -0.22284739 0.146776372 -0.003009252
## [3,] -0.44212270 -0.227918578 0.08470180 -0.056984171 0.032363352
## [4,] 0.09329163 -0.108661745 -0.02018674 0.042996293 -0.385973550
## [5,] -0.30873371 0.075063118 0.30886931 0.313277344 -0.077462977
## [6,] 0.03288863 0.082753104 0.03319269 -0.363923622 0.185381133
## [7,] -0.10293093 0.025168032 -0.01883752 0.449235459 -0.162176681
## [8,] 0.11833803 -0.024123103 0.03766722 -0.430320880 -0.007345780
## [9,] -0.01801266 -0.145348780 0.08507916 0.182869158 0.335105238
## [10,] -0.16721442 -0.008893103 -0.16124987 -0.017921028 0.043924436
## [11,] -0.28837871 -0.096204767 -0.23846363 -0.437093574 -0.015352133
## [12,] 0.25268251 -0.248712605 -0.45258476 0.273337019 0.012561412
## [13,] 0.06307660 -0.247378906 -0.38601024 -0.004189989 0.162212977
## [14,] -0.25497022 0.410431410 -0.07746391 -0.114629267 -0.513065886
## [15,] -0.07653768 0.415274397 0.11932690 0.048663804 0.597907646
## [16,] -0.05781238 -0.076685492 0.29966011 0.139313424 0.021128977
## [17,] 0.33330232 -0.444466219 0.53287860 -0.143199538 -0.119597335
## [,12] [,13] [,14] [,15] [,16]
## [1,] -0.0596494479 0.173868263 0.021255008 0.33990691 0.018397621
## [2,] 0.3583439856 -0.043784824 0.005082587 -0.68936372 -0.279026041
## [3,] 0.0232821235 -0.006366854 -0.007581095 0.05684779 0.046598924
## [4,] -0.5189611873 0.090706970 0.185160913 -0.07881277 0.109634097
## [5,] -0.2572829048 -0.330735690 -0.439080915 0.02771388 -0.285787030
## [6,] 0.0304987443 -0.169126001 0.080641248 -0.13350866 -0.192870142
## [7,] -0.0371921186 0.404445380 0.076928476 -0.10798016 0.172641737
## [8,] 0.0008197682 -0.344227162 -0.157967432 0.10736325 0.137979303
## [9,] 0.4421762647 0.290087257 -0.080299759 0.42913990 -0.091687407
## [10,] 0.1600326150 -0.200829589 0.151174826 -0.06475324 0.725134134
## [11,] -0.1827441887 0.420303198 0.203200555 0.04231127 -0.339738279
## [12,] -0.1165179657 -0.355619561 0.077240978 0.28274188 -0.181693130
## [13,] -0.0596685563 0.120675891 -0.399244171 -0.01585738 0.091551701
## [14,] 0.3522810681 0.005869241 -0.180002374 0.12378054 -0.007728344
## [15,] -0.3278229277 0.085448269 -0.010923197 -0.16580365 0.127717686
## [16,] 0.1412604581 -0.238084563 0.654492594 0.07441734 -0.149990508
## [17,] 0.0804570050 0.182593387 -0.195393055 -0.19831669 0.099936680
## [,17]
## [1,] 0.059003318
## [2,] -0.063955907
## [3,] 0.042079036
## [4,] 0.305515426
## [5,] 0.057863911
## [6,] 0.487528502
## [7,] -0.357324326
## [8,] -0.634619845
## [9,] 0.159325935
## [10,] 0.207476664
## [11,] -0.144511446
## [12,] -0.008412949
## [13,] 0.060720116
## [14,] 0.093570243
## [15,] -0.075670182
## [16,] -0.126287618
## [17,] 0.048581047myeigen<-eigen(Sigma_)
cumsum(myeigen$values) / sum(myeigen$values)## [1] 0.6928202 0.7940449 0.8451073 0.8723847 0.8913841 0.9076338 0.9216282
## [8] 0.9336889 0.9433872 0.9524455 0.9609037 0.9688907 0.9765235 0.9832209
## [15] 0.9894033 0.9953587 1.0000000We see that 80% variability at the position of 2, so we find the eigenshoes at [, 2].
Eigenshoes
scaling<-diag(myeigen$values[1:5]^(-1/2)) / (sqrt(nrow(scaled)-1))
eigenshoes<-scaled%*%myeigen$vectors[,1:5]%*%scaling
par(mfrow=c(2,3))
imageShow(array(eigenshoes[,2], c(60, 125, 3)))
Transform of the images.
height=1200
width=2500
scale=20
newimages=images
dim(newimages)=c(length(files), height*width*3/scale^2)
pca<-princomp(t(as.matrix(newimages)), scores=TRUE, cor=TRUE)Eigenshoes
pca2<-t(pca$scores)
dim(pca2)=c(length(files), height/scale, width/scale, 3)
par(mfrow=c(5,5))
par(mai=c(.01,.01,.01,.01))
for (i in 1:17) {
plot_jpeg(writeJPEG(pca2[i,,,]))
}
a<-round(pca$sdev[1:17]^2 / sum(pca$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.000New Data Set
We will write the new data set 80% of the variability for all images.
x <- t(t(eigenshoes)%*%scaled)