How to combine multiple R modules (with submodels and uiOuput) using shinydashboard? - r

I'm modularizing a Shiny app I developed using shinydashboard packages. Despite it traditionally works when I use it without involving modules, I can't make it work when I try to divide it into modules and submodules. Here I would like to combine two UIs (one for the sidebar, one for the body) in order to upload a dataset from the sidebar and show it into the body.
I'd be very glad if anybody could provide me some help with this.
Here is the code of the general Shiny app:
library(shiny)
library(excelR)
library(vroom)
library(readxl)
library(janitor)
library(dplyr)
library(shinydashboard)
library(shinydashboardPlus)
# # load separate module and function scripts
source("modules.R")
# app_ui
app_ui <- function() {
tagList(
shinydashboardPlus::dashboardPagePlus(
header = shinydashboardPlus::dashboardHeaderPlus(title = "module_test",
enable_rightsidebar = FALSE),
sidebar = shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(id = "tabs",
import_sidebar_ui("import"))
),
body = shinydashboard::dashboardBody(shinydashboard::tabItems(
import_body_ui("import"))
),
rightsidebar = NULL,
title = "Module App"
)
)
}
# app_server
app_server <- function(input, output, session) {
shiny::moduleServer(id = "import", module = import_server)
}
####################################################################
run_app <- function(...) {
shiny::shinyApp(
ui = app_ui,
server = app_server)
}
#---------------------------------
run_app()
and here is the modules.R file I wrote containing the UIs for sidebar and body, plus the server:
# Import module ####
#
# Import sidebar UI
import_sidebar_ui <- function(id) {
ns <- NS(id)
shinydashboard::menuItem("Module Testing",
tabName = "tab_testing_mod",
icon = icon("th"),
tagList(
selectInput(ns("input_type"),
"Type of file:",
choices = c("Choose one" = "",".csv" = "csv",
".txt" = "txt", ".xls/.xlsx" = "xlsx"),
selected = NULL),
uiOutput(ns("inputControls")),
fileInput(ns("file"), "Data", buttonLabel = "Upload..."),
checkboxInput(ns("rownames"), "Check if 1st column contains rownames"),
checkboxInput(ns("constant"), "Remove constant columns?"),
checkboxInput(ns("empty"), "Remove empty cols?"),
actionButton(ns("bttn_import"), "Import data")
)
)
}
# Import body UI
import_body_ui <- function(id) {
ns <- NS(id)
shinydashboard::tabItem(tabName = "tab_testing_mod",
fluidRow(
h3("Imported Data"),
excelR::excelOutput(ns("preview")))
)
}
# Import server
import_server <- function(input, output, session) {
ns <- session$ns
output$inputControls <- renderUI({
tagList(
switch(input$input_type,
"csv" = textInput("delim", "Delimiter (leave blank to guess)", ""),
"txt" = textInput("delim", "Delimiter (leave blank to guess)", "")
),
switch(input$input_type,
"xlsx" = numericInput("sheet", "Sheet number", value = 1))
)
})
raw <- reactive({
req(input$file)
if (input$input_type == "csv" || input$input_type == "txt") {
delim <- if (input$delim == "") NULL else input$delim
data <- vroom::vroom(input$file$datapath, delim = delim)
} else if (input$input_type == "xlsx") {
data <- tibble::as.tibble(readxl::read_excel(input$file$datapath, sheet = input$sheet, col_names = TRUE))
} else {
return(NULL)
}
raw <- data
raw
})
tidied <- eventReactive(input$bttn_import,{
out <- raw()
if (input$empty) {
out <- janitor::remove_empty(out, "cols")
}
if (input$constant) {
out <- janitor::remove_constant(out)
}
if (input$rownames) {
out <- tibble::column_to_rownames(out, var = colnames(out[1]))
}
out <- out %>% dplyr::mutate_if(is.character,as.factor)
out
})
output$preview <- excelR::renderExcel({
excelR::excelTable(data = raw(),
colHeaders = toupper(colnames(raw())),
fullscreen = FALSE,
columnDrag = TRUE,
rowDrag = TRUE,
wordWrap = FALSE,
search =TRUE,
showToolbar = TRUE,
minDimensions = c(ncol(raw()),10)
)
})
}
It seems to me I can upload the dataset (.csv, .txt or .xlsx) files but I can't show it into the body.
I'd be very glad if you can help me, thank you very much in advance for your assistance.

