I tried searching release notes or issues about this but couldn't find any...
It seems that the functions enable/disable from shinyjs are not working. I thought that the problem might be code, but show/hide are working fine. So my question is if these functions have been deprecated?
library(shiny)
library(shinyjs)
shinyApp(
ui = fluidPage(
useShinyjs(),
selectInput('in1', 'in1', choices = c('a','b'),
selected = 'a', multiple = TRUE),
dateInput('in2', label = 'in2'),
actionButton('process', 'Process'),
downloadButton('download', 'Download')
),
server = function(input, output, session) {
observeEvent( input$process, {
shinyjs::enable('download')
# shinyjs::show('download')
})
observe({
input$in1
input$in2
shinyjs::disable('download')
# shinyjs::hide('download')
})
# edit
output$download <- downloadHandler(
filename = function() {
date <- format(Sys.Date(), '%Y%m%d')
paste0(date, ' - test.csv') },
content = function(file) {
write.table(1, file)
}
)
}
)
Related
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
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.
All I am trying to do is read, render and download excel. Not sure how we can display specific UI details such as uploading excel button in dashboard sidebar and rendering and download button in dashboard body
Only error when I tried to get rid this error in mod_exampleUI module function.
Error in mod_example("example_mod") :
argument "output" is missing, with no default
Please find the code below
library(shiny)
library(magrittr) # Load magrittr for the piping operator %>%
library(DT)
library(readxl)
library(tidyselect)
library(writexl)
library(dplyr)
library(tidyr)
library(readxl)
library(stringr)
# Increase band width for shiny to handle bigger file
options(shiny.maxRequestSize=300*1024^2)
# Module UI to display sidebar content
mod_exampleUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
fileInput(ns("file1"), "Choose XLSX File (Convert xls to xlsx)",accept=c(".xlsx")),
tags$hr(),
downloadButton(ns("downloadData"), "Download")
)
}
# Module UI to display Body content
mod_example_displayUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
DT::dataTableOutput(ns("contents"))
)
}
# Function to read all excel sheet necessary
mod_example_display <- function(input, output, session) {
output$contents <- DT::renderDataTable({
DT::datatable(readxl::read_excel(input$file1$datapath)
,options = list(pageLength = 7,scrollX = TRUE))
})
output$downloadData <- downloadHandler(
filename = function() {
paste("updated file dated-", Sys.Date(), ".xlsx")
},
content = function(file) {
write_xlsx(DT::datatable(readxl::read_excel(input$file1$datapath),file))
}
)
}
ui <- fluidPage(
shinydashboard::dashboardPage(
skin = "yellow",
# HEADER -----
shinydashboard::dashboardHeader(
title = "Modularizing App"
),
# SIDEBAR -----
shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(
shinydashboard::menuItem('Example', tabName = 'example', icon = shiny::icon('file')),
shinydashboard::tabItems(
shinydashboard::tabItem("example", mod_exampleUI("example_sidemod"))
)
)
),
# BODY -----
shinydashboard::dashboardBody(
shiny::tags$head(shiny::tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")),
shinydashboard::tabItems(
shinydashboard::tabItem("example", mod_example_displayUI("example_bodymod"))
)
)
)
)
server <- function(input, output) {
shiny::callModule(mod_example_display, "mod_example")
}
shinyApp(ui,server)
Pleased to share answer so that it might helkp other shiny developers.
Although it is no elegant but mich appreciated if UI could be improved by experts.
library(shiny)
library(magrittr) # Load magrittr for the piping operator %>%
library(DT)
library(readxl)
library(tidyselect)
library(writexl)
library(dplyr)
library(tidyr)
library(readxl)
library(stringr)
# Increase band width for shiny to handle bigger file
options(shiny.maxRequestSize=30*1024^2)
# Function to read all excel sheet necessary
read_excel_allsheets <- function(filename, tibble = FALSE) {
sheets <- readxl::excel_sheets(filename)
x <- lapply(sheets, function(X) readxl::read_excel(filename, sheet = X, col_names = T, skip = 5
,col_types = "text"
))
if(!tibble) x <- lapply(x, as.data.frame)
names(x) <- sheets
x
}
# Module UI to read content
mod_readUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
fileInput(ns("file1"), h6("Choose xlsx file")
,accept=c(".xlsx"))
)
}
# Module UI to display content
mod_displayUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
DT::dataTableOutput(ns("contents"))
)
}
# Module UI to download content
mod_downloadUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
downloadButton(ns("downloadData"), "Download")
)
}
# Server functions
mod_display <- function(input, output, session, file) {
# In case want to alter the data to download
# myfile = reactive({as.data.frame(file()[,1])})
output$contents <- DT::renderDataTable({
DT::datatable(file()
,options = list(pageLength = 7,scrollX = TRUE))
})
reactive({
file()
# myfile()
})
}
mod_read <- function(input, output, session){
getData <- reactive({
req(input$file1)
inFile <- input$file1
mysheets <- read_excel_allsheets(inFile$datapath)
ppm <- mysheets$Download
ppm
})
### In ordert to send data as reactive
reactive({
getData()
})
}
mod_download <- function(input, output, session, displayData){
output$downloadData <- downloadHandler(
# browser(),
filename = function() {
paste("Updated file dated-", Sys.Date(), ".xlsx")
},
content = function(file) {
write_xlsx(displayData(),file)
}
)
}
ui <- fluidPage(
shinydashboard::dashboardPage(
skin = "yellow",
# HEADER -----
shinydashboard::dashboardHeader(
title = "Modularizing App"
),
# SIDEBAR -----
shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(id = "menu",
shinydashboard::menuItem('Example', tabName = 'example', icon = shiny::icon('file')),
conditionalPanel("input.menu == 'example'",
shinydashboard::menuSubItem(mod_readUI("sidemod")),
shinydashboard::menuSubItem(mod_downloadUI("downmod"))
)
)
),
# BODY -----
shinydashboard::dashboardBody(
shinydashboard::tabItems(
shinydashboard::tabItem("example", mod_displayUI("bodymod"))
)
)
)
)
server <- function(input, output) {
readFile <- shiny::callModule(mod_read, "sidemod")
displayFile <- shiny::callModule(mod_display, "bodymod", file = readFile)
shiny::callModule(mod_download, "downmod", displayFile)
}
shinyApp(ui,server)
I'm building a simple shiny app which will take inputs from the user and fetch data from a table in the DB and take the number of records to be downloaded as an input and provide a download file option.
Everything below works just fine. My only concern is the textInput bar( variable : uiOutput("text") in the ui and output$text in the server) appears only after the datatableOutput is displayed. I do not understand why this happens.
Ideally, I want the textInput bar ('uiOutput("text")') object to be displayed once the leaf(i.e. input$leaf1 is not null) is selected and then I want the datatableOutput to be displayed and then the Download Button should come up.
Is there a way I can achieve this? Thanks
library(shiny)
library(shinydashboard)
#library(stringr)
library(DT)
#library(shinyBS)
ui <- dashboardPage(
dashboardHeader(title = strong("DASHBOARD"),titleWidth = 240),
dashboardSidebar(
sidebarMenu(
selectizeInput("x", "Choose a number:", choices = sort(unique(lftable$x)), multiple = TRUE),
uiOutput("leaf_categ")
)
),
dashboardBody(
fluidRow(
uiOutput("text"),
dataTableOutput("lm_df"),
downloadButton('downloadData', 'Download')
)))
server <- function(input, output){
output$leaf_categ <- renderUI(
selectizeInput("leaf1", "Choose leaf categories:",
choices = reactive(unique(lftable[lftable$num %in% input$x, c("X_NAME")]))(),
multiple = TRUE)
)
#### creates a text input box
#### number of records to be downloaded is provided as input
output$text <- renderUI({
if(is.null(reactive(input$leaf1)())){
return()
}else{
textInput("var1", label = "Enter the number of records to be downloaded", value = "")
}
})
#### fetches data from DB
lm <- reactive({
if(is.null(input$leaf1)){
return()
}else{
leaf_id <- unique(lftable[lftable$X_NAME %in% input$leaf1, c("leaf_id")])
query_str <- paste('select * from table1 where current_date between start_dt and end_dt and score_num >= 0.1 and x in (' , input$x, ')', ' and X_ID in (', leaf_id, ')', ';', sep = "")
}
lm_data <- getDataFrmDW(query_str)
})
###creates a download tab
output$downloadData <- downloadHandler(
filename = function() { paste("lm_user_data", '.csv', sep='') },
content = function(file) {
lm_df <- lm()
lm_df <- lm_df[1:(as.integer(input$text)),]
print(dim(lm_df))
write.csv(lm_df, file, row.names = F)
})
output$lm_df <- DT::renderDataTable(lm())
}
shinyApp(ui, server)
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.