R Shiny: renderUI + uiOutput несколько входов при условии асинхронного - PullRequest
Новая
       33

R Shiny: renderUI + uiOutput несколько входов при условии асинхронного

0 голосов
/ 19 апреля 2020

Я создаю приложение.

В настоящее время у меня есть пользовательский интерфейс, в котором пользователь может нажать кнопку, чтобы выполнить запрос из базы данных для получения данных.

После того, как данные были схватил (занимает много времени). Я создал asyn c, используя функции future и %...>% в конце захвата данных для автоматической загрузки большего количества пользовательского интерфейса, используя renderUI (который я планирую сделать динамическим c в соответствии с данными схватил)

Пока все выглядит так:

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])
    })



}

В настоящее время я возможность отрисовки одного textInput на основе условного в server (output$observation_months). В настоящее время я не могу отобразить более одного компонента (добавление output$h_months с другим %...>% не будет работать. Это потому, что способ R работает с пространством имен. Я прочитал, что могу использовать modules (то есть https://shiny.rstudio.com/articles/modules.html) чтобы можно было одновременно визуализировать несколько пользовательских интерфейсов.

У меня такое ощущение, что то, что я пытаюсь выполнить sh, на самом деле не требует отдельной server логики c вне приложения и может быть сделано без создания из него модуля.

Есть мысли? Спасибо.

1 Ответ

0 голосов
/ 19 апреля 2020

Я использовал функцию tagList, чтобы сгруппировать входы и отобразить их в renderUI

load_spec_selection1 <- функцию (id, label = "spec_selection_inputs") {</p> 

    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")

            }
        }
    })
...