I'm trying to change the inner radius of a polar chart using highcharter so I can visualize the data by hoving the tooltip like in this awesome D3 charts from fivethirtyeight.
I know that it's possible to visualize data with solid gauge like in this example, but I want to the data to be visible in a polar.
I've tried changing innerSize and innerRadius parameters but I'm not able to accomplish it.
Here's my R code:
library(tidyverse)
library(highcharter)
highchart() %>%
hc_chart(polar = T, type = "bar") %>%
hc_title(text = "Athlete 1 vs Athlete 2") %>%
hc_xAxis(categories = c("Total Score", "Avg. Score", "Sum Score",
"Best Score"),
tickmarkPlacement = "on",
plotLines = list(
list(label = list(
rotation = 90))
)
) %>%
hc_yAxis(min = 0) %>%
hc_series(
list(
name = "Athlete 1",
data = c(43000, 19000, 60000, 35000)
),
list(
name = "Athlete 2",
data = c(50000, 39000, 42000, 31000)
)
) %>%
hc_colors(c("firebrick", "steelblue"))
The desired output would be something like:
Thank you!
EDIT
After #ppotaczek's answer I've updated with his chart, so the desired updated would look like this:
To achieve similar result in Highcharts polar chart, you should set pointPadding and groupPadding to 0. To create an empty space in the middle of the graph you can use Highcharts.SVGRenderer and offset for yAxis.
Highcharts.chart('container', {
chart: {
polar: true,
type: 'bar',
events: {
render: function() {
var chart = this,
middleElement = chart.middleElement;
if (middleElement) {
middleElement.destroy();
}
chart.middleElement = chart.renderer.circle(chart.plotSizeX / 2 + chart.plotLeft, chart.plotHeight / 2 + chart.plotTop, 20).attr({
zIndex: 3,
fill: '#ffffff'
}).add();
}
}
},
yAxis: {
offset: 20
},
series: [{
pointPadding: 0,
groupPadding: 0,
name: "Athlete 1",
data: [43000, 19000, 60000, 35000]
}, {
pointPadding: 0,
groupPadding: 0,
name: "Athlete 2",
data: [50000, 39000, 42000, 31000]
}]
});
Live demo: http://jsfiddle.net/BlackLabel/y6uL180j/
API Reference: https://api.highcharts.com/class-reference/Highcharts.SVGRenderer#circle
EDIT:
To display value from hovered point in the middle of the chart, use tooltip with proper options:
tooltip: {
borderWidth: 0,
backgroundColor: 'none',
shadow: false,
style: {
fontSize: '16px'
},
headerFormat: '',
pointFormatter: function() {
return this.y / 1000 + 'k'
},
positioner: function(labelWidth, labelHeight) {
return {
x: (this.chart.plotSizeX - labelWidth) / 2 + this.chart.plotLeft,
y: (this.chart.plotSizeY - labelHeight) / 2 + this.chart.plotTop
};
}
}
Live demo: http://jsfiddle.net/BlackLabel/5ybhtrmz/
Related
I need to replicate this chart bellow in my shiny app. But I am struggling to deal with the javascript part Any help would be amazing:
Clock Chart Highchart
This is the javascript code: how do I 'translate' this to R?
Any help/indication to deal with javascript in R would be amazing.
Many many tahnks guys
`/**
* Get the current time
*/
function getNow() {
var now = new Date();
return {
hours: now.getHours() + now.getMinutes() / 60,
minutes: now.getMinutes() * 12 / 60 + now.getSeconds() * 12 / 3600,
seconds: now.getSeconds() * 12 / 60
};
}
/**
* Pad numbers
*/
function pad(number, length) {
// Create an array of the remaining length + 1 and join it with 0's
return new Array((length || 2) + 1 - String(number).length).join(0) + number;
}
var now = getNow();
// Create the chart
Highcharts.chart('container', {
chart: {
type: 'gauge',
plotBackgroundColor: null,
plotBackgroundImage: null,
plotBorderWidth: 0,
plotShadow: false,
height: '80%'
},
credits: {
enabled: false
},
title: {
text: 'The Highcharts clock'
},
pane: {
background: [{
// default background
}, {
// reflex for supported browsers
backgroundColor: Highcharts.svg ? {
radialGradient: {
cx: 0.5,
cy: -0.4,
r: 1.9
},
stops: [
[0.5, 'rgba(255, 255, 255, 0.2)'],
[0.5, 'rgba(200, 200, 200, 0.2)']
]
} : null
}]
},
yAxis: {
labels: {
distance: -20
},
min: 0,
max: 12,
lineWidth: 0,
showFirstLabel: false,
minorTickInterval: 'auto',
minorTickWidth: 1,
minorTickLength: 5,
minorTickPosition: 'inside',
minorGridLineWidth: 0,
minorTickColor: '#666',
tickInterval: 1,
tickWidth: 2,
tickPosition: 'inside',
tickLength: 10,
tickColor: '#666',
title: {
text: 'Powered by<br/>Highcharts',
style: {
color: '#BBB',
fontWeight: 'normal',
fontSize: '8px',
lineHeight: '10px'
},
y: 10
}
},
tooltip: {
formatter: function () {
return this.series.chart.tooltipText;
}
},
series: [{
data: [{
id: 'hour',
y: now.hours,
dial: {
radius: '60%',
baseWidth: 4,
baseLength: '95%',
rearLength: 0
}
}, {
id: 'minute',
y: now.minutes,
dial: {
baseLength: '95%',
rearLength: 0
}
}, {
id: 'second',
y: now.seconds,
dial: {
radius: '100%',
baseWidth: 1,
rearLength: '20%'
}
}],
animation: false,
dataLabels: {
enabled: false
}
}]
},
// Move
function (chart) {
setInterval(function () {
now = getNow();
if (chart.axes) { // not destroyed
var hour = chart.get('hour'),
minute = chart.get('minute'),
second = chart.get('second'),
// run animation unless we're wrapping around from 59 to 0
animation = now.seconds === 0 ?
false : {
easing: 'easeOutBounce'
};
// Cache the tooltip text
chart.tooltipText =
pad(Math.floor(now.hours), 2) + ':' +
pad(Math.floor(now.minutes * 5), 2) + ':' +
pad(now.seconds * 5, 2);
hour.update(now.hours, true, animation);
minute.update(now.minutes, true, animation);
second.update(now.seconds, true, animation);
}
}, 1000);
});
/**
* Easing function from https://github.com/danro/easing-js/blob/master/easing.js
*/
Math.easeOutBounce = function (pos) {
if ((pos) < (1 / 2.75)) {
return (7.5625 * pos * pos);
}
if (pos < (2 / 2.75)) {
return (7.5625 * (pos -= (1.5 / 2.75)) * pos + 0.75);
}
if (pos < (2.5 / 2.75)) {
return (7.5625 * (pos -= (2.25 / 2.75)) * pos + 0.9375);
}
return (7.5625 * (pos -= (2.625 / 2.75)) * pos + 0.984375);
};`
This converts that JS into R/JS (you need to collect time in Javascript). I noticed odd vertical lines in the Viewer pane of RStudio when this runs, but these lines don't appear in my browser.
For most calls in JS for highcharter, the function or argument is identical in R. I used lubridate for the time functions in the R code. (Although, you could set the time to static values because the time isn't controlled by R code.)
After creating the graph, I used htmlwidgets::onRender to give add the animation so that it follows actual time.
If you run this without htmlwidgets, this is what you'll see. (Well, you'll see the time on the clock for your local time at the moment you render it.)
library(highcharter)
library(lubridate)
highchart() %>%
hc_chart(type = "gauge", plotBackgroundColor = NULL,
plotBackgroundImage = NULL, plotBorderWidth = 0,
plotShadow = F) %>%
hc_pane(
background = list(
backgroundColor = list(
radialGradient = list(cx = .5, cy = -.4, r = 1.9),
stops = list(
list(.5, "rgba(255, 255, 255, .2)"),
list(.5, "rgba(200, 200, 200, .2)"))
))) %>%
hc_tooltip(enabled = FALSE) %>%
hc_yAxis(
labels = list(distance = -20),
min = 0, max = 12, lineWidth = 0, showFirstLabel = F,
minorTickInterval = "auto", minorTickWidth = 1,
minorTickColor = "#666", tickColor = "#666",
minorTickPosition = "inside", minorGridLineWidth = 0,
tickInterval = 1, tickWidth = 2, tickPosition = "inside",
tickLength = 10) %>%
hc_add_series(
data = list(
list(id = "hour", y = hour(now()), dial = list(
radius = "60%", baseWidth = 4, baseLength = "95%", rearLength = 0)),
list(id = "minute", y = minute(now()), dial = list(
baseLength = "95%", rearLength = 0)),
list(id = "second", y = second(now()), dial = list(
radius = "100%", baseWidth = 1, rearLength = "20%"))),
dataLabels = list(enabled = F)) %>%
htmlwidgets::onRender("
function(el, x) {
chart = $('#' + el.id).highcharts()
$.extend($.easing, {
easeOutElastic: function (x, t, b, c, d) {
var s = 1.70158; var p = 0; var a = c;
if (t == 0) return b; if ((t /= d) == 1) return b+c;
if (!p) p = d*.3;
if (a < Math.abs(c)) { a = c; var s = p/4; }
else var s = p/(2 * Math.PI) * Math.asin (c/a);
return a * Math.pow(2, -10 * t) * Math.sin( (t * d - s) * (2 * Math.PI)/p) + c + b;
}
});
function getNow () {
var now = new Date();
return {
hours: now.getHours() + now.getMinutes() / 60,
minutes: now.getMinutes() * 12 / 60 + now.getSeconds() * 12 / 3600,
seconds: now.getSeconds() * 12 / 60
};
};
setInterval(function () {
var hour = chart.get('hour'),
minute = chart.get('minute'),
second = chart.get('second'),
now = getNow(),
/* run animation unless we're wrapping around from 59 to 0 */
animation = now.seconds == 0 ?
false : {easing: 'easeOutElastic'};
hour.update(now.hours, true, animation);
minute.update(now.minutes, true, animation);
second.update(now.seconds, true, animation);
}, 1000);
}")
In this JS, you'll see some deviation from the original code. I needed to define 'chart'. I did that using the same mechanism that is used to change any highcharter R object into it's HTML rendering: chart = $('#' + el.id).highcharts(). Since the function that sets the interval was originally part of creating the graph, it was an unnamed function. Since we're calling after we render the graph, I dropped that outer function(chart).
I'm trying to add a custom animation using highcharter R package like in this example where I use a polar chart.
I'm able to do this using JS, but I can't translate the animation function (from ease repository) to highcharter.
Here is my R code:
# I've tried to created a function using `JS`:
easeOutBounce <- JS("function (pos) {
if ((pos) < (1 / 2.75)) {
return (7.5625 * pos * pos);
}
if (pos < (2 / 2.75)) {
return (7.5625 * (pos -= (1.5 / 2.75)) * pos + 0.75);
}
if (pos < (2.5 / 2.75)) {
return (7.5625 * (pos -= (2.25 / 2.75)) * pos + 0.9375);
}
return (7.5625 * (pos -= (2.625 / 2.75)) * pos + 0.984375);
}")
library(tidyverse)
library(highcharter)
highchart() %>%
hc_chart(polar = T, type = "bar",
events = list(
render = JS("function() {
var chart = this,
middleElement = chart.middleElement;
if (middleElement) {
middleElement.destroy();
}
chart.middleElement = chart.renderer.circle(chart.plotSizeX / 2 + chart.plotLeft, chart.plotHeight / 2 + chart.plotTop, 20).attr({
zIndex: 3,
fill: '#ffffff'
}).add();
}")
)
) %>%
hc_title(text = "Athlete 1 vs Athlete 2") %>%
hc_xAxis(categories = c("Total Score", "Avg. Score", "Sum Score",
"Best Score"),
tickmarkPlacement = "on",
plotLines = list(
list(label = list(
rotation = 90))
)
) %>%
hc_yAxis(offset = 30) %>%
hc_series(
list(
pointPadding = 0,
groupPadding = 0,
name = "Athlete 1",
animatio = list(
duration = 1000,
easing = easeOutBounce
),
data = c(43000, 19000, 60000, 35000)
),
list(
pointPadding = 0,
groupPadding = 0,
name = "Athlete 2",
data = c(50000, 39000, 42000, 31000)
)
) %>%
hc_colors(c("firebrick", "steelblue")) %>%
hc_tooltip(
borderWidth = 0,
backgroundColor = 'none',
shadow = FALSE,
style = list(
fontSize = '16px'
),
headerFormat = '',
pointFormatter = JS("function() {
return this.y / 1000 + 'k'
}"),
positioner = JS("function(labelWidth, labelHeight) {
return {
x: (this.chart.plotSizeX - labelWidth) / 2 + this.chart.plotLeft,
y: (this.chart.plotSizeY - labelHeight) / 2 + this.chart.plotTop
};
}")
)
Thank you!
Animation doesn't work because you have a little typo in attached code. Please take a look on it:
animatio = list(
duration = 1000,
easing = easeOutBounce
),
Should be animation, not animatio. Please correct it, then animation should appear.
I'd like to make a horizontal legend below the ggvis chart. I can use legend properties to place it below the chart, but don't know how to make the labels horizontal below the legend title. Below is the minimum reproducible code (grabbed from the web).
df1 = data.frame(x=sample(1:10), y=sample(1:10))
df2 = data.frame(x=1:10, y=1:10)
df3 = data.frame(x=1:10, y=sqrt(1:10))
df2$id <- 1
df3$id <- 2
df4 <- rbind(df2,df3)
df4$id <- factor(df4$id)
df4 %>% ggvis(x=~x, y=~y, stroke=~id) %>% layer_lines() %>%
# make sure you use add relative scales
add_relative_scales() %>%
# values for x and y need to be between 0 and 1
# e.g for the x-axis 0 is the at far-most left point and 1 at the far-right
add_legend("stroke", title="Cylinders",
properties=legend_props(
legend=list(
x=scaled_value("x_rel", 0.2),
y=scaled_value("y_rel", -.2)
))) %>%
layer_points(x=~x, y=~y, data=df1, stroke:='black')
This is most certainly a hack, but works great:
df4 %>% ggvis(x=~x,y=~y,stroke=~id) %>% layer_lines() %>%
#make sure you use add relative scales
add_relative_scales() %>%
#values for x and y need to be between 0 and 1
#e.g for the x-axis 0 is the at far-most left point and 1 at the far-right
add_legend("stroke", title = "Cylinders", values = c(1, 1),
properties = legend_props(
legend = list(
x = scaled_value("x_rel", 0.2),
y = scaled_value("y_rel", -.2)
))) %>%
add_legend("stroke", title = " ", values = c(2, 2),
properties = legend_props(
legend = list(
x = scaled_value("x_rel", 0.23),
y = scaled_value("y_rel", -.2)
))) %>%
layer_points(x=~x,y=~y,data = df1,stroke:='black')
Basically, I'm adding another add_legend, setting the title as blank, adjusting the scale_value so that it is very close to the first legend but not overlapping. I then set the first legend with values = c(1,1) and the second with values = c(2,2) so that the two values stack on top of each other. This makes it look like one legend with horizontal values.
Seen that ggvis is dormant now, maybe you may consider switching to googleVis.
Here's a similar plot you can get by manipulating a little bit your sample data:
df5 <- df4[df4$id==1,]
colnames(df5)[2] <- "y1"
library(tidyverse)
df5 <- df5 %>%
mutate(
y0 = df1[order(df1$x),c(2)],
y2 = sqrt(x)
)
df5 <- df5[, c(1,4,2,5)]
library(googleVis)
plot_df5 <- gvisLineChart(df5, options=list(
legend="bottom",
series =
"[{labelInLegend: 'Dot', color: 'black'},
{labelInLegend: 'Cylinders: 1', color: 'blue', curveType: 'dot'},
{labelInLegend: 'Cylinders: 2', color: 'orange'}]"
)
)
plot(plot_df5)
<!-- LineChart generated in R 3.5.2 by googleVis 0.6.2 package -->
<!-- Sun Dec 30 21:21:26 2018 -->
<!-- jsHeader -->
<script type="text/javascript">
// jsData
function gvisDataLineChartID1fd8710660d () {
var data = new google.visualization.DataTable();
var datajson =
[
[
"1",
3,
1,
1
],
[
"2",
4,
2,
1.414213562
],
[
"3",
6,
3,
1.732050808
],
[
"4",
1,
4,
2
],
[
"5",
10,
5,
2.236067977
],
[
"6",
8,
6,
2.449489743
],
[
"7",
7,
7,
2.645751311
],
[
"8",
2,
8,
2.828427125
],
[
"9",
9,
9,
3
],
[
"10",
5,
10,
3.16227766
]
];
data.addColumn('string','x');
data.addColumn('number','y0');
data.addColumn('number','y1');
data.addColumn('number','y2');
data.addRows(datajson);
return(data);
}
// jsDrawChart
function drawChartLineChartID1fd8710660d() {
var data = gvisDataLineChartID1fd8710660d();
var options = {};
options["allowHtml"] = true;
options["legend"] = "bottom";
options["series"] = [{labelInLegend: 'Dot', color: 'black'},
{labelInLegend: 'Cylinders: 1', color: 'blue', curveType: 'dot'},
{labelInLegend: 'Cylinders: 2', color: 'orange'}];
var chart = new google.visualization.LineChart(
document.getElementById('LineChartID1fd8710660d')
);
chart.draw(data,options);
}
// jsDisplayChart
(function() {
var pkgs = window.__gvisPackages = window.__gvisPackages || [];
var callbacks = window.__gvisCallbacks = window.__gvisCallbacks || [];
var chartid = "corechart";
// Manually see if chartid is in pkgs (not all browsers support Array.indexOf)
var i, newPackage = true;
for (i = 0; newPackage && i < pkgs.length; i++) {
if (pkgs[i] === chartid)
newPackage = false;
}
if (newPackage)
pkgs.push(chartid);
// Add the drawChart function to the global list of callbacks
callbacks.push(drawChartLineChartID1fd8710660d);
})();
function displayChartLineChartID1fd8710660d() {
var pkgs = window.__gvisPackages = window.__gvisPackages || [];
var callbacks = window.__gvisCallbacks = window.__gvisCallbacks || [];
window.clearTimeout(window.__gvisLoad);
// The timeout is set to 100 because otherwise the container div we are
// targeting might not be part of the document yet
window.__gvisLoad = setTimeout(function() {
var pkgCount = pkgs.length;
google.load("visualization", "1", { packages:pkgs, callback: function() {
if (pkgCount != pkgs.length) {
// Race condition where another setTimeout call snuck in after us; if
// that call added a package, we must not shift its callback
return;
}
while (callbacks.length > 0)
callbacks.shift()();
} });
}, 100);
}
// jsFooter
</script>
<!-- jsChart -->
<script type="text/javascript" src="https://www.google.com/jsapi?callback=displayChartLineChartID1fd8710660d"></script>
<!-- divChart -->
<div id="LineChartID1fd8710660d"
style="width: 500; height: automatic;">
</div>
First of all thank you for spending a little bit of your time helping me to solve this issue.
I am getting started in plot_ly through R and I am struggling when trying to change the format of the values of my Pie Chart (I want them to be showed in the plot as currency "$" format).
So far my code looks like:
data <- data.frame(Level = c("Receipt","Disbursement"),Amount = c(1000,2000))
name_dataset <- "Overview"
plot_ly(data=data, labels = Level, values = Amount, type = "pie", textinfo= "label+percent",
hoverinfo = "label+percent+value", outsidetextfont = list(color = "white")) %>% layout(title = paste0(paste(unlist(strsplit(name_dataset,"_")),collapse = " ")))
Thank you for your help!
Are you looking for something like this:
data$AmountB <- prettyNum(data$Amount, big.mark=",",scientific=FALSE) #EDIT
data$AmountB <- paste(data$AmountB, "$", sep="")
plot_ly(data=data, labels = Level, values = Amount, type = "pie", textinfo= "text", text=AmountB,hoverinfo = "text", outsidetextfont = list(color = "white")) %>%
layout(title = paste0(paste(unlist(strsplit(name_dataset,"_")),collapse = " ")))
var text = [15588, 16787, 27778].map(function (v, i) {
return currencyFormatterForUI(v) //format here
});
var chartObj = {
header: 'New Backlog',
description: 'Total Value of Recently Added (Last 30 Days) Backlog by Issue Type',
type: 'chart',
id: 'div4',
layout: {
margin: {
autoexpand: true,
r: 25,
t: 20,
b: 20,
l: 25
},
legend: {
'orientation': 'h',
xanchor: 'center',
yanchor: 'top',
y: -0.1, // play with it
x: 0.5 // play with it
},
},
data: [{
values: [15588, 16787, 27778],
labels: ['Bug', 'Improvement', 'Story'],
text: text,
type: 'pie',
textinfo: 'label+text',
hoverinfo: 'label+text+percent'
}],
};
var myPlot = document.getElementById('div4');
Plotly.plot(myPlot, chartObj);
function currencyFormatterForUI(value) {
const formatter = new Intl.NumberFormat('en-US', {
style: 'currency',
currency: 'USD',
minimumFractionDigits: 0,
maximumFractionDigits: 0
});
return formatter.format(value || 0);
}
<script src="https://cdn.plot.ly/plotly-latest.min.js"></script>
<div id="div4"></div>
I am trying to show a different table or plot in a different div when a bar on a a bar plot is clicked. I have come this far.
server.R
library(shiny)
shinyServer(function(input,output,session) {
custom_data = # a data frame in R
barclick_func <- "#! function() {
var cats = ['100','200','3000','4000'];
var datum = [20,40,30,10];
}
$('#container_subcat').highcharts({
chart: {
type: 'column',
},
xAxis: { categories:cats },
series: [{data :datum}]
});
} !#"
output$my_plot <- renderChart2({
a <- hPlot(x="id",y="variable",data=custom_data,type="column")
a$tooltip( animation = 'true', formatter = "#! function() {return '<b>' + 'Frequency of tag_id ' + this.x + '</b>' + ' is ' + this.y;} !#")
a$plotOptions(series = list(color = '#388E8E'),column = list(dataLabels = list(enabled = T, rotation =-90, align = 'right', color = '#FFFFFF', x = 4, y = 10),
cursor = 'pointer', point = list(events = list(click = barclick_func))))
return(a)
})
})
ui.R
library(shiny)
require(rCharts)
shinyUI(fluidPage(
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "custom.css"),
tags$script(src="http://code.jquery.com/jquery-git2.min.js"),
),
titlePanel("Test"),
fluidRow(
showOutput("my_plot","highcharts")
),
div(id="container_subcat",style="min-width: 310-px; height: 400px; margin: 0 auto; margin-top:100px;")
)
))
In the above server.R script, in barclick_func() function, the data(variables cats and datum) is hardcoded. The above app works as expected when a bar is clicked, another plot pops up properly with the data.
But, if I want to use another data, that is if I have another data frame in R and want to use that data frame in barclick_func(), the console is throwing an error that the variable is not recognized and if I look at the type of that variable, it shows as 'undefined'. Can anyone suggest how to send data to the javascript function in this particular case. Ideally, my desired code is this.
server.R
library(shiny)
shinyServer(function(input,output,session) {
custom_data = # a data frame in R
custom_data2 = # another data frame in R for which I wanna shoe a plot when the bar is clicked.
barclick_func <- "#! function() {
var cats = #subsetting custom_data2 ;
var datum = #subsetting custom_data2 ;
}
$('#container_subcat').highcharts({
chart: {
type: 'column',
},
xAxis: { categories:cats },
series: [{data :datum}]
});
} !#"
output$my_plot <- renderChart2({
a <- hPlot(x="id",y="variable",data=custom_data,type="column")
a$tooltip( animation = 'true', formatter = "#! function() {return '<b>' + 'Frequency of tag_id ' + this.x + '</b>' + ' is ' + this.y;} !#")
a$plotOptions(series = list(color = '#388E8E'),column = list(dataLabels = list(enabled = T, rotation =-90, align = 'right', color = '#FFFFFF', x = 4, y = 10),
cursor = 'pointer', point = list(events = list(click = barclick_func))))
return(a)
})
})
You could try using paste to add the data to your barclick_func.
For example:
custom_data2 = data.frame(cats=c(100,200,3000,400),datum=c(20,40,30,10))
barclick_func <- paste("#! function() {
var cats = ",paste('[',paste(custom_data2$cats,collapse=','),']',sep=''),"
var datum = ",paste('[',paste(custom_data2$datum,collapse=','),']',sep=''),";
}
$('#container_subcat').highcharts({
chart: {
type: 'column',
},
xAxis: { categories:cats },
series: [{data :datum}]
});
} !#")
Should give the same barclick_func as in your hardcoded version.