change colSum

Author: Naeemkh

.gitignore

@@ -13,3 +13,5 @@ renv.lock
 /doc/
 /Meta/
 functional_tests/*.html
+functional_tests/*_cache/*
+functional_tests/*_files/*

R/compute_deriv_nn.R

@@ -98,10 +98,13 @@ compute_deriv_nn <- function(w,
   Sigma_obs_inv <- chol2inv(chol(Sigma_obs))
 
   all_weights <- sapply(id_all, function(id.ind){
+
     cross_dist <- spatstat.geom::crossdist(obs_new[id.ind,1], obs_new[id.ind,2],
                                           obs_use[,1], obs_use[,2])
-    Sigma_cross <- g_sigma*(1/alpha)*(2*outer(rep(w,length(id.ind))*(1/alpha), obs_use[,1], "-"))*
-      kernel_deriv_fn(cross_dist^2)
+
+    Sigma_cross <- g_sigma*(1/alpha)*(2*outer(rep(w,length(id.ind))*(1/alpha),
+                                              obs_use[,1], "-"))*
+                                              kernel_deriv_fn(cross_dist^2)
     #mean
     wght <- Sigma_cross%*%Sigma_obs_inv
     colSums(wght)

R/compute_posterior_sd_nn.R

@@ -106,5 +106,12 @@ compute_posterior_sd_nn <-  function(hyperparam,
                                                                 obs_use[,1],obs_use[,2])^2)
 
   sigma_sq2 <- c(calc_cross(cross_cov, cov_use_inv))/n^2
-  return(sqrt(sigma_sq1 - sigma_sq2 + sigma2))
+  posterior_sd <- sqrt(sigma_sq1 - sigma_sq2 + sigma2)
+
+  logger::log_debug("w: {w}, sigma_sq1: {sigma_sq1}, sigma_sq2: {sigma_sq2},",
+                    "sigma2: {sigma2}")
+
+
+
+  return(posterior_sd)
 }

R/compute_w_corr.R

@@ -49,7 +49,7 @@ compute_w_corr <- function(data, weights){
   w_sd <- sqrt(sum((w_obs - w_mean)^2*weights))
   w_stan <- (w_obs - w_mean)/w_sd
 
-  x_mean <- colMeans(x_design*weights)
+  x_mean <- colSums(x_design*weights)
   x_cov <- (t(x_design) - x_mean)%*%diag(weights)%*%t(t(x_design) - x_mean)
   x_stan <- t(t(solve(chol(x_cov)))%*%(t(x_design) - x_mean))
   covariate_balance <- abs(c(t(x_stan)%*%diag(weights)%*%w_stan))

R/estimate_mean_sd_nn.R

@@ -136,6 +136,8 @@ estimate_mean_sd_nn <- function(hyperparam,
                    mean = GPS_m$e_gps_pred,
                    sd = GPS_m$e_gps_std, log = T)
 
+    print(paste("Sigma2 is:", sigma2))
+
     val <- compute_posterior_sd_nn(hyperparam = hyperparam,
                                    w = wi,
                                    GPS_w = GPS_w,

R/train_GPS.R

@@ -24,7 +24,7 @@
 #'                       as.matrix(mydata$treat))
 #'
 #'
-train_GPS <- function(cov.mt, w.all){
+train_GPS <- function(cov.mt, w.all, dnorm_log = FALSE){
   GPS_mod <- xgboost::xgboost(data = cov.mt,
                               label = w.all,
                               nrounds=50,
@@ -35,7 +35,7 @@ train_GPS <- function(cov.mt, w.all){
 
   e_gps_pred <- predict(GPS_mod,cov.mt)
   e_gps_std <- sd(w.all-e_gps_pred)
-  GPS <- c(stats::dnorm(w.all, mean = e_gps_pred, sd = e_gps_std, log = T))
+  GPS <- c(stats::dnorm(w.all, mean = e_gps_pred, sd = e_gps_std, log = dnorm_log))
   GPS_m <- data.table::data.table(GPS = GPS,
                                   e_gps_pred = e_gps_pred,
                                   e_gps_std = e_gps_std)

docs/articles/GPCERF.html

@@ -5,7 +5,7 @@ articles:
   Full-Gaussian-Processes: Full-Gaussian-Processes.html
   GPCERF: GPCERF.html
   Nearest-neighbor-Gaussian-Processes: Nearest-neighbor-Gaussian-Processes.html
-last_built: 2022-06-08T19:06Z
+last_built: 2022-06-13T18:58Z
 urls:
   reference: https://fasrc.github.io/GPCERF/reference
   article: https://fasrc.github.io/GPCERF/articles