Как раскрасить кодовые маркеры в зависимости от выбранного входа? - PullRequest
Новая
       6

Как раскрасить кодовые маркеры в зависимости от выбранного входа?

0 голосов
/ 28 октября 2018

У меня блестящее приложение, которое использует буклет для отображения данных точек с помощью маркеров.Я хотел бы, чтобы маркеры были окрашены в соответствии с уровнями фактора из выбранного столбца.

В приведенном ниже примере пользователь выбрал бы цвет маркеров в соответствии с данными, найденными в столбце «cat», который содержит различные типы транспортных средств.

library(leaflet)

# read in data and generate new, fake data

df <- quakes[1:24,]
df$cat <- NULL
df$cat <- as.factor(sample(c("Car", "Truck", "Train", "Bus"), 24, replace=TRUE))
df$type <- NULL
df$type <- as.factor(sample(c("Walrus", "Dragon", "Llama"), 24, replace=TRUE))


# create color codes according to factors of a column

getColor <- function(df) {
  sapply(df$cat, function(cat) {
    if(cat == "Car") {
      "green"
    } else if(cat == "Truck") {
      "orange"
    } else if(cat == "Train") {
      "pink"
    } else {
      "red"
    } })
}

# create awesome icons

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

# plot data

leaflet(df) %>% addTiles() %>%
  addAwesomeMarkers(~long, ~lat, icon=icons, label=~as.character(cat))

По сути, я хотел бы автоматически сгенерировать функцию 'getColor' на основе выбранного входного столбца и без жесткого кодирования любых значений.

Рассмотрим еще один гипотетический столбец, называемый «тип», который содержит 3 уровня фактора, все из которых являются удивительными животными.Если бы пользователь выбрал цвет маркеров по типу, существующая функция getColor, которая использует входные данные из столбца cat, не будет работать.Есть ли способ автоматически заполнять функцию 'getColor' на основе выбранного столбца и связанных с ним уровней факторов?Обратите внимание, что мне бы не хотелось подбирать цвета вручную.

Надеюсь, что это имеет смысл, и большое спасибо за любую помощь, которую кто-либо может предложить :)

Ответы [ 2 ]

0 голосов
/ 28 октября 2018 
# only 19 colors are available (see help)
pal <- c("red", "darkred", "lightred", "orange", "beige", "green", "darkgreen", "lightgreen", "blue", "darkblue", "lightblue", "purple", "darkpurple", "pink", "cadetblue", "white", "gray", "lightgray", "black")

# create awesome icons and assign a color to each of 
# the levels of your input factor
icons <- awesomeIcons(
 icon = 'ios-close',
 iconColor = 'black',
 library = 'ion',
 markerColor = pal[1:length(levels(df$type))]
)

# plot data

leaflet(df) %>% addTiles() %>%
  addAwesomeMarkers(~long, ~lat, icon=icons, 
                    label=~as.character(type))
0 голосов
/ 28 октября 2018

Вот решение для того, что я думаю, что вы после.Следует помнить, что для маркера Colour доступно всего 19 цветов.Вместо этого вы можете адаптировать решение и изменить iconColor, что позволит вам использовать CSS-корректные цвета (соответственно вы можете использовать цветовые палитры / палитры). 

library(shiny)
library(leaflet)
library(data.table)

# read in data and generate new, fake data
DT <- data.table(quakes[1:24,])
DT$cat <- as.factor(sample(c("Car", "Truck", "Train", "Bus"), 24, replace=TRUE))
DT$type <- as.factor(sample(c("Walrus", "Dragon", "Llama"), 24, replace=TRUE))

# 19 possible colors
markerColorPalette <- c("red", "darkred", "lightred", "orange", "beige", "green", "darkgreen", "lightgreen", "blue", "darkblue", "lightblue", "purple", "darkpurple", "pink", "cadetblue", "white", "gray", "lightgray", "black")

ui <- fluidPage(
  leafletOutput("mymap"),
  p(),
  selectInput(inputId="columnSelect", label="Select column", choices=names(DT), selected = "cat")
)

server <- function(input, output, session) {

  # create awesome icons      
  icons <- reactive({
    columnLevels <- unique(DT[[input$columnSelect]])
    colorDT <- data.table(columnLevels = columnLevels, levelColor = markerColorPalette[seq(length(columnLevels))])
    setnames(colorDT, "columnLevels", input$columnSelect)
    DT <- colorDT[DT, on = input$columnSelect]

    icons <- awesomeIcons(
      icon = 'ios-close',
      iconColor = 'black',
      library = 'ion',
      markerColor = DT$levelColor
    )

    return(icons)
  })

  output$mymap <- renderLeaflet({
    req(icons())
    leaflet(DT) %>% addTiles() %>%
      addAwesomeMarkers(~long, ~lat, icon=icons(), label=as.character(DT[[input$columnSelect]]))
  })
}

shinyApp(ui, server)
...