【问题标题】:Shiny selecting ranges and numeric variable (as inputs) with leaflet带有传单的闪亮选择范围和数字变量(作为输入)
【发布时间】:2018-12-04 05:11:48
【问题描述】:

在闪亮时,我想显示一个数值变量列表和一个滑动条,以便用户可以选择一个数值变量和一个范围。然后,低于该数字的观测值将显示为绿色,该范围之间的观测值将显示为橙色,高于该范围的观测值将显示为红色。

在我将它们放入闪亮之前,下面的代码可以正常工作。但是我的闪亮代码不起作用,所有观察结果都是红色的。

library(Rcpp)
library(ggmap)
library(htmlwidgets)
library(leaflet)

crime2 <- crime[1:50,]

getColor <- function(crime2) {
 sapply(crime2$hour, function(hour) {
 if(hour< 1) {
   "green"
 } else if(hour <= 1) {
   "orange"
 } else {
   "red"
  } })
}

icons <- awesomeIcons(
  icon = 'ios-close',
  iconColor = 'black',
  library = 'ion',
  markerColor = getColor(crime2)
)

leaflet(crime2) %>%
  addTiles() %>%
  addAwesomeMarkers(~lon, ~lat, icon=icons)

这是不起作用的闪亮代码

ui <- fluidPage(
  titlePanel("Unusual Observations"),

  sidebarLayout(
    sidebarPanel(
      helpText("Create maps with 
        information from the Crime Data"),

      selectInput("var", 
                  label = "Choose a variable to display",
                  choices = c("Hour",
                              "Number"),
                  selected = "Hour"),

      sliderInput("range", 
                  label = "Range of interest:",
                  min = 0, max = 10, value = c(1, 2))
    ),

    mainPanel(leafletOutput("map"))
  )
)


server <- function(input, output) {
  output$map <- renderLeaflet({
    data <- switch(input$var,
                   "hour" = crime2$hour,
                   "number" = crime2$number)

    getColor <- function(data){sapply(data, function(var){
       if(input$var< input$range[1]) {
         "green"
       } else if(input$var <= input$range[2]) {
         "orange"
       } else {
         "red"
        } })
    }

  icons <- awesomeIcons(
  icon = 'ios-close',
  iconColor = 'black',
  library = 'ion',
  markerColor = getColor(crime2)
)

    leaflet(crime2) %>%
  addTiles() %>%
  addAwesomeMarkers(~lon, ~lat, icon=icons)

  })
}

shinyApp(ui=ui, server=server)

有人知道如何解决“所有点都显示为红色”的问题吗?

提前感谢您!

【问题讨论】:

  • 您可能想分享 d1 以使其可重现,...
  • @BigDataScientist 我已将代码更新为可重现的示例!

标签: r shiny leaflet


【解决方案1】:

一些变化:

  1. 当您创建 selectInput 时,选项(和选定的)需要小写以匹配犯罪 2 中的列名。

    selectInput("var", 
                  label = "Choose a variable to display",
                  choices = c("hour",
                              "number"),
                  selected = "hour"),
    
  2. getColor 函数内部,您希望循环遍历 data 中的值,而不是 input$var,因此您应该在 lambda 函数内部调用 var 而不是 input$var

    getColor <- function(data){sapply(data, function(var){
          if(var< input$range[1]) {
            "green"
          } else if(var <= input$range[2]) {
            "orange"
          } else {
            "red"
          } })
        }
    
  3. 当您实际创建图标时,您希望它们是基于 data 中的值创建的,而不是整个犯罪 2 数据集中的值。

    icons <- awesomeIcons(
          icon = 'ios-close',
          iconColor = 'black',
          library = 'ion',
          markerColor = getColor(data)
        )
    

把它们放在一起:

ui <- fluidPage(
  titlePanel("Unusual Observations"),

  sidebarLayout(
    sidebarPanel(
      helpText("Create maps with 
        information from the Crime Data"),

      selectInput("var", 
                  label = "Choose a variable to display",
                  choices = c("hour",
                              "number"),
                  selected = "hour"),

      sliderInput("range", 
                  label = "Range of interest:",
                  min = 0, max = 10, value = c(1, 2))
    ),

    mainPanel(leafletOutput("map"))
  )
)


server <- function(input, output) {
  output$map <- renderLeaflet({
    data <- switch(input$var,
                   "hour" = crime2$hour,
                   "number" = crime2$number)

    getColor <- function(data){sapply(data, function(var){
      if(var< input$range[1]) {
        "green"
      } else if(var <= input$range[2]) {
        "orange"
      } else {
        "red"
      } })
    }

    icons <- awesomeIcons(
      icon = 'ios-close',
      iconColor = 'black',
      library = 'ion',
      markerColor = getColor(data)
    )

    leaflet(crime2) %>%
      addTiles() %>%
      addAwesomeMarkers(~lon, ~lat, icon=icons)

  })
}

shinyApp(ui=ui, server=server)

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2019-10-09
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2021-07-16
    • 2019-05-13
    • 1970-01-01
    相关资源
    最近更新 更多