#find the sum of squares of all singular values
sum_sq_sv_all <- sum(ui_mtrx_svd$d^2)

#find the value k that satisfy the formula
dim_red <- NULL
k <- 0
for (i in 1:length(ui_mtrx_svd$d)){
  dim_red[i] <- ((sum(ui_mtrx_svd$d[1:i]^2))/sum_sq_sv_all)
  if (((sum(ui_mtrx_svd$d[1:i]^2))/sum_sq_sv_all) >= 0.9 && k==0){
    k=i
  }
}
if (abs((sum(ui_mtrx_svd$d[1:k]^2))/sum_sq_sv_all-0.9)>abs((sum(ui_mtrx_svd$d[1:k-1]^2))/sum_sq_sv_all-0.9)){
  k=k-1
}
print(str_c('The value k is: ', as.character(k)))

#plot the ratio of the sum of the squares of the first k singular values over that of all singular values
plot(dim_red, main="Ratio of Squares of Singular Values vs k", xlab="k", ylab="Ratio of k to all Squares of Singular Values", pch=19, col='deeppink')
abline(h=0.9, v=k)

#reduce dimensionality of U
u_k <- ui_mtrx_svd$u[,1:k]

#reduce dimensionality of S
s_k <- Diagonal(n=k, x=ui_mtrx_svd$d[1:k])

#reduce dimensionality of V^T
v_t_k <- t(ui_mtrx_svd$v)[1:k,]

ui_mtrx_svd_approx <- u_k %*% s_k %*% v_t_k %>%
  as.matrix() 

# limit the range of ratings to [-10,10]
ui_mtrx_svd_approx <- pmax(pmin(ui_mtrx_svd_approx,10),-10)

dim(ui_mtrx_svd_approx)

ui_mtrx_svd_approx_long <- ui_mtrx_svd_approx %>%
  data.frame() %>%
  gather(key = 'Joke', value = 'Rating', na.rm = TRUE)

#Summary statistics
ui_mtrx_long %>% 
  select(Rating) %>% 
  summary() %>%
  data.frame() %>%
  select(Freq) %>%
  separate(Freq,into = c('Metrics', 'Value'),':') %>%
  cbind(ui_mtrx_bp_long %>% 
          select(Rating) %>% 
          summary() %>%
          data.frame() %>%
          select(Freq) %>%
          separate(Freq,into = c('Metrics', 'Value'),':')) %>%
  cbind(ui_mtrx_svd_approx_long %>% 
          select(Rating) %>% 
          summary() %>%
          data.frame() %>%
          select(Freq) %>%
          separate(Freq,into = c('Metrics', 'Value'),':')) %>%
  kable() %>%
  kable_styling(bootstrap_options = c('striped','bordered'), full_width = FALSE) %>%
  add_header_above(c('Original Dataset' = 2, 'Dataset with Baseline Predictors' = 2, 'Predicted Matrix B' = 2)) %>%
  add_header_above(c('Summary Statistics' = 6))

#boxplots comparing
par(mfrow = c(1,3))
boxplot(ui_mtrx_long["Rating"], main="Original Ratings", col="lightyellow")
boxplot(ui_mtrx_bp_long["Rating"], main="NA Ratings replaced \nby Baseline Predictors", col="lightblue")
boxplot(ui_mtrx_svd_approx_long["Rating"], main="Predicted Matrix with \nSVD Dimensionality Reduction", col="deeppink")

#histograms comparing
par(mfrow = c(3,1))
hist(ui_mtrx_long$Rating, main="Original Ratings", col="lightyellow")
hist(ui_mtrx_bp_long$Rating, main="NA Ratings replaced by Baseline Predictors", col="lightblue")
hist(ui_mtrx_svd_approx_long$Rating, main="Predicted Matrix with SVD Dimensionality Reduction", col="deeppink")

