Rentang pemilihan yang mengkilap dan variabel numerik (sebagai masukan) dengan selebaran

Secara mengkilap, saya ingin menampilkan daftar variabel numerik dan bilah geser sehingga pengguna dapat memilih variabel numerik dan rentang. Kemudian, observasi di bawah angka tersebut akan berwarna hijau, dan observasi di antara rentang tersebut akan berwarna oranye, dan observasi di atas rentang tersebut akan berwarna merah.

Kode di bawah ini berfungsi dengan baik sebelum saya membuatnya mengkilap. Tetapi kode mengkilap saya tidak berfungsi dan semua pengamatan berwarna merah.

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)

Ini adalah kode mengkilap yang tidak berfungsi

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)

Adakah yang tahu cara memperbaiki masalah 'semua titik muncul sebagai merah'?

Terima kasih sebelumnya!


r leaflet shiny
person glor    schedule 25.06.2018    source sumber
comment
Anda mungkin ingin membagikan d1 agar dapat direproduksi,...   -  person Tonio Liebrand    schedule 29.06.2018
comment
@BigDataScientist Saya telah memperbarui kode menjadi contoh yang dapat direproduksi!   -  person glor    schedule 29.06.2018

Jawaban (1)


arrow_upward
1
arrow_downward

Beberapa perubahan:

  1. Saat Anda membuat selectInput pilihan (dan dipilih) harus menggunakan huruf kecil agar sesuai dengan nama kolom di kejahatan2.

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

  2. Di dalam fungsi getColor Anda ingin mengulang nilai dalam data, bukan input$var, jadi Anda harus memanggil var daripada input$var di dalam fungsi lambda.

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

  3. Saat Anda benar-benar ingin membuat ikon, Anda ingin ikon tersebut dibuat berdasarkan nilai di data, bukan nilai di seluruh kumpulan data kejahatan2.

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

Menyatukan semuanya:

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)
person Wil    schedule 28.02.2019