inst/shinyapp/helpers.R

In gongyh/RamanD2O: RamanD2O: an R/Shiny app designed for the analysis of cellular Ramanome data

# helper functions for RamanD2O shiny app

removeCosmic <- function(spc) {
  medianFilt <- runmed(spc, 3)
  diff <- spc - medianFilt
  cutoff <- max(2000, 8 * sd(diff))
  df <- data.frame(raw = spc, med = medianFilt, diff = diff)
  cosmic <- FALSE
  if (length(which(df$diff > cutoff)) > 0) {
    cosmic <- TRUE
    df[which(df$diff > cutoff), "raw"] <- df[which(df$diff > cutoff), "med"]
  }
  return(list("spc" = df$raw, "cosmic" = cosmic))
}

# search peaks for each spectrum
# size: need to be odd number
findPeaks <- function(spc, size = 9, level = 0.1) {
  half <- (size - 1) / 2
  maxI <- max(spc)
  peaks <- c()
  for (i in (half + 1):(length(spc) - half)) {
    if ((spc[i] >= level * maxI) &&
          (spc[i] >= max(spc[(i - half):(i + half)]))) {
      peaks <- c(peaks, i)
    }
  }
  peaks
}

mean_sd_filter <- function(x, n = 5) {
  x <- x - mean(x)
  s <- n * sd(x)
  (x <= s) & (x > -s)
}

round2 <- function(x) {
  round(x, digits = 2)
}

round4 <- function(x) {
  round(x, digits = 4)
}

unAsIs <- function(X) {
  if ("AsIs" %in% class(X)) {
    class(X) <- class(X)[-match("AsIs", class(X))]
  }
  X
}

withBusyIndicatorCSS <- "
.btn-loading-container {
margin-left: 10px;
font-size: 1.2em;
}
.btn-done-indicator {
color: green;
}
.btn-err {
margin-top: 10px;
color: red;
}
"

withBusyIndicatorUI <- function(button) {
  id <- button[["attribs"]][["id"]]
  div(
    shinyjs::useShinyjs(),
    singleton(tags$head(
      tags$style(withBusyIndicatorCSS)
    )),
    `data-for-btn` = id,
    button,
    span(
      class = "btn-loading-container",
      shinyjs::hidden(
        icon("spinner", class = "btn-loading-indicator fa-spin"),
        icon("check", class = "btn-done-indicator")
      )
    ),
    shinyjs::hidden(
      div(
        class = "btn-err",
        div(
          icon("exclamation-circle"),
          tags$b("Error: "),
          span(class = "btn-err-msg")
        )
      )
    )
  )
}

# Call this function from the server with the button id that is clicked and the
# expression to run when the button is clicked
withBusyIndicatorServer <- function(buttonId, expr) {
  # UX stuff: show the "busy" message,
  # hide the other messages, disable the button
  loadingEl <- sprintf("[data-for-btn=%s] .btn-loading-indicator", buttonId)
  doneEl <- sprintf("[data-for-btn=%s] .btn-done-indicator", buttonId)
  errEl <- sprintf("[data-for-btn=%s] .btn-err", buttonId)
  shinyjs::disable(buttonId)
  shinyjs::show(selector = loadingEl)
  shinyjs::hide(selector = doneEl)
  shinyjs::hide(selector = errEl)
  on.exit({
    shinyjs::enable(buttonId)
    shinyjs::hide(selector = loadingEl)
  })

  # Try to run the code when the button is clicked and show an error message if
  # an error occurs or a success message if it completes
  tryCatch(
    {
      value <- expr
      shinyjs::show(selector = doneEl)
      shinyjs::delay(2000, shinyjs::hide(
        selector = doneEl, anim = TRUE, animType = "fade",
        time = 0.5
      ))
      value
    },
    error = function(err) {
      errorFunc(err, buttonId)
    }
  )
}

# When an error happens after a button click, show the error
errorFunc <- function(err, buttonId) {
  errEl <- sprintf("[data-for-btn=%s] .btn-err", buttonId)
  errElMsg <- sprintf("[data-for-btn=%s] .btn-err-msg", buttonId)
  errMessage <- gsub("^ddpcr: (.*)", "\\1", err$message)
  shinyjs::html(html = errMessage, selector = errElMsg)
  shinyjs::show(selector = errEl, anim = TRUE, animType = "fade")
}