Hi fellow Shiny users,
I am been struggling with this bug for a day and would really appreciate your help.
Goal: To use updateSelectInput to refresh the variable selection in the drop down list.
Problem: The drop down list is empty, even though "exists("data", envir = .GlobalEnv)" indicates that "data" exists.
Below is my code. Note that "data" is a global dataset created in myFunctions.R.
rawdata:
colA <- c('1','2','3','3','2')
colB <- c('1','1','3','3','2')
colC <- c('14','12','33','33','26')
rawdata <- as.data.frame(cbind(colA,colB, colC))
ui.R:
fluidPage(
navbarPage(strong("My Structure"), id = "allResults",
tabPanel(value ='inputData', title = 'Run Structure',
sidebarLayout(
sidebarPanel(
actionButton("runButton", "Run Structure!"),
br(),
br(),
selectInput("selectvar", label = ("Select a variable"), choices = "")
),
mainPanel(
DT::dataTableOutput('structure')
)
)
),
tabPanel(value='temp',title="TEMP", verbatimTextOutput("temp"))
)
)
server.R:
source("./myFunctions.R")
library("DT")
function(input, output, session) {
# Run functions
structure_result <- eventReactive (input$runButton, {
assign('data', rawdata, envir=.GlobalEnv)
PrepareData(rawdata)
as.data.frame(head(data))
})
# Make a reactive copy of 'data' (a global dataset created in myFunctions.R)
data_copy <- reactiveValues()
observe({
if(exists("data") && is.data.frame(get("data", envir =.GlobalEnv))) {
data_copy$df <- get("data", envir = .GlobalEnv)
}
})
# Update SelectInput drop down list
observe({
req(data_copy$df)
updateSelectInput(session, "selectvar", choices = names(data_copy$df [ , 1:ncol(data_copy$df)]))
})
# Selected variable
var_dd <- reactiveValues()
observeEvent(input$selectvar, {
req(data_copy$df)
var_dd$selected <- match(input$selectvar, names(data_copy$df [ , 1:ncol(data_copy$df)]))
})
# Display structure results
output$structure <- DT::renderDataTable({
DT::datatable(structure_result(), options = list(paging = FALSE, searching = FALSE))
})
}
myFunctions.R:
PrepareData<-function(data) {
data<<-RankData(data)
}
RankData<-function(datax) {
return(datax[order(datax[,1],datax[,2]),])
}
Any help would be greatly appreciated. Thank you!
You have to source your functions inside (rather than before) the server function and use the local=TRUE option.
library("DT")
function(input, output, session) {
source("./myFunctions.R", local=TRUE)
# ...
}
Here you find more information on shiny's scoping rules: Link
Related
I am trying to make a module that accepts a data frame and produces an editable datatable out of it. This worked until I made the module able to accept multiple edits by making the following change:
editTable <- reactive({
datatable(
reactives$input,
#editable = T #PREVIOUS (working fine)
editable = list(target = "all"), #NEW (problem-causing)
rownames = F
)
})
Once the code labelled #NEW is included, clicking labelDo (in this case "Edit") causes the app to crash with this error message:
Warning: Error in split.default: first argument must be a vector
The closest problem I could find to this one is here . This user's problem is the same but mine is not solved (as theirs allegedly is) by putting rownames = FALSE into their datatable() equivalent of the snippet above.
Please go ahead and run the following module and app together and attempt to edit one of the numbers in the table. Click 'edit' and you will get the same result.
Module:
editrUI <- function(id, labelDo, labelUndo) {
ns <- NS(id)
tagList(
dataTableOutput(ns("out")),
actionButton(
inputId = ns("do"),
label = labelDo
),
actionButton(
inputId = ns("undo"),
label = labelUndo
)
)
}
editrServer <- function(id, dataFrame) {
moduleServer(
id,
function(input, output, session){
reactives <- reactiveValues()
reactives$input <- NULL
observe({
reactives$input <- dataFrame
})
editTable <- reactive({
datatable(
reactives$input,
#editable = T #old
editable = list(target = "all"), #new
rownames = F
)
})
output$out <- renderDataTable(
editTable()
)
observeEvent(input$do , {
reactives$input <<- editData(reactives$input, input$out_cell_edit, rownames = F)
})
observeEvent(input$undo , {
reactives$input <- dataFrame
})
return(reactive({reactives$input}))
}
)
}
App:
library(shiny)
source(
#source of module
)
a <- 1:5
df <- tibble(a, a*2)
ui <- fluidPage(
editrUI(id = "id", labelDo = "Edit", labelUndo = "Undo")
)
server <- function(input, output) {
editrServer(id = "id", dataFrame = df)
}
# Run the application
shinyApp(ui = ui, server = server)
It seems this error is caused when input$out_cell_edit is NULL (no cell has been edited).
You can fix it with req(input$out_cell_edit) that will cancel the event in case input$out_cell_edit is NULL.
Also you don't need to use <<- to assign to the reactiveValues.
observeEvent(input$do , {
req(input$out_cell_edit)
reactives$input <- editData(reactives$input, input$out_cell_edit, rownames = F)
})
The below code is working, but I need to enhance it by observing multiple inputs.
I need a multiple observeEvent on input$dateinput which selects the xlsx file to open and input$myfilter which checks if the user wants to apply a specific filter to the data.
but when I change
observeEvent(input$dateinput,... to:
observeEvent( c(input$dateinput, input$myfilter),{
The app crashes with Warning: Error in file: invalid 'description' argument [No stack trace available]
The code otherwise runs fine. Any help? thanks
full code : EDIT: THIS IS NOW REPRODUCIBLE AND DOES NOT REQUIRE ANY EXCEL FILE
library(shiny)
library(shinyWidgets)
library(openxlsx)
opendir <- function(dir = getwd()){
if (.Platform['OS.type'] == "windows"){
shell.exec(dir)
} else {
system(paste(Sys.getenv("R_BROWSER"), dir))
}
}
ui <- fluidPage(
sidebarPanel(
uiOutput("gpui")
),
mainPanel(
titlePanel("test app"),
br(),
checkboxInput("myfilter", label = "Filter all unnecessary (71, 46, 44) documents", value = TRUE),
br(),
tableOutput("datatable")
)
)
server <- function(input, output, session) {
rvalues <- reactiveValues()
rvalues$listfiles <- list.files(pattern=".xlsx")
observeEvent(input$refresh, {
print(input$dateinput)
session$reload()
})
observeEvent(input$openfolder, {
opendir()
})
output$gpui <- renderUI({
tagList(
actionButton("openfolder", "Open Data Folder"),
actionButton("refresh", "Refresh data folder"),
pickerInput("dateinput","Choose the date", choices=isolate(rvalues$listfiles), options = list(`actions-box` = TRUE),multiple = F)
)
})
observeEvent(input$myfilter,{
print("myfilter")
})
observeEvent( input$dateinput ,{
print(input$dateinput)
print("selecteddata")
cols <- c("Purchasing.Document", "Net.Order.Value", "Currency", "G/L.Account",
"Short.Text",
"Requisitioner", "Release.indicator", "Deletion.indicator")
seldata <- read.xlsx(input$dateinput)
print(nrow(seldata))
seldata <- seldata[,cols]
myfilter <- substr(seldata$Purchasing.Document,1,2) %in% c("71", "46", "44")
if(input$myfilter) {
rvalues$data <- seldata[myfilter,]
}
rvalues$data <- seldata
})
output$datatable <- renderTable(
rvalues$data,
striped = T,
spacing = 's'
)
}
shinyApp(ui, server)
For multiple observes in observeEvent() wrap them in curly brackets without commas, just as regular code.
Try:
shiny::observeEvent(
eventExpr = {
input$dataInput
input$myFilter
},
handlerExpr = {
# You code to run
}
)
In my experience it can be safer to wrap complex observeEvent expressions (handlerExpr) in isolate({}) to suppress any undesired reactivity.
When your observer reacts to input$myfilter, it is triggered at the startup. And input$dateinput is NULL. So you get this error:
> openxlsx::read.xlsx(NULL)
Error in file(description = xlsxFile) : argument 'description' incorrect
In the following app, I would like to add a global button, to save the tables in the 2 panels at the same time.
Ideally, they should be saved to an xlsx file, in tabs named after the corresponding tabs.
Please note that the tabs were created using a module.
Many thanks!!
library(shiny)
library(DT)
modDtUi <- function(id){ # UI module
ns = NS(id)
DT::dataTableOutput(ns('x1'))
}
modDt <- function(input, output, session, data, globalSession){ # Server module
x <- data
output$x1 <- DT::renderDataTable(x, selection = 'none', editable = TRUE)
proxy <- dataTableProxy('x1', session = globalSession)
}
ui <- fluidPage(
mainPanel(
tabsetPanel(
tabPanel("Table1", modDtUi("editable")),
tabPanel("Table2", modDtUi("editable2"))
)
)
)
server <- function(input, output, session) {
callModule(modDt,"editable", data = head(iris,10), globalSession = session)
callModule(modDt,"editable2", data = tail(iris,5), globalSession = session)
}
shinyApp(ui = ui, server = server)
I believe this demo works.
I used reactiveValues v$data to store the data inside the module. The module will return v$data so it can be retrieved when you want to save the data in the shiny server.
I also added an observeEvent to detect changes in the data, and update the data table with replaceData.
The excel file is created using the writexl library, but you could substitute with others of course.
Let me know if this works for you. I imagine there are some elements of this answer that can be improved upon - and if we can identify them, would like to edit further.
library(shiny)
library(DT)
library(writexl)
modDtUi <- function(id){ # UI module
ns = NS(id)
DT::dataTableOutput(ns(id))
}
modDt <- function(input, output, session, data, id, globalSession){ # Server module
v <- reactiveValues(data = data)
output[[id]] <- DT::renderDataTable(v$data, selection = 'none', editable = TRUE)
proxy <- dataTableProxy(id, session = globalSession)
id_input = paste(id, "cell_edit", sep = "_")
# Could add observeEvent here to detect edit event
observeEvent(input[[id_input]], {
info = input[[id_input]]
if (!is.null(info)) {
v$data[info$row, info$col] <<- DT::coerceValue(info$value, v$data[info$row, info$col])
}
replaceData(proxy, v$data, resetPaging = FALSE)
})
return(data = reactive({v$data}))
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
width = 2,
actionButton("btn", "Save Both")
),
mainPanel(
tabsetPanel(
tabPanel("Table1", modDtUi("editable1")),
tabPanel("Table2", modDtUi("editable2"))
)
)
)
)
server <- function(input, output, session) {
e1 <- callModule(modDt, "editable1", data = head(iris,10), id = "editable1", globalSession = session)
e2 <- callModule(modDt, "editable2", data = tail(iris,5), id = "editable2", globalSession = session)
observeEvent(input$btn, {
print("Saving...")
sheets <- list("e1" = e1(), "e2" = e2())
write_xlsx(sheets, "test.xlsx")
})
}
shinyApp(ui = ui, server = server)
I am trying to come up with a way to prevent a select input from resetting when the data it depends upon changes. Ideally, as more data arrives, the choices expand, silently, without visual disruption or input value resetting. I've tried using updateSelectInput, but without success. I've created an example that reasonably approximates my problem, have left in my comments and ideas to show where I tried to come up with a solution, and am hoping someone else has a better idea they can share. As always, thank you in advance. -nate
library(shiny)
if (interactive()) {
ui <- fluidPage(
titlePanel("Is It Possible To Prevent The Select Input From Resetting with New Data Arriving?"),
sidebarLayout(
sidebarPanel(
shiny::uiOutput(outputId = "streaming_select")
),
mainPanel(
tableOutput("table")
)
)
)
server<- function(input, output, session){
session_launched<- reactiveValues(count=1)
fake_global_rv_list<- reactiveValues()
fake_global_rv_list$tmp<- data.frame(glob_0001=runif(10))
session_rv_list<- reactiveValues()
session_rv_list$tmp<- data.frame(sess_0001=runif(10))
# Simulating Streaming Data every 7 seconds
shiny::observe({
shiny::invalidateLater(millis = 7000)
shiny::isolate({
shiny::showNotification(ui = "Generating Random Data", type = "default", duration = 3)
tmp<- data.frame(runif(10) )
colnames(tmp)<- paste0("stream_",format(as.numeric(Sys.time())))
session_rv_list$tmp<- cbind(session_rv_list$tmp, tmp) # Put the random data into the reactive Values list
})
})
full_dat<- shiny::reactive({ cbind(fake_global_rv_list$tmp, session_rv_list$tmp) })
# Table of 'Streaming' Data
output$table <- renderTable({
full_dat()
})
## Select Input that let's you pick a single column
output$streaming_select<- shiny::renderUI({
if(!is.null(full_dat())){
if(session_launched$count==1){
out<- shiny::selectizeInput(inputId = "streaming_select_input", label="Pick A Column", choices = unique(colnames(full_dat())), selected = NULL, multiple = TRUE)
}
}
})
## Possible Ideas (?) BELOW
# select_choices<- shiny::eventReactive(full_dat(), {
# if(!is.null(full_dat())){
# if(session_launched$count==1){
# out<- list( choices = unique(colnames(full_dat())), selected = NULL)
# #shiny::selectizeInput(inputId = "streaming_select_input", label="Pick A Column", choices = unique(colnames(full_dat())), selected = NULL, multiple = TRUE)
# session_launched$count<- 2
# return(out)
# } else if(session_launched$count > 1){
# old_selections<- input$streaming_select_input
# out<- list( choices = unique(colnames(full_dat())), selected = old_selections)
# return(out)
# #shiny::updateSelectizeInput(session, inputId = "streaming_select_input", choices = unique(colnames(full_dat())), selected = old_selections)
# }
# }
# })
# observeEvent(select_choices(), {
# cat("STR of select_choices is...", "\n")
# cat(str(select_choices()), "\n")
# })
#
# shiny::observeEvent(full_dat(), {
# if(session_launched$count != 1){
# old_selections<- input$streaming_select_input
# shiny::updateSelectizeInput(session, inputId = "streaming_select_input", choices = unique(colnames(full_dat())), selected = old_selections)
# }
# })
}
shinyApp(ui, server)
}
Below is an example that works. I create the selectizeInput in the ui part, and update it on change of the full_dat data frame using an observeEvent. I had to store and reset the selection in this update step to prevent it from being set to NULL.
library(shiny)
if (interactive()) {
ui <- fluidPage(
titlePanel("Is It Possible To Prevent The Select Input From Resetting with New Data Arriving?"),
sidebarLayout(
sidebarPanel(
shiny::selectizeInput(inputId = "streaming_select_input", label="Pick A Column",
choices = NULL,
selected = NULL,
multiple = TRUE)
),
mainPanel(
tableOutput("table")
)
)
)
server<- function(input, output, session){
session_launched<- reactiveValues(count=1)
fake_global_rv_list<- reactiveValues()
fake_global_rv_list$tmp<- data.frame(glob_0001=runif(10))
session_rv_list<- reactiveValues()
session_rv_list$tmp<- data.frame(sess_0001=runif(10))
# Simulating Streaming Data every 7 seconds
shiny::observe({
shiny::invalidateLater(millis = 7000)
shiny::isolate({
shiny::showNotification(ui = "Generating Random Data", type = "default", duration = 3)
tmp<- data.frame(runif(10) )
colnames(tmp)<- paste0("stream_",format(as.numeric(Sys.time())))
session_rv_list$tmp<- cbind(session_rv_list$tmp, tmp) # Put the random data into the reactive Values list
})
})
full_dat<- shiny::reactive({ cbind(fake_global_rv_list$tmp, session_rv_list$tmp) })
# Table of 'Streaming' Data
output$table <- renderTable({
full_dat()
})
## Select Input that let's you pick a single column
observeEvent(full_dat(), {
selectedCols <- input$streaming_select_input
updateSelectizeInput(session, "streaming_select_input", choices = colnames(full_dat()), selected = selectedCols)
})
}
shinyApp(ui, server)
}
I have a question regarding R shiny and the observ function. Is it possible to save the selected factors and the state of the work? For Example I created a programm which can choose colnames from the input data. After using bookmark and reopening the programm with the link in the browser the input data are loaded but the select factors of the colnames are reset. But I want to save the chosen colnames. Has anyone an idea? Thank you for your help!
ui <- function(request) {
fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons(
"fileType_Input",
label = h5(""),
choices = list(".csv" = 1, ".xlsx" = 2),
selected = 1,
inline = TRUE
),
fileInput('file1', '' ),
selectInput("letters", label=NULL, factors, multiple = TRUE),
bookmarkButton()
),
mainPanel(
tableOutput("contents")
)
)
)
}
server <- function(input, output,session) {
myData <- reactive({
inFile <- input$file1
# Get the upload file
if (is.null(inFile)) {
return(NULL) }
if (input$fileType_Input == "1") {
read.csv2(inFile$datapath,
header = TRUE,
stringsAsFactors = FALSE)
} else {
read_excel(inFile$datapath)
}
})
observe({
if(is.null(input$letters)){
data <- myData()
if(is.null(data)){
}else{
factors <- colnames(data)
t$choices <- input$letters # append(u$choices,input$letters2)
updateSelectInput(session, "letters",
choices = factors #[!factors2 %in% u$choices)]
)}
}
})
#Display all input Data
output$contents <- renderTable(digits = NULL,{
df <-myData()
df
})
}
enableBookmarking("server")
shinyApp(ui, server)
You can save all needed inputs in a file, and then reapply them with functions like updateRadioButtons() and others.
Saving it to the file could look like this:
observeEvent(input$someRadioButton, {
states <- list()
states$someRadioButton <- input$someRadioButton
#you can save all the needed inputs like this
...
save(states, file = paste0(getwd(), "/myfile"))
})