f?(i=r,r=f):i=f),v[0]!=r||v[1]!=i?(e?a=null:o=null,v[0]=r,v[1]=i,!0):void 0}function m(){d(),k.style("pointer-events","all").selectAll(".resize").style("display",n.empty()?"none":null),ao.select("body").style("cursor",null),q.on("mousemove.brush",null).on("mouseup.brush",null).on("touchmove.brush",null).on("touchend.brush",null).on("keydown.brush",null).on("keyup.brush",null),z(),w({type:"brushend"})}var M,x,b=this,_=ao.select(ao.event.target),w=l.of(b,arguments),k=ao.select(b),N=_.datum(),E=!/^(n|s)$/.test(N)&&c,A=!/^(e|w)$/.test(N)&&f,C=_.classed("extent"),z=W(b),L=ao.mouse(b),q=ao.select(t(b)).on("keydown.brush",u).on("keyup.brush",v);if(ao.event.changedTouches?q.on("touchmove.brush",d).on("touchend.brush",m):q.on("mousemove.brush",d).on("mouseup.brush",m),k.interrupt().selectAll("*").interrupt(),C)L[0]=s[0]-L[0],L[1]=h[0]-L[1];else if(N){var T=+/w$/.test(N),R=+/^n/.test(N);x=[s[1-T]-L[0],h[1-R]-L[1]],L[0]=s[T],L[1]=h[R]}else ao.event.altKey&&(M=L.slice());k.style("pointer-events","none").selectAll(".resize").style("display",null),ao.select("body").style("cursor",_.style("cursor")),w({type:"brushstart"}),d()}var o,a,l=N(n,"brushstart","brush","brushend"),c=null,f=null,s=[0,0],h=[0,0],p=!0,g=!0,v=Bl[0];return n.event=function(n){n.each(function(){var n=l.of(this,arguments),t={x:s,y:h,i:o,j:a},e=this.__chart__||t;this.__chart__=t,Hl?ao.select(this).transition().each("start.brush",function(){o=e.i,a=e.j,s=e.x,h=e.y,n({type:"brushstart"})}).tween("brush:brush",function(){var e=xr(s,t.x),r=xr(h,t.y);return o=a=null,function(i){s=t.x=e(i),h=t.y=r(i),n({type:"brush",mode:"resize"})}}).each("end.brush",function(){o=t.i,a=t.j,n({type:"brush",mode:"resize"}),n({type:"brushend"})}):(n({type:"brushstart"}),n({type:"brush",mode:"resize"}),n({type:"brushend"}))})},n.x=function(t){return arguments.length?(c=t,v=Bl[!c<<1|!f],n):c},n.y=function(t){return arguments.length?(f=t,v=Bl[!c<<1|!f],n):f},n.clamp=function(t){return arguments.length?(c&&f?(p=!!t[0],g=!!t[1]):c?p=!!t:f&&(g=!!t),n):c&&f?[p,g]:c?p:f?g:null},n.extent=function(t){var e,r,i,u,l;return arguments.length?(c&&(e=t[0],r=t[1],f&&(e=e[0],r=r[0]),o=[e,r],c.invert&&(e=c(e),r=c(r)),e>r&&(l=e,e=r,r=l),e==s[0]&&r==s[1]||(s=[e,r])),f&&(i=t[0],u=t[1],c&&(i=i[1],u=u[1]),a=[i,u],f.invert&&(i=f(i),u=f(u)),i>u&&(l=i,i=u,u=l),i==h[0]&&u==h[1]||(h=[i,u])),n):(c&&(o?(e=o[0],r=o[1]):(e=s[0],r=s[1],c.invert&&(e=c.invert(e),r=c.invert(r)),e>r&&(l=e,e=r,r=l))),f&&(a?(i=a[0],u=a[1]):(i=h[0],u=h[1],f.invert&&(i=f.invert(i),u=f.invert(u)),i>u&&(l=i,i=u,u=l))),c&&f?[[e,i],[r,u]]:c?[e,r]:f&&[i,u])},n.clear=function(){return n.empty()||(s=[0,0],h=[0,0],o=a=null),n},n.empty=function(){return!!c&&s[0]==s[1]||!!f&&h[0]==h[1]},ao.rebind(n,l,"on")};var $l={n:"ns-resize",e:"ew-resize",s:"ns-resize",w:"ew-resize",nw:"nwse-resize",ne:"nesw-resize",se:"nwse-resize",sw:"nesw-resize"},Bl=[["n","e","s","w","nw","ne","se","sw"],["e","w"],["n","s"],[]],Wl=ga.format=xa.timeFormat,Jl=Wl.utc,Gl=Jl("%Y-%m-%dT%H:%M:%S.%LZ");Wl.iso=Date.prototype.toISOString&&+new Date("2000-01-01T00:00:00.000Z")?eo:Gl,eo.parse=function(n){var t=new Date(n);return isNaN(t)?null:t},eo.toString=Gl.toString,ga.second=On(function(n){return new va(1e3*Math.floor(n/1e3))},function(n,t){n.setTime(n.getTime()+1e3*Math.floor(t))},function(n){return n.getSeconds()}),ga.seconds=ga.second.range,ga.seconds.utc=ga.second.utc.range,ga.minute=On(function(n){return new va(6e4*Math.floor(n/6e4))},function(n,t){n.setTime(n.getTime()+6e4*Math.floor(t))},function(n){return n.getMinutes()}),ga.minutes=ga.minute.range,ga.minutes.utc=ga.minute.utc.range,ga.hour=On(function(n){var t=n.getTimezoneOffset()/60;return new va(36e5*(Math.floor(n/36e5-t)+t))},function(n,t){n.setTime(n.getTime()+36e5*Math.floor(t))},function(n){return n.getHours()}),ga.hours=ga.hour.range,ga.hours.utc=ga.hour.utc.range,ga.month=On(function(n){return n=ga.day(n),n.setDate(1),n},function(n,t){n.setMonth(n.getMonth()+t)},function(n){return n.getMonth()}),ga.months=ga.month.range,ga.months.utc=ga.month.utc.range;var Kl=[1e3,5e3,15e3,3e4,6e4,3e5,9e5,18e5,36e5,108e5,216e5,432e5,864e5,1728e5,6048e5,2592e6,7776e6,31536e6],Ql=[[ga.second,1],[ga.second,5],[ga.second,15],[ga.second,30],[ga.minute,1],[ga.minute,5],[ga.minute,15],[ga.minute,30],[ga.hour,1],[ga.hour,3],[ga.hour,6],[ga.hour,12],[ga.day,1],[ga.day,2],[ga.week,1],[ga.month,1],[ga.month,3],[ga.year,1]],nc=Wl.multi([[".%L",function(n){return n.getMilliseconds()}],[":%S",function(n){return n.getSeconds()}],["%I:%M",function(n){return n.getMinutes()}],["%I %p",function(n){return n.getHours()}],["%a %d",function(n){return n.getDay()&&1!=n.getDate()}],["%b %d",function(n){return 1!=n.getDate()}],["%B",function(n){return n.getMonth()}],["%Y",zt]]),tc={range:function(n,t,e){return ao.range(Math.ceil(n/e)*e,+t,e).map(io)},floor:m,ceil:m};Ql.year=ga.year,ga.scale=function(){return ro(ao.scale.linear(),Ql,nc)};var ec=Ql.map(function(n){return[n[0].utc,n[1]]}),rc=Jl.multi([[".%L",function(n){return n.getUTCMilliseconds()}],[":%S",function(n){return n.getUTCSeconds()}],["%I:%M",function(n){return n.getUTCMinutes()}],["%I %p",function(n){return n.getUTCHours()}],["%a %d",function(n){return n.getUTCDay()&&1!=n.getUTCDate()}],["%b %d",function(n){return 1!=n.getUTCDate()}],["%B",function(n){return n.getUTCMonth()}],["%Y",zt]]);ec.year=ga.year.utc,ga.scale.utc=function(){return ro(ao.scale.linear(),ec,rc)},ao.text=An(function(n){return n.responseText}),ao.json=function(n,t){return Cn(n,"application/json",uo,t)},ao.html=function(n,t){return Cn(n,"text/html",oo,t)},ao.xml=An(function(n){return n.responseXML}),"function"==typeof define&&define.amd?(this.d3=ao,define(ao)):"object"==typeof module&&module.exports?module.exports=ao:this.d3=ao}();
diff --git a/inst/htmlwidgets/lfx-clustercharts/lfx-clustercharts-bindings.js b/inst/htmlwidgets/lfx-clustercharts/lfx-clustercharts-bindings.js
new file mode 100644
index 00000000..01788e6f
--- /dev/null
+++ b/inst/htmlwidgets/lfx-clustercharts/lfx-clustercharts-bindings.js
@@ -0,0 +1,660 @@
+/* global LeafletWidget, $, L */
+LeafletWidget.methods.addClusterCharts = function(geojson, layerId, group, type,
+ options, icon, html,
+ popup, popupOptions, label, labelOptions,
+ clusterOptions, clusterId,
+ categoryField, categoryMap, popupFields, popupLabels,
+ markerOptions, legendOptions) {
+
+ var map = this;
+
+ // options
+ var rmax = options.rmax ? options.rmax : 30;
+ var strokeWidth = options.strokeWidth ? options.strokeWidth : 1;
+ var labelBackground = options.labelBackground;
+ var labelFill = options.labelFill ? options.labelFill : "white";
+ var labelStroke = options.labelStroke ? options.labelStroke : "black";
+ var labelColor = options.labelColor ? options.labelColor : "black";
+ var labelOpacity = options.labelOpacity ? options.labelOpacity : 0.9;
+ var sortTitlebyCount = options.sortTitlebyCount ? options.sortTitlebyCount : false;
+ var aggregation = options.aggregation ? options.aggregation : "sum";
+ var valueField = options.valueField ? options.valueField : null;
+ var digits = options.digits ? options.digits : null;
+
+ // Make L.markerClusterGroup, markers, fitBounds and renderLegend
+ var markerclusters = L.markerClusterGroup(
+ Object.assign({
+ maxClusterRadius: 2 * rmax,
+ iconCreateFunction: defineClusterIcon // this is where the magic happens
+ }, clusterOptions)
+ )
+ map.layerManager.addLayer(markerclusters, "cluster", clusterId, group);
+ var markers = L.geoJson(geojson, {
+ pointToLayer: defineFeature,
+ onEachFeature: defineFeaturePopup
+ });
+ markerclusters.addLayer(markers);
+ map.fitBounds(markers.getBounds());
+ renderLegend();
+
+ // Show/Hide the legend when the group is shown/hidden
+ map.on('overlayadd', function(eventlayer){
+ if (eventlayer.name == group) {
+ $(".clusterlegend").show()
+ }
+ });
+ map.on('overlayremove', function(eventlayer){
+ if (eventlayer.name == group) {
+ $(".clusterlegend").hide()
+ }
+ });
+
+ // Functions
+ function defineFeature(feature, latlng) {
+ var categoryVal = feature.properties[categoryField]
+ var myClass = 'clustermarker category-'+categoryVal+' icon-'+categoryVal;
+ let extraInfo = { clusterId: clusterId };
+
+ // Make DIV-Icon marker
+ var myIcon = L.divIcon({
+ className: myClass,
+ html: feature.properties[html] ? feature.properties[html] : "",
+ iconSize: null
+ });
+ var marker = L.marker(latlng,
+ Object.assign({
+ icon: myIcon
+ }, markerOptions)
+ );
+
+ // Add Labels
+ if (label !== null && feature.properties[label] && feature.properties[label] !== null) {
+ var labelshow = feature.properties[label];
+ if (labelOptions !== null) {
+ if(labelOptions.permanent) {
+ marker.bindTooltip(labelshow, labelOptions).openTooltip();
+ } else {
+ marker.bindTooltip(labelshow, labelOptions);
+ }
+ } else {
+ marker.bindTooltip(labelshow);
+ }
+ }
+ // Add Mouse events with layerId and Group
+ var lid = feature.properties[layerId] ? feature.properties[layerId] : layerId
+ var lgr = feature.properties[group] ? feature.properties[group] : group
+ marker.on("click", LeafletWidget.methods.mouseHandler(map.id, lid, lgr, "marker_click", extraInfo), this);
+ marker.on("mouseover", LeafletWidget.methods.mouseHandler(map.id, lid, lgr, "marker_mouseover", extraInfo), this);
+ marker.on("mouseout", LeafletWidget.methods.mouseHandler(map.id, lid, lgr, "marker_mouseout", extraInfo), this);
+ marker.on("dragend", LeafletWidget.methods.mouseHandler(map.id, lid, lgr, "marker_dragend", extraInfo), this);
+
+ return marker;
+ }
+ function defineFeaturePopup(feature, layer) {
+ var props = feature.properties,
+ popupContent = '';
+ if (popup && props[popup]) {
+ popupContent = props[popup] + '';
+ } else if (popupFields !== null ) {
+ popupContent += '';
+ }
+
+ if (popupContent !== '') {
+ if (popupOptions !== null){
+ layer.bindPopup(popupContent, popupOptions);
+ } else {
+ layer.bindPopup(popupContent);
+ }
+ }
+ }
+ function defineClusterIcon(cluster) {
+ var children = cluster.getAllChildMarkers(),
+ n = children.length,
+ r = rmax - 2 * strokeWidth - (n<10?12:n<100?8:n<1000?4:0),
+ iconDim = (r + strokeWidth) * 2,
+ html,
+ innerRadius = options.innerRadius ? options.innerRadius : -10;
+
+ //bake some svg markup
+ if (type == "custom") {
+
+ // Define aggregation function
+ function aggregateData(data, categoryField, aggregationFunc, valueField) {
+ return d3.nest()
+ .key(function(d) { return d.feature.properties[categoryField]; })
+ .rollup(function(leaves) {
+ return aggregationFunc(leaves, function(d) { return d.feature.properties[valueField]; });
+ })
+ .entries(data);
+ }
+
+ // Aggregation functions
+ const aggregationFunctions = {
+ sum: (leaves, accessor) => d3.sum(leaves, accessor),
+ max: (leaves, accessor) => d3.max(leaves, accessor),
+ min: (leaves, accessor) => d3.min(leaves, accessor),
+ mean: (leaves, accessor) => d3.mean(leaves, accessor),
+ median: (leaves, accessor) => d3.median(leaves, accessor),
+ //mode: (leaves, accessor) => d3.mode(leaves, accessor),
+ //cumsum: (leaves, accessor) => d3.cumsum(leaves, accessor),
+ //least: (leaves, accessor) => d3.least(leaves, accessor),
+ //variance: (leaves, accessor) => d3.variance(leaves, accessor),
+ //deviation: (leaves, accessor) => d3.deviation(leaves, accessor),
+ };
+
+ // Aggregate Data based on the category `categoryField` and the value `valueField`
+ var data = aggregateData(children, categoryField, aggregationFunctions[aggregation], valueField);
+
+ // Calculate full aggregation for centered Text
+ var totalAggregation = aggregationFunctions[aggregation](children, function(d) {
+ return d.feature.properties[valueField];
+ });
+ totalAggregation = totalAggregation.toFixed(digits);
+
+ // Make Chart
+ html = bakeTheStatsChart({
+ data: data,
+ valueFunc: function(d) { return d.values; },
+ outerRadius: r,
+ innerRadius: r - innerRadius,
+ totalAggregation: totalAggregation,
+ bubbleClass: 'cluster-bubble',
+ bubbleLabelClass: 'clustermarker-cluster-bubble-label',
+ pathClassFunc: function(d) {
+ return "category-" + d.data.key;
+ },
+ pathTitleFunc: function(d) {
+ return d.data.key + ' (' + d.value + ')';
+ }
+ });
+
+ } else {
+ var data = d3.nest() //Build a dataset for the pie chart
+ .key(function(d) { return d.feature.properties[categoryField]; })
+ .entries(children, d3.map)
+
+ if (type == "pie") {
+ html = bakeThePie({
+ data: data,
+ valueFunc: function(d) { return d.values.length; },
+ outerRadius: r,
+ innerRadius: r - innerRadius,
+ pieLabel: n,
+ pieClass: 'cluster-pie',
+ pieLabelClass: 'clustermarker-cluster-pie-label',
+ pathClassFunc: function(d) {
+ return "category-" + d.data.key;
+ },
+ pathTitleFunc: function(d) {
+ return d.data.key + ' (' + d.data.values.length + ')';
+ }
+ })
+ } else if (type == "horizontal") {
+ html = bakeTheBarChartHorizontal({
+ data: data,
+ width: options.width ? options.width : 70,
+ height: options.height ? options.height : 40,
+ barLabel: n,
+ barClass: 'cluster-bar',
+ barLabelClass: 'clustermarker-cluster-bar-label',
+ pathClassFunc: function(d) {
+ return "category-" + d.key;
+ },
+ pathTitleFunc: function(d) {
+ return d.key + ' (' + d.values.length + ')';
+ }
+ });
+ } else {
+ html = bakeTheBarChart({
+ data: data,
+ width: options.width ? options.width : 70,
+ height: options.height ? options.height : 40,
+ barLabel: n,
+ barClass: 'cluster-bar',
+ barLabelClass: 'clustermarker-cluster-bar-label',
+ pathClassFunc: function(d) {
+ return "category-" + d.key;
+ },
+ pathTitleFunc: function(d) {
+ return d.key + ' (' + d.values.length + ')';
+ }
+ });
+ }
+ }
+
+ //Create a new divIcon and assign the svg markup to the html property
+ var myIcon = new L.DivIcon({
+ html: html,
+ className: 'clustermarker-cluster',
+ iconSize: new L.Point(iconDim, iconDim)
+ });
+
+ return myIcon;
+ }
+ //function that generates a svg markup for a Statistics chart
+ function bakeTheStatsChart(options) {
+ if (!options.data || !options.valueFunc) {
+ return '';
+ }
+ var data = options.data,
+ valueFunc = options.valueFunc,
+ r = options.outerRadius,
+ rInner = options.innerRadius,
+ pathClassFunc = options.pathClassFunc,
+ pathTitleFunc = options.pathTitleFunc,
+ totalAggregation = options.totalAggregation,
+ bubbleLabelClass = options.bubbleLabelClass,
+ origo = (r + strokeWidth),
+ w = origo * 2,
+ h = w,
+ donut = d3.layout.pie(),
+ arc = d3.svg.arc().innerRadius(rInner).outerRadius(r);
+
+ let radius = w;
+
+ let pie = donut
+ .padAngle(1 / radius)
+ //.sort(null)
+ .value(valueFunc);
+
+ var arc = d3.svg.arc()
+ .innerRadius(rInner)
+ .outerRadius(r);
+
+ // Create SVG
+ var svg = document.createElementNS(d3.ns.prefix.svg, 'svg');
+ var vis = d3.select(svg)
+ .attr("width", w)
+ .attr("height", h)
+
+ // Create the Arcs
+ var arcs = vis.selectAll('g.arc')
+ .data(pie(data))
+ .enter().append('svg:g')
+ .attr('class', 'arc')
+ .attr('transform', 'translate(' + origo + ',' + origo + ')');
+
+ arcs.append('svg:path')
+ .attr('class', pathClassFunc)
+ .attr('stroke-width', strokeWidth)
+ .attr('d', arc)
+
+ // Display the text of each Arc
+ arcs.append('text')
+ .attr('transform', function(d) {
+ return 'translate(' + arc.centroid(d) + ')';
+ })
+ .attr('class', bubbleLabelClass)
+ .attr('text-anchor', 'middle')
+ .attr('fill', labelColor)
+ .attr('dy','.3em')
+ .text(function(d){ return d.data.values.toFixed(digits); })
+ .append('svg:title')
+ .text(pathTitleFunc);
+
+ // Show Label Background
+ if (labelBackground && labelBackground == true) {
+ vis.append('circle')
+ .attr('r', rInner-5)
+ .attr('transform', 'translate(' + origo + ',' + origo + ')')
+ .attr('fill', labelFill)
+ .attr('stroke', labelStroke)
+ .attr('stroke-width', strokeWidth)
+ .attr('opacity', labelOpacity)
+ }
+
+ // Display the total aggregation in the Center
+ vis.append('text')
+ .attr('x', origo)
+ .attr('y', origo)
+ .attr('class', bubbleLabelClass)
+ .attr('text-anchor', 'middle')
+ .attr('fill', labelColor)
+ .attr('stroke', labelStroke)
+ .attr('opacity', labelOpacity)
+ .attr('stroke-width', strokeWidth)
+ .attr('dy', '.3em')
+ .text(totalAggregation);
+
+ return serializeXmlNode(svg);
+ }
+ //function that generates a svg markup for a Pie chart
+ function bakeThePie(options) {
+ if (!options.data || !options.valueFunc) {
+ return '';
+ }
+ var data = options.data,
+ valueFunc = options.valueFunc,
+ r = options.outerRadius,
+ rInner = options.innerRadius,
+ pathClassFunc = options.pathClassFunc,
+ pathTitleFunc = options.pathTitleFunc,
+ pieClass = options.pieClass,
+ pieLabel = options.pieLabel ? options.pieLabel : d3.sum(data, valueFunc),
+ pieLabelClass = options.pieLabelClass,
+ origo = (r + strokeWidth),
+ w = origo * 2,
+ h = w,
+ donut = d3.layout.pie(),
+ arc = d3.svg.arc().innerRadius(rInner).outerRadius(r);
+
+ // Create SVG
+ var svg = document.createElementNS(d3.ns.prefix.svg, 'svg');
+ var vis = d3.select(svg)
+ .data([data])
+ .attr('class', pieClass)
+ .attr('width', w)
+ .attr('height', h);
+
+ // Create the Arcs
+ var arcs = vis.selectAll('g.arc')
+ .data(donut.value(valueFunc))
+ .enter().append('svg:g')
+ .attr('class', 'arc')
+ .attr('transform', 'translate(' + origo + ',' + origo + ')');
+
+ arcs.append('svg:path')
+ .attr('class', pathClassFunc)
+ .attr('stroke-width', strokeWidth)
+ .attr('d', arc)
+ .append('svg:title')
+ .text(pathTitleFunc);
+
+ // Create Title for Individual Elements and All in Cluster
+ pathTitleFunc = function(d) {
+ return d.key + ' (' + d.values.length + ')';
+ }
+ let allTitles = ""
+ if (sortTitlebyCount) {
+ allTitles = data
+ .sort(function(a, b) { return b.values.length - a.values.length; }) // Sort by length in descending order
+ .map(function(d) { return pathTitleFunc(d); })
+ .join('\n');
+ } else {
+ let categoryOrder = {};
+ for (var key in categoryMap) {
+ categoryOrder[categoryMap[key]] = parseInt(key);
+ }
+ allTitles = data
+ .sort(function(a, b) {
+ // Get the order values from categoryOrder
+ var orderA = categoryOrder[a.key] || Infinity;
+ var orderB = categoryOrder[b.key] || Infinity;
+ return orderA - orderB; // Sort in ascending order
+ })
+ .map(function(d) { return pathTitleFunc(d); })
+ .join('\n');
+ }
+
+ // Show Label Background
+ if (labelBackground && labelBackground == true) {
+ vis.append('circle')
+ .attr('r', rInner-5)
+ .attr('transform', 'translate(' + origo + ',' + origo + ')')
+ .attr('fill', labelFill)
+ .attr('stroke', labelStroke)
+ .attr('stroke-width', strokeWidth)
+ .attr('opacity', labelOpacity)
+ .append('svg:title')
+ .text(allTitles);
+ }
+
+ // Text
+ vis.append('text')
+ .attr('x',origo)
+ .attr('y',origo)
+ .attr('class', pieLabelClass)
+ .attr('text-anchor', 'middle')
+ .attr('fill', labelColor)
+ .attr('stroke', labelStroke)
+ .attr('opacity', labelOpacity)
+ .attr('stroke-width', strokeWidth)
+ .attr('dy','.3em')
+ .text(pieLabel)
+ .append('svg:title')
+ .text(allTitles);
+
+ //Return the svg-markup rather than the actual element
+ return serializeXmlNode(svg);
+ }
+ //function that generates a svg markup for a Bar chart
+ function bakeTheBarChart(options) {
+ if (!options.data) {
+ return '';
+ }
+ var data = options.data,
+ barClass = options.barClass,
+ barLabel = options.barLabel ? options.barLabel : d3.sum(data, function(d) { return d.values.length; }),
+ barLabelClass = options.barLabelClass,
+ width = options.width,
+ height = options.height,
+ pathClassFunc = options.pathClassFunc,
+ pathTitleFunc = options.pathTitleFunc,
+ x = d3.scale.ordinal().rangeRoundBands([0, width], 0.1),
+ y = d3.scale.linear().range([height, 0]);
+
+ x.domain(data.map(function(d) { return d.key; }));
+ y.domain([0, d3.max(data, function(d) { return d.values.length; })]);
+
+ // Create svg
+ var svg = document.createElementNS(d3.ns.prefix.svg, "svg");
+ var vis = d3.select(svg)
+ .attr('class', barClass)
+ .attr('width', width + strokeWidth)
+ .attr('height', height + 20 + strokeWidth);
+
+ // Create Bars
+ vis.selectAll('.bar')
+ .data(data)
+ .enter().append('rect')
+ .attr('class', pathClassFunc)
+ .attr('x', function(d) { return x(d.key); })
+ .attr('width', x.rangeBand())
+ .attr('y', function(d) { return y(d.values.length); })
+ .attr('height', function(d) { return height - y(d.values.length); })
+ .append('svg:title')
+ .text(pathTitleFunc);
+
+ // Create Title for Individual Elements and All in Cluster
+ let allTitles = ""
+ if (sortTitlebyCount) {
+ allTitles = data
+ .sort(function(a, b) { return b.values.length - a.values.length; }) // Sort by length in descending order
+ .map(function(d) { return pathTitleFunc(d); })
+ .join('\n');
+ } else {
+ let categoryOrder = {};
+ for (var key in categoryMap) {
+ categoryOrder[categoryMap[key]] = parseInt(key);
+ }
+ allTitles = data
+ .sort(function(a, b) {
+ // Get the order values from categoryOrder
+ var orderA = categoryOrder[a.key] || Infinity;
+ var orderB = categoryOrder[b.key] || Infinity;
+ return orderA - orderB; // Sort in ascending order
+ })
+ .map(function(d) { return pathTitleFunc(d); })
+ .join('\n');
+ }
+
+ // Bar Label Background
+ if (labelBackground && labelBackground == true) {
+ vis.append('rect')
+ .attr('x', (width - (width - 10)) / 2)
+ .attr('y', height + 5)
+ .attr('width', width - 10)
+ .attr('height', 15)
+ .attr('fill', labelFill)
+ .attr('stroke', labelStroke)
+ .attr('opacity', labelOpacity)
+ .attr('stroke-width', strokeWidth)
+ .append('svg:title')
+ .text(allTitles);
+ }
+
+ // Bar Label (below)
+ vis.append('text')
+ .attr('x', width / 2)
+ .attr('y', height + 13)
+ .attr('class', barLabelClass)
+ .attr('text-anchor', 'middle')
+ .attr('fill', labelColor)
+ .attr('stroke', labelStroke)
+ .attr('opacity', labelOpacity)
+ .attr('stroke-width', strokeWidth)
+ .attr('dy', '.3em')
+ .text(barLabel)
+ .append('svg:title')
+ .text(allTitles);
+
+ return serializeXmlNode(svg);
+ }
+ //function that generates a svg markup for a Bar chart (horizontal)
+ function bakeTheBarChartHorizontal(options) {
+ if (!options.data) {
+ return '';
+ }
+ var data = options.data,
+ barClass = options.barClass,
+ barLabel = options.barLabel ? options.barLabel : d3.sum(data, function(d) { return d.values.length; }),
+ barLabelClass = options.barLabelClass,
+ width = options.width,
+ height = options.height,
+ pathClassFunc = options.pathClassFunc,
+ pathTitleFunc = options.pathTitleFunc,
+ x = d3.scale.linear().range([0, width]),
+ y = d3.scale.ordinal().rangeRoundBands([0, height], 0.1);
+
+ x.domain([0, d3.max(data, function(d) { return d.values.length; })]);
+ y.domain(data.map(function(d) { return d.key; }));
+
+ // Create SVG
+ var svg = document.createElementNS(d3.ns.prefix.svg, "svg");
+ var vis = d3.select(svg)
+ .attr('class', barClass)
+ .attr('width', width + strokeWidth)
+ .attr('height', height + 20 + strokeWidth);
+
+ // Create Bars
+ vis.selectAll('.bar')
+ .data(data)
+ .enter().append('rect')
+ .attr('class', pathClassFunc)
+ .attr('x', 0)
+ .attr('y', function(d) { return y(d.key); })
+ .attr('width', function(d) { return x(d.values.length); })
+ .attr('height', y.rangeBand())
+ .append('svg:title')
+ .text(pathTitleFunc);
+
+ // Create Title for Individual Elements and All in Cluster
+ let allTitles = ""
+ if (sortTitlebyCount) {
+ allTitles = data
+ .sort(function(a, b) { return b.values.length - a.values.length; }) // Sort by length in descending order
+ .map(function(d) { return pathTitleFunc(d); })
+ .join('\n');
+ } else {
+ let categoryOrder = {};
+ for (var key in categoryMap) {
+ categoryOrder[categoryMap[key]] = parseInt(key);
+ }
+ allTitles = data
+ .sort(function(a, b) {
+ // Get the order values from categoryOrder
+ var orderA = categoryOrder[a.key] || Infinity;
+ var orderB = categoryOrder[b.key] || Infinity;
+ return orderA - orderB; // Sort in ascending order
+ })
+ .map(function(d) { return pathTitleFunc(d); })
+ .join('\n');
+ }
+
+ // Bar Label Background
+ if (labelBackground && labelBackground == true) {
+ vis.append('rect')
+ .attr('x', 0)
+ .attr('y', height + 3)
+ .attr('width', width)
+ .attr('height', 15)
+ .attr('fill', labelFill)
+ .attr('stroke', labelStroke)
+ .attr('opacity', labelOpacity)
+ .attr('stroke-width', strokeWidth)
+ .append('svg:title')
+ .text(allTitles);
+ }
+
+ // Bar Label
+ vis.append('text')
+ .attr('x', width / 2)
+ .attr('y', (height + 8))
+ .attr('class', barLabelClass)
+ .attr('text-anchor', 'middle')
+ .attr('dominant-baseline', 'middle')
+ .attr('alignment-baseline', 'middle')
+ .attr('stroke', labelStroke)
+ .attr('opacity', labelOpacity)
+ .attr('stroke-width', strokeWidth)
+ .attr('dy', '.3em')
+ .attr('fill', labelColor)
+ .text(barLabel)
+ .append('svg:title')
+ .text(allTitles);
+
+ return serializeXmlNode(svg);
+ }
+ //Helper function
+ function serializeXmlNode(xmlNode) {
+ if (typeof window.XMLSerializer != "undefined") {
+ return (new window.XMLSerializer()).serializeToString(xmlNode);
+ } else if (typeof xmlNode.xml != "undefined") {
+ return xmlNode.xml;
+ }
+ return "";
+ }
+ //Function for generating a legend with the same categories as in the clusterPie
+ function renderLegend() {
+ var data = Object.entries(categoryMap).map(([key, value]) => ({
+ key: key,
+ value: value
+ }));
+ var legendControl = L.control({position: legendOptions.position});
+
+ legendControl.onAdd = function(map) {
+ var div = L.DomUtil.create('div', 'clusterlegend');
+ div.innerHTML = legendOptions.title ? '' + legendOptions.title + '
' : '';
+
+ var legendItems = d3.select(div)
+ .selectAll('.legenditem')
+ .data(data);
+
+ legendItems.enter()
+ .append('div')
+ .attr('class', function(d) {
+ return 'category-' + d.value;
+ })
+ .classed('legenditem', true)
+ .text(function(d) { return d.value; });
+
+ return div;
+ };
+
+ // Add the custom control to the map
+ legendControl.addTo(map);
+ }
+
+};
+
+
+
+
diff --git a/inst/htmlwidgets/lfx-clustercharts/lfx-clustercharts.css b/inst/htmlwidgets/lfx-clustercharts/lfx-clustercharts.css
new file mode 100644
index 00000000..6a14b948
--- /dev/null
+++ b/inst/htmlwidgets/lfx-clustercharts/lfx-clustercharts.css
@@ -0,0 +1,50 @@
+
+.clustermarkerpopuplabel {
+ font-weight: 800;
+}
+
+.clusterlegend {
+ padding: 2px 9px;
+ border-radius: 8px;
+ z-index: 100;
+ font-size: 1em;
+ font-family: sans-serif;
+ background: rgba(255,255,255,0.9);
+ min-width: 100px;
+}
+.legendheading {
+ position: relative;
+ height: 25px;
+ padding: 5px 2px 0px 2px;
+ font-size: larger;
+ font-weight: bold;
+}
+.legenditem {
+ padding: 2px;
+ margin-bottom: 2px;
+}
+
+/*Marker clusters*/
+.clustermarker-cluster-pie g.arc{
+ fill-opacity: 0.5;
+}
+.clustermarker-cluster-pie-label, .clustermarker-cluster-bar-label {
+ font-size: 14px;
+ font-weight: bold;
+ font-family: sans-serif;
+}
+
+/*Markers*/
+.clustermarker {
+ border-width: 2px;
+ border-radius:10px;
+ border-style: solid;
+}
+.clustermarker div{
+ text-align: center;
+ font-size: 14px;
+ font-weight: bold;
+ font-family: sans-serif;
+}
+
+
diff --git a/man/addClusterCharts.Rd b/man/addClusterCharts.Rd
new file mode 100644
index 00000000..4b15b2a6
--- /dev/null
+++ b/man/addClusterCharts.Rd
@@ -0,0 +1,172 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/clusterCharts.R
+\name{addClusterCharts}
+\alias{addClusterCharts}
+\title{addClusterCharts}
+\usage{
+addClusterCharts(
+ map,
+ layerId = NULL,
+ group = NULL,
+ type = c("pie", "bar", "horizontal", "custom"),
+ aggregation = c("sum", "min", "max", "mean", "median"),
+ valueField = NULL,
+ options = clusterchartOptions(),
+ icon = NULL,
+ html = NULL,
+ popup = NULL,
+ popupOptions = NULL,
+ label = NULL,
+ labelOptions = NULL,
+ clusterOptions = NULL,
+ clusterId = NULL,
+ categoryField,
+ categoryMap,
+ popupFields = NULL,
+ popupLabels = NULL,
+ markerOptions = NULL,
+ legendOptions = list(title = "", position = "topright"),
+ data = getMapData(map)
+)
+}
+\arguments{
+\item{map}{a map widget object created from \code{\link[leaflet]{leaflet}()}}
+
+\item{layerId}{the layer id}
+
+\item{group}{the name of the group the newly created layers should belong to
+(for \code{\link[leaflet]{clearGroup}} and \code{\link[leaflet]{addLayersControl}} purposes).
+Human-friendly group names are permitted--they need not be short,
+identifier-style names. Any number of layers and even different types of
+layers (e.g. markers and polygons) can share the same group name.}
+
+\item{type}{The type of chart to use for clusters: \code{"pie"}, \code{"bar"}, \code{"horizontal"}, or \code{"custom"}.}
+
+\item{aggregation}{Aggregation method for \code{"custom"} charts (e.g., sum, min, max, mean, median).}
+
+\item{valueField}{Column name with values to aggregate for \code{"custom"} charts.}
+
+\item{options}{Additional options for cluster charts (see \code{\link{clusterchartOptions}}).}
+
+\item{icon}{An icon or set of icons to include, created with \code{makeIcon} or \code{iconList}.}
+
+\item{html}{The column name containing the HTML content to include in the markers.}
+
+\item{popup}{The column name used to retrieve feature properties for the popup.}
+
+\item{popupOptions}{A Vector of \code{\link[leaflet]{popupOptions}} to provide popups}
+
+\item{label}{a character vector of the HTML content for the labels}
+
+\item{labelOptions}{A Vector of \code{\link[leaflet]{labelOptions}} to provide label
+options for each label. Default \code{NULL}}
+
+\item{clusterOptions}{if not \code{NULL}, markers will be clustered using
+\href{https://github.com/Leaflet/Leaflet.markercluster}{Leaflet.markercluster};
+ you can use \code{\link[leaflet]{markerClusterOptions}()} to specify marker cluster
+options}
+
+\item{clusterId}{the id for the marker cluster layer}
+
+\item{categoryField}{Column name for categorizing charts.}
+
+\item{categoryMap}{A data.frame mapping categories to chart properties (e.g., label, color, icons, stroke).}
+
+\item{popupFields}{A string or vector of strings indicating the column names to include in popups.}
+
+\item{popupLabels}{A string or vector of strings indicating the labels for the popup fields.}
+
+\item{markerOptions}{Additional options for markers (see \code{\link[leaflet:markerOptions]{markerOptions::markerOptions()}}).}
+
+\item{legendOptions}{A list of options for the legend, including the title and position.}
+
+\item{data}{the data object from which the argument values are derived; by
+default, it is the \code{data} object provided to \code{leaflet()}
+initially, but can be overridden}
+}
+\description{
+Clusters markers on a Leaflet map and visualizes them using
+customizable charts, such as pie or bar charts, showing counts by category.
+When using the \code{"custom"} type, a pie chart is rendered with aggregated data,
+employing methods like sum, min, max, mean, or median.
+}
+\details{
+The `clusterCharts` use Leaflet's `L.DivIcon`, allowing you to fully customize
+the styling of individual markers and clusters using CSS. Each individual marker
+within a cluster is assigned the CSS class `clustermarker`, while the entire
+cluster is assigned the class `clustermarker-cluster`. You can modify the appearance
+of these elements by targeting these classes in your custom CSS.
+}
+\examples{
+# Example usage:
+library(sf)
+library(leaflet)
+library(leaflet.extras2)
+
+data <- sf::st_as_sf(breweries91)
+categories <- c("Schwer", "Mäßig", "Leicht", "kein Schaden")
+data$category <- sample(categories, size = nrow(data), replace = TRUE)
+
+## Pie Chart
+leaflet() \%>\%
+ addProviderTiles("CartoDB.Positron") \%>\%
+ leaflet::addLayersControl(overlayGroups = "clustermarkers") \%>\%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , categoryMap = data.frame(labels = categories,
+ colors = c("#F88", "#FA0", "#FF3", "#BFB"),
+ strokes = "gray")
+ , group = "clustermarkers"
+ , popupFields = c("brewery", "address", "zipcode", "category")
+ , popupLabels = c("Brauerei", "Adresse", "PLZ", "Art")
+ , label = "brewery"
+ )
+
+## Bar Chart
+leaflet() \%>\%
+ addProviderTiles("CartoDB.Positron") \%>\%
+ leaflet::addLayersControl(overlayGroups = "clustermarkers") \%>\%
+ addClusterCharts(data = data
+ , type = "bar"
+ , categoryField = "category"
+ , categoryMap = data.frame(labels = categories,
+ colors = c("#F88", "#FA0", "#FF3", "#BFB"),
+ strokes = "gray")
+ , group = "clustermarkers"
+ , popupFields = c("brewery", "address", "zipcode", "category")
+ , popupLabels = c("Brauerei", "Adresse", "PLZ", "Art")
+ , label = "brewery")
+
+## Custom Pie Chart with "mean" aggregation on column "value"
+data <- sf::st_as_sf(breweries91)
+categories <- c("Schwer", "Mäßig", "Leicht", "kein Schaden")
+data$category <- sample(categories, size = nrow(data), replace = TRUE)
+data$value <- round(runif(nrow(data), 0, 100), 0)
+
+leaflet() \%>\%
+ addProviderTiles("CartoDB.Positron") \%>\%
+ leaflet::addLayersControl(overlayGroups = "clustermarkers") \%>\%
+ addClusterCharts(data = data
+ , type = "custom"
+ , valueField = "value"
+ , aggregation = "mean"
+ , categoryField = "category"
+ , categoryMap = data.frame(labels = categories,
+ colors = c("#F88", "#FA0", "#FF3", "#BFB"),
+ strokes = "gray")
+ , options = clusterchartOptions(rmax=50, digits=0, innerRadius = 20)
+ , group = "clustermarkers"
+ , popupFields = c("brewery", "address", "zipcode", "category","value")
+ , popupLabels = c("Brauerei", "Adresse", "PLZ", "Art", "Value")
+ , label = "brewery"
+ )
+
+## For Shiny examples, please run:
+# runApp(system.file("examples/clusterCharts_app.R", package = "leaflet.extras2"))
+# runApp(system.file("examples/clustercharts_sum.R", package = "leaflet.extras2"))
+}
+\seealso{
+Other clusterCharts:
+\code{\link{clusterchartOptions}()}
+}
+\concept{clusterCharts}
diff --git a/man/addTimeslider.Rd b/man/addTimeslider.Rd
index 6338b01a..64a99d36 100644
--- a/man/addTimeslider.Rd
+++ b/man/addTimeslider.Rd
@@ -84,7 +84,6 @@ JQuery UI slider.
library(leaflet)
library(leaflet.extras2)
library(sf)
-library(geojsonsf)
data <- sf::st_as_sf(leaflet::atlStorms2005[1,])
data <- st_cast(data, "POINT")
diff --git a/man/clusterchartOptions.Rd b/man/clusterchartOptions.Rd
new file mode 100644
index 00000000..9031091f
--- /dev/null
+++ b/man/clusterchartOptions.Rd
@@ -0,0 +1,57 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/clusterCharts.R
+\name{clusterchartOptions}
+\alias{clusterchartOptions}
+\title{clusterchartOptions}
+\usage{
+clusterchartOptions(
+ rmax = 30,
+ size = c(20, 20),
+ width = 40,
+ height = 50,
+ strokeWidth = 1,
+ innerRadius = 10,
+ labelBackground = FALSE,
+ labelFill = "white",
+ labelStroke = "black",
+ labelColor = "black",
+ labelOpacity = 0.9,
+ digits = 2,
+ sortTitlebyCount = TRUE
+)
+}
+\arguments{
+\item{rmax}{The maximum radius of the clusters.}
+
+\item{size}{The size of the cluster markers.}
+
+\item{width}{The width of the bar-charts.}
+
+\item{height}{The height of the bar-charts.}
+
+\item{strokeWidth}{The stroke width of the chart.}
+
+\item{innerRadius}{The inner radius of pie-charts.}
+
+\item{labelBackground}{Should the label have a background? Default is `FALSE`}
+
+\item{labelFill}{The label background color. Default is `white`}
+
+\item{labelStroke}{The label stroke color. Default is `black`}
+
+\item{labelColor}{The label color. Default is `black`}
+
+\item{labelOpacity}{The label color. Default is `0.9`}
+
+\item{digits}{The amount of digits. Default is `2`}
+
+\item{sortTitlebyCount}{Should the svg-title be sorted by count or by the categories.}
+}
+\description{
+Adds options for clusterCharts
+}
+\seealso{
+Other clusterCharts:
+\code{\link{addClusterCharts}()}
+}
+\concept{clusterCharts}
diff --git a/tests/testthat/test-clustercharts.R b/tests/testthat/test-clustercharts.R
new file mode 100644
index 00000000..5a1624b8
--- /dev/null
+++ b/tests/testthat/test-clustercharts.R
@@ -0,0 +1,277 @@
+
+test_that("clustercharts", {
+
+ # shipIcon <- leaflet::makeIcon(
+ # iconUrl = "./icons/Icon5.svg"
+ # ,className = "lsaicons"
+ # ,iconWidth = 24, iconHeight = 24, iconAnchorX = 0, iconAnchorY = 0
+ # )
+
+
+ ## data ##########
+ data <- sf::st_as_sf(breweries91)
+ data$category <- sample(c("Schwer", "Mäßig", "Leicht", "kein Schaden"), size = nrow(data), replace = TRUE)
+ data$label <- paste0(data$brewery, "
", data$address)
+ data$id <- paste0("ID", seq.int(nrow(data)))
+ data$popup <- paste0("", data$brewery, "
", data$address, "
")
+ data$tosum <- sample(1:100, nrow(data), replace = TRUE)
+ data$tosumlabel <- paste("Sum: ", data$tosum)
+ data$web <- gsub(">(.*?)<", ">",data$tosum,"<", data$web)
+ data$web <- ifelse(is.na(data$web), "", paste0("", data$web, "
"))
+
+ ## simple example ##########
+ m <- leaflet() %>% addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
+ colors = c("lightblue", "orange", "lightyellow", "lightgreen")))
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## simple example (SP-data) ##########
+ m <- leaflet() %>% addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = as(data, "Spatial")
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
+ colors = c("lightblue", "orange", "lightyellow", "lightgreen")))
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## simple example with popupFields / popupLabels ##########
+ m <- leaflet() %>% addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
+ colors = c("lightblue", "orange", "lightyellow", "lightgreen"))
+ , popupFields = c("id","brewery","address","zipcode", "category","tosum")
+ , popupLabels = c("id","Brauerei","Addresse","PLZ", "Art", "tosum")
+ )
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ m <- leaflet() %>% addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
+ colors = c("lightblue", "orange", "lightyellow", "lightgreen"))
+ , popupFields = c("id","brewery","address","zipcode", "category","tosum")
+ )
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## No `categoryMap` - Error ##########
+ m <- expect_error(
+ leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ ))
+
+ ## No `categoryField` - Error ##########
+ m <- expect_error(
+ leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryMap =
+ data.frame(colors = c("lightblue", "orange", "lightyellow", "lightgreen")
+ )
+ ))
+
+ ## No `colors` in `categoryMap` ##########
+ m <- expect_warning(
+ leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden")
+ # ,colors = c("lightblue", "orange", "lightyellow", "lightgreen")
+ )
+ ))
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## No `labels` in `categoryMap` ##########
+ m <- expect_warning(
+ leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(colors = c("lightblue", "orange", "lightyellow", "lightgreen")
+ )
+ ))
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## Multiple Sizes ##########
+ m <- leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden")
+ ,colors = c("lightblue", "orange", "lightyellow", "lightgreen")
+ )
+ , options = clusterchartOptions(size = c(10,40))
+ )
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## Icons (single) ##########
+ shipIcon <- makeIcon(
+ iconUrl = "https://cdn-icons-png.flaticon.com/512/1355/1355883.png",
+ iconWidth = 40, iconHeight = 50,
+ iconAnchorX = 0, iconAnchorY = 0
+ )
+ m <- leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , icon = shipIcon
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden")
+ ,colors = c("lightblue", "orange", "lightyellow", "lightgreen")
+ )
+ , popupFields = c("id","brewery","address","zipcode", "category","tosum","tosum2")
+ , popupLabels = c("id","Brauerei","Addresse","PLZ", "Art", "tosum","tosum2")
+ , label = "label"
+ , options = clusterchartOptions(size = 50)
+ )
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## Icons (multiple) ##########
+ shipIcon <- iconList(
+ "Schwer" = makeIcon("https://leafletjs.com/examples/custom-icons/leaf-red.png",
+ iconWidth = 40, iconHeight = 50),
+ "Mäßig" = makeIcon("https://upload.wikimedia.org/wikipedia/commons/thumb/0/0b/Maki2-ferry-18.svg/480px-Maki2-ferry-18.svg.png",
+ iconWidth = 40),
+ "Leicht" = makeIcon("https://upload.wikimedia.org/wikipedia/commons/thumb/c/c3/Maki2-danger-24.svg/240px-Maki2-danger-24.svg.png",
+ iconWidth = 40),
+ "kein Schaden" = makeIcon("https://leafletjs.com/examples/custom-icons/leaf-green.png",
+ iconWidth = 40, iconHeight = 50)
+ )
+ m <- leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , icon = shipIcon
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden")
+ ,colors = c("lightblue", "orange", "lightyellow", "lightgreen")
+ )
+ , popupFields = c("id","brewery","address","zipcode", "category","tosum","tosum2")
+ , popupLabels = c("id","Brauerei","Addresse","PLZ", "Art", "tosum","tosum2")
+ , label = "label"
+ , options = clusterchartOptions(size = c(30,35))
+ )
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## Icons in `categoryMap` ##########
+ iconvec <- c("https://leafletjs.com/examples/custom-icons/leaf-red.png",
+ "https://upload.wikimedia.org/wikipedia/commons/thumb/0/0b/Maki2-ferry-18.svg/480px-Maki2-ferry-18.svg.png",
+ "https://upload.wikimedia.org/wikipedia/commons/thumb/0/0b/Maki2-ferry-18.svg/480px-Maki2-ferry-18.svg.png",
+ "https://leafletjs.com/examples/custom-icons/leaf-green.png")
+ m <- leaflet() %>% addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = as(data, "Spatial")
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
+ colors = c("lightblue", "orange", "lightyellow", "lightgreen"),
+ icons = iconvec)
+ , options = clusterchartOptions(size = 50)
+ , popupFields = c("id","brewery","address","zipcode", "category","tosum","tosum2")
+ , popupLabels = c("id","Brauerei","Addresse","PLZ", "Art", "tosum","tosum2")
+ , label = "label")
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## ALL ############
+ m <- leaflet() %>% addMapPane("clusterpane", 420) %>%
+ addClusterCharts(data = data
+ , aggregation = "sum"
+ , valueField = "tosum"
+ , options = clusterchartOptions(rmax = 50,
+ size = 40,
+ # size = c(100,140),
+ labelBackground = TRUE,
+ labelStroke = "orange",
+ labelColor = "gray",
+ labelOpacity = 0.5,
+ innerRadius = 20,
+ digits = 0,
+ sortTitlebyCount = TRUE)
+ # , type = "bar"
+ # , type = "horizontal"
+ # , type = "custom"
+ , categoryField = "category"
+ , html = "web"
+ , icon = shipIcon
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
+ colors = c("lightblue", "orange", "lightyellow", "lightgreen"))
+ , group = "clustermarkers"
+ , layerId = "id"
+ , clusterId = "id"
+ , popupFields = c("id","brewery","address","zipcode", "category","tosum","tosum2")
+ , popupLabels = c("id","Brauerei","Addresse","PLZ", "Art", "tosum","tosum2")
+ , label = "label"
+ , markerOptions = markerOptions(interactive = TRUE,
+ draggable = TRUE,
+ keyboard = TRUE,
+ title = "Some Marker Title",
+ zIndexOffset = 100,
+ opacity = 1,
+ riseOnHover = TRUE,
+ riseOffset = 400)
+ , legendOptions = list(position = "bottomright", title = "Unfälle im Jahr 2003")
+ , clusterOptions = markerClusterOptions(showCoverageOnHover = TRUE,
+ zoomToBoundsOnClick = TRUE,
+ spiderfyOnMaxZoom = TRUE,
+ removeOutsideVisibleBounds = TRUE,
+ spiderLegPolylineOptions = list(weight = 1.5, color = "#222", opacity = 0.5),
+ freezeAtZoom = TRUE,
+ clusterPane = "clusterpane",
+ spiderfyDistanceMultiplier = 2
+ )
+ , labelOptions = labelOptions(opacity = 0.8, textsize = "14px")
+ , popupOptions = popupOptions(maxWidth = 900, minWidth = 200, keepInView = TRUE)
+ )
+
+})
diff --git a/tests/testthat/test-contextmenu.R b/tests/testthat/test-contextmenu.R
index 97aa18f2..4cf4e97b 100644
--- a/tests/testthat/test-contextmenu.R
+++ b/tests/testthat/test-contextmenu.R
@@ -46,6 +46,14 @@ test_that("contextmenu", {
expect_equal(m$x$calls[[length(m$x$calls)]]$method,
"hideContextmenu")
+ m <- m %>% enableContextmenu()
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method,
+ "enableContextmenu")
+
+ m <- m %>% disableContextmenu()
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method,
+ "disableContextmenu")
+
if (packageVersion("leaflet") < "2.0.4") {
m <- expect_warning(
m %>% addItemContextmenu(
diff --git a/tests/testthat/test-heightgraph.R b/tests/testthat/test-heightgraph.R
index 1118760b..e3b3da34 100644
--- a/tests/testthat/test-heightgraph.R
+++ b/tests/testthat/test-heightgraph.R
@@ -28,7 +28,6 @@ data <- structure(list(
## TESTS #######################
test_that("heightgraph", {
library(sf)
- library(geojsonsf)
data <- st_transform(data, 4326)
data <- data.frame(st_coordinates(data))
diff --git a/tests/testthat/test-movingmarker.R b/tests/testthat/test-movingmarker.R
index d48f4dec..5abe7c7b 100644
--- a/tests/testthat/test-movingmarker.R
+++ b/tests/testthat/test-movingmarker.R
@@ -17,11 +17,12 @@ df <- new("SpatialLinesDataFrame", data = structure(list(Name = structure(1L, le
test_that("movingmarker", {
- m <- leaflet() %>%
- addMovingMarker(data = df,
- movingOptions = movingMarkerOptions(autostart = TRUE, loop = TRUE),
- label="I am a pirate!",
- popup="Arrr")
+ m <- expect_warning(
+ leaflet() %>%
+ addMovingMarker(data = df,
+ movingOptions = movingMarkerOptions(autostart = TRUE, loop = TRUE),
+ label="I am a pirate!",
+ popup="Arrr"))
expect_is(m, "leaflet")
expect_equal(m$x$calls[[1]]$method, "addMovingMarker")
@@ -52,11 +53,13 @@ test_that("movingmarker", {
## Data is Simple Feature LINESTRING
df1 <- sf::st_as_sf(df)
- m <- leaflet() %>%
+ m <- expect_warning(
+ leaflet() %>%
addMovingMarker(data = df1,
movingOptions = movingMarkerOptions(autostart = TRUE, loop = TRUE),
label="I am a pirate!",
popup="Arrr")
+ )
expect_is(m, "leaflet")
expect_equal(m$x$calls[[1]]$method, "addMovingMarker")
deps <- findDependencies(m)
@@ -64,49 +67,52 @@ test_that("movingmarker", {
## Data is Simple Feature POINT
df1 <- sf::st_as_sf(df)[1,]
- df1 <- sf::st_cast(df1, "POINT")
- m <- leaflet() %>%
+ df1 <- expect_warning(sf::st_cast(df1, "POINT"))
+ m <- expect_warning(
+ leaflet() %>%
addMovingMarker(data = df1,
movingOptions = movingMarkerOptions(autostart = TRUE, loop = TRUE),
label="I am a pirate!",
popup="Arrr")
+ )
expect_is(m, "leaflet")
expect_equal(m$x$calls[[1]]$method, "addMovingMarker")
-
+ dfsf <- sf::st_as_sf(df)
+ dfsf <- expect_warning(st_cast(dfsf, "POINT"))
+ dfsf <- st_transform(dfsf, 4326)
m <- leaflet() %>%
- addMovingMarker(data = df) %>%
- startMoving()
+ addMovingMarker(data = dfsf) %>%
+ startMoving()
expect_is(m, "leaflet")
expect_equal(m$x$calls[[length(m$x$calls)]]$method, "startMoving")
m <- leaflet() %>%
- addMovingMarker(data = df) %>%
- startMoving()
+ addMovingMarker(data = dfsf) %>%
+ startMoving()
expect_is(m, "leaflet")
expect_equal(m$x$calls[[length(m$x$calls)]]$method, "startMoving")
m <- leaflet() %>%
- addMovingMarker(data = df) %>%
+ addMovingMarker(data = dfsf) %>%
stopMoving()
expect_is(m, "leaflet")
expect_equal(m$x$calls[[length(m$x$calls)]]$method, "stopMoving")
m <- leaflet() %>%
- addMovingMarker(data = df) %>%
+ addMovingMarker(data = dfsf) %>%
pauseMoving()
expect_is(m, "leaflet")
expect_equal(m$x$calls[[length(m$x$calls)]]$method, "pauseMoving")
m <- leaflet() %>%
- addMovingMarker(data = df) %>%
+ addMovingMarker(data = dfsf) %>%
resumeMoving()
expect_is(m, "leaflet")
expect_equal(m$x$calls[[length(m$x$calls)]]$method, "resumeMoving")
-
m <- leaflet() %>%
- addMovingMarker(data = df) %>%
+ addMovingMarker(data = dfsf) %>%
addLatLngMoving(latlng = list(33, -67), duration = 2000)
expect_is(m, "leaflet")
expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addLatLngMoving")
@@ -114,7 +120,7 @@ test_that("movingmarker", {
expect_equal(m$x$calls[[length(m$x$calls)]]$args[[3]], 2000)
m <- leaflet() %>%
- addMovingMarker(data = df) %>%
+ addMovingMarker(data = dfsf) %>%
moveToMoving(latlng = list(33, -67), duration = 2000)
expect_is(m, "leaflet")
expect_equal(m$x$calls[[length(m$x$calls)]]$method, "moveToMoving")
@@ -122,7 +128,7 @@ test_that("movingmarker", {
expect_equal(m$x$calls[[length(m$x$calls)]]$args[[3]], 2000)
m <- leaflet() %>%
- addMovingMarker(data = df) %>%
+ addMovingMarker(data = dfsf) %>%
addStationMoving(pointIndex = 2, duration = 5000)
expect_is(m, "leaflet")
expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addStationMoving")
diff --git a/tests/testthat/test-timeslider.R b/tests/testthat/test-timeslider.R
index acd705e8..323b12fd 100644
--- a/tests/testthat/test-timeslider.R
+++ b/tests/testthat/test-timeslider.R
@@ -15,7 +15,6 @@ test_that("timeslider", {
expect_is(m, "leaflet")
expect_identical(m$x$calls[[1]]$method, "addTimeslider")
expect_is(m$x$calls[[1]]$args[[1]], "geojson")
- # expect_identical(m$x$calls[[1]]$args[[1]], sf_geojson(data))
expect_true(inherits(m$x$calls[[1]]$args[[1]], "geojson"))
m <- leaflet() %>%
@@ -29,7 +28,6 @@ test_that("timeslider", {
expect_is(m, "leaflet")
expect_identical(m$x$calls[[1]]$method, "addTimeslider")
expect_is(m$x$calls[[1]]$args[[1]], "geojson")
- # expect_identical(m$x$calls[[1]]$args[[1]], sf_geojson(data))
expect_true(inherits(m$x$calls[[1]]$args[[1]], "geojson"))
@@ -45,11 +43,34 @@ test_that("timeslider", {
expect_is(m, "leaflet")
expect_identical(m$x$calls[[1]]$method, "addTimeslider")
expect_is(m$x$calls[[1]]$args[[1]], "geojson")
- # expect_identical(m$x$calls[[1]]$args[[1]], sf_geojson(data))
expect_true(inherits(m$x$calls[[1]]$args[[1]], "geojson"))
m <- m %>%
removeTimeslider()
expect_identical(m$x$calls[[length(m$x$calls)]]$method, "removeTimeslider")
+ m <- leaflet() %>%
+ addTimeslider(data = data, fill = FALSE,
+ label = ~Name,
+ options = timesliderOptions(
+ position = "topright",
+ timeAttribute = "time",
+ range = FALSE))
+ expect_is(m, "leaflet")
+ expect_identical(m$x$calls[[1]]$method, "addTimeslider")
+ expect_is(m$x$calls[[1]]$args[[1]], "geojson")
+ expect_true(inherits(m$x$calls[[1]]$args[[1]], "geojson"))
+
+ m <- leaflet() %>%
+ addTimeslider(data = data, fill = FALSE,
+ label = data$Name,
+ options = timesliderOptions(
+ position = "topright",
+ timeAttribute = "time",
+ range = FALSE))
+ expect_is(m, "leaflet")
+ expect_identical(m$x$calls[[1]]$method, "addTimeslider")
+ expect_is(m$x$calls[[1]]$args[[1]], "geojson")
+ expect_true(inherits(m$x$calls[[1]]$args[[1]], "geojson"))
+
})