R Shiny: renderUI + uiOutput multiple inputs upon condition asynchronously

Question

I am creating an app.

Currently I have a UI in which the user can press a button to execute a query from a database to get data.

After the data has been grabbed (takes a long time). I have created a async using the future and %...>% functions at the end of the grabbing data to automatically load more ui using renderUI (which I plan on it to be dynamic according to the data grabbed)

It looks like this so far:

ui.R:

navbarPage("R",
           tabPanel("Summary",
                    sidebarLayout(
                        sidebarPanel(
                            selectInput( inputId = "dataset",
                                         label = "Choose dataset",
                                         choices = c("A")
                            ),

                            dateRangeInput( inputId = "date_range",
                                            start = "2007-01-01",
                                            end = "2009-01-01",
                                            format = "yyyy-mm-dd",
                                            label = "Observation Start and End Date",
                                            startview = "decade",
                                            autoclose = TRUE
                            ),


                            actionButton("update_data", "Load Data"),

                            uiOutput("observation_months"),

                            uiOutput("h_months")

                        ),

                        mainPanel(

                          verbatimTextOutput("summary"),

                          tableOutput("sample_view")

                        )
                    )
                    )




           )

server.R:

server <- function(input, output, session) {


    data <- eventReactive(  eventExpr = input$update_data, {

        mon = mongo(collection = "data", db = "test", url = "mongodb://uid:pw@localhost:27017")

        future({

            dat_dump <- mon$find( query = paste0(paste0(paste0(paste0('{"date": { "$gte" : { "$date" : "', strftime( input$date_range[1] , "%Y-%m-%dT%H:%M:%S%z")), '\" }, "$lt" : {"$date" : "'), strftime( input$date_range[2] , "%Y-%m-%dT%H:%M:%S%z")), '\"} }}'))




            dat_dump <- dat_dump[, -which(colnames(dat_dump) == "e_id")] %>%
                mutate( date = as.Date(date, format = "%Y-%m-%d")) %>%
                `row.names<-`(., NULL) %>%
                column_to_rownames(var = "date")

            dat_dump_log <- as.data.frame(sapply(dat_dump, function(x) diff(log(as.numeric(x)))))

            row_names_df <- tail(rownames(dat_dump), -1)

            row.names(dat_dump_log) <- row_names_df

            df_log <<- dat_dump_log

            total_num_of_codes <<- ncol(dat_dump_log)
            total_num_of_obs_df <<- nrow(dat_dump_log)






        }) %...>%

        beep()
    })   

    output$observation_months <- renderUI({

        data() %...>% {
            num <- total_num_of_obs_df
            if (is.null(num)) {

                return(NULL)

            } else if( !is.null(num)){

                textInput( inputId = "observation_months_input",
                           label = "Observation Months (in mo.)",
                           value = 12
                )



            }
        }
    })


    output$summary <- renderPrint({
        summary(data()[1000])
    })



}

Currently, I am able to render one textInput based on a conditional in the server (output$observation_months). Currently I am not able to render more than one component (adding output$h_months with another %...>% won't work. It is because the way R works with namespace. I read that I can use modules (i.e. https://shiny.rstudio.com/articles/modules.html) to be able to render multiple uis at the same time.

I have a feeling that what I am trying to accomplish doesnt really require a separate server logic outside of the app and could be done without making a module out of it.

Any thoughts? Thanks.

charlie090 charlie090 · Accepted Answer · 2020-04-19T15:09:35

I used the tagList function to group the inputs and render it into the renderUI

load_spec_selection1 <- function(id, label = "spec_selection_inputs") {

    ns <- NS(id)

    tagList(

        textInput( inputId = ns("o_months"),
                   label = "Months (in mo.)",
                   value = 12
        ),

        textInput( inputId = ns("h_months"),
                   label = "Months (in mo.)",
                   value = 6
        )

    )

}

output$specs_inputs <- renderUI({

        data() %...>% {
            num <- total_num_of_obs_df
            if (is.null(num)) {

                return(NULL)

            } else if( !is.null(num)){

                load_spec_selection1("specs_input")

            }
        }
    })

R Shiny: renderUI + uiOutput multiple inputs upon condition asynchronously

1 Answers