correcting two minor bugs caused by indexing only one row in matrices...

JeremyGelb · Nov 5, 2023 · 72c334a · 72c334a
1 parent 66cb380
commit 72c334a
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 11 deletions.
diff --git a/R/bandwidth_selection_cv_sf.R b/R/bandwidth_selection_cv_sf.R
@@ -397,7 +397,7 @@ bw_cv_likelihood_calc <- function(bws = NULL,
     pb <- txtProgressBar(min = 0, max = n_quadra, style = 3)
   }
   dfs <- lapply(1:n_quadra,function(i){
-
+    print(i)
     sel <- selections[[i]]
 
     # the events_loc must cover the quadra and the bw
@@ -408,10 +408,10 @@ bw_cv_likelihood_calc <- function(bws = NULL,
 
     # but I also need to know on which events I must calculate the densities (in the quadra)
     quad_events <- sel$samples
-    sel_weights <- events_weight[sel_events$wid,]
+    sel_weights <- events_weight[sel_events$wid,,drop=FALSE]
 
     # I extract here the bws required
-    sel_bws <- mat_bws[sel_events$wid,]
+    sel_bws <- mat_bws[sel_events$wid,,drop=FALSE]
 
     values <- nkde_worker_bw_sel(sel$lines, quad_events, sel_events_loc, sel_events, sel_weights,
                                   kernel_name, sel_bws,
@@ -563,10 +563,13 @@ bw_cv_likelihood_calc.mc <- function(bws, lines, events, w, kernel_name, method,
     })
   }else{
     if(is.null(mat_bws)){
-      mat_bws <- adaptive_bw.mc(grid, events, lines, all_bws, trim_bws, method,
+      mat_bws <- adaptive_bw.mc(grid = grid,
+                                events = events,
+                                lines = lines,
+                                bw = all_bws,
+                                trim_bw = trim_bws,
+                                method = method,
                              kernel_name, max_depth, tol, digits, sparse, verbose)
-      # mat_bws2 <- adaptive_bw(grid, events, lines, all_bws, trim_bws, method,
-      #                           kernel_name, max_depth, tol, digits, sparse, verbose)
     }else{
 
       # in the case where all the bandwidths were provided by the user
@@ -629,10 +632,10 @@ bw_cv_likelihood_calc.mc <- function(bws, lines, events, w, kernel_name, method,
 
         # but I also need to know on which events I must calculate the densities (in the quadra)
         quad_events <- sel$samples
-        sel_weights <- events_weight[sel_events$wid,]
+        sel_weights <- events_weight[sel_events$wid,,drop=FALSE]
 
         # I extract here the bws required
-        sel_bws <- mat_bws[sel_events$wid,]
+        sel_bws <- mat_bws[sel_events$wid,,drop=FALSE]
 
         values <- nkde_worker_bw_sel(sel$lines, quad_events, sel_events_loc, sel_events, sel_weights,
                                      kernel_name, sel_bws,
@@ -656,10 +659,10 @@ bw_cv_likelihood_calc.mc <- function(bws, lines, events, w, kernel_name, method,
 
       # but I also need to know on which events I must calculate the densities (in the quadra)
       quad_events <- sel$samples
-      sel_weights <- events_weight[sel_events$wid,]
+      sel_weights <- events_weight[sel_events$wid,,drop=FALSE]
 
       # I extract here the bws required
-      sel_bws <- mat_bws[sel_events$wid,]
+      sel_bws <- mat_bws[sel_events$wid,,drop=FALSE]
 
       values <- nkde_worker_bw_sel(sel$lines, quad_events, sel_events_loc, sel_events, sel_weights,
                                    kernel_name, sel_bws,

diff --git a/R/nkde_execution_functions_sf.R b/R/nkde_execution_functions_sf.R
@@ -876,7 +876,13 @@ adaptive_bw.mc <- function(grid,events,lines,bw,trim_bw,method,kernel_name,max_d
 
         # df <- data.frame("goid"=sel$samples$goid,
         #                  "k" = values)
-        df <- cbind(sel$samples$goid, values)
+
+        if(nrow(sel$samples) == 1){
+          df <- c(sel$samples$goid, values)
+        }else{
+          df <- cbind(sel$samples$goid, values)
+        }
+
         p(sprintf("i=%g", sel$index))
         return(df)
       }, future.packages = c("spNetwork"))