options(shiny.maxRequestSize = 50 * 1024 ^ 2)
library(bdchecks)
library(bdutilities)
shinyServer(function(input, output, session) {
session$onSessionEnded(function() {
stopApp()
})
# ------------- Local Data store ------------------------
data_store <-
list(
inputData = data.frame(),
darwinizedData = data.frame(),
configuredCleaning = FALSE,
customizedChecks = c(),
customizedCheck = FALSE,
flaggedData = data.frame(),
flaggingDone = FALSE,
cleanedData = data.frame(),
cleaningDone = FALSE,
questionnaire = bdclean::create_default_questionnaire(),
warningData =
data.frame(
from = c("Startup"),
message = c("bdclean Started"),
time = "Now",
icon = "rocket"
),
cleaningThresholdControl = 7
)
# ------------- End of Local Data store ------------------------
# ------------- Information Modal ------------------------
# showModal(modalDialog(
# title = h3("Welcome to bdclean!"),
# p(
# "Clean your Biodiversity data with this tool with greater control."
# ),
# p(
# "Click the tabs in the left and follow the instructions to customize cleaning."
# ),
# img(src = "bdverse.png", align = "center"),
# helpText(
# "GPL-3 ©Tomer Gueta, Vijay Barve, Thiloshon Nagarajah, Ashwin Agrawal and Carmel Yohay (2018).
# bdclean: Biodiversity Data Cleaning Workflow. R package version 0.1.900"
# ),
# helpText(
# "Contribute: ",
# a("https://github.com/bd-R/bdclean", href = "https://github.com/bd-R/bdclean"),
# " Join: ",
# a("https://bd-r-group.slack.com", href = "https://bd-r-group.slack.com")
# )
#
# ))
# ------------- End of Information Modal ------------------------
# ------------- Next Buttons Navigation Control -------------------
observeEvent(input$dataToConfigure, {
# Converting reactive element to dataframe
idata <- bdutilities::return_core(data_store$inputData)
dData <- bdutilities::return_core(data_store$darwinizedData)
if (length(dData) > 0) {
data_store$inputData <<- dData
data_store$darwinizedData <<- data.frame()
} else {
data_store$inputData <<- idata
}
output$inputDataRows <-
renderText(nrow(data_store$inputData))
output$inputDataColumns <-
renderText(length(data_store$inputData))
output$inputDataSpecies <-
renderText(length(unique(
data_store$inputData$scientificName
)))
if (nrow(data_store$inputData) > 0) {
updateTabItems(session, "sideBar", "configure")
} else {
showNotification("Please add data first!", duration = 2)
}
})
observeEvent(input$configureToFlag, {
if (length(input$typeInput) > 0) {
showNotification("Response to customized cleaning detected",
duration = 2)
dummyQuestion <-
bdclean::BdQuestion(
# bdclean::
question = "Customized Quality Checks",
possible.responses = c("Yes", "No"),
question.type = "ChildRouter",
router.condition = c("Yes"),
quality.checks = input$typeInput,
question.id = "dummy",
ui.type = "single-checkbox"
)
dummyQuestion$users.answer <- "Yes"
data_store$customizedChecks <<-
bdclean::BdQuestionContainer(c(dummyQuestion))
data_store$customizedCheck <<- TRUE
} else {
getResponse <- function(bdQuestion) {
showNotification("Response to questionnaire detected",
duration = 2)
if (bdQuestion$ui.type == "numericInput" &&
!(input[[paste(bdQuestion$question.id, "_ctrl", sep = "")]])) {
# do nothing
} else {
# set response
bdQuestion$set_response(input[[bdQuestion$question.id]])
if (bdQuestion$question.type == "Router") {
if (bdQuestion$users.answer %in% bdQuestion$router.condition) {
for (question in bdQuestion$child.questions) {
getResponse(question)
}
}
}
}
}
data_store$questionnaire$reset_responses()
for (question in data_store$questionnaire$bdquestions) {
if (question$question.type != "Child") {
getResponse(question)
}
}
}
data_store$configuredCleaning <<- TRUE
updateTabItems(session, "sideBar", "flag")
})
observeEvent(input$flagToClean, {
data_store$flaggedData <<- bdutilities::return_core(data_store$flaggedData)
data_store$flaggingDone <<- TRUE
if (!data_store$flaggingDone) {
showNotification("Please click Flag first!", duration = 2)
return()
}
withProgress(message = "Cleaning Data...", {
data_store$cleanedData <<-
bdclean::cleaning_function(data_store$flaggedData) # bdclean::
})
shinyjs::addClass(id = "flagToCleanDiv",
class = "readyButton")
shinyjs::removeClass(id = "flagToCleanDiv",
class = "completedButton")
data_store$cleaningDone <<- TRUE
})
observeEvent(input$flagToDocument, {
data_store$flaggedData <<- data_store$flaggedData()
data_store$flaggingDone <<- TRUE
updateTabItems(session, "sideBar", "document")
checks <-
ifelse(data_store$customizedCheck,
"customizedChecks",
"questionnaire")
withProgress(message = "Generating Artifacts...", {
bdclean::create_report_data(
# bdclean::
data_store$inputData,
data_store$flaggedData,
data_store$cleanedData,
data_store[[checks]],
data_store$cleaningDone,
c("md_document")
)
})
data_store$cleaningDone <- FALSE
data_store$cleanedData <- data_store$flaggedData
})
observeEvent(input$cleanToDocument, {
updateTabItems(session, "sideBar", "document")
withProgress(message = "Generating Artifacts...", {
checks <-
ifelse(data_store$customizedCheck,
"customizedChecks",
"questionnaire")
bdclean::create_report_data(
# bdclean::
data_store$inputData,
data_store$flaggedData,
data_store$cleanedData,
data_store[[checks]],
data_store$cleaningDone,
c("md_document")
)
})
})
# ------------- End of Next Buttons Navigation Control -------------------
# ------------- Add Data Module -------------------
data_store$inputData <- callModule(bdutilities.app::mod_add_data_server, "bdFileInput", "dataToDictionaryDiv")
data_store$darwinizedData <- callModule(bdutilities.app::mod_darwinize_server, "darwinize", dat = data_store$inputData)
observeEvent(input$launch_bddwc, {
path_app <- system.file("scripts", 'bddwc.R', package = "bdclean")
rstudioapi::jobRunScript(path = path_app)
})
# ------------- End of Add Data Module -------------------
# ------------- Questionnaire Module -------------------
callModule(questionnaire,
"questionnaireMod",
bdquestions = data_store$questionnaire$bdquestions)
# ------------- End of Questionnaire Module -------------------
# ------------- Quality Checks Module -------------------
callModule(customizedCheck, "customCheckMod")
# ------------- End of Quality Checks Module -------------------
# ------------- Flagging Module -------------------
data_store$flaggedData <-
callModule(Flagging, "flaggingMod", reactive({
data_store
}))
# ------------- End of Flagging Module -------------------
# ------------- Cleaning Module ------------------------
output$cleanedResultsUI <- renderUI({
conditionalPanel("input.flagToClean > 0",
tagList(
div(id = "completedIcon", img(
src = "completed.png", align = "center"
)),
p(paste("Cleaning is succesfully done.")),
div(
id = "cleanToDocumentDiv",
class = "completedButton",
actionButton("cleanToDocument", label = "Next: Manage Artifacts and Reports")
),
div(class = "progressStep", taskItem(
value = 80, color = "red",
"Step 5 of 6"
))
))
})
# ------------- End of Cleaning Module ------------------------
callModule(
bdutilities.app::mod_citation_server,
id = "bdcite",
package = "bdclean"
)
# ------------- Documentation Module ------------------------
output$documentContentUI <- renderUI({
input$flagButton
tagList(
conditionalPanel(
"input.flagToDocument > 0 || input.cleanToDocument > 0",
tagList(
tabsetPanel(
type = "tabs",
id="artifactsTab",
tabPanel(
"Input Data",
value = "option1",
div(class = "secondaryHeaders", h3("Artifact 01: Input RAW Data")),
br(),
selectInput("dataformat_input",
"Data Type",
choices = if (!("list" %in% sapply(data_store$inputData, class))) {
c(list("CSV" = "csv", "TXT" = "txt"),
list("RDS" = "rds", "RDA" = "rda"))
} else {
list("RDS" = "rds", "RDA" = "rda")
}),
downloadButton("downloadInput", "Download Input Data"),
br(),
br(),
DT::renderDataTable(summarizeDataframe(data_store$inputData), width = 300)
),
tabPanel(
"Flagged Data",
value = "option2",
div(class = "secondaryHeaders", h3(
"Artifact 02: Complete Flagged Data"
)),
br(),
selectInput("dataformat_flag",
"Data Type",
choices = if (!("list" %in% sapply(data_store$flaggedData, class))) {
c(list("CSV" = "csv", "TXT" = "txt"),
list("RDS" = "rds", "RDA" = "rda"))
} else {
list("RDS" = "rds", "RDA" = "rda")
}),
downloadButton("downloadFlagged", "Download Flagged Data"),
br(),
br(),
DT::renderDataTable(summarizeDataframe(data_store$flaggedData), width = 300)
),
tabPanel(
"Cleaned Data",
value = "option3",
div(class = "secondaryHeaders", h3("Artifact 03: Cleaned Data")),
br(),
selectInput("dataformat_clean",
"Data Type",
choices = if (!("list" %in% sapply(data_store$cleanedData, class))) {
c(list("CSV" = "csv", "TXT" = "txt"),
list("RDS" = "rds", "RDA" = "rda"))
} else {
list("RDS" = "rds", "RDA" = "rda")
}),
downloadButton("downloadCleaned", "Download Cleaned Data"),
br(),
br(),
DT::renderDataTable(summarizeDataframe(data_store$cleanedData), width = 300)
),
tabPanel(
"Cleaning Report",
value = "option4",
div(class = "secondaryHeaders", h3(
"Report 01: Short Cleaning Summary"
)),
br(),
selectInput(
"reportFormat_short",
"Report Type",
choices = list(
"PDF" = "pdf_document",
"HTML" = "html_document",
"Word" = "word_document",
"Markdown" = "md_document"
),
selected = "pdf_document"
),
downloadButton("downloadShortReport", "Download Cleaning Summary"),
br(),
includeMarkdown(paste(
tempdir(), "/generateShortReport.md", sep = ""
))
),
tabPanel(
"Detailed Quality Check Report",
value = "option5",
div(class = "secondaryHeaders", h3(
"Report 02: Detailed Quality Check Report"
)),
br(),
selectInput(
"reportFormat_detailed",
"Report Type",
choices = list(
"PDF" = "pdf_document",
"HTML" = "html_document",
"Word" = "word_document",
"Markdown" = "md_document"
),
selected = "pdf_document"
),
downloadButton("downloadDetailedReport", "Download Detailed Report"),
br(),
includeMarkdown(
paste(tempdir(), "/generateDetailedReport.md", sep = "")
)
)
),
div(
class = "progressStep",
taskItem(value = 100, color = "green",
"Step 6 of 6")
)
)
)
)
})
output$downloadShortReport <- downloadHandler(
filename = function() {
paste("shortReport-", Sys.Date(), switch(
input$reportFormat_short,
"pdf_document" = ".pdf",
"html_document" = ".html",
"word_document" = ".docx",
"md_document" = ".md"
), sep = "")
},
content = function(file) {
withProgress(message = "Preparing download...", {
checks <-
ifelse(data_store$customizedCheck,
"customizedChecks",
"questionnaire")
bdclean::create_report_data(
# bdclean::
data_store$inputData,
data_store$cleanedData,
data_store$flaggedData,
data_store[[checks]],
data_store$cleaningDone,
input$reportFormat_short
)
})
file.copy(file.path(
tempdir(),
paste("/generateShortReport", switch(
input$reportFormat_short,
"pdf_document" = ".pdf",
"html_document" = ".html",
"word_document" = ".docx",
"md_document" = ".md"
), sep = "")
),
file)
}
)
output$downloadDetailedReport <- downloadHandler(
filename = function() {
paste("detailedReport-", Sys.Date(), switch(
input$reportFormat_detailed,
"pdf_document" = ".pdf",
"html_document" = ".html",
"word_document" = ".docx",
"md_document" = ".md"
), sep = "")
},
content = function(file) {
withProgress(message = "Preparing download...", {
checks <-
ifelse(data_store$customizedCheck,
"customizedChecks",
"questionnaire")
bdclean::create_report_data(
# bdclean::
data_store$inputData,
data_store$cleanedData,
data_store$flaggedData,
data_store[[checks]],
data_store$cleaningDone,
input$reportFormat_detailed
)
})
file.copy(file.path(
tempdir(),
paste("/generateDetailedReport", switch(
input$reportFormat_detailed,
"pdf_document" = ".pdf",
"html_document" = ".html",
"word_document" = ".docx",
"md_document" = ".md"
), sep = "")
),
file)
}
)
output$downloadInput <- downloadHandler(
filename = function() {
paste("inputData-", Sys.Date(), switch(
input$dataformat_input,
"csv" = ".csv",
"txt" = ".txt",
"rds" = ".RDS",
"rda" = ".RDA"
), sep = "")
},
content = function(con) {
input_data <- data_store$inputData
switch(
input$dataformat_input,
"csv" = write.csv(data_store$inputData, con),
"txt" = write.table(data_store$inputData, con),
"rds" = saveRDS(data_store$inputData, con),
"rda" = save(input_data, file = con)
)
}
)
output$downloadFlagged <- downloadHandler(
filename = function() {
paste("flaggedData-", Sys.Date(), switch(
input$dataformat_flag,
"csv" = ".csv",
"txt" = ".txt",
"rds" = ".RDS",
"rda" = ".RDA"
), sep = "")
},
content = function(con) {
flag_data <- data_store$flaggedData
switch(
input$dataformat_flag,
"csv" = write.csv(data_store$flaggedData, con),
"txt" = write.table(data_store$flaggedData, con),
"rds" = saveRDS(data_store$flaggedData, con),
"rda" = save(flag_data, file = con)
)
}
)
output$downloadCleaned <- downloadHandler(
filename = function() {
paste("cleanedData-", Sys.Date(), switch(
input$dataformat_clean,
"csv" = ".csv",
"txt" = ".txt",
"rds" = ".RDS",
"rda" = ".RDA"
), sep = "")
},
content = function(con) {
clean_data <- data_store$cleanedData
switch(
input$dataformat_clean,
"csv" = write.csv(data_store$cleanedData, con),
"txt" = write.table(data_store$cleanedData, con),
"rds" = saveRDS(data_store$cleanedData, con),
"rda" = save(clean_data, file = con)
)
}
)
# ------------- End of Documentation Module ------------------------
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.