How can I overwrite/re-define a reactive expression, while keeping all observers to that expression intact?
Below example is intended to make the observer listen to a button click, but only after the button has been clicked once. Before that, the observer should react to a numeric input field. (Please note that I would like the observer untouched if possible. I would like to re-define the reactive expression instead.)
library(shiny)
ui <- fluidPage(
numericInput(inputId="some_numbers",value=8,label = "Enter a number:"),
actionButton(inputId = "button1",label="Update reactive expression")
)
server <- function(input, output, session) {
my_reactive_expr <- reactive({
input$some_numbers
})
observeEvent(my_reactive_expr(),{
print("reactive value change detected!")
})
observeEvent(input$button1,{
my_reactive_expr <<- reactive({
input$button1
})
})
}
shinyApp(ui = ui, server = server)
Like written in the comments i would suggest sthg like:
my_reactive_expr <- reactive({
if(!input$button1) return(input$some_numbers)
input$button1
})
The full app would read:
library(shiny)
ui <- fluidPage(
numericInput(inputId="some_numbers",value=8,label = "Enter a number:"),
actionButton(inputId = "button1",label="Update reactive expression")
)
server <- function(input, output, session) {
my_reactive_expr <- reactive({
if(!input$button1) return(input$some_numbers)
input$button1
})
observeEvent(my_reactive_expr(),{
print("reactive value change detected!")
})
observeEvent(input$button1,{
my_reactive_expr <<- reactive({
input$button1
})
})
}
shinyApp(ui = ui, server = server)
Like that you can avoid overwriting the reactive function.
Related
I have a simple task of printing the output of a call to table() on a selected variable.
I want to display the output when the button "Print" is clicked.
In the following example, once the button is clicked, the output is always triggered when I change the selected variable.
If I clicked "Print", and then change the selected variable, I want the ouput to be gone, waited to be printed again when clicking "Print".
Thank you!
Here is a reproducible example:
library(shiny)
data = iris
ui = fluidPage(
uiOutput("selectvar"),
actionButton("print", "Print"),
verbatimTextOutput("info")
)
server = function(input, output, session)
{
output$selectvar = renderUI({
selectInput("selectedvar",
"Select variable",
choices = colnames(iris))
})
tab = reactive( table(data[[input$selectedvar]]) )
observeEvent(input$print, {
output$info = renderPrint( tab() )
})
}
shinyApp(ui, server)
That's because output$info is reactive to tab(), even while it is enclosed in an observeEvent. I think this app does what you want:
library(shiny)
data = iris
ui = fluidPage(
uiOutput("selectvar"),
actionButton("print", "Print"),
verbatimTextOutput("info")
)
server = function(input, output, session)
{
output$selectvar = renderUI({
selectInput("selectedvar",
"Select variable",
choices = colnames(iris))
})
tab <- reactiveVal()
observeEvent(input$selectedvar, {
tab(NULL)
})
observeEvent(input$print, {
tab(table(data[[input$selectedvar]]))
})
output$info <- renderPrint({
tab()
})
}
shinyApp(ui, server)
I created a matrix, and I want to input an action button to enable the user to control the view.
please use this dataset and here is the error message as after clicking "transpose" button nothing happens:
Here is the code
library(shiny)
library(DT)
ui <- basicPage(
h2("India cities"),
DT::dataTableOutput("mytable"),
actionButton("go", "Transpose"),
dataTableOutput("mytabletranspose")
)
server <- function(input, output,session)
{output$mytable = DT::renderDataTable({
indiacities
})
observeEvent(input$go, {
})
output$mytabletranspose<-renderDataTable({
t(mytable)
})
}
Unsure what is the expected output. One option is to have the transposed table show up when the button is clicked in a new data table. This is relatively straight forward.
If you want the transposed table to appear as a new data table,
library(shiny)
library(DT)
ui <- basicPage(
h2("India cities"),
DT::dataTableOutput("mytable"),
actionButton("go", "Transpose"),
dataTableOutput("mytabletranspose")
)
server <- function(input, output,session){
indiacities <- data.frame(city = c("Mumbai","Bangalore"),population = c(18,8.4),area_code = c("+91-22","+91-080"))
output$mytable <- DT::renderDataTable({
indiacities
})
output$mytabletranspose <- DT::renderDataTable({
req(input$go)
t(indiacities)
})
}
shinyApp(ui = ui,server = server)
If you want to transpose the same table we will need to edit the original table indiacities. Because observer and reactive execute functions in their own environment we need to use the global assignment operator <<-
library(shiny)
library(DT)
ui <- basicPage(
h2("India cities"),
DT::dataTableOutput("mytable"),
actionButton("go", "Transpose"),
)
server <- function(input, output,session){
indiacities <- data.frame(city = c("Mumbai","Bangalore"),population = c(18,8.4),area_code = c("+91-22","+91-080"))
data <- reactive({
if(length(input$go) == 0){
#Executed when the app is initializes
return(indiacities)
}else{
indiacities <<- t(indiacities)
}
})
output$mytable <- DT::renderDataTable({
req(data())
data()
})
}
shinyApp(ui = ui,server = server)
From the example below, I would expect the display of user input to only update every 2s (2000ms). But it's not, it's updating just as fast as when I don't include a debounce statement.
if (interactive()) {
options(device.ask.default = FALSE)
ui <- fluidPage(
textInput(inputId = "text",
label = "To see how quickly..."),
textOutput(outputId = "text")
)
server <- function(input, output, session) {
text_input <- reactive({
input$text
})
debounce(text_input, 2000)
output$text <- renderText({
text_input()
})
}
shinyApp(ui, server)
}
You have to assign the result of the debounce() call and use that in your output:
server <- function(input, output, session) {
text_input <- reactive({
input$text
})
text_d <- debounce(text_input, 2000)
output$text <- renderText({
text_d()
})
}
Small question here: I know I can access selected rows by input$dfname_rows_selected it gives back the numbers of rows selected, but how do I read the rows names, not numbers? In my case they are generated not in the order I use them later, therefore I need to get the values inside to make it work.
edit: added example
ui <- shinyUI(fluidPage(
DT::dataTableOutput("table"),
actionButton("btn", "press me")
))
server <- function(input, output) {
observeEvent(input$btn, {
print(input$table_rows_selected)
})
output$table <- DT::renderDataTable({
mtcars %>%
datatable(selection = "multiple")
})
}
shinyApp(ui = ui, server = server)
Something like this:
library(shiny)
library(DT)
ui <- basicPage(
mainPanel(DT::dataTableOutput('mytable')),
textOutput("selected")
)
server <- function(input, output,session) {
mydata <- reactive({mtcars})
output$mytable = DT::renderDataTable(
datatable(mydata())
)
selectedRow <- eventReactive(input$mytable_rows_selected,{
row.names(mtcars)[c(input$mytable_rows_selected)]
})
output$selected <- renderText({
selectedRow()
})
}
runApp(list(ui = ui, server = server))
I don't think you can. What you could do is write a reactive, where all modifications to your dataframe take place, before creating the datatable. An example:
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
DT::dataTableOutput("table"),
textOutput("selectedcar")
)
)
server <- function(input, output,session) {
# the reactive where we filter/sort/modify the data
reactive_df <- reactive({
mtcars[order(mtcars$cyl),]
})
# This datatable uses the reactive directly, so no more modifications
output$table <- DT::renderDataTable({
DT::datatable(reactive_df())
})
# now we can get the row/rowname as follows:
output$selectedcar <- renderText({
paste0(rownames(reactive_df())[input$table_rows_selected], collapse = ", ")
})
}
shinyApp(ui, server)
Hope this helps!
I'm developing an app in which I use modules to display different tab's ui content. However it seems like the module does not communicate with the main (or parent) app. It displays the proper ui but is not able to execute the observeEvent function when an actionButton is clicked, it should update the current tab and display the second one.
In my code I have created a namespace function and wrapped the actionButton's id in ns(), however it still does not work. Does anyone knows what's wrong?
library(shiny)
moduleUI <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session){
observeEvent(input$action1, {
updateTabItems(session, "tabsPanel", "two")
})
}
ui <- fluidPage(
navlistPanel(id = "tabsPanel",
tabPanel("one",moduleUI("first")),
tabPanel("two",moduleUI("second"))
))
server <- function(input, output, session){
callModule(module,"first")
callModule(module,"second")
}
shinyApp(ui = ui, server = server)
The observeEvent works, but since modules only see and know the variables given to them as input parameters, it does not know the tabsetPanel specified and thus cannot update it. This problem can be solved using a reactive Value, which is passed as parameter and which is changed inside the module. Once it's changed, it is known to the main app and can update the tabsetPanel:
library(shiny)
library(shinydashboard)
moduleUI <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session, tabsPanel, openTab){
observeEvent(input$action1, {
if(tabsPanel() == "one"){ # input$tabsPanel == "one"
openTab("two")
}else{ # input$tabsPanel == "two"
openTab("one")
}
})
return(openTab)
}
ui <- fluidPage(
h2("Currently open Tab:"),
verbatimTextOutput("opentab"),
navlistPanel(id = "tabsPanel",
tabPanel("one", moduleUI("first")),
tabPanel("two", moduleUI("second"))
))
server <- function(input, output, session){
openTab <- reactiveVal()
observe({ openTab(input$tabsPanel) }) # always write the currently open tab into openTab()
# print the currently open tab
output$opentab <- renderPrint({
openTab()
})
openTab <- callModule(module,"first", reactive({ input$tabsPanel }), openTab)
openTab <- callModule(module,"second", reactive({ input$tabsPanel }), openTab)
observeEvent(openTab(), {
updateTabItems(session, "tabsPanel", openTab())
})
}
shinyApp(ui = ui, server = server)