在 dplyr 管道运算符中结合条件评估 (%>%)答案

【问题标题】：Combining conditional evaluation within dplyr pipe operators (%>%)在 dplyr 管道运算符中结合条件评估 (%>%)
【发布时间】：2018-11-28 04:49:06
【问题描述】：

所以我在SO 上找到了一个非常相似的问题，但我无法解决我的问题。我正在用 Shiny 传单制作地图。我想要的是，当某个变量具有某些值（条件）时，创建一个addAwesomeMarkers()；否则，请创建addCircleMarkers()。我尝试了一些if (else)、case_when() 和mutate() 声明，但无法修复。所以...这是我的代码。

包：

library(dplyr)
library(ggplot2)
library(leaflet)
library(reshape2)
library(shiny)
library(tidyr)

虚拟数据集：

NAME    VAR WAIT    latitude    longitude
a   4   1   52,6263 4,7312
b       3   52,2946 4,9585
c   6   8   52,3331 6,6468
d   8   5   51,2864 4,0492
e   7   6   50,9832 5,8446

代码：

leafletOutput('myMap', width = '80%', height = 600)

output$myMap <- renderLeaflet({    
getColor <- function(DATASET) {
        sapply(DATASET$WAIT, function(WAIT) {
        if(WAIT == 0 | is.na(WAIT) | is.nan(WAIT)) {"gray"}
        else if(WAIT <= 1){"darkgreen"}
        else if(WAIT <= 2){"green"}    
        else if(WAIT <= 4){"lightgreen"}
        else if(WAIT <= 6){"orange"}
        else if(WAIT <= 8){"red"}
        else {"darkred"}
        })
      }

    icons <- awesomeIcons(
      icon = 'heart-o',
      lib = 'fa',
      iconColor = "#FFFFFF",
      markerColor = getColor(DATASET))

     map <- leaflet(DATASET) %>%          
                addTiles() %>% 
# DATASET$VAR is a char in my dataset
                     {if (DATASET$VAR == "4") filter(., addAwesomeMarkers(lng = ~longitude, lat = ~latitude, icon = icons,
                              label = ~as.character(DATASET$NAME),
                              popup = paste0("<strong>Name: </strong>", DATASET$NAME)))
                       else filter(., addCircleMarkers(lng = ~longitude, lat = ~latitude, radius = 10, label = ~as.character(DATASET$NAME),
                             popup = paste0("<strong>Name: </strong>", DATASET$NAME)))} %>% 
    addProviderTiles(providers$OpenStreetMap)
        })

所以我的 if else 是行不通的；给出以下错误：

no applicable method for 'filter_' applied to an object of class "c('leaflet', 'htmlwidget')"

我尝试实现mutate()。提前感谢您的帮助！

【问题讨论】：

我不喜欢leaflet，但根据您的代码和错误消息，我认为问题是在leaflet(DATASET) %>% addTiles() 之后您不再处理data.frame（或“tibble ") 这是 dplyr 工作所必需的。因此，dplyr 无法将 filter 应用于传单对象并返回错误。
您好 docendo discimus，感谢您提供的信息。我的目标是在传单中实现不同的标记，无论如何。所以我可以接受任何其他方式。

标签： r shiny dplyr leaflet r-leaflet

【解决方案1】：

您可以添加两者并过滤add*Markers-函数的数据输入，而不是在标记之间切换。所以，给定你的虚拟数据集：

library(dplyr)
library(leaflet)

df <- tribble(
  ~NAME, ~VAR, ~WAIT, ~latitude, ~longitude,
  'a', 4, 1, 52.6263, 4.7312,
  'b', 0, 3, 52.2946, 4.9585,
  'c', 6, 8, 52.3331, 6.6468,
  'd', 8, 5, 51.2864, 4.0492,
  'e', 7, 6, 50.9832, 5.8446
)

这样做：

map <- leaflet(df) %>%
  addTiles() %>%
  addAwesomeMarkers(data = df %>% filter(VAR == '4')) %>%
  addCircleMarkers(data = df %>% filter(VAR != '4'))

这不是你要找的吗？

【讨论】：

【解决方案2】：

我首先在我的数据准备脚本中定义了两列，说明是绘制方形标记还是默认标记 ('IND_VAR') 以及是否显示相应标记内的星号（'VAR_SHOWING_STAR'）：

 Dataset <- Dataset %>% 
  dplyr::group_by(NAME, VAR) %>%
    dplyr::mutate(IND_VAR = ifelse(VAR == '4', 1, 0)) %>%
  dplyr::ungroup() %>%
  dplyr::mutate(NICE_ICON = ifelse(VAR_SHOWING_STAR == "NOT", "", "Star"))

其次，我在我的应用脚本中定义了颜色：

 Dataset <- Dataset %>%
  mutate(COLOR_WAIT = case_when(
    (is.na(WAIT) | is.nan(WAIT)) ~"gray",
    (WAIT >= 0 & WAIT <= 1) ~ "darkgreen",
    (WAIT == 2) ~ "green",
    (WAIT >= 3 & WAIT <= 4) ~ "lightgreen",
    (WAIT >= 5 & WAIT <= 6) ~ "orange",
    (WAIT >= 7 & WAIT <= 8) ~ "lightred",
    (WAIT >= 9 & WAIT <= 10) ~ "red",
    TRUE ~ "darkred"))

第三，我定义了图标（也在我的应用脚本中），包括一个关于“IND_VAR”的ifelse()：

  icons <- makeAwesomeIcon(icon = Dataset$NICE_ICON, lib  = 'fa',
                           squareMarker = ifelse(Dataset$IND_VAR == 1, TRUE, FALSE),
                           iconColor = "#FFFFFF", spin = TRUE,
                           markerColor = Dataset$COLOR_WAIT)

最后，我在renderLeaflet({}) 中实现了addAwesomeMarkers()：

    %>% 
addAwesomeMarkers(lng = ~longitude, lat = ~latitude, icon = icons,
                      label = ~as.character(Dataset$SOME_LABEL),
                      popup = paste0("<strong>Pop_up: </strong>", Dataset$SOME_POPUP) %>%

结果：

【讨论】：