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

Question

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

the Hutt · Accepted Answer · 2022-01-20 06:03:55Z

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

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

2) Sharing the data in cluster object: Each marker gets to see its popup object and popup options. So you can manipulate popup from within marker object itself, in our case from iconCreateFunction.

The MarkerCluster library doesn't provide way to have label or popup for cluster markers. When you click on cluster icon it zooms in and doesn't show popup. As a workaround we can disable on click zoom in and show custom tooltip/popup:

# 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","limegreen")[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' />`
  });

  let icon = 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'
   });
   
   // make custom popup for the cluster
   if(cluster._map){
     let counts =  groups.map(group => markers
                        .filter(marker => marker.options.group === group).length);
     let content = `<span style='color:limegreen'>${groups[2]}</span>&nbsp;<span>(${counts[2]})</span><br>`;
     content += `<span style='color:orangered'>${groups[1]}</span>&nbsp;<span>(${counts[1]})</span><br>`;
     content += `<span style='color:darkviolet'>${groups[0]}</span>&nbsp;<span>(${counts[0]})</span><br>`;
     content = `<div style='font-size:13px;font-weight:bold'>` + content + `</div>`;

      cluster.on('click', function (a) {
          let tt = L.tooltip({permanent:false, direction:'top', offset: L.point(0, -width*2)});
        tt.setContent( content );
        tt.setLatLng(cluster.getLatLng());
        tt.addTo(cluster._map);
      });
   }
   
   return icon;
}")

# 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("limegreen", "orangered", "darkviolet"),
            labels = c(s1, s2,s3),
            title = "Beer goodness:",
            opacity = 1) %>%
  addMarkers(data = breweries91,
             group = ~goodbeer,
             popup = paste("", breweries91$goodbeer),
             popupOptions = popupOptions(maxWidth = 1000, closeOnClick = TRUE),
             options = markerOptions(score = getScore(breweries91)),
             clusterOptions = markerClusterOptions(
               singleMarkerMode = TRUE,
               zoomToBoundsOnClick = FALSE,
               iconCreateFunction = JS(jsscript3)
             )
  )


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

Here we've shown popup on individual markers using regular method:

leaflet() %>%
  addTiles() %>%
    addMarkers(data = breweries91,
             popup = paste("", breweries91$goodbeer),
             popupOptions = popupOptions(maxWidth = 1000, closeOnClick = TRUE),
    ...)

Special handling done in iconCreateFunction is for only cluster markers.

In worst case scenario if you want to share the data between markers/clusters then you can find Leaflet map object in cluster._map property. Or you can attach data to javascript window object and access it anywhere across javascript code.

3) Passing entire row to leaflet: We can pass entire row to leaflet using:

options = markerOptions(row_data = setNames(split(breweries91,
                                             seq(nrow(breweries91))),
                                              rownames(breweries91)))

With this we can now have many things on popup, including coordinates:

# 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)
breweries91$score<-ifelse(breweries91$goodbeer == "terrific",3L,
                                                ifelse(breweries91$goodbeer == "marvelous",2L,
                                                       ifelse(breweries91$goodbeer == "culparterretaping",1L,0L)))
names(breweries91)

# Colors
joliepalette<-c("darkviolet","orangered","limegreen")[1:nlevels(breweries91$goodbeer)]
getColor <- function(breweries91) {joliepalette[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();
   //console.log(markers[0]);
   let grandTotal = markers.reduce((a,b)=> +a + +b.options.row_data.data.score, 0);
    
   const proportions= groups.map(group => markers
                        .filter(marker => marker.options.group === group)
                         .reduce((a,b)=> +a + +b.options.row_data.data.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' />`
  });

  let icon = 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'
   });
   
   // make custom popup for the cluster
   let content ='popup';
   if(cluster._map){ //if it's cluster
   //console.log(cluster);
     let counts =  groups.map(group => markers
                        .filter(marker => marker.options.group === group).length);
     content = `<span style='color:limegreen'>${groups[2]}</span>&nbsp;<span>(${counts[2]})</span><br>`;
     content += `<span style='color:orangered'>${groups[1]}</span>&nbsp;<span>(${counts[1]})</span><br>`;
     content += `<span style='color:darkviolet'>${groups[0]}</span>&nbsp;<span>(${counts[0]})</span><br>`;
     content = `<div style='font-size:13px;font-weight:bold'>` + content + `</div>`;

      
   } else{ //if it's single marker
    //console.log(cluster.getAllChildMarkers());
    cluster = cluster.getAllChildMarkers()[0];
    //console.log(cluster);
    let r = cluster.options.row_data;
    let loc = r.coords;
    r = r.data;
    let address = r.address;
    let name = `${r.brewery} (${r.founded})`;
    content = `<span><strong>${name}</strong></span><br>`;
    content += `<span style='margin-bottom:10px'>[${loc}]</span><hr>`;
    content += `<span>${address}, ${r.village}, ${r.zipcode}</span><br>`;
    content += `<span>Goodness: ${r.goodbeer}</span>`;
   }
   cluster.on('click', function (a) {
          let tt = L.tooltip({permanent:false, direction:'top', offset: L.point(0, -width*2)});
        tt.setContent( content );
        tt.setLatLng(cluster.getLatLng());
        tt.addTo(cluster._map);
      });
   
   return icon;
}")

# 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("limegreen", "orangered", "darkviolet"),
            labels = c(s1, s2,s3),
            title = "Beer goodness:",
            opacity = 1) %>%
  addMarkers(data = breweries91,
             group = ~goodbeer,
             popupOptions = popupOptions(maxWidth = 1000, closeOnClick = TRUE),
             options = markerOptions(row_data = setNames(split(breweries91, seq(nrow(breweries91))), rownames(breweries91))),
             clusterOptions = markerClusterOptions(
               singleMarkerMode = TRUE,
               zoomToBoundsOnClick = FALSE,
               iconCreateFunction = JS(jsscript3)
             )
  )


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

For reference I've extracted a sample cluster object: Cluster Object Json.
Using this you can find out properties from the cluster object to use in javascript.

This is absolutely great for studying communication btw js and r. Thank you very much. I wonder also if it is possible to extract back from the marker the values standing behind the pie. Can they be easily extracted? Eg. for a popup in leaflet? — Jacek Kotowski, Commented Jan 16, 2022 at 19:10
You can create/update popups/labels from within the javascript method. See the updated answer. — the Hutt, Commented Jan 17, 2022 at 10:30
This is absolutely great and I will print it out on large sheet to study. One more question for completeness. Say one wants to return longitude, latitude or any of the columns indicating the location in the popup, grouped or the lowest level. Is it possible to pass from R to leaflet? — Jacek Kotowski, Commented Jan 19, 2022 at 9:33
You can pass an entire row to the leaflet, see the updated answer. To debug you can use console.log(vriable) statements in javascript. The logs can be seen by right clicking map and selecting inspect element. Then select second tab named Console. — the Hutt, Commented Jan 20, 2022 at 5:59

public.rant · Accepted Answer · 2021-11-16 05:36:43Z

0

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".

answered Nov 16, 2021 at 5:36

public.rant

1075 bronze badges

Add a comment |

Collectives™ on Stack Overflow

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

2 Answers 2

Not the answer you're looking for? Browse other questions tagged
javascript
r
leaflet
r-leaflet
leaflet.markercluster
or ask your own question.

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Not the answer you're looking for? Browse other questions tagged javascriptrleafletr-leafletleaflet.markercluster or ask your own question.

Linked

Related

Not the answer you're looking for? Browse other questions tagged
javascript
r
leaflet
r-leaflet
leaflet.markercluster
or ask your own question.