Передача реактивного значения в функцию построения графика в качестве аргумента - PullRequest
Новая
       4

Передача реактивного значения в функцию построения графика в качестве аргумента

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

Я пытаюсь передать реактивное значение, полученное из selectizeInput select1 , в функцию построения. Само реактивное значение зависит от ввода от awesomeRadio radio1 .

К сожалению, передача этого значения в функцию plot не работает, хотя она доступна renderText () , Вот пример: 

library(shiny)
library(shinydashboard)
##### plot function ------------------------ 
plot_function <- function(highlight){
  plot(1:9)
  points(x=c(1:9)[highlight],
         y=c(1:9)[highlight],
         col="red")
}

##### ui ------------------------ 
header <- dashboardHeader(
  title = "Title",
  titleWidth = 500
)
body <- dashboardBody(
  fluidRow(
    column(width = 4,
           box(title = "Plot 1",
               plotOutput("plot1", height = 300)
               ),
           box(width = NULL, status = "warning",
               awesomeRadio(inputId = "radio1",
                            label = "Radio1",
                            choices = c("Option1","Option2"),
                            inline = TRUE,
                            status="primary"
               ),br(),
               uiOutput("select1"))
    ),
    column(width = 3,
           box(width = NULL, status = "warning",
               textOutput(outputId = "option1")),
           box(width = NULL, status = "warning",
               textOutput(outputId = "option2")))
  )
)
ui = dashboardPage(
  header,
  dashboardSidebar(disable = TRUE),
  body
)

##### server ------------------------ 
server =   function(input, output) { 
  onSessionEnded(stopApp)

  choices = reactive({
    if (input$radio1=="Option1") {
      1:4
    } else if (input$radio1=="Option2") {
      5:8
    }
  })
  output$select1 <- renderUI({
    selectizeInput("select1", label="Select1",
                   choices=choices())
                   })

  tmp = reactive({input$radio1})
  tmp2 = reactive({input$select1})
  output$plot1 <- renderPlot(plot_function(highlight = tmp2()))
  output$option1 = renderText(paste(tmp()))
  output$option2 = renderText(paste(tmp2()))
}
##### ui ------------------------ 
shinyApp(ui,server)

Кроме того, я не совсем понимаю различное поведение tmp и tmp2 , с момента передачи tmp чтобы сюжетная функция работала. Спасибо за любую помощь!

1 Ответ

2 голосов
/ 14 января 2020

После нескольких изменений в вашем коде 

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
    fluidRow(
      column(width = 4,
             box(title = "Plot 1",
                 plotOutput("plot1", height = 300)
             ),
             box(width = NULL, status = "warning",
                 awesomeRadio(inputId = "radio1",
                              label = "Radio1",
                              choices = c("Option1","Option2"),
                              inline = TRUE,
                              status = "primary"
                 ),br(),
                 uiOutput("select1"))
      ),
      column(width = 3,
             box(width = NULL, status = "warning",
                 textOutput(outputId = "option1")),
             box(width = NULL, status = "warning",
                 textOutput(outputId = "option2")))
)
)

##### server ------------------------
server <- function(input, output) {
  onSessionEnded(stopApp)

  choices <- reactive({
    if (input$radio1 == "Option1") {
      1:4
    } else if (input$radio1 == "Option2") {
      5:8
    }
  })
  output$select1 <- renderUI({
    selectizeInput("sel", label = "Select1",
                   choices = choices())
  })

  output$plot1 <- renderPlot({
    plot(1:9)
    points(x = c(1:9)[as.numeric(input$sel)],
           y = c(1:9)[as.numeric(input$sel)],
           col = "red")
  })
  output$option1 <- renderText(input$radio1)
  output$option2 <- renderText(input$sel)
}

shinyApp(ui,server)
...