Могу ли я использовать сервер вывода в качестве нового параметра ввода в Shiny? - PullRequest
1 голос
/ 14 апреля 2020

Я пытаюсь использовать сервер вывода в качестве входа. Я сделал это приложение, чтобы показать, что я хочу. В этом примере пользователь введет два параметра, количество строк и столбцов. Приложение собирается построить матрицу с нормальными случайными значениями. Выходными данными является диагональ матрицы.

Могу ли я использовать эти значения диагонали как selectInput () ? Я искал информацию об этом, но мне не повезло. Спасибо.

library(shiny)
library(DT)

ui <- fluidPage(

    # Application title
    titlePanel("Test app"),

    # Sidebar with a slider input for number rows and columns 
    sidebarLayout(
        sidebarPanel(
            numericInput(inputId = "Rows", label = "Enter the rows number",
                         value = 10, min = 5),
            numericInput(inputId = "Columns", label = "Enter the columns number",
                         value = 5, min = 5)

        ),

        # Show a DT table of the diagonal of matrix
        mainPanel(
           DTOutput("dt1")
        )
    )
)

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

    my_fun <- reactive({

        datos <- round(rnorm(input$Rows*input$Columns, mean = 48, sd = 1.5), 2)
        M <- matrix(data = datos, ncol = input$Columns, nrow = input$Rows, byrow = FALSE)

        list(diag = as.data.frame(diag(M)))
    })

    output$dt1 <- renderDT({

        my_diag <- my_fun()$diag
        datatable(my_diag, rownames = FALSE
                  , caption = 'Table 1: This is a simple caption for the table.')

    })


}

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

1 Ответ

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

Конечно, updateSelectInput может использоваться для обновления выбора раскрывающегося списка / selectInput.

Вот оно в действии:

updateSelectInput(session, inputId = 'Dropdown', label = "Select a Value:", choices = my_diag)

Здесь полный код:

library(shiny)
library(DT)

ui <- fluidPage(

    # Application title
    titlePanel("Test app"),

    # Sidebar with a slider input for number rows and columns 
    sidebarLayout(
        sidebarPanel(
            numericInput(inputId = "Rows", label = "Enter the rows number",
                         value = 10, min = 5),
            numericInput(inputId = "Columns", label = "Enter the columns number",
                         value = 5, min = 5),
            selectInput(inputId = "Dropdown", "Select a Value", choices = "")


        ),

        # Show a DT table of the diagonal of matrix
        mainPanel(
            DTOutput("dt1")
        )
    )
)

# Define server logic required to build a table
server <- function(input, output, session) {

    my_fun <- reactive({

        datos <- round(rnorm(input$Rows*input$Columns, mean = 48, sd = 1.5), 2)
        M <- matrix(data = datos, ncol = input$Columns, nrow = input$Rows, byrow = FALSE)

        list(diag = as.data.frame(diag(M)))
    })

    output$dt1 <- renderDT({

        my_diag <- my_fun()$diag

        updateSelectInput(session, inputId = 'Dropdown', label = "Select a Value:", choices = my_diag)

        datatable(my_diag, rownames = FALSE
                  , caption = 'Table 1: This is a simple caption for the table.')

    })


}

# Run the application 
shinyApp(ui = ui, server = server)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...