简体   繁体   中英

Pie charts in R leaflet, turn count into sum and control more the size

I am fascinated by the solution of grouping markers and presenting counts by groups in form of small piecharts https://stackoverflow.com/a/60525137/3480717 I am R only and do not know JS. I would like the code to sum values from each data point and not count (each individual data point may represent already a count). And I would like to control more the size of the bubbles dependent on the value. Can you help me out and show how to change the js code so that it sums values from datapoints and how to perhaps increase/control the size of the bubbles?

Here there is a desired solution to sum instead of count for non-pie markers: How to display the value (sum) rather than count of markers in a dc.leaflet.js Here there is a solution that also controls the size of the bubbles: Clustered leaflet markers with sum (not count) totals: how to get consistent round red shape and label format like in unclustered markers

The original code is by https://stackoverflow.com/users/2711712/danielbonnery @DanielBonnery

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)))

Note this line of your code

const arcs= cumulativeProportions.map((prop, i) => { return {

From what I can tell, the size of the paths created with the SVG is controlled by the value of prop , which I guess means "proportion".

I copied the javascript into vim and searched for the location where prop is set. It seems to me that prop is never assigned a value.

They keep telling me it always helps to keep things in "proportion".

I would like the code to sum values from each data point and not count.

You can pass your data/stats to markers using markerOptions()

leaflet() %>%
  addTiles() %>%
    addMarkers(
      options = markerOptions(score = getScore(breweries91)),
      ...
    )

then inside JavaScript use marker.options.score to retrieve it.

And I would like to control more the size of the bubbles dependent on the value.

In demo code below, in javascript, look for code let width = 4 + 2*Math.sqrt(grandTotal/1.5); play with it to adjust bubble radius.

... count for non-pie markers

Available, Leaflet for R, initializers makeIcon , awesomeIcons , and icons forces you to create and use custom images. And there is no way getting around it. The addCircleMarkers looks useful for our purpose but it doesn't let you set text.
We can use singleMarkerMode in clusterOptions. Using it we can make single markers a size 1 cluster and render them using our already coded iconCreateFunction JavaScript code:

leaflet() %>%
  addTiles() %>%
   addMarkers(
             ...
             clusterOptions = markerClusterOptions(
               singleMarkerMode = TRUE,
               iconCreateFunction = JS(jsscript3)
             )
  )

Demo: In your code there is no usable numeric data that can be used in marker. So I created a mapping, using getScore function, for score value:

terrific          => 3
marvelous         => 2
culparterretaping => 1

Added legend with summary using summarytools .
Here is the final code:

# Title: R Leaflet custom summing marker demo


# Load packages ##################
install.packages("pacman")
require(pacman)

pacman::p_load(pacman, dplyr, leaflet, summarytools)


# Creates data ##################
data("breweries91",package="leaflet")
cat('\014') # ctrl+L
#head(breweries91, 2L)
breweries91$goodbeer<-sample(as.factor(c("terrific","marvelous","culparterretaping")),nrow(breweries91),replace=T)
names(breweries91)

# Colors
joliepalette<-c("darkviolet","orangered","lime")[1:nlevels(breweries91$goodbeer)]
getColor <- function(breweries91) {joliepalette[breweries91$goodbeer]}

# Score
jolieValue<-c(1L,2L,3L)[1:nlevels(breweries91$goodbeer)]
getScore <- function(breweries91) {jolieValue[breweries91$goodbeer]}


# iconCreateFunction Javascript
jsscript3<-paste0(
  "function(cluster) {
   const groups= [",paste("'",levels(breweries91$goodbeer),"'",sep="",collapse=","),"];
   const colors= {
     groups: [",paste("'",joliepalette,"'",sep="",collapse=","),"],
     center:'#ddd',
     text:'black'
    };
   const markers= cluster.getAllChildMarkers();
   let grandTotal = markers.reduce((a,b)=> +a + +b.options.score, 0);

   const proportions= groups.map(group => markers
                        .filter(marker => marker.options.group === group)
                         .reduce((a,b)=> +a + +b.options.score, 0) / grandTotal);

   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);

  let width = 4 + 2*Math.sqrt(grandTotal/1.5);
  width = width > 16? 16: width;
  let radius= 10 + (width/2);
  radius += (grandTotal < 40)? grandTotal/10 : 4;

  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-2}' fill-opacity='0.3' stroke-opacity fill='${colors.groups[i]}' 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}' />
      ${paths.join('')}
      <text x='0' y='0' dominant-baseline='central' text-anchor='middle' fill='${colors.text}' font-size='16'>${grandTotal}</text>
    </svg>
    `,
   className: 'marker-cluster'
   });
}")

# gather stats for legend
myStat <- freq(breweries91$goodbeer, report.nas = FALSE, cumul = FALSE)
s1 <- paste("3 - terrific(",myStat[3,1],")")
s2 <- paste("2 - marvelous(",myStat[2,1],")")
s3 <- paste("1 - culparterretaping(", myStat[1,1],")")


# generates the map.
leaflet() %>%
  addTiles() %>%
  addLegend("topright", 
            colors = c("lime", "orangered", "darkviolet"),
            labels = c(s1, s2,s3),
            title = "Beer goodness:",
            opacity = 1) %>%
  addMarkers(data = breweries91,
             group = ~goodbeer,
             options = markerOptions(score = getScore(breweries91)),
             clusterOptions = markerClusterOptions(
               singleMarkerMode = TRUE,
               iconCreateFunction = JS(jsscript3)
             )
  )


# print stats
freq(breweries91$goodbeer, report.nas = FALSE, cumul = FALSE)
print(paste("Grand Score: ", myStat[1,1]*1 + myStat[2,1]*2 + myStat[3,1]*3))


Screenshot:

在此处输入图像描述

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM