## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----simulate_data, message=FALSE, warning=FALSE------------------------------ library(AddiVortes) set.seed(42) n <- 300 # Sample random locations on the globe lat <- runif(n, -pi / 2, pi / 2) # latitude in radians: [-pi/2, pi/2] lon <- runif(n, -pi, pi) # longitude in radians: [-pi, pi] # True function: warmer at the equator, slight east-west gradient y_true <- 20 * cos(lat) + 5 * sin(lon) # Add observation noise y <- y_true + rnorm(n, sd = 2) # Covariate matrix: latitude first, longitude last (required convention) x <- cbind(lat, lon) ## ----plot_data, fig.width=7, fig.height=4, fig.align='center'----------------- # Colour scale for the response cols <- colorRampPalette(c("blue", "white", "red"))(100) col_index <- cut(y, breaks = 100, labels = FALSE) # Convert radians to degrees for a readable plot lat_deg <- lat * 180 / pi lon_deg <- lon * 180 / pi plot(lon_deg, lat_deg, col = cols[col_index], pch = 19, cex = 0.7, xlab = "Longitude (degrees)", ylab = "Latitude (degrees)", main = "Simulated Response on the Globe" ) legend("bottomleft", legend = c("High", "Low"), col = c("red", "blue"), pch = 19, bty = "n" ) ## ----fit_spherical, results='hide'-------------------------------------------- fit_sph <- AddiVortes( y = y, x = x, m = 50, totalMCMCIter = 500, mcmcBurnIn = 100, metric = "S", # use great-circle distance for all columns showProgress = FALSE ) ## ----rmse_spherical----------------------------------------------------------- cat("In-sample RMSE (spherical metric):", round(fit_sph$inSampleRmse, 3), "\n") ## ----fit_euclidean, results='hide'-------------------------------------------- fit_euc <- AddiVortes( y = y, x = x, m = 50, totalMCMCIter = 500, mcmcBurnIn = 100, metric = "E", # Euclidean distance (default) showProgress = FALSE ) ## ----rmse_euclidean----------------------------------------------------------- cat("In-sample RMSE (Euclidean metric):", round(fit_euc$inSampleRmse, 3), "\n") ## ----test_data---------------------------------------------------------------- set.seed(101) n_test <- 200 lat_test <- runif(n_test, -pi / 2, pi / 2) lon_test <- runif(n_test, -pi, pi) y_true_test <- 20 * cos(lat_test) + 5 * sin(lon_test) y_test <- y_true_test + rnorm(n_test, sd = 2) x_test <- cbind(lat_test, lon_test) ## ----predictions, results='hide'---------------------------------------------- preds_sph <- predict(fit_sph, x_test, showProgress = FALSE) preds_euc <- predict(fit_euc, x_test, showProgress = FALSE) ## ----compare_rmse------------------------------------------------------------- rmse_sph <- sqrt(mean((y_test - preds_sph)^2)) rmse_euc <- sqrt(mean((y_test - preds_euc)^2)) cat("Test RMSE — spherical metric:", round(rmse_sph, 3), "\n") cat("Test RMSE — Euclidean metric:", round(rmse_euc, 3), "\n") ## ----plot_predictions, fig.width=7, fig.height=5, fig.align='center'---------- y_range <- range(c(y_test, preds_sph, preds_euc)) plot(y_test, preds_sph, pch = 19, col = "darkblue", cex = 0.7, xlab = "Observed values", ylab = "Predicted values", main = "Spherical vs. Euclidean Metric: Predicted vs. Observed", xlim = y_range, ylim = y_range ) points(y_test, preds_euc, pch = 4, col = "darkred", cex = 0.7) abline(0, 1, lwd = 2, lty = 2, col = "grey40") legend("topleft", legend = c("Spherical metric", "Euclidean metric", "y = x"), col = c("darkblue", "darkred", "grey40"), pch = c(19, 4, NA), lty = c(NA, NA, 2), lwd = c(NA, NA, 2), bty = "n" ) ## ----augmented-data----------------------------------------------------------- lat_prime1 <- runif(n, -pi/2, pi/2) lat_prime2 <- runif(n, -pi/2, pi/2) lon_prime <- runif(n, -pi, pi) y_prime_true <- 20 * cos(lat) + 5 * sin(lon) - 5 * cos(lat_prime1) * sin(lat_prime2) + 10*sin(lon_prime)^2 * sin(abs(lat_prime1 - lat_prime2)) y_prime <- y_prime_true + rnorm(n, sd = 3) x_prime <- cbind(lat, lon, lat_prime1, lat_prime2, lon_prime) ## ----fit_multi_spherical_error, error=TRUE------------------------------------ try({ fit_sph_new <- AddiVortes( y = y_prime, x = x_prime, m = 50, totalMCMCIter = 500, mcmcBurnIn = 100, metric = "S", # use great-circle distance for all columns showProgress = FALSE ) }) ## ----fit_multi_spherical, results='hide'-------------------------------------- fit_sph_new <- AddiVortes( y = y_prime, x = x_prime, m = 50, totalMCMCIter = 500, mcmcBurnIn = 100, metric = "S", # use great-circle distance for all columns, members = rep(1:2, times = c(2,3)), # indicate membership showProgress = FALSE ) ## ----multi_sphere_euc, results='hide'----------------------------------------- fit_euc_new <- AddiVortes( y = y_prime, x = x_prime, m = 50, totalMCMCIter = 500, mcmcBurnIn = 100, metric = "E", # Euclidean distance (default) showProgress = FALSE ) ## ----multi_sph_compare, fig.width=7, fig.height=5, fig.align='center'--------- ## Set up test data lat_prime_test1 <- runif(n_test, -pi/2, pi/2) lat_prime_test2 <- runif(n_test, -pi/2, pi/2) lon_prime_test <- runif(n_test, -pi, pi) y_prime_test_true <- 20 * cos(lat_test) + 5 * sin(lon_test) - 5 * cos(lat_prime_test1) * sin(lat_prime_test2) + 10*sin(lon_prime_test)^2 * sin(abs(lat_prime_test1 - lat_prime_test2)) y_prime_test <- y_prime_test_true + rnorm(n_test, sd = 3) x_prime_test <- cbind(lat_test, lon_test, lat_prime_test1, lat_prime_test2, lon_prime_test) ## Make predictions preds_prime_sph <- predict(fit_sph_new, x_prime_test, showProgress = FALSE) preds_prime_euc <- predict(fit_euc_new, x_prime_test, showProgress = FALSE) rmse_prime_sph <- sqrt(mean((y_prime_test - preds_prime_sph)^2)) rmse_prime_euc <- sqrt(mean((y_prime_test - preds_prime_euc)^2)) cat("Test RMSE — spherical metric:", round(rmse_prime_sph, 3), "\n") cat("Test RMSE — Euclidean metric:", round(rmse_prime_euc, 3), "\n") y_prime_range <- range(c(y_prime_test, preds_prime_sph, preds_prime_euc)) plot(y_prime_test, preds_prime_sph, pch = 19, col = "darkblue", cex = 0.7, xlab = "Observed values", ylab = "Predicted values", main = "Spherical vs. Euclidean Metric: Predicted vs. Observed", xlim = y_prime_range, ylim = y_prime_range ) points(y_prime_test, preds_prime_euc, pch = 4, col = "darkred", cex = 0.7) abline(0, 1, lwd = 2, lty = 2, col = "grey40") legend("topleft", legend = c("Spherical metric", "Euclidean metric", "y = x"), col = c("darkblue", "darkred", "grey40"), pch = c(19, 4, NA), lty = c(NA, NA, 2), lwd = c(NA, NA, 2), bty = "n" )