Allowed electrode prototype to display markers; added viewer options …

…for localization

CHANGELOG.md

@@ -1,6 +1,13 @@
 ## Changes since last CRAN release
-* `ef1e293d (HEAD -> master)` [_`dipterix`_]: Plotting slices have correct margins with partial plot
-* `4bd0352c (origin/master, origin/HEAD)` [_`dipterix`_]: Allow users to drag and drop value tables
+* `12970a6b (HEAD -> master, origin/master, origin/HEAD)` [_`dipterix`_]: Fixed the `GLTF` not showing inner-most contact issue
+* `c8522cd7` [_`dipterix`_]: Removed `devel` version of `ravetools` from check
+* `11bb99e8` [_`dipterix`_]: Update `Github` action check script
+* `cbeac8bc` [_`dipterix`_]: Added rhub check
+* `b302dd71` [_`dipterix`_]: minor change
+* `02880b44` [_`dipterix`_]: Ready for a CRAN release
+* `9efec0cb` [_`dipterix`_]: Removed `doc` folder
+* `bae88ccb` [_`dipterix`_]: Plotting slices have correct margins with partial plot
+* `4bd0352c` [_`dipterix`_]: Allow users to drag and drop value tables
 * `10ac71ad` [_`dipterix`_]: Allow users to hide crosshairs
 * `05836f94` [_`dipterix`_]: Allow `shiny` app to change current color map via proxy
 * `fbca42f4` [_`dipterix`_]: Allows drag-drop electrode color files; Added `set_electrode_data` to brain proxy class, allowing `shiny` applications to change the electrode data, set color palettes, and set value ranges in the same call

R/class_electrode_proto.R

