To reproduce :
library(shiny)
library(DT)
testdf<-c("car1",sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1))
testdf<-rbind(testdf,c("car2",sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1)))
testdf<-data.frame(testdf)
shinyApp(
ui = fluidPage(
tabPanel("tab1",dataTableOutput("datatable")),
actionButton("CheckFile", "Refresh data")
),
server = function(input, output, session) {
X = testdf
output$datatable = renderDataTable(
{X},selection = list(mode = 'single',target = 'cell')
)
observeEvent(input$CheckFile, {
tryCatch(eval(testdf[nrow(testdf)+1,]<-c(sample(row.names(mtcars),1),sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1))))
#same with evaluate function
#evaluate(testdf[nrow(testdf)+1,]<-c(sample(row.names(mtcars),1),sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1)))
removeModal()
showModal(modalDialog(
title="Refresh done",
footer=NULL,
easyClose=T
))
})
}
)
My app is rendering a table. I want to give the user the possibility to update this dataset with an actionButton(). It then calls an other R file that update this dataset with source(). However, this script may contain some errors and stops before the end. So I chose to handle errors with tryCatch() and eval(). The problem is that these two functions inside my shiny app avoid the update of the dataset.
I made this reproducible example to illustrate the problem.
When I'm only running this line the dataset is updated:
tryCatch(eval(testdf[nrow(testdf)+1,]<-c(sample(row.names(mtcars),1),sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1))))
But in the app, it is not the case.
Any idea?
Thanks in advance.
Related
In the below example code, the function testFunction() is defined in the separate source file functionsLibrary.R saved on the desktop. This example code works as intended.
How would I modify the code to first test if testFunction() is an object in the R workspace, and source it (running the line source("C:/Users/laran/OneDrive/Desktop/functionsLibrary.R")) only if the function is not in the workspace?
In the full code this is intended for, the function takes a very long time to run (reading a large data file into memory) and I only want it sourced if it is not currently a workspace object.
Example code:
library(shiny)
source("C:/Users/laran/OneDrive/Desktop/functionsLibrary.R")
ui <- fluidPage(
br(),
numericInput('selectValue','Select number of values to square:',value=1,step=1,min=1),
br(),
tableOutput('table')
)
server <- function(input,output,session)({
output$table <- renderTable(testFunction(input$selectValue))
})
shinyApp(ui, server)
Source file contents (filename functionsLibrary.R):
testFunction <- function(a) {
b <- data.frame(Value=seq(1:a),Square_Value = seq(1:a)^2)
return(b)
}
An easy way to go about this would be to use exist(). This should work for your problem.
library(shiny)
if (!exists("testFunction")) {
source("C:/Users/laran/OneDrive/Desktop/functionsLibrary.R")
}
ui <- fluidPage(
br(),
numericInput('selectValue','Select number of values to square:',value=1,step=1,min=1),
br(),
tableOutput('table')
)
server <- function(input,output,session)({
output$table <- renderTable(testFunction(input$selectValue))
})
shinyApp(ui, server)
We could extend the if clause to check if testFunction is really a function in case it exists and if not source the file.
if (!exists("testFunction") || (exists("testFunction") && !is.function(testFunction)))
I have a Shiny app that should calculate a value, present it and then use the same value for further more expensive computation. The problem is that it shows me the output only after it finishes evaluating the whole script. Here is a simple example:
library(shiny)
ui <- fluidPage(
titlePanel("test"),
sidebarLayout(
sidebarPanel(
textInput("text_in","Enter text here",value = "This is text to process"),
actionButton("go", "Go")
),
mainPanel(
textOutput("first_text"),
textOutput("results")
)
)
)
# Define server logic
server <- function(input, output) {
num_letter<-eventReactive(input$go, {
nchar(input$text_in)})
output$first_text <- renderText(num_letter())
sec_calculation<-eventReactive(num_letter(), {
Sys.sleep(3)
num_letter()*num_letter()})
output$first_text <- renderText(num_letter())
output$results <- renderText(sec_calculation())
}
# Run the application
shinyApp(ui = ui, server = server)
I added the Sys.sleep so it will be easier to see the problem. I would like to get the first output without waiting for the second one.
This is not currently possible (at least not with native shiny code - you can always hack a workaround). An open issue for this exists on the shiny github repository: https://github.com/rstudio/shiny/issues/1705
I am having a lot of trouble getting a search filtering module working.
I am to run stats on a large database of cat owner information.
I want my search module to bring up a list of possible owners(that the user can select from) based on a selection from a list of cat breeds.
I thought wrapping the updateSelectInput with observe and using a reactive cat owner expression would facilitate this, in the module, but it is not working( and I can't guess why this is happening or how to debug this). It worked in these other posts([1]:R shiny passing reactive to selectInput choices , [2]:using values from a reactive input to directly input into a custom function)
Why won't my selectInput update with cat owners?
library(shiny)
df=data.frame(
cat=c("tabby","DSH","MSH","LSH","DSH","MSH","LSH","sphinx"),
owner=c("Foo","Bar","Bash","Foo","Foo","Foo","Bar","Bash"),stringsAsFactors = F)
refinedSearch<-function(input, output, session){
ownsCat<-reactive({df[df$cat%in%input$cat,"owner"]})
observe({updateSelectInput(session, "ownerSelected",
label ="Owned By",choices = ownsCat())})
return()
}
refinedSearchUI<-function(id){
ns <- NS(id)
fluidRow(
column(4,selectInput(ns("cat"),"Cat",selectize = T,
choices =c("tabby","DSH","MSH","LSH","sphinx") )),
column(4,selectInput(ns("ownerSelected"),"Owned By","",selectize = T))
)
}
ui <- fluidPage(
h1("Find cats owners"),
fluidRow(column(10,offset=1, refinedSearchUI("tmp"))),
fluidRow(column(10,offset=1, actionButton("addFilter","Add a Filter",
icon = icon("plus"))))
)
server <- function(input, output,session) {
refinedSearch(input,output,session)
observeEvent(input$add, {insertUI(selector = "#addFilter",where = "beforeBegin",
ui = refinedSearch(input,output,session))})
}
shinyApp(ui = ui, server = server)
Thank y'all for you time.
There seems to be quite a bit of confusion on how to call modules. You need to use the callModule() function in the server. Also, when inserting UI (using the insertUI()function), you need to call the refinedSearchUI() function, not the refinedSearch() function (which, again, should always be called through callModule(), so it should never actually get called directly like that).
I'd recommend a re-reading of the modules article.
You also have a typo. The event in your observeEvent() function should be input$addFilter, not input$add (which doesn't exist, so that observer is never fired..)
If you change your server function to this, your app will work as expected:
server <- function(input, output,session) {
callModule(refinedSearch, "tmp")
observeEvent(input$addFilter, {
id <- paste0("filter_", input$add)
insertUI(selector = "#addFilter",where = "beforeBegin",
ui = refinedSearchUI(id))
callModule(refinedSearch, id)
})
}
I am wondering what the best practice is for handling a dynamic number of datatables. Here is a toy example:
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
mainPanel(
sliderInput("number","Number of tables",1,10,1,1),
uiOutput("tables")
)))
server <- shinyServer(function(input, output, session) {
observe({
lapply(seq_len(input$number), function(i) {
output[[paste0("table",i)]] <- DT::renderDataTable(head(mtcars))
})
})
output$tables <- renderUI({
lapply(seq_len(input$number), function(i) {
DT::dataTableOutput(paste0("table",i))
})
})
})
# Run the application
shinyApp(ui = ui, server = server)
This approach is sort of a blunt tool, because you have to rerender all the datatables, whenever a single datatable is added or removed.
Is there a better approach to dynamically generating output that doesn't require creating all the output in a loop, and therefore recreating all the output each time there is a change?
I'm the author of insertUI and removeUI. It seems like you found a bug in insertUI when applied to interactive outputs. I filed an issue for this in the Shiny repo and will try to get to it soon. In the meantime, a workaround is to use where = "beforeBegin" instead of where = "beforeEnd" in the call to insertUI(). See my answer to the original issue filed in the DT repo for more details.
[Edit] Answer has been updated with the workaround from #Bárbara Borges (see her answer for details on why it works)
Here is an example, but note that it is working for normal tables (no refresh), but for datatables, there is no refresh when removing tables but always refreshing when adding tables. I think this is something caused by DT but haven't found the real cause yet. I am posting in the hope that someone can improve this.
library(shiny)
library(DT)
numUI <- 0
ui <- shinyUI(fluidPage(
mainPanel(
sliderInput("number","Number of tables",1,10,1,1),
tags$div(id="tables")
)))
server <- shinyServer(function(input, output, session) {
observe({
if (input$number > numUI) {
for (num in (numUI+1):input$number) {
insertUI("#tables", "beforeBegin", DT::dataTableOutput(paste0("table", num)))
output[[paste0("table",num)]] <- DT::renderDataTable(head(mtcars), server = FALSE)
}
}
if (input$number < numUI) {
for (num in (input$number+1):numUI) {
removeUI(paste0("#table", num))
}
}
numUI <<- input$number
})
})
# Run the application
shinyApp(ui = ui, server = server)
I have created an application using R and Shiny and want to output everything that happens in the console to a special status window in the Shiny app.
Here is how the skeleton of the function called by Shiny application looks.
myfunction = function(x,y,path....){
if(...){...}
cat("Reading Database\n")
df = read.csv(...)
cat("Processing\n")
#MORE CODE
}
I want a status bar that shows the progress of the called function by viewing the cat(...) console outputs.
If yes, can it be done without making any changes to the original function (making changes only in server.R and/or ui.R)?
Unfortunately I don't know how to do this with the normal Shiny approach of using reactivity. I tried getting it to work with textOuput+printText but I was unable. I'd love to see other solutions, but here is my solution that uses shinyjs package to update the element instead of using reactivity. I hope this works for you, it's pretty simple.
library(shiny)
library(shinyjs)
calculate <- function() {
lapply(1:5, function(x) {
message(x)
Sys.sleep(0.5)
})
message("Done")
}
runApp(shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(), br(),
actionButton("btn","Click me"), br(), br(),
"Progress:",
tags$pre(id = "progress")
),
server = function(input,output, session) {
observeEvent(input$btn, {
withCallingHandlers({
shinyjs::text("progress", "")
calculate()
},
message = function(m) {
shinyjs::text(id = "progress", text = m$message, add = TRUE)
})
})
}
))