I would like to add a checkbox (input$autorefresh) in my shiny application to control where my data input is auto updated (=reactive()) at every change, or whether it is only updated when a button (=input$refresh) is pushed. The idea is described in the following code, which I however didn't expect to work. I could use reactive() together with a conditional isolate(), but since I have many inputs, that is not very elegant. Any ideas?
if (input$autorefresh==TRUE){
dataInput <- reactive({
dosomething
})
} else {
dataInput <- eventReactive(input$refresh,{
dosomething
})
}
Are you looking for something like this?
library(shiny)
ui <- fluidPage(
checkboxInput("autorefresh","autorefresh", F),
actionButton("refresh","refresh"),
mainPanel(plotOutput("plot"))
)
autoInvalidate <- reactiveTimer(1000)
server <- function(input, output, session) {
data <- reactive({
input$refresh
data <- plot(rnorm(100),type="l",col="red")
if(input$autorefresh){
autoInvalidate()
return(data)
}
return(data)
})
output$plot <- renderPlot({
data()
})
}
runApp(shinyApp(ui = ui, server = server))
Related
I'm learning Shiny modules. And I'm stuck in a very silly thing: I don't know how to call an input inside moduleServer. In this reprex, the table does not show, I think its because the getInput argument is not properly used in the server. Here's a reprex:
library(shiny)
library(DT)
tablaResumen <- function(id, getInput, tabla1, tabla2) {
moduleServer(id, function(input, output, session) {
output$table <- renderDT({
if(getInput == FALSE){
tabla <- tabla1
}else{
tabla <- tabla2
}
DT::datatable(tabla, escape = FALSE, rownames = FALSE)
})
})
}
ui <- fluidPage(
checkboxInput("input1", label = "Change table"),
DTOutput("table1")
)
server <- function(input, output, session) {
tablaResumen("table1", input$input1, mtcars, iris)
}
shinyApp(ui, server)
library(shiny)
library(DT)
tablaResumen <- function(id, parent_in, get, tabla1, tabla2) {
moduleServer(id, function(input, output, session) {
output$mytable <- renderDT({
if(parent_in[[get]] == FALSE){
tabla <- tabla1
}else{
tabla <- tabla2
}
DT::datatable(tabla, escape = FALSE, rownames = FALSE)
})
})
}
tablaResumenUI <- function(id) {
ns <- NS(id)
DTOutput(ns("mytable"))
}
ui <- fluidPage(
checkboxInput("input1", label = "Change table"),
tablaResumenUI("table")
)
server <- function(input, output, session) {
tablaResumen("table", parent_in = input, "input1", mtcars, iris)
}
shinyApp(ui, server)
Things are a little tricky here.
To render the table, you must put the DTOutput under the same namespace as your mod server. The way we usually do it is by creating a mod UI function and use NS to wrap the id to create the namespace.
You module is depend on a reactive input value input$input1, but the server function itself is not reactive. This means if you provide it as an argument for the mod function, it will be run only one time, so getInput will never be changed after the app is initialized. It becomes a fixed value. To get the reactive value of input1, you need to provide the parent input as an argument as access from there.
I am trying to create a dashboard in rShiny which follow the following steps
Select a parameter
Filter data from a source table for this parameter
Create a list of this filtered data for one of the column
Iterate over this list to display graphs etc...
I have tried various options for making this work but the communication between ui and server is not happening as expected
I have created a setup as below fot testing
library(shiny)
df_mtcars <- mtcars
df_mtcars <- cbind(CarName = rownames(df_mtcars), df_mtcars)
df_mtcars$CarName <- sub(" ", "_", df_mtcars$CarName)
select the number of gears
Find the cars with that number of gears
Create a list of these cars
Display the data for each of the car by using loop. Loop is needed as other output types like graphs can be latter added
simpUI <- function(id) {
tagList(tableOutput(NS(id, "dat_output"))
numericInput(NS(id, "GearNumber"), "Gear Numbers", 3),
lapply(seq(1, length(v_lst_CarName), by = 1), function(i) {
v_CarName = v_lst_CarName[i]
v_obj_CarName = paste0('sp_cars_', v_CarName)
tableOutput(NS(id, v_obj_CarName))
}))
}
simpServer <- function(id) {
moduleServer(id, function(input, output, session) {
output$dat_output <- renderTable(df_mtcars)
v_lst_CarName <-
reactive(df_mtcars[GearNumber == input$GearNumber]$CarName)
for (v_CarName in v_lst_CarName)
v_obj_CarName = paste0('sp_cars_', v_CarName)
output$v_obj_CarName <- renderTable(v_obj_CarName)
})
}
ui <- fluidPage(fluidRow(simpUI("cars")))
server <- function(input, output, session) {
simpServer("cars")
}
shinyApp(ui = ui, server = server)
It is better to do server side processing. Try this
library(shiny)
library(ggplot2)
df_mtcars <- mtcars
df_mtcars <- cbind(CarName = rownames(df_mtcars), df_mtcars)
df_mtcars$CarName <- sub(" ", "_", df_mtcars$CarName)
simpUI <- function(id) {
ns <- NS(id)
tagList(tableOutput(ns("dat_output")),
numericInput(ns("GearNumber"), "Gear Numbers", 3),
uiOutput(ns("plotxy")),
tableOutput(ns("v_obj_CarName")),
verbatimTextOutput(ns("mylist")),
plotOutput(ns("myplot"))
)
}
simpServer <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$dat_output <- renderTable(head(df_mtcars))
mydf <- reactive(df_mtcars[df_mtcars$gear == input$GearNumber,])
v_lst_CarName <- eventReactive(mydf(), {paste0("sp_cars_",mydf()$CarName)})
output$plotxy <- renderUI({
req(mydf())
tagList(
selectInput(ns("xvar"), label = "X-axis variable", choices = names(mydf()), selected=names(mydf())[2] ),
selectInput(ns("yvar"), label = "Y-axis variable", choices = names(mydf()), selected=names(mydf())[5] )
)
})
output$v_obj_CarName <- renderTable({mydf()})
output$mylist <- renderPrint(list(v_lst_CarName() ))
output$myplot <- renderPlot({
req(input$xvar,input$yvar)
ggplot(mydf(),aes(x=.data[[input$xvar]], y=.data[[input$yvar]])) + geom_point()
})
})
}
ui <- fluidPage(fluidRow(simpUI("cars")))
server <- function(input, output, session) {
simpServer("cars")
}
shinyApp(ui = ui, server = server)
I want to use a reactive expression that can be updated in either of two ways. Below is a very simple example with either numeric input or a reset button to set the expression back to its original state (in practice the expression is more complex, so can't use reactive values). It seems that only the second definition of num is recognised, so in the example the numeric input is ignored).
What am I missing?
Many thanks!
ui <- fluidPage(
numericInput("number", "Input", 1),
actionButton("button", "Reset"),
textOutput("check")
)
server <- function(input, output){
num <- reactive({
input$number
})
num <- eventReactive(input$button, {
1
})
output$check <- renderText({
num()
})
}
shinyApp(ui, server)
Edit:
We can use observeEvent() with each input to update num().
library(shiny)
ui <- fluidPage(
numericInput("number", "Input", 1),
actionButton("button", "Reset"),
textOutput("check")
)
server <- function(input, output) {
num <- reactiveVal()
observeEvent(input$number, {
num(input$number)
})
observeEvent(input$button, {
num(1)
})
observeEvent(c(input$button, input$number), {
output$check <- renderText({
num()
})
})
}
shinyApp(ui, server)
I would like to use a user defined function in Shiny to perform a simple calculation with output two variables. The function I wrote works when it is not part of a shiny app. However when part of a Shiny, the returned object (dfr) is ‘not in scope’. What am I missing?
library(shiny)
# Function ----------------------------------------------------------------
convert <- function(coef_1, coef_2, vec) {
part_1 <- coef_1/(2*sin((vec/2)*pi/180))
part_2 <- 2*(180/pi)*(asin(coef_2/(2*part_1)))
dfr <- data.frame(part_1, part_2)
return(dfr)
}
# End Function ------------------------------------------------------------
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput("num", h3("Enter number to convert:"), value = NULL)
),
mainPanel(
verbatimTextOutput("text1", placeholder = TRUE),
verbatimTextOutput("text2", placeholder = TRUE)
)
)
)
server <- function(input, output) {
nums_str <- as.character(input$num)
nums_vector <- as.numeric(unlist(strsplit(nums_str, split = ",")))
convert(1.5, 1.1, nums_vector)
output$text1 <- renderText({
req(input$num)
dfr$part_1
})
output$text2 <- renderText({
req(input$num)
dfr$part_2
})
}
shinyApp(ui = ui, server = server)
When you use inputs, you need to do it in reactive environment, such as reactive(), renderDataTable(), etc.
Here, you need to run your function in a reactive() and then call it with dfr() in the outputs.
server <- function(input, output) {
dfr <- reactive({
convert(1.5, 1.1, as.numeric(input$num))
})
output$text1 <- renderText({
req(input$num)
dfr()$part_1
})
output$text2 <- renderText({
req(input$num)
dfr()$part_2
})
}
Since this is quite basic stuff with R Shiny, checking some tutorials might be very useful.
I am working with global variables that update after time X. This issue I am coming across is it updates the global variable but the current session doesn't update accordingly, however, any new session open uses the updated global variable.
Question: how do I get the current session to use the updated global variable? I thought wrapping it in a reactive would work but it doesn't.
Code:
library(shiny)
library(shinydashboard)
####/GLOBAL/####
num <- 4
####/UI/####
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
verbatimTextOutput("test")
)
ui <- dashboardPage(header, sidebar, body)
####/SERVER/####
server <- function(input, output, session) {
data <- reactive({num})
output$test <- renderText({ data() })
observe({
invalidateLater(0.5*60*1000,session)
num <<- sample(1:1000,1,replace=T)
})
}
shinyApp(ui, server)
If you wait 30+ seconds and then open up a new session you will see that the number has changed from 4 but the original session still shows 4. They should be showing the same number.
Solved! Realized I needed to wrap it in a reactiveValues versus reactive. I also made the updating a value a dataframe versus a single number because that fits my real dashboard's problem.
library(shiny)
library(shinydashboard)
####/GLOBAL/####
dataset <- data.frame(ColA = c("dogs", "cats", "birds"), ColB = c(10, 2, 2), stringsAsFactors = FALSE)
####/UI/####
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
box(width = 3, tableOutput("test"))
)
ui <- dashboardPage(header, sidebar, body)
####/SERVER/####
server <- function(input, output, session) {
values <- reactiveValues(n = dataset)
data <- reactive({values$n})
output$test <- renderTable({ data() })
observe({
invalidateLater(0.5*60*1000,session)
new1 <- sample(1:10,1,replace=T)
new2 <- sample(1:10,1,replace=T)
new3 <- sample(1:10,1,replace=T)
print(new1)
print(new2)
print(new3)
dat <- data.frame(ColA = c("dogs", "cats", "birds"), ColB = c(new1, new2, new3), stringsAsFactors = FALSE)
values$n <- dat
dataset <<- dat
})
}
shinyApp(ui, server)