From 90e755b94f39ad71eee280228844a3a94a337209 Mon Sep 17 00:00:00 2001
From: simon-smart88 <simon.smart@cantab.net>
Date: Tue, 2 Jul 2024 10:13:37 +0100
Subject: [PATCH 1/5] incorporate changes from disaggregation 0.4.0

---
 inst/shiny/modules/fit_fit.R    | 55 +++++++--------------------------
 inst/shiny/modules/prep_final.R |  8 ++---
 2 files changed, 16 insertions(+), 47 deletions(-)

diff --git a/inst/shiny/modules/fit_fit.R b/inst/shiny/modules/fit_fit.R
index 50d50d4..b6995aa 100644
--- a/inst/shiny/modules/fit_fit.R
+++ b/inst/shiny/modules/fit_fit.R
@@ -136,27 +136,19 @@ fit_fit_module_server <- function(id, common, parent_session, map) {
   })
 
 
+  plot_data <- reactive({
+    gargoyle::watch("fit_fit")
+    disaggregation::plot_disag_model_data(common$fit)
+    })
+
+
     output$model_plot <- plotly::renderPlotly({
-      gargoyle::watch("fit_fit")
-      req(common$fit$sd_out)
-
-      parameter <- sd <- obs <- pred <- NULL
-      posteriors <- as.data.frame(summary(common$fit$sd_out, select = 'fixed'))
-      posteriors <- dplyr::mutate(posteriors, name = rownames(posteriors))
-      names(posteriors) <- c('mean', 'sd', 'parameter')
-      posteriors$fixed <- grepl('slope', posteriors$parameter)
-      posteriors$type <- ifelse(posteriors$fixed, 'Slope', 'Other')
-
-      # Check name lengths match before substituting.
-      lengths_match <- terra::nlyr(common$fit$data$covariate_rasters) == sum(posteriors$fixed)
-      if(lengths_match){
-        posteriors$parameter[grepl('slope', posteriors$parameter)] <- names(common$fit$data$covariate_rasters)
-      }
+      req(plot_data())
+
+      posteriors <- plot_data()$posteriors
 
-      # Unique types for faceting
       unique_types <- unique(posteriors$type)
 
-      # Create subplots for each type
       plots <- lapply(unique_types, function(type) {
         subset_data <- posteriors[posteriors$type == type, ]
 
@@ -174,7 +166,6 @@ fit_fit_module_server <- function(id, common, parent_session, map) {
                  margin = list(t = 100))
       })
 
-      # Combine subplots into a single plot
       final_plot <- plotly::subplot(plots, nrows = 1, shareX = FALSE, margin = 0.05) %>%
         plotly::layout(title = "Model parameters (excluding random effects)",
                showlegend = FALSE)
@@ -185,34 +176,13 @@ fit_fit_module_server <- function(id, common, parent_session, map) {
 
 
     output$obs_pred_plot <- plotly::renderPlotly({
-      gargoyle::watch("fit_fit")
-      req(common$fit)
-      report <- common$fit$obj$report()
-
-      # Form of the observed and predicted results depends on the likelihood function used
-      if( common$fit$model_setup$family == 'gaussian') {
-        observed_data = report$polygon_response_data/report$reportnormalisation
-        predicted_data = report$reportprediction_rate
-        title <- 'In sample performance: incidence rate'
-      } else if( common$fit$model_setup$family == 'binomial') {
-        observed_data =  common$fit$data$polygon_data$response / common$fit$data$polygon_data$N
-        predicted_data = report$reportprediction_rate
-        title <- 'In sample performance: prevalence rate'
-      } else if( common$fit$model_setup$family == 'poisson') {
-        observed_data = report$polygon_response_data/report$reportnormalisation
-        predicted_data = report$reportprediction_rate
-        title <- 'In sample performance: incidence rate'
-      }
-
-      data <- data.frame(obs = observed_data, pred = predicted_data)
-
-      title <- "Observed vs Predicted"
+      req(plot_data())
+      data <- plot_data()$data
+      title <- plot_data()$title
 
-      # Define range for the identity line
       x_range <- range(data$obs, data$pred)
       identity_line <- data.frame(x = x_range, y = x_range)
 
-      # Create scatter plot and add identity line
       obspred_plot <- plotly::plot_ly(data, x = ~obs, y = ~pred, type = 'scatter', mode = 'markers') %>%
         plotly::add_lines(data = identity_line, x = ~x, y = ~y, line = list(color = 'blue')) %>%
         plotly::layout(title = list(text = title, x = 0.5),
@@ -221,7 +191,6 @@ fit_fit_module_server <- function(id, common, parent_session, map) {
                margin = list(t = 100),
                showlegend = FALSE)
 
-      # Display the plot
       obspred_plot
     })
 
diff --git a/inst/shiny/modules/prep_final.R b/inst/shiny/modules/prep_final.R
index 7ec0371..e3b6534 100644
--- a/inst/shiny/modules/prep_final.R
+++ b/inst/shiny/modules/prep_final.R
@@ -79,8 +79,8 @@ prep_final_module_server <- function(id, common, parent_session, map) {
                                                  aggregation_raster = common$agg_prep,
                                                  id_var = as.character(input$id_var),
                                                  response_var = as.character(input$resp_var),
-                                                 na.action = input$na_action,
-                                                 makeMesh = FALSE)},
+                                                 na_action = input$na_action,
+                                                 make_mesh = FALSE)},
                              error = function(x){ common$logger %>% writeLog(type = "error",
                                paste0("An error occurred whilst preparing the data: ", x))})
     } else {
@@ -89,8 +89,8 @@ prep_final_module_server <- function(id, common, parent_session, map) {
                                                   aggregation_raster = common$agg_prep_lores,
                                                   id_var = as.character(input$id_var),
                                                   response_var = as.character(input$resp_var),
-                                                  na.action = input$na_action,
-                                                  makeMesh = FALSE)},
+                                                  na_action = input$na_action,
+                                                  make_mesh = FALSE)},
                              error = function(x){ common$logger %>% writeLog(type = "error",
                                 paste0("An error occurred whilst preparing the data: ", x))})
     }

