## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.align = "center", dpi = 300 ) ## ----message=FALSE------------------------------------------------------------ library(SpatPCA) library(ggplot2) base_theme <- theme_minimal(base_size = 10, base_family = "Times") + theme(legend.position = "bottom") fill_bar <- guides(fill = guide_colourbar( barwidth = 10, barheight = 0.5, label.position = "bottom") ) coltab <- with( list(), colorRampPalette(c("#3b4cc0", "#f7f7f7", "#b40426"))(128) ) color_scale_limit <- c(-.8, .8) ## ----out.width = '100%'------------------------------------------------------- set.seed(1024) p <- 25 n <- 8 location <- matrix(rep(seq(-5, 5, length = p), 2), nrow = p, ncol = 2) expanded_location <- expand.grid(location[, 1], location[, 2]) unnormalized_eigen_fn <- as.vector(exp(-location[, 1] ^ 2) %*% t(exp(-location[, 2] ^ 2))) true_eigen_fn <- unnormalized_eigen_fn / norm(t(unnormalized_eigen_fn), "F") plot_df <- data.frame( location_dim1 = expanded_location[, 1], location_dim2 = expanded_location[, 2], eigenfunction = true_eigen_fn ) ggplot(plot_df, aes(location_dim1, location_dim2)) + geom_tile(aes(fill = eigenfunction)) + scale_fill_gradientn(colours = coltab, limits = color_scale_limit) + base_theme + labs(title = "True Eigenfunction", fill = "") + fill_bar ## ----------------------------------------------------------------------------- realizations <- rnorm(n = n, sd = 3) %*% t(true_eigen_fn) + matrix(rnorm(n = n * p^2), n, p^2) ## ----out.width = '100%'------------------------------------------------------- realization_df <- data.frame( location_dim1 = expanded_location[, 1], location_dim2 = expanded_location[, 2], value = realizations[1, ] ) ggplot(realization_df, aes(location_dim1, location_dim2)) + geom_tile(aes(fill = value)) + scale_fill_gradientn(colours = coltab, limits = c(-10, 10)) + base_theme + labs(title = "1st realization", fill = "") + fill_bar ## ----------------------------------------------------------------------------- tau2 <- c(0, exp(seq(log(10), log(400), length = 10))) cv <- spatpca(x = expanded_location, Y = realizations, tau2 = tau2) eigen_est <- cv$eigenfn ## ----out.width = '100%'------------------------------------------------------- plot_df <- data.frame( location_dim1 = expanded_location[, 1], location_dim2 = expanded_location[, 2], spatpca = eigen_est[, 1], pca = svd(realizations)$v[, 1] ) plot_df_long <- rbind( data.frame(location_dim1 = plot_df$location_dim1, location_dim2 = plot_df$location_dim2, estimate = "spatpca", eigenfunction = plot_df$spatpca), data.frame(location_dim1 = plot_df$location_dim1, location_dim2 = plot_df$location_dim2, estimate = "pca", eigenfunction = plot_df$pca) ) ggplot(plot_df_long, aes(location_dim1, location_dim2)) + geom_tile(aes(fill = eigenfunction)) + scale_fill_gradientn(colours = coltab, limits = color_scale_limit) + base_theme + facet_wrap(~estimate) + labs(fill = "") + fill_bar