Related

How to have sequential Modal dialogs in Shiny

I need a shiny app to do the following:
The user clicks a button
N pop-ups appear to the user asking for input
Then the user downloads the information displayed in the app with a download button
I've been able to achieve points 1 & 2, however I haven't been able to get to 3 because of the fact that the user inputs are reactive values. Here is a sample of code that almost works:
library(shiny)
library(shinyalert)
test <- c("C", "D", "F")
NUM_MODALS <- length(test)
ui <- fluidPage(
shinyalert::useShinyalert(),
actionButton("show", "Show modal dialog"),
lapply(seq(NUM_MODALS), function(id) {
div(id, ":", textOutput(paste0("modal", id), inline = TRUE))
}),
downloadButton("downloadData", "Download")
)
server <- function(input, output) {
observeEvent(input$show, {
for(id in 1:NUM_MODALS){
shinyalert::shinyalert(
type = "input",
text = paste("¿Cuál es la industria de la siguiente empresa?:", test[id]),
inputPlaceholder = "Cuidado con mayúsculas/minúsculas",
inputId = paste0("modal", id)
)
}
})
lapply(seq(NUM_MODALS), function(id) {
output[[paste0("modal", id)]] <- renderText({paste(test[id],input[[paste0("modal", id)]])})
})
export <- reactive(c(input$modal1, input$modal2, input$modal3))
export2 <- isolate(export)
print(export2)
#browser()
output$downloadData <- downloadHandler(
filename = function() {
paste('data-', Sys.Date(), '.csv', sep='')
},
content = function(filesillo) {
fs <- c()
tmpdir <- tempdir()
setwd(tempdir())
path <- paste("prueba.txt", sep = "")
fs <- c(fs, path)
write.csv(export2, filesillo)
}
)
}
shinyApp(ui = ui, server = server)
Instead of the inputs being assigned as a reactive, you can assign to reactiveValues in an observe.
export <- reactiveValues(
dat = NULL
)
observe({
export$dat <- dplyr::bind_rows(
modal1 = input$modal1,
modal2 = input$modal2,
modal3 = input$modal3
)
})
# export <- reactive(c(input$modal1, input$modal2, input$modal3))
# export2 <- isolate(export)
# print(export2)
#browser()
Then in your downloadHandler
#write.csv(export2, filesillo)
write.csv(export$dat, filesillo)
This will output a csv with modal inputs as columns

R shiny module with save button

