Merge pull request #67 from CSAFE-ISU/65-fix-crosscut-nas

65 fix crosscut nas

Author: stephaniereinders

NAMESPACE

@@ -2,8 +2,6 @@
 
 export("%>%")
 export(bulletAnalyzrApp)
-export(reportMainUI)
 export(reportServer)
-export(reportSidebarUI)
 importFrom(magrittr,"%>%")
 importFrom(stats,predict)

NEWS.md

@@ -11,6 +11,7 @@
   - Bullet-to-bullet similarity scores
   - Land-to-land score matrices
   - Aligned signal comparisons and other diagnostic metrics
+* **Display settings**: Users can adjust the down-sampling performed on display images.
 
 ## Current Requirements
 

R/app.R

@@ -5,25 +5,32 @@
 #' @name bulletAnalyzrApp
 #' @rdname bulletAnalyzrApp
 #' @keywords Shiny
-#' 
+#'
 #' @param run_interactive TRUE allows the user to adjust the crosscut and groove
 #'   locations. FALSE uses the crosscut and grooves automatically chosen by the
 #'   app.
+#' @param sample_m An integer value by which to downsample the x3p scan for
+#'   display. High-resolution scans that are 15+ MB require more memory and
+#'   might crash the app unless down-sampled. On the other hand,
+#'   lower-resolution scans can appear too smooth if too much down-sampling is
+#'   performed. The default of sample_m = 10 was optimized for 15+ MB scans.
+#'   Downsampling is only performed on the displayed scans. All computations use
+#'   the original resolution.
 #' @param ... Other arguments passed on to 'onStart', 'options', 'uiPattern', or
 #'   'enableBookmarking' of 'shiny::shinyApp'
-#' 
+#'
 #' @returns No return value, called to launch 'shiny' app
-#' 
+#'
 #' @export
 #' @importFrom stats predict
-#' 
+#'
 #' @examples
 #' \dontrun{
 #'   bulletAnalyzrApp()
 #' }
 #'
 #' @returns A Shiny app
-bulletAnalyzrApp <- function(run_interactive = TRUE, ...){
+bulletAnalyzrApp <- function(run_interactive = TRUE, sample_m = 10, ...){
 
   ## Config
   options(rgl.useNULL = TRUE)
@@ -38,7 +45,6 @@ bulletAnalyzrApp <- function(run_interactive = TRUE, ...){
     text = ggplot2::element_text(size = 22), 
     plot.title = ggplot2::element_text(size = 22, face = "bold")
   )
-  sample_m = 10
 
   ui <- shiny::shinyUI({
     shiny::fluidPage(title = "BulletAnalyzr",

R/process-wrappers.R

@@ -84,13 +84,40 @@ get_default_cc_wrapper <- function(bullets, ylimits = c(150, NA)) {
 
   bullets$crosscut <- sapply(bullets$x3p, bulletxtrctr::x3p_crosscut_optimize, ylimits = ylimits)
 
-  # Check for NA values
-  na_idx <- is.na(bullets$crosscut)
-  if (any(na_idx)) {
-    bullet_land <- paste("Bullet", bullets$bullet, "Land", bullets$land)
+  # If any of the crosscut values are NA, this means that bulletxtrctr could not
+  # find a stable region, where the minimum ccf allowed is 0.9. Try
+  # incrementally lowering the permitted minimum ccf by 0.05 each time. If a
+  # minimum ccf of 0.6 still does not yield a stable region, throw an error.
+  if (any(is.na(bullets$crosscut))) {
+    # Get indices of any lands where the crosscut location is NA
+    missing_cc_indx <- which(is.na(bullets$crosscut))
 
-    stop(paste("x3p_crosscut_optimize could not find a stable region in land:", 
-               paste(bullet_land[na_idx], collapse = ", ")))
+    for (i in missing_cc_indx) {
+      current_cc <- bullets$crosscut[i]
+      current_minccf <- 0.85
+      
+      while (current_minccf >= 0.6) {
+        current_cc <- bulletxtrctr::x3p_crosscut_optimize(
+          x3p = bullets$x3p[[i]],
+          ylimits = ylimits,
+          minccf = current_minccf
+        )
+        if (is.na(current_cc) && current_minccf == 0.6) {
+          # Error if a stable region still can't be found
+          bullet_land <- paste("Bullet", bullets$bullet[i], "Land", bullets$land[i])
+          stop(paste("x3p_crosscut_optimize could not find a stable region in land:", 
+                     paste(bullet_land, collapse = ", ")))
+        } else if (is.na(current_cc)) {
+          current_minccf <- current_minccf - 0.05
+          next
+        } else {
+          break
+        }
+      }
+      
+      # Update crosscut in bullets data frame
+      bullets$crosscut[i] <- current_cc
+    }
   }
 
   return(bullets)

R/report-module.R

@@ -218,7 +218,7 @@ reportServer <- function(id, bullet_data = NULL, comp_bul1 = NULL, comp_bul2 = N
       )
     })
 
-    downloadDataServer("data1", bullet_data = bullet_data, phase_test_results = phase_test_results, drop_x3p = FALSE)
+    downloadDataServer("data1", bullet_data = bullet_data, phase_test_results = phase_test_results, drop_x3p = TRUE)
 
     # OUTPUT - Phase test score ----
     output$bull_comp_score <- shiny::renderText({