From 1a6221ab94c348e2438c9452208b1266cf62a19d Mon Sep 17 00:00:00 2001
From: simon-smart88 <simon.smart@cantab.net>
Date: Tue, 2 Jul 2024 10:31:15 +0100
Subject: [PATCH 2/5] remove INLA after update

---
 Dockerfile           | 3 +--
 R/helper_functions.R | 1 -
 2 files changed, 1 insertion(+), 3 deletions(-)

diff --git a/Dockerfile b/Dockerfile
index 3a57c1d..5dd918a 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -19,8 +19,7 @@ RUN apt-get update && apt-get install -y \
     libhdf5-dev \
     patch
 
-# install R packages 
-RUN R -e "install.packages('INLA',repos=c(getOption('repos'),INLA='https://inla.r-inla-download.org/R/testing'), dep=TRUE)"
+# install R packages
 RUN R -e "install.packages('devtools')"
 ARG DISAGAPP_VER=unknown
 RUN R -e "devtools::install_github('simon-smart88/disagapp')"
diff --git a/R/helper_functions.R b/R/helper_functions.R
index 170dd9a..8d273b8 100644
--- a/R/helper_functions.R
+++ b/R/helper_functions.R
@@ -44,7 +44,6 @@ spurious <- function(x) {
   R6::R6Class(x)
   corrplot::corrplot(x)
   disaggregation::build_mesh(x)
-  INLA::inla.mesh.2d(x)
   leafem::addMouseCoordinates(x)
   leaflet.extras::removeDrawToolbar(x)
   fmesher::fm_as_sfc(x)

From 8f995e5c6bf1ff8e7575e3008990f094a09b1fdb Mon Sep 17 00:00:00 2001
From: simon-smart88 <simon.smart@cantab.net>
Date: Wed, 28 Aug 2024 15:16:40 +0100
Subject: [PATCH 3/5] further parameter changes

---
 R/pred_transfer_f.R                  | 4 ++--
 inst/shiny/modules/pred_transfer.Rmd | 4 ++--
 inst/shiny/modules/prep_final.Rmd    | 4 ++--
 3 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/R/pred_transfer_f.R b/R/pred_transfer_f.R
index 70421b0..b0b0ef3 100644
--- a/R/pred_transfer_f.R
+++ b/R/pred_transfer_f.R
@@ -102,7 +102,7 @@ covs_prep <- terra::rast(covs_prep)
 if (common$meta$prep_final$resolution == "High resolution"){
 
   # generate the prediction
-  transfer <- disaggregation::predict_model(common$fit, newdata = covs_prep)
+  transfer <- disaggregation::predict_model(common$fit, new_data = covs_prep)
 
   # convert to cases
   transfer$agg <- agg
@@ -117,7 +117,7 @@ if (common$meta$prep_final$resolution == "Low resolution"){
   agg_lores <- terra::aggregate(agg, fact = common$meta$prep_resolution$factor, fun = "sum")
 
   # generate the prediction
-  transfer <- disaggregation::predict_model(common$fit, newdata = covs_prep_lores)
+  transfer <- disaggregation::predict_model(common$fit, new_data = covs_prep_lores)
 
   # convert to cases
   transfer$agg <- agg_lores
diff --git a/inst/shiny/modules/pred_transfer.Rmd b/inst/shiny/modules/pred_transfer.Rmd
index 5e4902a..d052525 100644
--- a/inst/shiny/modules/pred_transfer.Rmd
+++ b/inst/shiny/modules/pred_transfer.Rmd
@@ -133,7 +133,7 @@ Decrease covariate resolution and generate the transferred predictions
 transfer_covariates_prepared_lores <- terra::aggregate(transfer_covariates_prepared, fact = {{meta$prep_resolution$factor}}, fun = "mean")
 transfer_aggregation_lores <- terra::aggregate(transfer_aggregation, fact = {{meta$prep_resolution$factor}}, fun = "sum")
 
-transfer_predictions <- disaggregation::predict_model(fitted_model, newdata = transfer_covariates_prepared)
+transfer_predictions <- disaggregation::predict_model(fitted_model, new_data = transfer_covariates_prepared)
 transfer_predictions$cases <- transfer_predictions$prediction * transfer_aggregation 
 
 plot(transfer_predictions)
@@ -145,7 +145,7 @@ Generate the transferred predictions
 ```
 
 ```{r, echo = {{all(c(pred_transfer_knit, pred_transfer_hires))}}, include = {{all(c(pred_transfer_knit, pred_transfer_hires))}}}
-transfer_predictions <- disaggregation::predict_model(fitted_model, newdata = transfer_covariates_prepared)
+transfer_predictions <- disaggregation::predict_model(fitted_model, new_data = transfer_covariates_prepared)
 transfer_predictions$cases <- transfer_predictions$prediction * transfer_aggregation 
 
 plot(transfer_predictions)
diff --git a/inst/shiny/modules/prep_final.Rmd b/inst/shiny/modules/prep_final.Rmd
index b41490b..3e60e27 100644
--- a/inst/shiny/modules/prep_final.Rmd
+++ b/inst/shiny/modules/prep_final.Rmd
@@ -9,8 +9,8 @@ prepared_data <- disaggregation::prepare_data(polygon_shapefile = shape,
                                      aggregation_raster = aggregation_prepared,
                                      id_var = "{{prep_id_var}}",
                                      response_var = "{{prep_resp_var}}",
-                                     na.action = {{prep_na_action}},
-                                     makeMesh = FALSE)
+                                     na_action = {{prep_na_action}},
+                                     make_mesh = FALSE)
 
 prepared_data$mesh <- mesh
 

From 485267528e645a9f3181441b1bac86ee9f657b04 Mon Sep 17 00:00:00 2001
From: simon-smart88 <simon.smart@cantab.net>
Date: Thu, 29 Aug 2024 11:56:31 +0100
Subject: [PATCH 4/5] mesh_args

---
 inst/shiny/modules/prep_mesh.R   | 10 +++++-----
 inst/shiny/modules/prep_mesh.Rmd |  2 +-
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/inst/shiny/modules/prep_mesh.R b/inst/shiny/modules/prep_mesh.R
index afecb04..1e5c0eb 100644
--- a/inst/shiny/modules/prep_mesh.R
+++ b/inst/shiny/modules/prep_mesh.R
@@ -42,7 +42,7 @@ prep_mesh_module_server <- function(id, common, parent_session, map) {
     # FUNCTION CALL ####
     common$logger |> writeLog(type = "starting", "Starting to build the mesh")
     results$resume()
-    common$tasks$prep_mesh$invoke(common$shape, mesh.args = list(max.edge = input$mesh_edge,
+    common$tasks$prep_mesh$invoke(common$shape, mesh_args = list(max.edge = input$mesh_edge,
                                                               cut = input$mesh_cut,
                                                               offset = input$offset))
 
@@ -71,15 +71,15 @@ prep_mesh_module_server <- function(id, common, parent_session, map) {
     save = function() {list(
       ### Manual save start
       ### Manual save end
-      mesh_edge = input$mesh_edge, 
-      mesh_cut = input$mesh_cut, 
+      mesh_edge = input$mesh_edge,
+      mesh_cut = input$mesh_cut,
       mesh_offset = input$mesh_offset)
     },
     load = function(state) {
       ### Manual load start
       ### Manual load end
-      updateSliderInput(session, "mesh_edge", value = state$mesh_edge) 
-      updateSliderInput(session, "mesh_cut", value = state$mesh_cut) 
+      updateSliderInput(session, "mesh_edge", value = state$mesh_edge)
+      updateSliderInput(session, "mesh_cut", value = state$mesh_cut)
       updateSliderInput(session, "mesh_offset", value = state$mesh_offset)
     }
   ))
diff --git a/inst/shiny/modules/prep_mesh.Rmd b/inst/shiny/modules/prep_mesh.Rmd
index a8f0a53..097ac5f 100644
--- a/inst/shiny/modules/prep_mesh.Rmd
+++ b/inst/shiny/modules/prep_mesh.Rmd
@@ -3,7 +3,7 @@ Build the spatial mesh
 ```
 
 ```{r, echo = {{prep_mesh_knit}}, include = {{prep_mesh_knit}}}
-mesh <- disaggregation::build_mesh(shape, mesh.args = list(max.edge = {{prep_mesh_edge}}, 
+mesh <- disaggregation::build_mesh(shape, mesh_args = list(max.edge = {{prep_mesh_edge}}, 
                                                       cut = {{prep_mesh_cut}},
                                                       offset = {{prep_mesh_offset}}))
 ```

From d549e7b20d7f0fb7ac694a208d50d804164f39eb Mon Sep 17 00:00:00 2001
From: simon-smart88 <simon.smart@cantab.net>
Date: Thu, 29 Aug 2024 12:25:37 +0100
Subject: [PATCH 5/5] fix pipes

---
 inst/shiny/modules/prep_final.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/inst/shiny/modules/prep_final.R b/inst/shiny/modules/prep_final.R
index 82ab958..2da9887 100644
--- a/inst/shiny/modules/prep_final.R
+++ b/inst/shiny/modules/prep_final.R
@@ -81,7 +81,7 @@ prep_final_module_server <- function(id, common, parent_session, map) {
                                                  response_var = as.character(input$resp_var),
                                                  na_action = input$na_action,
                                                  make_mesh = FALSE)},
-                             error = function(x){ common$logger %>% writeLog(type = "error",
+                             error = function(x){ common$logger |> writeLog(type = "error",
                                paste0("An error occurred whilst preparing the data: ", x))})
     } else {
      common$prep <- tryCatch({disaggregation::prepare_data(polygon_shapefile = common$shape,
@@ -91,7 +91,7 @@ prep_final_module_server <- function(id, common, parent_session, map) {
                                                   response_var = as.character(input$resp_var),
                                                   na_action = input$na_action,
                                                   make_mesh = FALSE)},
-                             error = function(x){ common$logger %>% writeLog(type = "error",
+                             error = function(x){ common$logger |> writeLog(type = "error",
                                 paste0("An error occurred whilst preparing the data: ", x))})
     }