Import Libraries
library(foreach)## Warning: package 'foreach' was built under R version 4.1.2library(jpeg)
library(EBImage)## Warning: package 'EBImage' was built under R version 4.1.1library(OpenImageR)## Warning: package 'OpenImageR' was built under R version 4.1.2##
## Attaching package: 'OpenImageR'## The following objects are masked from 'package:EBImage':
##
## readImage, writeImagelibrary(stringr)
library(raster)## Warning: package 'raster' was built under R version 4.1.2## Loading required package: splibrary(rgdal)## Please note that rgdal will be retired by the end of 2023,
## plan transition to sf/stars/terra functions using GDAL and PROJ
## at your earliest convenience.
##
## rgdal: version: 1.5-28, (SVN revision 1158)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 3.2.1, released 2020/12/29
## Path to GDAL shared files: /Users/alecmccabe/Library/R/x86_64/4.1/library/rgdal/gdal
## GDAL binary built with GEOS: TRUE
## Loaded PROJ runtime: Rel. 7.2.1, January 1st, 2021, [PJ_VERSION: 721]
## Path to PROJ shared files: /Users/alecmccabe/Library/R/x86_64/4.1/library/rgdal/proj
## PROJ CDN enabled: FALSE
## Linking to sp version:1.4-6
## To mute warnings of possible GDAL/OSR exportToProj4() degradation,
## use options("rgdal_show_exportToProj4_warnings"="none") before loading sp or rgdal.
## Overwritten PROJ_LIB was /Users/alecmccabe/Library/R/x86_64/4.1/library/rgdal/projUpload Images
Pull all jpegs into our session
files=list.files("/Users/alecmccabe/Desktop/Masters Program/DATA 605/homework/homework_4/jpg",pattern="\\.jpg", all.files=TRUE)Plot JPEG
Code obtained from stackoverflow https://stackoverflow.com/questions/9543343/plot-a-jpg-image-using-base-graphics-in-r
height=1200; width=2500;scale=20plot_jpeg = function(path, add=FALSE) {
require('jpeg')
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 all jpeg image data into an array
images_array = array(
rep(0,length(files)*height/scale*width/scale*3),
dim=c(length(files), height/scale,width/scale,3)
)
for (i in 1:length(files)){
temp=resize(readJPEG(paste0("/Users/alecmccabe/Desktop/Masters Program/DATA 605/homework/homework_4/jpg/", files[i])),height/scale, width/scale)
images_array[i,,,]=array(temp,dim=c(1, height/scale, width/scale,3))}
dim(images_array)## [1] 17 60 125 3Vectorize the Array
flat=matrix(0, length(files), prod(dim(images_array)))
for (i in 1:17) {
newim <- readJPEG(paste0("/Users/alecmccabe/Desktop/Masters Program/DATA 605/homework/homework_4/jpg/", files[i]))
r=as.vector(images_array[i,,,1]); g=as.vector(images_array[i,,,2]);b=as.vector(images_array[i,,,3])
flat[i,] <- t(c(r, g, b))
}
shoes=as.data.frame(t(flat))
dim(flat)## [1] 17 382500Plot the actual jpeg shoes
par(mfrow=c(3,3))
par(mai=c(.3,.3,.3,.3))
for (i in 1:length(files)){ #plot the first images only
plot_jpeg(writeJPEG(images_array[i,,,]))
}
Calculate Eigencomponents
scaled <- scale(shoes, center = TRUE, scale = TRUE)
shoe_mean <- attr(scaled, "scaled:center")
shoe_std <- attr(scaled, "scaled:scale")
dim(scaled)## [1] 382500 17sigma=cor(scaled)
dim(sigma)## [1] 17 17eigen_vals <- eigen(sigma)
eigen_vals## 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.048581047When looking at the cumulative sum of our eigenvalues, we can see that at position 2 we reach nearly 80% variability.
cumsum(eigen_vals$values) / sum(eigen_vals$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.0000000scaling=diag(eigen_vals$values[1:2]^(-1/2)) / (sqrt(nrow(scaled)-1))
scaling## [,1] [,2]
## [1,] 0.0004711401 0.000000000
## [2,] 0.0000000000 0.001232586eigenshoes=scaled%*%eigen_vals$vectors[,1:2]%*%scaling
dim(eigenshoes)## [1] 382500 2imageShow(array(eigenshoes[,1], c(60,125,3)))