# Module UI
#' @title mod_import_ui and mod_import_server
#' @description Import dataset and show basic overview
#'
#' @param id shiny id
#' @param input internal
#' @param output internal
#' @param session internal
#'
#' @rdname mod_import
#'
#' @keywords internal
#' @export
#' @importFrom shiny NS tagList
#' @import shinyjs
#' @import dplyr
#' @import forcats
#' @import DBI
#' @import RSQLite
#' @import vroom
mod_import_ui <- function(id){
ns <- NS(id)
tagList(
fluidPage(
navlistPanel(
'',
id = 'import_menu',
well=FALSE,
widths=c(3,9),
# fluidRow(
# verbatimTextOutput(ns('check'))),
tabPanel(
'Upload Data Set',
value = 'upload_data_tab',
fluidRow(
br(), br(),
h1('Upload Data Set'),
column(
width=5,
# Use sample dataset?
shinyWidgets::materialSwitch(
ns("example"), "Example dataset",
inline = TRUE, value = FALSE, status = 'success'),
br(),
conditionalPanel(
condition = paste0("input['", ns('example'), "'] == false"),
# Upload sqlite database file
fileInput(ns("db_file"), "Database file"),
fileInput(ns("metadata_file"), "Metadata file",
accept = c('.csv','.tsv'))),
br(),
# Launch data
withBusyIndicatorUI(
actionButton(ns('launch'), 'Launch Dataset', class = "btn-primary")
)
),
column(
width=7,
p("Importing the 16S rRNA gene sequences and associated data tables is the first step in the analysis. This is done be uploading the database file produced by the OCMS 16S analysis pipeline. If your data has not been processed through this pipeline, a helper tool is available to help you format your data accordingly (see below for details).", br(),
"Once your data is uploaded, you can preview your data in the tabs in the left panel. The app will validate your data set to ensure the metadata uploaded matches with the database uploaded. Please ensure the validation process has been complete before continuing with the analysis.", br(),
h2('Additional Resources'),
"The database file produced from the OCMS pipeline is a sqlite relational database framework. You can access the data tables in the database by using GUI sqlite tools such as",
a('SQLite Browser', href = 'https://sqlitebrowser.org'), ".",
br(),
"If your data has not been processed through the OCMS pipeline, you can format data tables into a sqlite database file using the create_db() function. See ", code("?OCMSlooksy::create_db()"), "for details.",
br(),
"You can find a tutorial on how to use this app on the",
a("OCMS blog", href = "https://oxfordcms.github.io/OCMS-blog/")
), # end p
hr(style="border-top: 1px solid #000000;")
) # end column 7
), # end fluidRow
fluidRow(
div(style="font-weight: bold",
textOutput(ns('import_status')) %>%
shinycssloaders::withSpinner()
) # end div
) # end fluidRow
), # end tabPanel
# Preview of metadata-------------------------------------------------
tabPanel(
'Preview metadata',
value = 'metadata_menu_tab',
fluidRow(
br(), br(),
h1('Preview Metadata'),
DT::dataTableOutput(ns('metadata_preview')) %>%
shinycssloaders::withSpinner()
)
),
# Preview of read count-----------------------------------------------
tabPanel(
'Preview counts',
value = 'asv_menu_tab',
fluidRow(
br(), br(),
h1('Preview Sequence Counts'),
DT::dataTableOutput(ns('asv_preview')) %>%
shinycssloaders::withSpinner()
),
),
tabPanel(
'Preview Taxonomy',
value = 'tax_menu_tab',
fluidRow(
br(), br(),
h1('Preview of taxonomy'),
DT::dataTableOutput(ns('tax_preview')) %>%
shinycssloaders::withSpinner()
)
)
) # end navlistPanel
) # end fluidPage
) # end taglist
}
# Module Server-----------------------------------------------------------------
#' @rdname mod_import
#' @export
#' @keywords internal
mod_import_server <- function(input, output, session, parent_session) {
ns <- session$ns
# activate launch button once uploaded or if using example data
observe({
toggleState('launch', condition = (input$example == TRUE ||
(!is.null(input$metadata_file) | !is.null(input$db_file$datapath))))
})
observe({
toggle(condition = import_status() == 'Data validation successful',
selector="#import_menu li a[data-value=metadata_menu_tab]")
toggle(condition = import_status() == 'Data validation successful',
selector="#import_menu li a[data-value=asv_menu_tab]")
toggle(condition = import_status() == 'Data validation successful',
selector="#import_menu li a[data-value=tax_menu_tab]")
})
data_set <- eventReactive(input$launch, {
withBusyIndicatorServer("launch", 'import_ui_1',{
Sys.sleep(1)
# read in database file--------------------------------------------------
if(input$example == FALSE) {
req(input$db_file, input$metadata_file)
# initialize list of dataframes
data_ls <- list()
# read in metadata
metadata <- reactive({
req(input$metadata_file)
ext <- tools::file_ext(input$metadata_file$name)
out <- switch(ext,
csv = vroom::vroom(input$metadata_file$datapath, delim = ","),
tsv = vroom::vroom(input$metadata_file$datapath, delim = "\t"),
validate("Invalid file; Please upload a .csv or .tsv file"))
# check for spaces or special characters
check_char <- any(grepl("[^[:alnum:]_]", colnames(out)))
if(check_char) {
# remove all spaces and special characters
new_colname <- gsub("[^[:alnum:]_]", "_", colnames(out))
colnames(out) <- new_colname
}
out
})
data_ls[['metadata']] <- metadata()
# read in database
con <- RSQLite::dbConnect(RSQLite::SQLite(), input$db_file$datapath)
# extract data tables
table_ls <- RSQLite::dbListTables(con)
for(i in 1:length(table_ls)) {
query <- sprintf("SELECT * FROM %s", table_ls[i])
entry <- RSQLite::dbGetQuery(con, query)
data_ls[[table_ls[i]]] <- entry
}
# close connection
RSQLite::dbDisconnect(con)
}
# Use example dataset-----------------------------------------------------
else {
switch(input$example, {data_ls <- OCMSlooksy::example_data})
}
# roll down taxonomy for unclassified taxa--------------------------------
tax_df <- data_ls$merged_taxonomy %>%
mutate_all(as.character)
tax_level <- c('Kingdom','Phylum','Class','Order','Family','Genus',
'Species')
# work with one column at a time -- not checking Kingdom level
for(i in 2:length(tax_level)) {
# find row with na in current tax_level
na_ind <- which(is.na(tax_df[tax_level[i]]))
if(length(na_ind) != 0) {
# look at column before
curr <- tax_df[, c(tax_level[i-1], tax_level[i])]
# make updated tax_df labels
curr <- curr %>%
mutate(updated = ifelse(
is.na(.data[[tax_level[i]]]), # if current taxon is NA
# prefix with prev level
paste(.data[[tax_level[i-1]]], 'unclassified',sep = '_'),
.data[[tax_level[i]]])) # else keep as current taxaon
# update entire row tax_df table
tax_df[na_ind, tax_level[i:length(tax_level)]] <- curr$updated[na_ind]
}
}
data_ls$merged_taxonomy <- tax_df
data_ls
})
})
# validate dataset------------------------------------------------------------
table_ls <- c('merged_abundance_id', 'merged_taxonomy', 'metadata',
'merged_filter_summary','merged_qc_summary', 'parameter_table')
metaID <- reactive(sort(as.character(data_set()$metadata$sampleID)))
dbID <- reactive({
sort(as.character(colnames(data_set()[['merged_abundance_id']])[colnames(data_set()[['merged_abundance_id']]) != 'featureID']))
})
msg <- reactive({
# check sample IDs match
ref <- unique(c(metaID(), dbID()))
checkID <- data.frame(refID = ref, metadataID = ref %in% metaID(),
databaseID = ref %in% dbID())
only_in_db <- as.character(checkID$refID[checkID$metadataID == FALSE])
only_in_met <- as.character(checkID$refID[checkID$databaseID == FALSE])
msg <- ''
if(length(only_in_met) > 0) {
entry <- sprintf("'%s' only found in metadata file.",
paste(only_in_met, collapse = "', '"))
msg <- paste(msg, entry, collapse='')
}
if(length(only_in_db) > 0) {
entry <- sprintf("'%s' only found in database file.",
paste(only_in_db, collapse = "', '"))
msg <- paste(msg, entry, collapse='')
}
msg
})
import_status <- reactiveVal("No data imported")
observeEvent(input$launch,{
if(!any(table_ls %in% names(data_set()))) {
import_status("database file missing necessary table(s).")
} else if(!"sampleID" %in% colnames(data_set()$metadata)) {
# metadata must have sampleID as a identifier
import_status("Metadata must include 'sampleID'.")
} else if(any(duplicated(data_set()$metadata$sampleID))) {
# sampleID must be unique
import_status("Sample identifiers (sampleID) must be unique.")
} else if(!identical(metaID(), dbID())) {
# sampleID matches merge_abundance_id samples exactly
import_status(sprintf("Uh oh! sampleID in metadata do not match samples in uploaded database.\n%s", msg()))
} else if(any(grepl("^[0-9]", colnames(data_set()$metadata)))) {
import_status("Column names in metadata cannot begin with a number")
}
else if(class(data_set()) == 'list') {
import_status("Data validation successful")
}
})
output$import_status <- renderText({
import_status()
})
# # Check
# output$check <- renderPrint({
#
# })
# Launch dataset-------------------------------------------------------------
asv <- eventReactive(input$launch, {
data_set()$merged_abundance_id
})
met <- eventReactive(input$launch, {
data_set()$metadata
})
tax <- eventReactive(input$launch, {
data_set()$merged_taxonomy
})
# combine tables into working dataframes--------------------------------------
# reduce loading times downstream
asv_gather <- eventReactive(input$launch, {
asv() %>%
gather('sampleID','read_count', -featureID)
})
asv_tax <- eventReactive(input$launch, {
asv_gather() %>%
inner_join(tax(), by = 'featureID') %>%
select(-sequence) %>%
mutate(read_count = as.numeric(read_count)) %>%
ungroup()
})
asv_met <- eventReactive(input$launch, {
asv_gather() %>%
inner_join(met(), by = 'sampleID')
})
work <- eventReactive(input$launch, {
asv_tax() %>% inner_join(met(), by = 'sampleID')
})
# Summary of metadata-------------------------------------------------------
output$metadata_preview <- DT::renderDT({
DT::datatable(met(), extensions = 'Buttons',
rownames = FALSE,
options = list(scrollX = TRUE,
dom = 'Blfrtip', buttons = c('copy','csv')))
})
# preview of count table----------------------------------------------------
output$asv_preview <- DT::renderDT({
DT::datatable(asv(), extensions = list(c('Buttons', 'FixedColumns')),
rownames = FALSE,
options = list(
pageLength = 30,
scrollX = TRUE,
dom = 'Blfrtip',
buttons = c('copy','csv'),
fixedColumns=list(leftColumns = 2)
))
})
output$tax_preview <- DT::renderDT({
DT::datatable(tax() %>% relocate(sequence, .after=last_col()),
extensions = 'Buttons',
rownames = FALSE,
options = list(
pageLength = 30,
scrollX = TRUE,
dom = 'Blfrtip',
buttons = c('copy','csv')))
})
# output$check <- renderPrint({
# cross_module$import_status
# })
# jump to next tab------------------------------------------------------------
# observeEvent(input$next_tab, {
# updateTabsetPanel(session, "tabs", selected = "prepare")
# })
# return dataset
cross_module = reactiveValues()
observe({
cross_module$data_db <- data_set()
# adding long data formats to data list to be passed along in modules
cross_module$asv_gather <- asv_gather()
cross_module$asv_tax <- asv_tax()
cross_module$asv_met <- asv_met()
cross_module$work <- work()
cross_module$import_status <- import_status()
})
return(cross_module)
}
## To be copied in the UI
# mod_import_ui("import_ui_1")
## To be copied in the server
# callModule(mod_import_server, "import_ui_1")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.