#UBCF models
model_UBCF_CC <- Recommender(data = ui_mtrx_train, method = 'UBCF', parameter = list(normalize = "center", method="Cosine"))
model_UBCF_CP <- Recommender(data = ui_mtrx_train, method = 'UBCF', parameter = list(normalize = "center", method="Pearson"))
model_UBCF_CE <- Recommender(data = ui_mtrx_train, method = 'UBCF', parameter = list(normalize = "center", method="Euclidean"))
model_UBCF_ZC <- Recommender(data = ui_mtrx_train, method = 'UBCF', parameter = list(normalize = "Z-score", method="Cosine"))
model_UBCF_ZP <- Recommender(data = ui_mtrx_train, method = 'UBCF', parameter = list(normalize = "Z-score", method="Pearson"))
model_UBCF_ZE <- Recommender(data = ui_mtrx_train, method = 'UBCF', parameter = list(normalize = "Z-score", method="Euclidean"))

suppress_rating <- function(x, min = -10, max = 10){
  return(pmax(pmin(x, 10),-10))
  }

#predictions with boundaries set
p_UBCF_CC <- predict(model_UBCF_CC, ui_mtrx_test_known, type='ratings')
p_UBCF_CC@data@x <- pmax(pmin(p_UBCF_CC@data@x, 10),-10)

p_UBCF_CP <- predict(model_UBCF_CP, ui_mtrx_test_known, type='ratings') 
p_UBCF_CP@data@x <- pmax(pmin(p_UBCF_CP@data@x, 10),-10)

p_UBCF_CE <- predict(model_UBCF_CE, ui_mtrx_test_known, type='ratings') 
p_UBCF_CE@data@x <- pmax(pmin(p_UBCF_CE@data@x, 10),-10)

p_UBCF_ZC <- predict(model_UBCF_ZC, ui_mtrx_test_known, type='ratings') 
p_UBCF_ZC@data@x <- pmax(pmin(p_UBCF_ZC@data@x, 10),-10)

p_UBCF_ZP <- predict(model_UBCF_ZP, ui_mtrx_test_known, type='ratings') 
p_UBCF_ZP@data@x <- pmax(pmin(p_UBCF_ZP@data@x, 10),-10)

p_UBCF_ZE <- predict(model_UBCF_ZE, ui_mtrx_test_known, type='ratings') 
p_UBCF_ZE@data@x <- pmax(pmin(p_UBCF_ZE@data@x, 10),-10)

#accuracies
UBCF_Model_Metrics <- rbind(
  'UBCF_CC' = calcPredictionAccuracy(p_UBCF_CC, ui_mtrx_test_unknown),
  'UBCF_CP' = calcPredictionAccuracy(p_UBCF_CP, ui_mtrx_test_unknown),
  'UBCF_CE' = calcPredictionAccuracy(p_UBCF_CE, ui_mtrx_test_unknown),
  'UBCF_ZC' = calcPredictionAccuracy(p_UBCF_ZC, ui_mtrx_test_unknown),
  'UBCF_ZP' = calcPredictionAccuracy(p_UBCF_ZP, ui_mtrx_test_unknown),
  'UBCF_ZE' = calcPredictionAccuracy(p_UBCF_ZE, ui_mtrx_test_unknown)
) %>%
  data.frame() %>%
  rownames_to_column('Model') %>%
  arrange(RMSE)

UBCF_Model_Metrics %>%
  mutate_if(is.numeric, ~round(.,6)) %>%
  mutate(RMSE = cell_spec(RMSE, bold  = ifelse(RMSE == min(RMSE),TRUE,FALSE)),
         MSE = cell_spec(MSE, bold  = ifelse(MSE == min(MSE),TRUE,FALSE)),
         MAE = cell_spec(MAE, bold  = ifelse(MAE == min(MAE),TRUE,FALSE))
         ) %>%
  kable(escape = FALSE) %>%
  kable_styling(bootstrap_options = c('striped','bordered'), full_width = FALSE) %>%
  add_header_above(c('Comparison of User-Based Collaborative Filtering Models' = 4)) 