I am setting up a module, with the purpose of having two data tables in the same app, in different tabs.
I would like to be able to edit and save each table separately.
In my code, only the first "save" button works, and it saves both data tables.
Ideally, each save button should work and save only the corresponding table.
Important: I use the modified version of DTedit:
devtools::install_github('DavidPatShuiFong/DTedit#2.2.1')
Here is my problematic code:
library(shiny)
library(DTedit)
myModuleUI <- function(id,nam) {
ns <- shiny::NS(id)
shiny::tagList(
br(),
##### needs corrections!!
tabsetPanel(tabPanel("XXX", dteditmodUI(ns(nam)),actionButton(ns("reset"), "Reset to Saved", styleclass = "warning"), actionButton(ns("saveBtn"), label = "save"), br(),
id=ns('tabset'), type = 'tabs')
)
)
####
}
myModule <- function(input, output, session,df,nam,taby,wb) {
dfr=reactiveVal()
dfr(df)
Grocery_List_Results <- shiny::callModule(
dteditmod,
id = nam,
thedata =dfr)
# ### save part
savd = data.frame(isolate(dfr()))
observeEvent(input$saveBtn, {
print("Q")
## Add worksheets
st = paste(taby,as.character(unclass(Sys.time())),sep="_")
addWorksheet(wb, st)
writeData(x = Grocery_List_Results$thedata,
wb = wb,
sheet = st)
saveWorkbook(wb, "wb.xlsx", overwrite = T)
savd <<- Grocery_List_Results$thedata
shinyalert(title = "Saved!", type = "success")
})
observeEvent(input$reset, {
dfr(savd)
print(dfr)
shinyalert(title = "Reset to saved data!", type = "info")
})
}
########
ui <- fluidPage(
h3('Grocery List'),
myModuleUI('myModule1',nam="groc"),br(),
myModuleUI('myModule1',nam="groc2")
)
server <- function(input, output, session) {
df= data.frame(
Buy = c('Tea', 'Biscuits', 'Apples',"Tea","Apples"),
Quantity = c(7, 2, 5,9,44),
stringsAsFactors = FALSE
)
file = "AICs.xlsx"
wb <- loadWorkbook(file)
shiny::callModule(myModule, 'myModule1',nam="groc",df=df,taby="Tea",wb)
shiny::callModule(myModule, 'myModule1',nam="groc2",df=df,taby="Apples",wb)
}
shinyApp(ui = ui, server = server)
Appreciate your time!
At long last,
and thanks to this thread,
it seems that I managed to solve this:
library( "openxlsx" )
library("shiny" )
library(shinyalert)
library(shinysky)
library(DTedit) ## used the modified version from https://github.com/DavidPatShuiFong/DTedit
#installed with devtools::install_github('DavidPatShuiFong/DTedit#2.2.1')
results_2_UI <- function(id,nam) {
useShinyalert()
ns <- NS(id)
tabPanel(
title = "Export1",
dteditmodUI(ns(nam)),
actionButton(ns("reset"), "Reset to Saved", styleclass = "warning"), actionButton(ns("saveBtn"), label = "save")
)
}
results_3_UI <- function(id,nam) {
useShinyalert()
ns <- NS(id)
tabPanel(
title = "Export2",
dteditmodUI(ns(nam)),
actionButton(ns("reset"), "Reset to Saved", styleclass = "warning"), actionButton(ns("saveBtn"), label = "save")
)
}
results <- function(input, output, session,df,nam,taby,wb) {
## do some complicated data transformations
dfr=reactiveVal()
dfr(df)
Grocery_List_Results <- shiny::callModule(
dteditmod,
id = nam,
thedata =dfr)
# ### save part
savd = data.frame(isolate(dfr()))
observeEvent(input$saveBtn, {
print("Q")
## Add worksheets
st = paste(taby,as.character(unclass(Sys.time())),sep="_")
addWorksheet(wb, st)
writeData(x = Grocery_List_Results$thedata,
wb = wb,
sheet = st)
saveWorkbook(wb, "wb.xlsx", overwrite = T)
savd <<- Grocery_List_Results$thedata
shinyalert :: shinyalert(title = "Saved!", type = "success")
})
observeEvent(input$reset, {
dfr(savd)
print(dfr)
shinyalert::shinyalert(title = "Reset to saved data!", type = "info")
})
}
### module end
ui <- fluidPage(
tabsetPanel(
id = "tabs",
# results_1_UI(id = "test1"),
results_2_UI(id = "test2",nam="groc"),
results_3_UI(id = "test3",nam="groc2")
)
)
server <- function(input, output, session) {
df= data.frame(
Buy = c('Tea', 'Biscuits', 'Apples',"Tea","Apples"),
Quantity = c(7, 2, 5,9,44),
stringsAsFactors = FALSE
)
file = "AICs.xlsx"
wb <- loadWorkbook(file)
callModule(
module = results,
id = "test2",
nam="groc",df=df,taby="groc",wb=wb
)
callModule(
module = results,
id = "test3",
nam="groc2",df=df,taby="groc2",wb=wb
)
}
shinyApp(ui = ui, server = server)
Fingers crossed, it is OK!

Downloading Reactive Dataframe/datatable issue