@@ -77,6 +77,7 @@ ElectrodePrototype <- R6::R6Class(
     .normal = NULL,
     .texture_size = NULL,
     .channel_map = NULL,
+    .marker_map = NULL,
     .channel_numbers = NULL,
     .contact_center = NULL,
     .contact_sizes = NULL,
@@ -106,6 +107,7 @@ ElectrodePrototype <- R6::R6Class(
     fix_outline = TRUE,
 
     model_rigid = TRUE,
+    viewer_options = list(),
 
     .last_texture = NULL,
     initialize = function( type, n_vertices = 4 ) {
@@ -126,6 +128,10 @@ ElectrodePrototype <- R6::R6Class(
       self$from_list( other$as_list() )
     },
 
+    set_viewer_options = function(opt) {
+      self$viewer_options <- as.list(opt)
+    },
+
     set_transform = function( m44, byrow = TRUE ) {
       stopifnot2(is.numeric(m44) && !anyNA(m44), msg = "Transform must be a 4x4 numeric matrix with no NA")
       if(is.matrix(m44)) {
@@ -348,6 +354,17 @@ ElectrodePrototype <- R6::R6Class(
       }
     },
 
+    set_marker_map = function(marker_map) {
+      # only for visualization purposes
+      if(!missing(marker_map)) {
+        if(!is.null(marker_map)) {
+          marker_map <- as_row_matrix(marker_map, nr = 4, storage_mode = "integer")
+          marker_map[ is.na(marker_map) | marker_map < 1 | marker_map > private$.texture_size ] <- NA
+        }
+        private$.marker_map <- marker_map
+      }
+    },
+
     set_contact_sizes = function( sizes ) {
       if(!is.numeric(sizes)) {
         warning("Contact sizes must be numeric (mm).")
@@ -479,14 +496,31 @@ ElectrodePrototype <- R6::R6Class(
         re <- array(value, dim = dim)
       } else {
         re <- array(NA, dim = dim)
+
+        # ensure markers
+        if(!is.null(private$.marker_map)) {
+          n_iters <- ncol(private$.marker_map)
+          for(ii in seq_len(n_iters)) {
+            map <- private$.marker_map[, ii]
+            if(!anyNA(map)) {
+              i <- (map[[1]] - 1) + seq_len(map[[3]])
+              i[i > dim[[1]]] <- i[i > dim[[1]]] - dim[[1]]
+              j <- (map[[2]] - 1) + seq_len(map[[4]])
+              j[j > dim[[2]]] <- j[j > dim[[2]]] - dim[[2]]
+              re[ i, j ] <- 0
+            }
+          }
+        }
+
         n_channels <- ncol(private$.channel_map)
         for(ii in seq_len(n_channels)) {
           map <- private$.channel_map[, ii]
           if(!anyNA(map)) {
-            re[
-              (map[[1]] - 1) + seq_len(map[[3]]),
-              (map[[2]] - 1) + seq_len(map[[4]])
-            ] <- value[[ii]]
+            i <- (map[[1]] - 1) + seq_len(map[[3]])
+            i[i > dim[[1]]] <- i[i > dim[[1]]] - dim[[1]]
+            j <- (map[[2]] - 1) + seq_len(map[[4]])
+            j[j > dim[[2]]] <- j[j > dim[[2]]] - dim[[2]]
+            re[ i, j ] <- value[[ii]]
           }
         }
         # idx <- private$.channel_map[1, ] + dim[[1]] * (private$.channel_map[2, ] - 1L)
@@ -495,10 +529,11 @@ ElectrodePrototype <- R6::R6Class(
         #   re[idx[idx_valid]] <- value[idx_valid]
         # }
       }
+
       if(is.factor(value)) {
-        attr(re, "levels") <- levels(value)
+        attr(re, "levels") <- unique(c(levels(value), "0"))
       } else if(is.character(value)) {
-        attr(re, "levels") <- sort(unique(unlist(value)))
+        attr(re, "levels") <- unique(c(sort(unique(unlist(value))), "0"))
       }
       self$.last_texture <- re
       if(plot) {
@@ -594,6 +629,7 @@ ElectrodePrototype <- R6::R6Class(
         normal = as.vector(private$.normal),
         texture_size = self$texture_size,
         channel_map = as.vector(private$.channel_map),
+        marker_map = as.vector(private$.marker_map),
         channel_numbers = as.vector(private$.channel_numbers),
         contact_center = as.vector(private$.contact_center),
         contact_sizes = self$contact_sizes,
@@ -605,7 +641,8 @@ ElectrodePrototype <- R6::R6Class(
         model_rigid = self$model_rigid,
         model_up = self$model_up,
         world_up = private$.world_up,
-        default_interpolation = self$default_interpolation
+        default_interpolation = self$default_interpolation,
+        viewer_options = self$viewer_options
       )
     },
     from_list = function(li) {
@@ -621,6 +658,7 @@ ElectrodePrototype <- R6::R6Class(
       self$set_normal(li$normal)
       self$set_texture_size(li$texture_size)
       self$set_channel_map(li$channel_map, li$contact_center)
+      self$set_marker_map(li$marker_map)
       self$set_contact_channels(li$channel_numbers)
       self$set_contact_sizes(li$contact_sizes)
       if(length(li$model_control_points)) {
@@ -648,6 +686,7 @@ ElectrodePrototype <- R6::R6Class(
 
       self$default_interpolation <- li$default_interpolation
       self$model_rigid <- !isFALSE(li$model_rigid)
+      self$set_viewer_options(li$viewer_options)
       self
     },
     as_json = function(to_file = NULL, ...) {
@@ -864,6 +903,7 @@ ElectrodePrototype <- R6::R6Class(
     normal = function() { private$.normal },
     texture_size = function() { private$.texture_size },
     channel_map = function() { private$.channel_map },
+    # marker_map = function() { private$.marker_map },
     transform = function() { private$.transform },
     control_points = function() {
       if( !length(private$.model_control_points) ) { return(NULL) }

R/prototype_seeg.R

@@ -19,6 +19,9 @@
 #' is false, which throws a warning when duplicated
 #' @param default_interpolation default interpolation string for electrode
 #' localization
+#' @param viewer_options list of viewer options; this should be a list of
+#' key-value pairs where the keys are the controller names and values are the
+#' corresponding values when users switch to localizing the electrode group
 #' @returns A electrode shaft geometry prototype; the configuration file is
 #' saved to 'RAVE' 3rd-party repository.
 #'
@@ -58,6 +61,7 @@ seeg_prototype <- function(
     fix_contact = 1, overall_length = 200,
     description = NULL, dry_run = FALSE,
     default_interpolation = NULL,
+    viewer_options = NULL,
     overwrite = FALSE) {
 
   # DIPSAUS DEBUG START
@@ -229,7 +233,9 @@ seeg_prototype <- function(
     model_direction = c(0, 0, 1),
     model_rigid = FALSE,
 
-    default_interpolation = default_interpolation
+    default_interpolation = default_interpolation,
+
+    viewer_options = as.list(viewer_options)
   )
 
   proto <- ElectrodePrototype$new("")$from_list(config)

inst/prototypes/.gitignore

@@ -2,3 +2,4 @@ Precision33x31.json
 Precision33x31.R
 sEEG-16.json
 MicroArray.R
+DBS.R