library(imager)
## Warning: package 'imager' was built under R version 4.2.2
## Loading required package: magrittr
## 
## Attaching package: 'imager'
## The following object is masked from 'package:magrittr':
## 
##     add
## The following objects are masked from 'package:stats':
## 
##     convolve, spectrum
## The following object is masked from 'package:graphics':
## 
##     frame
## The following object is masked from 'package:base':
## 
##     save.image

Let’s get our file set 

files=list.files("./hw4/shoe_basis/",pattern="\\.jpg")
files
##  [1] "RC_2500x1200_2014_us_53446.jpg" "RC_2500x1200_2014_us_53455.jpg"
##  [3] "RC_2500x1200_2014_us_53469.jpg" "RC_2500x1200_2014_us_53626.jpg"
##  [5] "RC_2500x1200_2014_us_53632.jpg" "RC_2500x1200_2014_us_53649.jpg"
##  [7] "RC_2500x1200_2014_us_53655.jpg" "RC_2500x1200_2014_us_53663.jpg"
##  [9] "RC_2500x1200_2014_us_53697.jpg" "RC_2500x1200_2014_us_54018.jpg"
## [11] "RC_2500x1200_2014_us_54067.jpg" "RC_2500x1200_2014_us_54106.jpg"
## [13] "RC_2500x1200_2014_us_54130.jpg" "RC_2500x1200_2014_us_54148.jpg"
## [15] "RC_2500x1200_2014_us_54157.jpg" "RC_2500x1200_2014_us_54165.jpg"
## [17] "RC_2500x1200_2014_us_54172.jpg"

Let’s Set our Resolution 

height=1200
width=2500

Let’s do a basic read in of the images

At this point of the code, were iterating through every picture contained in the shoe_basis directory. From there, we resize them, and converting them into a RGB channel. I’m wondering how the resultant data would change if a different color basis, like CMYK was selected.

Also since I view these as staged photos, I’m going to assume that they are all sized the same, and centered and framed the same as well.

image_data <- matrix(0, length(files), 3*(height*width))

for (i in 1:length(files)) {
  temp_img <- load.image(paste0("./hw4/shoe_basis/", files[i]))
  red_vector <- as.vector(channel(temp_img, 1))
  green_vector <- as.vector(channel(temp_img, 2))
  blue_vector <- as.vector(channel(temp_img, 3))
  image_data[i,] <- t(c(red_vector, green_vector, blue_vector))
}

image_data <- t(image_data)

Now lets check it read in correctly

First things first, lets check the dimensionality:

print(dim(image_data))
## [1] 9000000      17

Now lets print the image:

img_data <- image_data[,1]
img_array <- array(img_data, dim = c(width, height, 3))
img_cimg <- as.cimg(img_array)
## Warning in as.cimg.array(img_array): Assuming third dimension corresponds to
## colour
plot(img_cimg)

And it looks great! Let’s make that into a function

plot_rgb = function(shoe=1, matrix=image_data)
{
  img_data <- matrix[,shoe]
  img_array <- array(img_data, dim = c(width, height, 3))
  img_cimg <- as.cimg(img_array)
  plot(img_cimg)
}

And lets test it

plot_rgb()
## Warning in as.cimg.array(img_array): Assuming third dimension corresponds to
## colour

And it works great!

SVD

Lets begin with scaling the matrix:

scaled_image_data <- scale(image_data)

And now let’s perform a SVD:

svd_image_data <- svd(scaled_image_data)
plot(svd_image_data$d^2/sum(svd_image_data$d^2), type="b",xlab = "Number of Values", ylab = "Variance explained", pch = 1)

sigma <- svd_image_data$d

cumulative_prop <- cumsum((sigma^2) / sum(sigma^2))
vector_target <- which(cumulative_prop >= 0.8)[1]
print(paste0("Number of singular vectors needed to explain 80% of the variance: ", vector_target))
## [1] "Number of singular vectors needed to explain 80% of the variance: 3"

Lets reconstruct the image data and plot it!

U <- svd_image_data$u
V <- svd_image_data$v

U_subset <- U[, 1:vector_target]
V_subset <- V[, 1:vector_target]
image_data_superset <- U_subset %*% diag(sigma[1:vector_target]) %*% t(V_subset)
plot_rgb(1, image_data_superset)
## Warning in as.cimg.array(img_array): Assuming third dimension corresponds to
## colour

Weirdly, I feel like that feels like most of my running shoes! I’m wondering if the highly defined spikes at the bottom are because all the cleats use the same sole pattern, which would heavily weight those stylistic elements?