I have a very simple plotly graph for which I would like to put the company logos instead (or both) of their names on the Y axis
library(plotly)
plot_ly(
y = c("company_1", "company_2", "company_3", "company_4", "company_5"),
x = c(20, 14, 23, 6, 28),
name = "companies",
type = "bar"
)
For example, we can imagine that the companies are Facebook, Twitter, Apple, Microsoft and Tesla
I have images (logo) in png format.
Is there a way to do this?
This isn't something you'll be able to do strictly in R. However, if you use the function onRender from htmlwidgets, you can do it.
I added margin so the images would fit. However, the plot is exactly as you provided it. Make sure that if/when you make changes you respect the whitespace shown here. HTML and Javascript won't understand if the attributes are smashed together.
The first code & plot uses an image that is on the web. The next code & plot uses a local file. That way you can use whichever method applies in your situation.
Images via Hyperlink
plot_ly(
y = c("company_1", "company_2", "company_3", "company_4", "company_5"),
x = c(20, 14, 23, 6, 28),
name = "companies",
type = "bar") %>%
layout(margin = list(l = 120, r = 20, t = 20, b = 50)) %>%
htmlwidgets::onRender("function(){
gimme = document.querySelectorAll('g.ytick'); /* get the text positions on y-axis */
imTag1 = '<image width=\"100\" height=\"100\" ' /* pre-build the HTML */
imTag2 = ' href=\"https://www.rstudio.com/wp-content/uploads/2018/10/RStudio-Logo-Flat.png\" />'
for(i = 0; i < gimme.length; i++) {
zz = gimme[i].firstChild.getAttribute('transform'); /* get position on page*/
yy = gimme[i].firstChild.getAttribute('y');
yy = yy * -10;
img = imTag1 + 'x=\"10\" y=\"' + yy + '\" transform=\"' + zz + '\"' + imTag2;
gimme[i].innerHTML = img; /* replace the text tag */
}
}")
Images via Local File
The image I used here is from https://www.hiclipart.com/free-transparent-background-png-clipart-qzdon/download
In MY files it's saved at ./_images/orangeIcon.png (where '.' represents the current working directory).
Because this file is a png, I need to make something better for web portability, so I used base64 encoding using the package base64enc.
img <- base64enc::dataURI(file = "./_images/orangeIcon.png")
I'm going to assign this to customdata in the call for plotly. If you had five images, you can make a list of the 5 encoded images. if you list one, plotly will replicate it. (That's what it did here.)
plot_ly(
y = c("company_1", "company_2", "company_3", "company_4", "company_5"),
x = c(20, 14, 23, 6, 28),
name = "companies", customdata = img, # <---- custom data!!
type = "bar") %>%
layout(margin = list(l = 120, r = 20, t = 20, b = 50)) %>%
htmlwidgets::onRender("function(el, x){ /* changed here, as well */
gimme = document.querySelectorAll('g.ytick'); /* get the text positions on y-axis */
imgs = x.data[0].customdata; /* collect the images */
imTag1 = '<image width=\"100\" height=\"100\" href=\"' /* pre-build the HTML */
imTag2 = ' \" />'
for(i = 0; i < gimme.length; i++) {
zz = gimme[i].firstChild.getAttribute('transform'); /* get position on page*/
yy = gimme[i].firstChild.getAttribute('y');
yy = yy * -10;
img = imTag1 + imgs[i] + '\" x=\"10\" y=\"' + yy + '\" transform=\"' + zz + '\"' + imTag2;
gimme[i].innerHTML = img; /* replace the text tag */
}
}") # note the differences in imgTag1 and imgTag2
# to accommodate the new info for href
In the sankeydiagram example below, is there anyway to hide the "Values" being shown in the diagram while hovering - both on the Nodes as well as the Links. Im basically using the sankey chart to show a stylised flow diagram, and I would like the Values not be shown to the user at all
URL <- paste0('https://cdn.rawgit.com/christophergandrud/networkD3/master/JSONdata/energy.json')
energy <- jsonlite::fromJSON(URL)
sankeyNetwork(Links = energy$links, Nodes = energy$nodes, Source = 'source',
Target = 'target', Value = 'value', NodeID = 'name',
units = 'TWh', fontSize = 12, nodeWidth = 30)
To be clear, in the screenshot below,I would still like to see the Wind-Electricitygrid, but would like 289KWH not be displayed
You can generate any text you want to be displayed in the tooltips and add it to the htmlwidgets object, then use some custom JavaScript to set the tooltip text to it...
library(jsonlite)
library(networkD3)
library(htmlwidgets)
URL <- paste0('https://cdn.rawgit.com/christophergandrud/networkD3/master/JSONdata/energy.json')
energy <- jsonlite::fromJSON(URL)
# generate the text you want to display
energy$links$name <-
paste0(energy$nodes$name[energy$links$source + 1],
" -> ", energy$nodes$name[energy$links$target + 1])
sn <- sankeyNetwork(Links = energy$links, Nodes = energy$nodes, Source = 'source',
Target = 'target', Value = 'value', NodeID = 'name',
units = 'TWh', fontSize = 12, nodeWidth = 30)
# add the names back into the links data because sankeyNetwork strips it out
sn$x$links$name <- energy$links$name
# add onRender JavaScript to set the title to the value of 'name' for each link
sn <- htmlwidgets::onRender(
sn,
'
function(el, x) {
d3.selectAll(".link").select("title foreignObject body pre")
.text(function(d) { return d.name; });
}
'
)
# display the result
sn
I found this image from the Internet (link) and I think it was draw in R. I tried to reproduce this Figure and make it more or less similar with one from the above link. The code I used is as following:
ID <- 0:24
NodeGroup <- c(rep(1,8),2,5,rep(4,7),3,5,6,6,7,7,8,9)
name <- c("29581k","5279k","4218k","1917k","1356k","Ventas diversas: 116","Venta diversa: 97","Venta de: 141","Venta totales: 42705","Contribucion marginal: 18183", "17531k","1744k","1326k","1208k","526k","459k","14k","IIBB: 1714","Costo: 22808","Gastos directos: 6734","Gastos distribudos: 2958","Resultado: 8851","Total Gastos: 9332","Imp. Gcias: 3098","Resultado Netto: 5.753")
nodes <- data.frame(ID, name, NodeGroup)
nodes$NodeGroup <- as.character(nodes$NodeGroup)
source <- c(0:7, rep(8,9), 10:16, rep(9,3), 19, 20, 21, 21)
target <- c(rep(8,8), 17, 10:16, 9, rep(18,7), 19:21, rep(22, 2), 23, 24)
value <- c(29581,5279,4218,1917,1356,116,97,141,1714,17531,1744,1326,1208,526,459,14,18138,17531,1744,1326,1208,526,459,14,6374,2958,8851,6374,2958,3098,5753)
group <- c(1:8, rep(9,8), 10, rep(19,7), rep(18,3), rep(23,2), rep(22,2))
links <- data.frame(source, target, value, group)
links$group <- as.character(links$group)
sn <- sankeyNetwork(Links=links, Nodes=nodes, Source='source', Target='target',
Value='value', NodeID='name', fontSize=18,
NodeGroup = "NodeGroup",
sinksRight = FALSE,
LinkGroup = "group",
#nodeWidth = 40,
#width=1500, height=500,
#margin = list("right"=250),
iterations = FALSE)
sn
From this links it is possible to change the position of a node not only vertically, but also horizontally. Can we implement it in R?
Update 1: I can solve issue in question 2 by changing the source code of sankeyNetwork.js by using the code provide at this links. I do not know how to implement it through htmlwidgets (I am not familiar with JS; hence, just do trial and error!). I just need to copy the following code to the end of sankeyNetwork.js.
function dragmove(d) {
d3.select(this).attr("transform",
"translate(" + (
d.x = Math.max(0, Math.min(width - d.dx, d3.event.x))
) + "," + (
d.y = Math.max(0, Math.min(height - d.dy, d3.event.y))
) + ")");
sankey.relayout();
link.attr("d", path);
}
To enable horizontal movement of the nodes, along with the vertical movement, you could adapt d3noob's code to work, but it's not as easy as dropping in just their dragmove function declaration.
It was written using D3v3, and networkD3 uses D3v4... and they're not entirely compatible.
That function refers to a bunch of objects that are defined elsewhere, so the function on its own cannot work without knowing what these are: width, height, sankey, link, and path.
Here is one way of adapting it to work...
library(networkD3)
library(htmlwidgets)
ID <- 0:24
NodeGroup <- c(rep(1,8),2,5,rep(4,7),3,5,6,6,7,7,8,9)
name <- c("29581k","5279k","4218k","1917k","1356k","Ventas diversas: 116",
"Venta diversa: 97","Venta de: 141","Venta totales: 42705",
"Contribucion marginal: 18183", "17531k","1744k","1326k","1208k",
"526k","459k","14k","IIBB: 1714","Costo: 22808",
"Gastos directos: 6734", "Gastos distribudos: 2958","Resultado: 8851",
"Total Gastos: 9332","Imp. Gcias: 3098","Resultado Netto: 5.753")
nodes <- data.frame(ID, name, NodeGroup)
nodes$NodeGroup <- as.character(nodes$NodeGroup)
source <- c(0:7, rep(8,9), 10:16, rep(9,3), 19, 20, 21, 21)
target <- c(rep(8,8), 17, 10:16, 9, rep(18,7), 19:21, rep(22, 2), 23, 24)
value <- c(29581,5279,4218,1917,1356,116,97,141,1714,17531,1744,1326,1208,526,
459,14,18138,17531,1744,1326,1208,526,459,14,6374,2958,8851,6374,
2958,3098,5753)
group <- c(1:8, rep(9,8), 10, rep(19,7), rep(18,3), rep(23,2), rep(22,2))
links <- data.frame(source, target, value, group)
links$group <- as.character(links$group)
sn <- sankeyNetwork(Links=links, Nodes=nodes, Source='source', Target='target',
Value='value', NodeID='name', fontSize=18,
NodeGroup = "NodeGroup",
sinksRight = FALSE,
LinkGroup = "group",
#nodeWidth = 40,
#width=1500, height=500,
#margin = list("right"=250),
iterations = FALSE)
onRender(sn,
'
function(el, x) {
var sankey = this.sankey;
var path = sankey.link();
var nodes = d3.selectAll(".node");
var link = d3.selectAll(".link")
var width = el.getBoundingClientRect().width - 40;
var height = el.getBoundingClientRect().height - 40;
window.dragmove = function(d) {
d3.select(this).attr("transform",
"translate(" + (
d.x = Math.max(0, Math.min(width - d.dx, d3.event.x))
) + "," + (
d.y = Math.max(0, Math.min(height - d.dy, d3.event.y))
) + ")");
sankey.relayout();
link.attr("d", path);
};
nodes.call(d3.drag()
.subject(function(d) { return d; })
.on("start", function() { this.parentNode.appendChild(this); })
.on("drag", dragmove));
}
'
)
I generated a scatterplot in HTML format using plotly and a generic dataframe. I am aware that it is possible to highlight (with a different color for example) certain data points before generating the plot HTML. However, I wonder if it is possible to add an element to the HTML file that would enable a user to find/highlight a certain data point based on its text label after the plot has been produced.
The code I used to produce the dataframe and scatter:
tab <- data.frame(sample.id = pca$sample.id,
EV1 = pca$eigenvect[, 1],
EV2 = pca$eigenvect[, 2],
stringsAsFactors=F)
p <- plot_ly(tab, x=tab$EV1, y=tab$EV2, text=tab$sample.id)
p <- layout(p, title="PCA", xaxis=list(title="PC 1"),
yaxis=list(title="PC 2"))
htmlwidgets::saveWidget(as.widget(p), paste(output_name, ".html", sep=""))
As far as I know there is not builtin functionality in Plotly but you just need a few lines of Javascript code to get the functionality.
Plotly stores the data in a application/json object in the HTML file. You can get the data via
var data = JSON.parse(document.querySelectorAll("script[type='application/json']")[0].innerHTML);
The text elements are stored in
data.x.data[i].text[j]
where i is the trace number and j is point number.
Now we need a text field and a button, we can use htmltools for that purpose
p <- htmlwidgets::appendContent(p, htmltools::tags$input(id='inputText', value='Merc', ''), htmltools::tags$button(id='buttonSearch', 'Search'))
Let's add a eventlister to the button which triggers a hover event of the first point of the first trace.
p <- htmlwidgets::appendContent(p, htmltools::tags$script(HTML(
'document.getElementById("buttonSearch").addEventListener("click", function()
{
var myDiv = document.getElementsByClassName("js-plotly-plot")[0]
Plotly.Fx.hover(myDiv, [{curveNumber: 0, pointNumber: 0}]);
}
)
')))
And the whole code which searches for through all text labels and triggers a hover event when the entered text is found in the label.
library(plotly)
library(htmlwidgets)
library(htmltools)
pcaCars <- princomp(mtcars, cor = TRUE)
carsHC <- hclust(dist(pcaCars$scores), method = "ward.D2")
carsDf <- data.frame(pcaCars$scores, "cluster" = factor(carsClusters))
carsClusters <- cutree(carsHC, k = 3)
carsDf <- transform(carsDf, cluster_name = paste("Cluster", carsClusters))
p <- plot_ly(carsDf, x = ~Comp.1 , y = ~Comp.2, text = rownames(carsDf),
mode = "markers", color = ~cluster_name, marker = list(size = 11), type = 'scatter', mode = 'markers')
p <- htmlwidgets::appendContent(p, htmltools::tags$input(id='inputText', value='Merc', ''), htmltools::tags$button(id='buttonSearch', 'Search'))
p <- htmlwidgets::appendContent(p, htmltools::tags$script(HTML(
'document.getElementById("buttonSearch").addEventListener("click", function()
{
var i = 0;
var j = 0;
var found = [];
var myDiv = document.getElementsByClassName("js-plotly-plot")[0]
var data = JSON.parse(document.querySelectorAll("script[type=\'application/json\']")[0].innerHTML);
for (i = 0 ;i < data.x.data.length; i += 1) {
for (j = 0; j < data.x.data[i].text.length; j += 1) {
if (data.x.data[i].text[j].indexOf(document.getElementById("inputText").value) !== -1) {
found.push({curveNumber: i, pointNumber: j});
}
}
}
Plotly.Fx.hover(myDiv, found);
}
);')))
htmlwidgets::saveWidget(p, paste('pca', ".html", sep=""))
p
The PCA implementation was modified from here.
I've created a sankey diagram in rCharts but have one question. How do I add color? I'd like to represent each node with a different color so it's easier to vizualize the paths, instead of just seeing the same grey lines connecting everything. Code and output below:
require(rCharts)
require(rjson)
x = read.csv('/Users/<username>/sankey.csv', header=FALSE)
colnames(x) <- c("source", "target", "value")
sankeyPlot <- rCharts$new()
sankeyPlot$set(
data = x,
nodeWidth = 15,
nodePadding = 10,
layout = 32,
width = 500,
height = 300,
units = "TWh",
title = "Sankey Diagram"
)
sankeyPlot$setLib('http://timelyportfolio.github.io/rCharts_d3_sankey')
sankeyPlot
Here is what my chart looks like
Thanks so much!
not sure what colors you want, but if you have installed the newer rCharts with devtools::install_github("ramnathv/rCharts"), here is how you might color based on the source value with a demo here.
require(rCharts)
require(rjson)
x = read.csv('/Users/<username>/sankey.csv', header=FALSE)
colnames(x) <- c("source", "target", "value")
sankeyPlot <- rCharts$new()
sankeyPlot$set(
data = x,
nodeWidth = 15,
nodePadding = 10,
layout = 32,
width = 500,
height = 300,
units = "TWh",
title = "Sankey Diagram"
)
sankeyPlot$setLib('http://timelyportfolio.github.io/rCharts_d3_sankey')
sankeyPlot$setTemplate(
afterScript = "
<script>
// to be specific in case you have more than one chart
d3.selectAll('#{{ chartId }} svg path.link')
.style('stroke', function(d){
//here we will use the source color
//if you want target then sub target for source
//or if you want something other than gray
//supply a constant
//or use a categorical scale or gradient
return d.source.color;
})
//note no changes were made to opacity
//to do uncomment below but will affect mouseover
//so will need to define mouseover and mouseout
//happy to show how to do this also
// .style('stroke-opacity', .7)
</script>
")
sankeyPlot
If you wanted to use a d3.scale.category??() to provide your color, I assume you would want to also similarly color the node rectangle. Here is one example of changing the color for both the node and the link.
sankeyPlot$setTemplate(
afterScript = "
<script>
var cscale = d3.scale.category20b();
// to be specific in case you have more than one chart
d3.selectAll('#{{ chartId }} svg path.link')
.style('stroke', function(d){
//here we will use the source color
//if you want target then sub target for source
//or if you want something other than gray
//supply a constant
//or use a categorical scale or gradient
//return d.source.color;
return cscale(d.source.name);
})
//note no changes were made to opacity
//to do uncomment below but will affect mouseover
//so will need to define mouseover and mouseout
//happy to show how to do this also
// .style('stroke-opacity', .7)
d3.selectAll('#{{ chartId }} svg .node rect')
.style('fill', function(d){
return cscale(d.name)
})
.style('stroke', 'none')
</script>
")
sankeyPlot