parameter inference shouldn't minus mean

R/infer_parameters.R

@@ -4,21 +4,26 @@ cor_translate <- function(x){
 
 infer_space_kernel_params <- function(data, plot = FALSE){
 
-  spatial_distance <- get_spatial_distance(data)
+  data$z_t_hat = log(data$n + 1)# - data$observed_mu
+
+    spatial_distance <- get_spatial_distance(data)
 
   space_cor <- expand.grid(id1 = unique(data$id), id2 = unique(data$id), t = unique(data$t)) |>
     dplyr::filter(as.numeric(id1) < as.numeric(id2)) |>
-    dplyr::left_join(dplyr::select(data, id, t, n), by = c("id1" = "id", "t" = "t")) |>
-    dplyr::left_join(dplyr::select(data, id, t, n), by = c("id2" = "id", "t" = "t")) |>
-    dplyr::filter(!is.na(n.x), !is.na(n.y)) |>
+    dplyr::left_join(dplyr::select(data, id, t, z_t_hat), by = c("id1" = "id", "t" = "t")) |>
+    dplyr::left_join(dplyr::select(data, id, t, z_t_hat), by = c("id2" = "id", "t" = "t")) |>
+    dplyr::filter(!is.na(z_t_hat.x), !is.na(z_t_hat.y)) |>
+    dplyr::filter(dplyr::n() > 5, .by = c(id1, id2)) |>
     dplyr::summarise(
-      cor = cor(n.x, n.y),
+      cor = cor(z_t_hat.x, z_t_hat.y),
       .by = c("id1", "id2")
     ) |>
     dplyr::mutate(
       cor = ifelse(cor < 0, 0, cor),
       distance = purrr::map2_dbl(id1, id2, ~ spatial_distance[.x, .y])
-    )
+    ) |>
+    dplyr::filter(!is.na(cor))
+
 
   # Fitting theta to empirical correlations
   fit_sigma <- function(theta, space_cor) {
@@ -54,18 +59,20 @@ infer_space_kernel_params <- function(data, plot = FALSE){
 }
 
 infer_time_kernel_params <- function(data, period, plot = FALSE){
+
+  data$z_t_hat = log(data$n + 1)# - data$observed_mu
+
   time_cor <- expand.grid(t1 = unique(data$t), t2 = unique(data$t), id = unique(data$id)) |>
-    #dplyr::filter(t1 < t2) |>
-    dplyr::left_join(dplyr::select(data, id, t, z), by = c("t1" = "t", "id" = "id")) |>
-    dplyr::left_join(dplyr::select(data, id, t, z), by = c("t2" = "t", "id" = "id")) |>
-    dplyr::filter(!is.na(z.x), !is.na(z.y)) |>
+    dplyr::filter(t1 < t2) |>
+    dplyr::left_join(dplyr::select(data, id, t, z_t_hat), by = c("t1" = "t", "id" = "id")) |>
+    dplyr::left_join(dplyr::select(data, id, t, z_t_hat), by = c("t2" = "t", "id" = "id")) |>
+    dplyr::filter(!is.na(z_t_hat.x), !is.na(z_t_hat.y)) |>
     dplyr::filter(dplyr::n() > 5, .by = c(t1, t2)) |>
     dplyr::summarise(
-      cor = cor(z.x, z.y),
+      cor = cor(z_t_hat.x, z_t_hat.y),
       .by = c("t1", "t2")
     ) |>
     dplyr::mutate(
-      #cor = ifelse(cor < 0, 0, cor),
       time_distance = abs(t2 - t1)
     )
 
@@ -85,7 +92,8 @@ infer_time_kernel_params <- function(data, period, plot = FALSE){
     par = c(1, 1),
     fn = fit_sigma,
     method = "L-BFGS-B",
-    lower = c(0.01, 0.01),
+    lower = c(0.1, 10),
+    upper = c(10, 52 * 10000),
     period = period,
     time_cor = time_cor
   )