I'm new to R but I was given the task to create a working download button that would download the data within the queried table, to a .csv file. Currently, I'm having trouble understanding what I should pass on to my write.csv() function. I know I have to make the queried table reactive but I'm also unsure how to do that. The error I'm getting with my current code is "
cannot coerce class ‘c("datatables", "htmlwidget")’ to a data.frame"
I've tried passing my df() function as an argument but it doesn't work.
#ui
column(3,
conditionalPanel("input.table.period != '1980'",
# only prompt for rcp if a future period (not historical)
# input: select rcp
selectInput("table.rcp", "Emissions Scenario:",
c("Medium" = "45",
"High" = "85")),
downloadButton('downloadData', 'Download')
)
#server
server <- function(input, output) {
currentdf <- reactive({
# build query based on user-selections
if (input$table.stype == "ann") {
col.name <- columns.annual[grep(input$table.var, columns.annual)]
if (input$table.period == "1980") {
query <- paste0("SELECT ", col.name, ", subbasin, gcm_id FROM hydro_ann WHERE (period = ", input$table.period,
")")
} else {
query <- paste0("SELECT ", col.name, ", subbasin, gcm_id FROM hydro_ann WHERE (period = ", input$table.period,
") AND (rcp = ", input$table.rcp, ")")
}
} else {
col.name <- columns.month[grep(input$table.var, columns.month)]
if (input$table.period == "1980") {
query <- paste0("SELECT ", col.name, ", subbasin, gcm_id, calendar_month FROM hydro_month WHERE (period = ", input$table.period,
")")
} else {
query <- paste0("SELECT ", col.name, ", subbasin, gcm_id, calendar_month FROM hydro_month WHERE (period = ", input$table.period,
") AND (rcp = ", input$table.rcp, ")")
}
}
df <- dbGetQuery(db, query)
DT::df
})
output$querytable <- renderTable({ DT::datatable(currentdf()) })
output$downloadData <- downloadHandler(
filename = function() {
paste("QueriedData", "csv", sep = ".")
},
content = function(file) {
write.csv(as.data.frame(currentdf()),file)
}
I have tried a solution width Iris dataset which can give you option to select datatype you want to save before downloading data as per option you selected...
library(shiny)
library(shinydashboard)
library(DT)
library(datasets)
library(xlsx)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(
DTOutput("dtable")
)
)
)
)
server <- function(input, output) {
myModal <- function() {
div(id = "Download_DATA",
modalDialog(downloadButton("download1","Download iris as CSV"),
br(),
br(),
downloadButton("download2","Download iris as XLSX"),
easyClose = TRUE, title = "Download Table")
)
}
output$dtable <- renderDT(
datatable(iris,
extensions = 'Buttons',
options = list(
dom = 'Bfrtip',
buttons = list(
list(
extend = "collection",
text = 'Download',
action = DT::JS("function ( e, dt, node, config ) {
Shiny.setInputValue('Download_DATA', true, {priority: 'event'});
}")
)
)
)
)
)
observeEvent(input$Download_DATA, {
showModal(myModal())
})
output$download1 <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(iris, file)
}
)
output$download2 <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".xlsx", sep="")
},
content = function(file) {
write.xlsx(iris, file)
}
)
}
shinyApp(ui, server)
Please let me know....

Dynamically adding column names in R Shiny

