shinyFunBioDiv/R/utils.R at main · FunBioDiv/shinyFunBioDiv · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
# length unique --------------------------------
#' number of unique elements
#'
#' @export
length_unique <- function(x) {
  #remove empty string
  x <- x[!is.na(x)]
  x <- x[x != ""]
  x <- x[x != "NA_NA"]
  x <- firstup(x)
  length(unique(x[!is.na(x)]))
}


# concat ---------------------------------------
#' concatenate unique list of characters
#'
#' @export
concat <- function(x, sep = ", ") {
  #remove empty string
  x <- x[!is.na(x)]
  x <- x[x != ""]
  x <- firstup(x)
  paste(sort(unique(x)), collapse = sep)
}


# minmax ---------------------------------------
#' concatenate minimum and maximum
#'
#' @export
minmax <- function(x, na.rm = TRUE) {
  if (all(!is.na(x)) | any(!is.na(x)) & na.rm) {
    if (min(x, na.rm = na.rm) < max(x, na.rm = na.rm)) {
      out <- paste(min(x, na.rm = na.rm), max(x, na.rm = na.rm), sep = " - ")
    } else {
      out <- min(x, na.rm = na.rm)
    }
  } else {
    out <- NA
  }
  return(out)
}

# firstup ---------------------------------------
#' Capitalize characters
#'
#' @export
firstup <- function(x) {
  x <- tolower(x)
  substr(x, 1, 1) <- toupper(substr(x, 1, 1))
  return(x)
}

# runShiny ---------------------------------------
#' Run shiny app made using cuspra package functions
#'
#' @export
runShiny <- function() {
  appDir <- here::here("app")
  # system.file("app", package = "cuspra")
  if (appDir == "") {
    stop(
      "Could not find example directory. Try re-installing `cuspra`.",
      call. = FALSE
    )
  }
  shiny::runApp(appDir, display.mode = "normal")
}