#IBCF models
model_IBCF_CC <- Recommender(data = ui_mtrx_train, method = 'IBCF', parameter = list(normalize = "center", method="Cosine"))

model_IBCF_CP <- Recommender(data = ui_mtrx_train, method = 'IBCF', parameter = list(normalize = "center", method="Pearson"))

model_IBCF_CE <- Recommender(data = ui_mtrx_train, method = 'IBCF', parameter = list(normalize = "center", method="Euclidean"))

model_IBCF_ZC <- Recommender(data = ui_mtrx_train, method = 'IBCF', parameter = list(normalize = "Z-score", method="Cosine"))

model_IBCF_ZP <- Recommender(data = ui_mtrx_train, method = 'IBCF', parameter = list(normalize = "Z-score", method="Pearson"))

model_IBCF_ZE <- Recommender(data = ui_mtrx_train, method = 'IBCF', parameter = list(normalize = "Z-score", method="Euclidean"))


#predictions with boundaries set
p_IBCF_CC <- predict(model_IBCF_CC, ui_mtrx_test_known, type='ratings')
p_IBCF_CC@data@x <- pmax(pmin(p_IBCF_CC@data@x, 10),-10)

p_IBCF_CP <- predict(model_IBCF_CP, ui_mtrx_test_known, type='ratings') 
p_IBCF_CP@data@x <- pmax(pmin(p_IBCF_CP@data@x, 10),-10)

p_IBCF_CE <- predict(model_IBCF_CE, ui_mtrx_test_known, type='ratings') 
p_IBCF_CE@data@x <- pmax(pmin(p_IBCF_CE@data@x, 10),-10)

p_IBCF_ZC <- predict(model_IBCF_ZC, ui_mtrx_test_known, type='ratings') 
p_IBCF_ZC@data@x <- pmax(pmin(p_IBCF_ZC@data@x, 10),-10)

p_IBCF_ZP <- predict(model_IBCF_ZP, ui_mtrx_test_known, type='ratings') 
p_IBCF_ZP@data@x <- pmax(pmin(p_IBCF_ZP@data@x, 10),-10)

p_IBCF_ZE <- predict(model_IBCF_ZE, ui_mtrx_test_known, type='ratings') 
p_IBCF_ZE@data@x <- pmax(pmin(p_IBCF_ZE@data@x, 10),-10)


#accuracies
IBCF_Model_Metrics <- rbind(
  'IBCF_CC' = calcPredictionAccuracy(p_IBCF_CC, ui_mtrx_test_unknown),
  'IBCF_CP' = calcPredictionAccuracy(p_IBCF_CP, ui_mtrx_test_unknown),
  'IBCF_CE' = calcPredictionAccuracy(p_IBCF_CE, ui_mtrx_test_unknown),
  'IBCF_ZC' = calcPredictionAccuracy(p_IBCF_ZC, ui_mtrx_test_unknown),
  'IBCF_ZP' = calcPredictionAccuracy(p_IBCF_ZP, ui_mtrx_test_unknown),
  'IBCF_ZE' = calcPredictionAccuracy(p_IBCF_ZE, ui_mtrx_test_unknown)
) %>%
  data.frame() %>%
  rownames_to_column('Model') %>%
  arrange(RMSE)


IBCF_Model_Metrics %>%
  mutate_if(is.numeric, ~round(.,6)) %>%
  mutate(RMSE = cell_spec(RMSE, bold  = ifelse(RMSE == min(RMSE),TRUE,FALSE)),
         MSE = cell_spec(MSE, bold  = ifelse(MSE == min(MSE),TRUE,FALSE)),
         MAE = cell_spec(MAE, bold  = ifelse(MAE == min(MAE),TRUE,FALSE))
         ) %>%
  kable(escape = FALSE) %>%
  kable_styling(bootstrap_options = c('striped','bordered'), full_width = FALSE) %>%
  add_header_above(c('Comparison of Item-Based Collaborative Filtering Models' = 4))