Quite New to R here and not an experienced coder. I want to create a simple function to upload an external file via R shiny, but the file will not have fixed number of columns and may or may not have a column name.
In the case where the raw file does not have a header, I wish to force the name of the first column to be "Date" and the remaining columns 2,3,4...,n to be "Investment 1","Investment 2","Investment 3",...,"Investment n-1" respectively
Here's my current code, server side,
server <- function(input, output) {
rawdata <- reactive({
file_to_read = input$file
if(is.null(file_to_read)) {
return()
}
data <- read.table(file_to_read$datapath, sep = input$sep, header =
input$dataheader)
})
addcolumn <- reactive({
if(input$dataheader = FALSE) {
paste("Date",colnames(rawdata()[,1]))
for (i in 2:ncol(rawdata())) {
paste("Investment " + i, colnames(rawdata()[,i]))
}
}
})
output$datatable <- renderTable({
If(input$dataheader = FALSE) {
addcolumn(rawdata())
} else {
rawdata()
}
})
and ui side,
dashboardBody(
tabItems(
tabItem(
tabName = "import",
fluidRow(
box(
title = "Instructions",
solidHeader = TRUE,
width = 12,
status = "warning",
height = 120,
textOutput("instructionsImport")
),
box(
solidHeader = FALSE,
width = 3,
status = "primary",
fileInput("file","Choose a file to upload"),
radioButtons("sep","Separator",choices = c(Comma = ",", Space = " ",Period = ".", Tilde = "~", minus = "-")),
checkboxInput("dataheader","File has header?")
),
box(
title = "Uploaded Data",
solidHeader = TRUE,
width = 9,
status = "primary",
tableOutput("datatable")
)
)
),
Ideally, I would like the operation of adding column name to be done once after import and the resulting data table created instead of making a reactive function for adding column.
Thanks
Just change your server.R code to that :
server <- function(input, output) {
rawdata <- reactive({
file_to_read = input$file
if(is.null(file_to_read)) {
return()
}
data <- read.table(file_to_read$datapath, sep = input$sep, header =
input$dataheader)
if(!input$dataheader){
colnames(data)<-c("Date",paste("Investment",1:(ncol(data)-1)))
}
return(data)
})
output$datatable <- renderTable({
rawdata()
})
}

How to update UI on file change

Hello I'm building a shinydashboard using several excel files.
I inserted links to these files in the footer of the box and I want to refresh the shinydashboard when changing something in my excel file.
I don't want to run the whole R code each time.
How can I re-render the Output once the file content changes?
Here an example:
sidebar <- dashboardSidebar(
sidebarMenu( menuItem("Hello", tabName = "Hello", icon = icon("dashboard"))
))
body <- dashboardBody(
tabItems(
tabItem(tabName = "Hello",
box(title = "my file",
footer = a("df.xlsx", href="df.xlsx" ) ,
DT::dataTableOutput("df1"),style = "font-size: 100%; overflow: auto;",
width = 12, hight = NULL, solidHeader = TRUE, collapsible = TRUE, collapsed = TRUE, status = "primary")
)))
ui <- dashboardPage(
dashboardHeader(title = "My Dashboard"),
sidebar,
body)
server <- function(input, output) {
output$df1 <- renderDataTable({
df <- read_excel("df.xlsx")
DT::datatable(df, escape = FALSE, rownames=FALSE,class = "cell-border",
options =list(bSort = FALSE, paging = FALSE, info = FALSE)
)
})
}
shinyApp(ui, server)
To monitor the change in a file you could use the cheksum of the file like this:
library(shiny)
library(digest)
# Create data to read
write.csv(file="~/iris.csv",iris)
shinyApp(ui=shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel(
textInput("path","Enter path: "),
actionButton("readFile","Read File"),
tags$hr()
),
mainPanel(
tableOutput('contents')
)))
),
server = shinyServer(function(input,output,session){
file <- reactiveValues(path=NULL,md5=NULL,rendered=FALSE)
# Read file once button is pressed
observeEvent(input$readFile,{
if ( !file.exists(input$path) ){
print("No such file")
return(NULL)
}
tryCatch({
read.csv(input$path)
file$path <- input$path
file$md5 <- digest(file$path,algo="md5",file=TRUE)
file$rendered <- FALSE
},
error = function(e) print(paste0('Error: ',e)) )
})
observe({
invalidateLater(1000,session)
print('check')
if (is.null(file$path)) return(NULL)
f <- read.csv(file$path)
# Calculate ckeksum
md5 <- digest(file$path,algo="md5",file=TRUE)
# If no change in cheksum, do nothing
if (file$md5 == md5 && file$rendered == TRUE) return(NULL)
output$contents <- renderTable({
print('render')
file$rendered <- TRUE
f
})
})
}))
If I understand the question correctly, I'd say you need the reactiveFileReader function.
Description from the function's reference page:
Given a file path and read function, returns a reactive data source
for the contents of the file.
The file reader will poll the file for changes, and once a change is detected the UI gets updated reactively.
Using the gallery example as a guide, I updated the server function in your example to the following:
server <- function(input, output) {
fileReaderData <- reactiveFileReader(500,filePath="df.xlsx", readFunc=read_excel)
output$df1 <- renderDataTable({
DT::datatable(fileReaderData(), escape = FALSE, rownames=FALSE,class = "cell-border",
options =list(bSort = FALSE, paging = FALSE, info = FALSE)
)
})
}
With that, any changes I saved to 'df.xlsx' were propagated almost instantly to the UI.

Resources