Как условно изменить цвет фона Shiny wellPanel () в зависимости от selectInput ()?

Question

Я создал воспроизводимый код, чтобы выделить проблему, с которой я столкнулся. Я знаю, что для изменения цвета фона wellPanel() я использую, например, wellPanel(...,style = "background: green").

Однако я хочу sh изменить цвет фона wellPanel() в зависимости от компании, которая выбрана (selectInput()) из опций компаний в моем фрейме данных. Итак, я вызвал wellPanel(...,style=textOutput("colour_panel")) в пользовательском интерфейсе, а затем определил output$colour_panel на сервере, значение которого зависит от выбранной компании.

Почему не меняется цвет фона?

library(shiny)
library(dplyr)

name <- c("Company1","Company2","Company3")
price <- c("400","200","150")

my_data <- data.frame(name,price)

ui <- fluidPage(
  h1("Shiny Template"),
  sidebarLayout(
    sidebarPanel(
      selectInput("company", "Choose a Company:", choices = c(Choose="",levels(as.factor(my_data$name))))
    ),
    mainPanel(
      fluidRow(
        column(4,
               wellPanel(
                 textOutput("price"),
                 style=textOutput("colour_panel")
               ))
      )
    )
  )
)

server <- function(input, output) {

  filtered_data <-  reactive ({
    data <- my_data %>% 
      filter(name==input$company)
    data
  })

  output$colour_panel <- renderText({
    ifelse(input$company=='',
           paste0("background: grey"),
           ifelse(
             input$company=="Company1" | input$company=="Company2",
             paste0("background: green"), 
             paste0("background: red")))
  })

  output$price <- renderText({
    if(input$company==""){
      return()
    }
    else(
      filtered_data() %>% 
        select(price) %>% 
        as.integer()
    )
  })
}

shinyApp(ui, server)

Answer 1

Примерно так можно решить вашу проблему

library(shiny)
library(dplyr)

name <- c("Company1","Company2","Company3")
price <- c("400","200","150")

my_data <- data.frame(name,price)

ui <- fluidPage(
  h1("Shiny Template"),
  sidebarLayout(
    sidebarPanel(
      selectInput("company", "Choose a Company:", choices = c(Choose="",levels(as.factor(my_data$name))))
    ),
    mainPanel(
      fluidRow(
        column(4,uiOutput("well_panel_server"))
      )
    )
  )
)


server <- function(input, output) {

  filtered_data <-  reactive ({
    data <- my_data %>% 
      filter(name %in% input$company)
    data
  })

  color_panel <- reactive(ifelse(input$company=='',
           paste0("background: grey"),
           ifelse(
             input$company=="Company1" | input$company=="Company2",
             paste0("background: green"),
             paste0("background: red"))))




  output$price <- renderText({
    if(input$company==""){
      "Select Company"
    }
    else(
      filtered_data() %>%
        pull(price) %>% 
        as.character()
    )
  })  


  output$well_panel_server <- renderUI({
      wellPanel(textOutput("price"),style = color_panel())
    })
}

shinyApp(ui, server)