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>
Related
I want to make a treemap to get an impression of the sizes in one data.frame. Let me show you an example:
I use the following code to produce this chart:
library(shiny)
library(highcharter)
library(gapminder)
library(dplyr)
ui <- fluidPage(
highchartOutput("hcontainer")
)
server <- function(input, output){
output$hcontainer <- renderHighchart({
gapminder %>%
filter(year == 2007) %>%
data_to_hierarchical(group_vars = c(continent, country),
size_var = pop,
colors = c('pink','yellow','blue','green','orange','red')) %>%
hchart(type = "treemap"
#showInLegend = TRUE,
#legendType='point',
)
})
}
shinyApp(ui,
server,
options = list(launch.browser = TRUE)
)
I saw it is possible to create a legend by uncommenting those two lines of code in the hchart-function, but the result is not what I want:
Is there a way to tell highcharts that I only want the continents in my legend?
As a less important sidenote: There seems to be a bug in the highcharts, because after clicking on the legend (which you can use to hide/make reappear countries), they change their color in the legend according to their continent:
Use the following plugin to achieve that:
(function(H) {
let pick = H.pick,
defined = H.defined,
fireEvent = H.fireEvent
H.wrap(H.Legend.prototype.getAllItems = function(p) {
var allItemsFirst = [],
allItems = [];
this.chart.series.forEach(function(series) {
var seriesOptions = series && series.options;
// Handle showInLegend. If the series is linked to another series,
// defaults to false.
if (series && pick(seriesOptions.showInLegend, !defined(seriesOptions.linkedTo) ? void 0 : false, true)) {
// Use points or series for the legend item depending on
// legendType
allItemsFirst = allItems.concat(series.legendItems ||
(seriesOptions.legendType === 'point' ?
series.data :
series));
}
});
allItemsFirst.forEach(el => {
if (el.isVisibleInLegend) {
allItems.push(el)
}
})
fireEvent(this, 'afterGetAllItems', {
allItems: allItems
});
return allItems;
});
}(Highcharts));
And set isVisibleInLegend: true for each point from you expect to be in the legend.
Highcharts.chart('container', {
series: [{
type: "treemap",
layoutAlgorithm: 'squarified',
showInLegend: true,
legendType: 'point',
data: [{
id: "id_1",
name: 'A',
isVisibleInLegend: true
}, {
id: "id_2",
name: 'A1',
value: 2,
parent: 'id_1',
}, {
id: "id_3",
name: 'A2',
value: 2,
parent: 'id_1',
}]
}]
});
JS Demo:
https://jsfiddle.net/BlackLabel/vdqtok9m/
Extending Highcharts:
https://www.highcharts.com/docs/extending-highcharts/extending-highcharts
I know this has already been answered in JS but I was hoping for a solution using highcharter in R. Highcharts - drill down to multiple series
I'm new to JS and also not that familiar with the highcharter library in R so any help would be greatly appreciated. The following code compiles but as the code is more experimental than anything it does not allow me to drill down to a multi- series chart as hoped.
DATABrowser = list(list(y= 55.11
,drilldown = list(
name = 'MSIE versions',
categories = list('MSIE 6.0', 'MSIE 7.0', 'MSIE 8.0',
'MSIE 9.0'),
series = list(list(
type = 'spline',
name = 'MSIE versions 2000',
data = list(10.85, 7.35, 33.06, 2.81)
),list(
type = 'spline',
name = 'MSIE versions 2010',
data = list (1, 5, 10, 15)
))
)),list(y = 21.6),list(y = 11.6),list(y = 7.3),list(y =
2.6)
)
categories = list('MSIE', 'Firefox', 'Chrome', 'Safari', 'Opera')
name = 'Browser brands'
fn <-"function () {
var drilldown = this.drilldown;
var len = chart.series.length;
var name = null, catergories = drilldown.categories, data = drilldown, type
=drilldown.type;
chart.xAxis[0].setCategories(categories);
for(var i = 0; i < len; i++){
chart.series[0].remove();
}
if(data.series){
for( i = 0; i < data.series.length; i ++ ){
chart.addSeries({
name: data.series[i].name,
data: data.series[i].data,
type: data.series[i].type,
});
}
} else {
chart.addSeries({
name: name,
data: data,
type: type,
});
}
}
"
hc = highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = "Basic Drilldown Big Bossing") %>%
hc_xAxis(categories = categories) %>%
hc_add_series(
name = name
,data = DATABrowser
) %>% hc_plotOptions(
column = list(
# allowPointSelect = TRUE,
cursor = "pointer",
point = list(
events = list(
click = JS(fn)
)
)
)
)
hc
The JS function returns an error
chart is undefined
Indeed we don't have access to the chart from the click event, but we can retrive it with:
var chart = Highcharts.charts[0]
So putting that inside the JS, together with some typo fix gives us:
fn <-"function () {
var chart = Highcharts.charts[0];
var drilldown = this.drilldown;
var len = chart.series.length;
var name = null,
categories = drilldown.categories,
data = drilldown,
type = drilldown.type;
chart.xAxis[0].setCategories(categories);
for(var i = 0; i < len; i++){
chart.series[0].remove();
}
if(data.series){
for( i = 0; i < data.series.length; i ++ ){
chart.addSeries({
name: data.series[i].name,
data: data.series[i].data,
type: data.series[i].type,
});
}
} else {
chart.addSeries({
name: name,
data: data,
type: type,
});
}
}
"
Giving us:
library(highcharter)
highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = "Basic Drilldown Big Bossing") %>%
hc_xAxis(categories = categories) %>%
hc_add_series(
name = name
,data = DATABrowser
) %>% hc_plotOptions(
column = list(
# allowPointSelect = TRUE,
cursor = "pointer",
point = list(
events = list(
click = JS(fn)
)
)
)
)
I have been struggling like mad to solve an apparently basic question.
Imagine you have a scatter plot, with say ... 10 markers.
I suppose this plot has been generated using plotly within a Shiny environment.
One can easily get the coordinates of these markers using the event_data("plotly_click") code.
Now imagine you do not need the coordinates of these markers, but the coordinates generated by a mouse click but precisely where no marker exists (for example because you would like to set a new marker exactly there, and you would like to re-use the information coming from that mouse click).
I cannot obtain such a behavior using onclick(), or whatever.
Any idea ?
You could add a D3 event listener to your plot
Plotly.d3.select('.plotly').on('click', function(d, i) {})
and then
retrieve the relative x and y values based on the click position (d3.event.layerX resp. layerY)
adjusting for the relative graph position (document.getElementsByClassName('bg')[0].attributes['x'])
and finally calculating the new values based on the axis ranges (myPlot.layout.xaxis.range[0])
The new x and y value are then pushed to the existing graph
Plotly.extendTraces(myPlot, {
x: [[x]],
y: [[y]]
}, [1]);
Complete R code
library("plotly")
library("htmlwidgets")
p <- plot_ly(x = c( -2, 0, 2 ),y = c( -2, 1, 2), type = 'scatter' ,mode = 'lines+markers') %>%
add_trace(x=c(-1,0.4,2),y=c(2, 0, -1),type='scatter',mode='lines+markers') %>%
layout(hovermode='closest')
javascript <- "
var myPlot = document.getElementsByClassName('plotly')[0];
Number.prototype.between = function (min, max) {
return this >= min && this <= max;
};
Plotly.d3.select('.plotly').on('click', function(d, i) {
var e = Plotly.d3.event;
var bg = document.getElementsByClassName('bg')[0];
var x = ((e.layerX - bg.attributes['x'].value + 4) / (bg.attributes['width'].value)) * (myPlot.layout.xaxis.range[1] - myPlot.layout.xaxis.range[0]) + myPlot.layout.xaxis.range[0];
var y =((e.layerY - bg.attributes['y'].value + 4) / (bg.attributes['height'].value)) * (myPlot.layout.yaxis.range[0] - myPlot.layout.yaxis.range[1]) + myPlot.layout.yaxis.range[1]
if (x.between(myPlot.layout.xaxis.range[0], myPlot.layout.xaxis.range[1]) &&
y.between(myPlot.layout.yaxis.range[0], myPlot.layout.yaxis.range[1])) {
Plotly.extendTraces(myPlot, {
x: [[x]],
y: [[y]]
}, [1]);
}
});"
p <- htmlwidgets::prependContent(p, onStaticRenderComplete(javascript), data=list(''))
p
Interactive Javascript example
var traces = [{
x: [1, 2, 3, 4],
y: [10, 15, 13, 17],
mode: 'markers',
type: 'scatter'
}];
traces.push({
x: [2, 3, 4, 5],
y: [16, 5, 11, 9],
mode: 'markers',
type: 'scatter'
});
traces.push({
x: [1, 2, 3, 4],
y: [12, 9, 15, 12],
mode: 'markers',
type: 'scatter'
});
traces.push({
x: [],
y: [],
mode: 'lines+markers',
type: 'scatter'
});
var myPlot = document.getElementById('myPlot')
Plotly.newPlot('myPlot', traces, {hovermode: 'closest'});
Number.prototype.between = function(min, max) {
return this >= min && this <= max;
};
Plotly.d3.select(".plotly").on('click', function(d, i) {
var e = Plotly.d3.event;
var bg = document.getElementsByClassName('bg')[0];
var x = ((e.layerX - bg.attributes['x'].value + 4) / (bg.attributes['width'].value)) * (myPlot.layout.xaxis.range[1] - myPlot.layout.xaxis.range[0]) + myPlot.layout.xaxis.range[0];
var y = ((e.layerY - bg.attributes['y'].value + 4) / (bg.attributes['height'].value)) * (myPlot.layout.yaxis.range[0] - myPlot.layout.yaxis.range[1]) + myPlot.layout.yaxis.range[1]
if (x.between(myPlot.layout.xaxis.range[0], myPlot.layout.xaxis.range[1]) &&
y.between(myPlot.layout.yaxis.range[0], myPlot.layout.yaxis.range[1])) {
Plotly.extendTraces(myPlot, {
x: [
[x]
],
y: [
[y]
]
}, [3]);
}
});
<script src="https://cdn.plot.ly/plotly-latest.min.js"></script>
<div id="myPlot" style="width:100%;height:100%"></div>
Shiny example
library(shiny)
library("plotly")
library("htmlwidgets")
ui <- fluidPage(
plotlyOutput("plot")
)
server <- function(input, output) {
javascript <- "
function(el, x){
Number.prototype.between = function (min, max) {
return this >= min && this <= max;
};
Plotly.d3.select('.plotly').on('click', function(d, i) {
var e = Plotly.d3.event;
var bg = document.getElementsByClassName('bg')[0];
var x = ((e.layerX - bg.attributes['x'].value + 4) / (bg.attributes['width'].value)) * (el.layout.xaxis.range[1] - el.layout.xaxis.range[0]) + el.layout.xaxis.range[0];
var y =((e.layerY - bg.attributes['y'].value + 4) / (bg.attributes['height'].value)) * (el.layout.yaxis.range[0] - el.layout.yaxis.range[1]) + el.layout.yaxis.range[1]
if (x.between(el.layout.xaxis.range[0], el.layout.xaxis.range[1]) && y.between(el.layout.yaxis.range[0], el.layout.yaxis.range[1])) {
Plotly.extendTraces(el, {
x: [[x]],
y: [[y]]
}, [1]);
}
});
}"
output$plot <- renderPlotly({
plot_ly(x = c( -2, 0, 2 ),y = c( -2, 1, 2), type = 'scatter' ,mode = 'lines+markers') %>%
add_trace(x=c(-1,0.4,2),y=c(2, 0, -1),type='scatter',mode='lines+markers') %>%
layout(hovermode='closest') %>% onRender(javascript)
})
}
shinyApp(ui = ui, server = server)
The solution by Maximilian does not work on Plotly.js versions later than 1.42.0. Trying to fetch
var bg = document.getElementsByClassName('bg')[0];
returns undefined. The solution works using version 1.41.3.
This answer is most likely more suited to be a comment but my reputation does not meet the minimum requirement of 50.
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.