internals.R 2.57 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
## High level Helper functions

.import_biom <- function(input) {
  ## Select appropriate import_function
  import_function <- switch(input$biomFormat,
                            "std"   = import_biom,
                            "frogs" = import_frogs)
  ## Import
  return(import_function(input$fileBiom$datapath, ## biom file
                         input$fileTree$datapath  ## tree file
  ))
}

.import_sample_data <- function(input, physeq) {
  ## Unhappy path
  if (is.null(input$fileMeta)) {
    return(data.frame(SampleID = sample_names(physeq) , row.names = sample_names(physeq)))
  }

  ## Happy path: excel version
  if (input$CSVsep == "excel") {
Midoux Cedric's avatar
Midoux Cedric committed
22
23
24
    sdf <- as.data.frame(readxl::read_excel(input$fileMeta$datapath))
    row.names(sdf) <- sdf[, 1]
    sdf <- sdf[, -1]
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
    sdf$SampleID <- rownames(sdf)
    return(sdf)
  }

  ## Happy path: csv version
  sdf <- read.csv(
    input$fileMeta$datapath,
    header = TRUE,
    sep = input$CSVsep,
    row.names = 1,
    na.strings = NA
  )
  sdf$SampleID <- rownames(sdf)
  return(sdf)
}

.format_tax_table <- function(tdf) {
  ## explicit rank names
  colnames(tdf) <- c("Kingdom", "Phylum", "Class", "Order",
                     "Family", "Genus", "Species", "Strain")[1:ncol(tdf)]
  ## Replace unknown by NA
  tdf[grep("unknown ", tdf)] <- NA
  #tdf[grep("Unclassified", tdf)] <- NA
  return(tdf)
49
50
51
52
53
54
55
56
57
58
59
60
61
}

.import_from_rdata <- function(input) {
  ## Happy path
  ne <- new.env() ## new env to store RData content and avoid border effects
  if (!is.null(input$fileRData))
    load(input$fileRData$datapath, envir = ne)
  if (class(ne$data) == "phyloseq")
    return(ne$data)

  ## Unhappy paths: everything else
  return()
}
Midoux Cedric's avatar
Midoux Cedric committed
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86

###

checkNull <- function(x) {
  if (!exists(as.character(substitute(x)))) {
    return(NULL)
  } else if (is.null(x)) {
    return(NULL)
  } else if (length(x) > 1) {
    return(x)
  }
  else if (x %in% c(0, "", NA, "NULL")) {
    return(NULL)
  } else {
    return(x)
  }
}

beautifulTable <- function(data)  {
  DT::datatable(
    data = data,
    rownames = FALSE,
    filter = "top",
    extensions = c("Buttons", "ColReorder", "FixedColumns"),
    options = list(
Midoux Cedric's avatar
Midoux Cedric committed
87
      dom = "Btlip",
Midoux Cedric's avatar
Midoux Cedric committed
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
      pageLength = 10,
      lengthMenu = list(c(10, 25, 50, 100,-1), list('10', '25', '50', '100', 'All')),
      buttons = list(
        'colvis',
        list(
          extend = 'collection',
          buttons = c('copy', 'csv', 'excel', 'pdf'),
          text = 'Download'
        )
      ),
      colReorder = TRUE,
      scrollX = TRUE,
      fixedColumns = list(leftColumns = 1, rightColumns = 0)
    ),
    width = "auto",
    height = "auto"
  )
}