我有一个lat/lon数据集和一个时间戳.我希望标记的颜色用连续的调色板显示时间.我正在使用colorNumeric()
之前创建的朱利安日期julian(x, "2015-01-01")
.
data = structure(list(timestamp = structure(c(1434056453, 1434148216, 1434153635, 1434245436, 1434358840, 1434364288, 1434369611, 1434461435, 1434466830, 1434558725), class = c("POSIXct", "POSIXt"), tzone = ""), lon = c(-119.8777, -119.9614, -119.8769, -119.8775, -120.2283, -120.2285, -119.8429, -120.0954, -120.3957, -120.4421), lat = c(34.4041,34.376, 34.4061, 34.4021, 34.4696, 34.4697, 34.1909, 34.4328, 34.4554, 34.4456), ID = as.factor(c("Z11","Z05","Z01", "Z04", "Z11", "Z04","Z01","Z05","Z05","Z11"))), .Names = c("timestamp", "lon", "lat", "ID"), row.names = c(1:10), class = "data.frame") data$julian = as.numeric(julian(data$timestamp, origin = "2015-01-01")) pal = colorNumeric( palette = rainbow(7), domain = data$julian) m = leaflet(data) m %>% addTiles() %>% addCircles(~lon, ~lat, color = ~pal(julian)) %>% addLegend("bottomright", pal = pal, values = ~julian, title = "Time", opacity = 1)
图例将标签显示为数字,朱利安日期:我希望它们以"2015-01-01"或类似格式显示为"正确"日期.
为此,我使用
as.Date(x, origin=as.Date("2015-01-01"))但是,当我将其插入到不工作
addLegend()
有addLegend(pal = pal, values = ~julian, labFormat = labelFormat(transform = ~as.Date(julian, origin=as.Date("2015-01-01"))))有没有办法修改图例标签,以便它们显示日期和/或字符?
从传说中的传单页面:
您还可以通过传递labFormat = labelFormat()来方便地自定义标签外观.labelFormat()具有自定义范围之间的分隔符,要呈现的位数以及每个标签的前缀/后缀的参数.如果您的标签格式需要超出labelFormat()可以提供的范围,您还可以使用自定义函数作为labFormat参数; 有关说明,请参阅?addLegend中的详细信息部分.
因此,我们可以修改labelFormat
函数的源代码,以包含自定义函数来转换日期
myLabelFormat = function(
prefix = '', suffix = '', between = ' – ', digits = 3, big.mark = ',',
transform = identity, dates = FALSE ## new 'dates' argument
) {
formatNum = function(x) {
format(
round(transform(x), digits), trim = TRUE, scientific = FALSE,
big.mark = big.mark
)
}
## added 'formatDate' function
formatDate = function(x) {
d = as.Date(x, origin="1970-01-01")
}
function(type, ...) {
switch(
type,
numeric = (function(cuts) {
if(dates){
## will format numbers into dates if dates == TRUE
paste0(formatDate(cuts))
}else{
paste0(prefix, formatNum(cuts), suffix)
}
})(...),
bin = (function(cuts) {
n = length(cuts)
paste0(prefix, formatNum(cuts[-n]), between, formatNum(cuts[-1]), suffix)
})(...),
quantile = (function(cuts, p) {
n = length(cuts)
p = paste0(round(p * 100), '%')
cuts = paste0(formatNum(cuts[-n]), between, formatNum(cuts[-1]))
# mouse over the legend labels to see the values (quantiles)
paste0(
'', prefix, p[-n], between, p[-1], suffix,
''
)
})(...),
factor = (function(cuts) {
paste0(prefix, as.character(transform(cuts)), suffix)
})(...)
)
}
}
其中,正如@Nice指出的可以缩短为
myLabelFormat = function(...,dates=FALSE){ if(dates){ function(type = "numeric", cuts){ as.Date(cuts, origin="1970-01-01") } }else{ labelFormat(...) } }
有了这个新功能,我们可以正常调用它
data = structure(list(timestamp = structure(c(1434056453, 1434148216, 1434153635, 1434245436, 1434358840, 1434364288, 1434369611, 1434461435, 1434466830, 1434558725), class = c("POSIXct", "POSIXt"), tzone = ""), lon = c(-119.8777, -119.9614, -119.8769, -119.8775, -120.2283, -120.2285, -119.8429, -120.0954, -120.3957, -120.4421), lat = c(34.4041,34.376, 34.4061, 34.4021, 34.4696, 34.4697, 34.1909, 34.4328, 34.4554, 34.4456), ID = as.factor(c("Z11","Z05","Z01", "Z04", "Z11", "Z04","Z01","Z05","Z05","Z11"))), .Names = c("timestamp", "lon", "lat", "ID"), row.names = c(1:10), class = "data.frame") data$julian <- as.numeric(as.Date(data$timestamp)) library(leaflet) pal = colorNumeric( palette = rainbow(7), domain = data$julian) m = leaflet(data) m %>% addTiles() %>% addCircles(~lon, ~lat, color = ~pal(julian)) %>% addLegend("bottomright", pal = pal, values = ~julian, title = "Time", opacity = 1, labFormat = myLabelFormat(dates=TRUE))