CODEWITHSUNDEEP
ruser-interfacedynamicshiny
jxf
jxf

Reputation: 303

Observing events in another module

I want to create a UI module, insert it, and obtain an input object from the server module. I then want to observe events on this input object.

Currently, I return an input object as a reactive value from callModule. However, the observer I create only fires once (on initialisation).

Can anyone tell me if what I am trying to do is possible, and where I'm going wrong? Code attached. Thanks in advance.

John

app.R

library(shiny)
source("added.R")
source("addedUI.R")

# Define UI for application that draws a histogram
ui <- fluidPage(

    actionButton("add_id", "Add"),
    actionButton("print_id", "Print list"),
    tags$hr(),
    tags$div(id = "div"),
    tags$hr()
)

# Define server logic required to draw a histogram
server <- function(input, output) {

    id <- 0  
    rv <- list()

    next_id <- function()
    {
        id <<- id + 1
        return (as.character(id))
    }
    observeEvent(input$print_id,
                 {
                     print(rv)
                 })
    observeEvent(input$add_id,
    {
        x <- next_id()
        ui <- addedUI(x)
        insertUI(selector = sprintf("#%s", "div"), where = "beforeEnd", ui = ui)

        rv[[x]] <<- callModule(added, x)

        observeEvent(rv[[x]],
        {
            print(sprintf("Observed %s: ", x))
        })
        print(rv)
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

added.R

added <- function(input, output, session)
{
    return (reactive(input$text_id))
}

addedUI.R

addedUI <- function(id)
{
    ns <- NS(id)

    tags$div(textInput(ns("text_id"), "Text", value = "Abc"))
}

Upvotes: 2

Views: 806

Answers (1)

Gregor de Cillia
Gregor de Cillia

Reputation: 7695

You need to use observeEvent(rv[[x]](), ...) to read the current value from the reactive. Otherwise you recieve the reference to the reactive object, which is not observable. Same for the print_id observer.

library(shiny)
added <- function(input, output, session)
{
  return (reactive(input$text_id))
}
addedUI.R

addedUI <- function(id)
{
  ns <- NS(id)

  tags$div(textInput(ns("text_id"), "Text", value = "Abc"))
}

# Define UI for application that draws a histogram
ui <- fluidPage(

    actionButton("add_id", "Add"),
    actionButton("print_id", "Print list"),
    tags$hr(),
    tags$div(id = "div"),
    tags$hr()
)

# Define server logic required to draw a histogram
server <- function(input, output) {

    id <- 0  
    rv <- list()

    next_id <- function()
    {
        id <<- id + 1
        return (as.character(id))
    }
    observeEvent(input$print_id,
                 {
                     print(lapply(rv, function(x){x()}))
                 })
    observeEvent(input$add_id,
    {
        x <- next_id()
        ui <- addedUI(x)
        insertUI(selector = sprintf("#%s", "div"), where = "beforeEnd", ui = ui)

        rv[[x]] <<- callModule(added, x)

        observeEvent(rv[[x]](),
        {
            print(sprintf("Observed %s: ", x))
        })
        print(rv)
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

Upvotes: 2

Related Questions