在 dplyr 管道运算符中组合条件评估 (%>%)
Combining conditional evaluation within dplyr pipe operators (%>%)
所以我在 上发现了一个非常相似的问题,但我无法解决我的问题。我正在用闪亮的传单制作地图。我想要的是,当某个变量具有某些值(条件)时,制作一个 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()
。在此先感谢您的帮助!
您可以同时添加和过滤 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'))
这不正是您要找的吗?
我通过首先在我的数据准备脚本中定义两列来管理它(在底部一直查看结果),说明是绘制方形标记还是默认标记('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) %>%
结果:
所以我在 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()
。在此先感谢您的帮助!
您可以同时添加和过滤 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'))
这不正是您要找的吗?
我通过首先在我的数据准备脚本中定义两列来管理它(在底部一直查看结果),说明是绘制方形标记还是默认标记('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) %>%
结果: