如何更改 clusterOptions 以在 R 传单中显示饼图? [英] How to change clusterOptions to display pie charts in R leaflet?

问题描述

考虑来自传单 R 包的 breweries91 数据.我在 breweries91 数据框中模拟了一个附加变量，该变量对应于啤酒厂的两组.

下面的代码将重现下图的左侧部分:

这里在 Javascript 中有一个解决方案:

-

图书馆(传单)图书馆(dplyr)#创建数据数据(breweries91"，包=传单")#set.seed(1);breweries91$goodbear<-sample(as.factor(c("terrific","marvelous","culpartertaping")),nrow(breweries91),replace=T)#颜色joliepalette<-c("red","green","blue")[1:nlevels(breweries91$goodbear)]getColor <- function(breweries91) {joliepalette[breweries91$goodbear]}图标 <- awesomeIcons(icon = 'ios-关闭',iconColor = '黑色',图书馆 = '离子',标记颜色 = getColor(breweries91))#生成javascriptjsscript3<-粘贴0(功能(集群){const groups= [",paste("'",levels(breweries91$goodbear),"'",sep="",collapse=","),"];常量颜色= {组: [",paste("'",joliepalette,"'",sep="",collapse=","),"],中心:'#ddd'，文字:'黑色'};const 标记 = cluster.getAllChildMarkers();const ratios= groups.map(group =>markers.filter(marker =>marker.options.group === group).length/markers.length);函数总和(arr，第一个= 0，最后一个){return arr.slice(first, last).reduce((total, curr) => total+curr, 0);}constcumulativeProportions= ratios.map((val, i, arr) => sum(arr, 0, i+1));累积比例.unshift(0);const width = 2*Math.sqrt(markers.length);const 半径= 15+宽度/2；const arcs=cumulativeProportions.map((prop, i) => { return {x : 半径*Math.sin(2*Math.PI*prop),y : -radius*Math.cos(2*Math.PI*prop),长:比例[i-1] > .5 ?1 : 0}});const path= ratios.map((prop, i) => {if (prop === 0) 返回 '';else if (prop === 1) return `<circle cx='0' cy='0' r='${radius}' fill='none' stroke='${colors.groups[i]}'stroke-width='${width}'stroke-alignment='center'stroke-linecap='butt'/>`;否则返回 `<path d='M ${arcs[i].x} ${arcs[i].y} A ${radius} ${radius} 0 ${arcs[i+1].long} 1${arcs[i+1].x} ${arcs[i+1].y}' fill='none' stroke='${colors.groups[i]}' stroke-width='${width}'笔画对齐='中心'笔画线帽='屁股'/>`});返回新的 L.DivIcon({html:`<svg width='60' height='60' viewBox='-30 -30 60 60' style='width: 60px;高度:60px；位置:相对；顶部:-24px；左:-24px;'><circle cx='0' cy='0' r='15'stroke='none' fill='${colors.center}'/><text x='0' y='0'dominant-baseline='central' text-anchor='middle' fill='${colors.text}' font-size='15'>${markers.长度}${paths.join('')}</svg>`，className: '标记簇'});}")# 生成地图.传单()%>%addTiles() %>%addAwesomeMarkers(data=breweries91,group=~goodbear,图标 = 图标，clusterOptions = markerClusterOptions(图标创建函数 =JS(jsscript3)))

Consider the breweries91 data from the leaflet R package. I have simulated an additional variable in the breweries91 dataframe that corresponds to two groups for breweries.

The code below will reproduce the left part of the following figure:

There exists a solution in Javascript here:

http://bl.ocks.org/gisminister/10001728

Another example is here: https://github.com/SINTEF-9012/PruneCluster

the topic of pie-charts is also discussed there: https://ux.stackexchange.com/questions/76402/how-to-cluster-map-markers-with-different-statuses

Has anybody already used similar JS code in leaflet options via the JS function ?

library(leaflet)
library(dplyr)
data("breweries91",package="leaflet")
set.seed(1);breweries91$goodbear<-sample(as.factor(c("terrific","marvelous")),nrow(breweries91),replace=T)
leaflet() %>%
  addTiles() %>%
  addMarkers(data=breweries91,
             clusterOptions = markerClusterOptions(
               iconCreateFunction =
                 JS("function(cluster) {
   return new L.DivIcon({
     html: '<div style=\"background-color:rgba(77,77,77,0.5)\"><span>' + cluster.getChildCount() + '</div><span>',
     className: 'marker-cluster'
   });}")))

How to adapt the code to produce the image on the right ?

解决方案

Merci à Guilhem pour la solution:

-

library(leaflet)
library(dplyr)
#Creates data
data("breweries91",package="leaflet")
#set.seed(1);
breweries91$goodbear<-sample(as.factor(c("terrific","marvelous","culparterretaping")),nrow(breweries91),replace=T)
#Colors
joliepalette<-c("red","green","blue")[1:nlevels(breweries91$goodbear)]
getColor <- function(breweries91) {joliepalette[breweries91$goodbear]}

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

#Generate the javascript

jsscript3<-
  paste0(
"function(cluster) {
const groups= [",paste("'",levels(breweries91$goodbear),"'",sep="",collapse=","),"];
const colors= {
groups: [",paste("'",joliepalette,"'",sep="",collapse=","),"],
center:'#ddd',
text:'black'
};
const markers= cluster.getAllChildMarkers();

const proportions= groups.map(group => markers.filter(marker => marker.options.group === group).length / markers.length);
function sum(arr, first= 0, last) {
return arr.slice(first, last).reduce((total, curr) => total+curr, 0);
}
const cumulativeProportions= proportions.map((val, i, arr) => sum(arr, 0, i+1));
cumulativeProportions.unshift(0);

const width = 2*Math.sqrt(markers.length);
const radius= 15+width/2;

const arcs= cumulativeProportions.map((prop, i) => { return {
x   :  radius*Math.sin(2*Math.PI*prop),
y   : -radius*Math.cos(2*Math.PI*prop),
long: proportions[i-1] >.5 ? 1 : 0
}});
const paths= proportions.map((prop, i) => {
if (prop === 0) return '';
else if (prop === 1) return `<circle cx='0' cy='0' r='${radius}' fill='none' stroke='${colors.groups[i]}' stroke-width='${width}' stroke-alignment='center' stroke-linecap='butt' />`;
else return `<path d='M ${arcs[i].x} ${arcs[i].y} A ${radius} ${radius} 0 ${arcs[i+1].long} 1 ${arcs[i+1].x} ${arcs[i+1].y}' fill='none' stroke='${colors.groups[i]}' stroke-width='${width}' stroke-alignment='center' stroke-linecap='butt' />`
});

return new L.DivIcon({
html: `
<svg width='60' height='60' viewBox='-30 -30 60 60' style='width: 60px; height: 60px; position: relative; top: -24px; left: -24px;' >
<circle cx='0' cy='0' r='15' stroke='none' fill='${colors.center}' />
<text x='0' y='0' dominant-baseline='central' text-anchor='middle' fill='${colors.text}' font-size='15'>${markers.length}</text>
${paths.join('')}
</svg>
`,
className: 'marker-cluster'
});
}")

# Generates the map.
leaflet() %>%
  addTiles() %>%
  addAwesomeMarkers(data=breweries91,
                    group=~goodbear,
                    icon = icons,
                    clusterOptions = markerClusterOptions(
                      iconCreateFunction =
                        JS(jsscript3)))

这篇关于如何更改 clusterOptions 以在 R 传单中显示饼图?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！