Использование sprintf () для краткости - PullRequest
Новая
       97

Использование sprintf () для краткости

0 голосов
/ 07 августа 2020

Я пытаюсь сделать эту часть моего кода короче - в частности, операторов if, else if, используя sprintf () и просто меняя цвета для боковых панелей. Как мне go об этом? 


output$calculation<-renderUI({
          req(input$popDensity)
          populationDensity <- input$popDensity;
          likelihood <- populationDensity/500

        if (likelihood()>1) {
          sidebarPanel(style="background-color: red; width: 300px; height: 300px;", h3("Extreme risk!"))

        } else if (likelihood()>.65){
          sidebarPanel(style="background-color: orange; width: 300px; height: 300px;",
                       h3("Very high risk!"))
        }
        else if (likelihood()>.35){
          sidebarPanel(style="background-color: yellow; width: 300px; height: 300px;",
                       h3("High risk!"))
        }
        else if (likelihood()>.10){
          sidebarPanel(style="background-color: blue; width: 300px; height: 300px;",
                       h3("Moderate risk!"))

        } else {
          sidebarPanel(style="background-color: #39ac39; width: 300px; height: 300px;",
                       h3("Low risk!"))

        }

      })

1 Ответ

0 голосов
/ 07 августа 2020

Не уверен, как бы вы включили сюда sprintf(). Я сделал его довольно кратким, изменив класс sidebarPanel, используя shiny js. Вот приложение.R: 

library(shiny)
library(shinyjs)
library(dplyr)

# Define UI for application that draws a histogram
ui <- fluidPage(
    
    useShinyjs(),
    
    # Application title
    titlePanel("Colour slider"),
    
    tags$head(
        tags$style(HTML("
        
      .sidebar {
        width: 300px;
        height: 300px;
      }
        
      .red { background-color: red; }
      .orange { background-color: orange; }
      .yellow { background-color: yellow; }
      .blue { background-color: blue; }
      .green { background-color: #39ac39; }

    "))
    ),
    
    sidebarLayout(
        sidebarPanel(
            id = "sidebar",
            class = "sidebar",
            textOutput("header") %>% 
                tagAppendAttributes(class = "h3")
        ),
        
        mainPanel(
            sliderInput("popDensity",
                        "Population Density",
                        min = 1,
                        max = 600,
                        value = 10)
        )
    )
)

fun <- function(x, y) {
    
    removeClass("sidebar", c("red", "orange", "yellow", "blue", "green"))
    addClass("sidebar", y)
    
    x
}

# Define server logic required to draw a histogram
server <- function(input, output) {
    
    output$header <- renderText({
        
        req(input$popDensity)
        
        likelihood <- input$popDensity / 500
        
        if (likelihood > 1)
            fun("Extreme risk!", "red")
        else if (likelihood > 0.65) 
            fun("Very high risk!", "orange")
        else if (likelihood > 0.35) 
            fun("High risk!", "yellow")
        else if (likelihood > 0.10) 
            fun("Moderate risk!", "blue")
        else 
            fun("Low risk!", "green")
        
    })
}

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