Manipulating R plotly legend - r

Probably an easy question:
Trying to use plotly to produce a scatter plot and customize the legend.
Here's my data:
require(plotly)
set.seed(1)
my.df <- data.frame(id=LETTERS[sample(26,100,replace=T)],x=rnorm(100),y=rnorm(100),sig=runif(100,0,1),stringsAsFactors = F)
In my case I'm calling this with the column indices, thus:
x.idx <- which(colnames(my.df) == "x")
y.idx <- which(colnames(my.df) == "y")
sig.idx <- which(colnames(my.df) == "sig")
sig.name <- "p-value"
And what I want to do is have the legend title be sig.name and make the legend smaller than the default size. So I'm trying:
p <- plot_ly(x=~my.df[,x.idx],y=~my.df[,y.idx],color=~my.df[,sig.idx],text=~my.df$id,colors=c("darkblue","darkred")) %>% add_annotations(text=sig.name,xref="paper",yref="paper",xanchor="left",x=1,y=1,yanchor="top",legendtitle=T,showarrow=FALSE) %>% layout(legend=list(y=0.8,yanchor="top"),xaxis=list(title=colnames(my.df)[x.idx],zeroline=F),yaxis=list(title=colnames(my.df)[y.idx],zeroline=F))
Which gives me:
Not exactly what I want.
So:
How do I delete the default legend title?
How do I make the legend smaller?

You are probably looking for colorbar: len and colorbar: title.
plot_ly(type = 'scatter',
mode = 'markers',
x = ~my.df[,x.idx],
y = ~my.df[,y.idx],
color = ~my.df[,sig.idx],
text =~my.df$id,
colors = c("darkblue","darkred"),
marker = list(colorbar = list(len = 0.2,
title = sig.name)
)
)

Related

R Plotly Heatmap Conditional Annotation with ifelse?

Follwoing:
R Heatmap: conditionally change label text colours with (ggplot2 or plotly)
I thought the code below would create a heatmap whose annotation is white if the value is greater than 5 (so in this case, when (X,Y)=(3,"C")) but it does not work. Any idea?
Thank you!
df<-tibble(Y=c("A","B","C"),
X=c(1,2,3),
Z=c(1,5,10))
df %>%
plot_ly(x = ~X, y=~Y, z=~Z, type='heatmap') %>%
add_annotations(text = ~Z,
showarrow = FALSE,
font = list(color = ~ifelse(Z>5,'white','black')))
Font colors weren't designed to be dynamic in Plotly. Even though add_annotations inherently understands that you want one 'add_annotation' for each value in Z, it does not assume that's what you mean for the font color. However, you can still have it changed on the fly with a UDF.
This function rebuilds the plot, then parses the annotations to assign colors.
that <- function(plt) {
plt <- plotly_build(plt) # build the plot to collect the data
lapply(1:length(plt$x$layout$annotations), # loop through annotations
function(j) {
this <- plt$x$layout$annotations[[j]] # collect annotation
colr <- ifelse(this$text > 5, "white", "black") # test for color
plt$x$layout$annotations[[j]]$font$color <<- colr # assign color
})
plt # return updated plot
}
The way that you use this is by just piping it to the end of your plot call. I didn't tie in exceptions for cases in which no color was specifically assigned. In other words, assign a color in your original plot call, it doesn't matter what color it is.
df %>%
plot_ly(x = ~X, y = ~Y, z = ~Z, type = 'heatmap') %>%
add_annotations(text = ~Z,
showarrow = FALSE,
font = list(color = "black")) %>% that() # <- I'm new!
I used the color sequence you chose, but I think this is the opposite of what you really wanted.
For example, if I swap the conditions for the colors in the function:
that <- function(plt) {
plt <- plotly_build(plt) # build the plot to collect the data
lapply(1:length(plt$x$layout$annotations), # loop through annotations
function(j) {
this <- plt$x$layout$annotations[[j]] # collect annotation
colr <- ifelse(this$text > 5, "black", "white") # test for color
plt$x$layout$annotations[[j]]$font$color <<- colr # assign color
})
plt # return updated plot
}
df %>%
plot_ly(x = ~X, y = ~Y, z = ~Z, type = 'heatmap') %>%
add_annotations(text = ~Z,
showarrow = FALSE,
font = list(color = "black")) %>% that()
Now you can see the text a lot better:
By the way, you could also call the plot as it is and use that(last_plot()) to rerender it with the new text colors.
Both plotly and ggplot2 have the function last_plot(); make sure you're calling the plotly version if you use this method.
Just an idea, you can also use a heatplot like this if you want to show a thresholded map:
ggplot(df, mapping = aes(x = X, y = Y, fill = Z>5, fill_max = 5)) + geom_tile()

Is it possible to combine the ggplot legend with the plotly legend so they are equivalent?

I'm trying to combine ggplot and plotly together to make a timeline.
It's working great, but have an issue using the legend. The code below replicates what I'm trying to do.
library(ggplot2)
library(plotly)
x=1:10
df2 = data.frame(x,y = 2*x+rnorm(length(x)),lab = as.factor(c("col1","col2")))
status_colors <- c("#0070C0", "#00B050", "#FFC000", "#C00000","darkgreen","purple","darkgrey","blue","salmon","darkorange","black","navy","darkblue")
status_levels <- c(sort(unique(df2$lab)))
p= ggplot(df2,aes(x=x, y=y, col = lab)) + geom_point() + labs(col="labtest") +
scale_color_manual(values=status_colors,
labels=status_levels, drop = FALSE)
fig = ggplotly(p, tooltip = NULL)
fig %>%
add_text(
x = df2$x,
y = ifelse(df2$y>0,df2$y+0.05,df2$y-0.05),
text = df2$lab,
hovertext = df2$lab,
hoverinfo = 'text',
mode ="text",
textfont = list(color=status_colors[df2$lab], size =10),
marker = list(color=status_colors[df2$lab], size = 0.00001),
showlegend = T,
textposition = ifelse(df2$y>0,"top center","bottom center")
)
Basically, as you can see in the image, the label of each point is the same colour as the point that it is attached to. But whenever I add the legend of the label text from plotly, there is a new legend that appears that controls all the points regardless of their colour.
Thus, is there a way to combine the ggplot legend with the plotly legend so that it's only written col1 and col2 with the right colour and that whenever I interact with the points of a certain colour, the label attached to it stays there?
In other words, is there a way to remove the "trace 2" legend and make the "add_text" know that there is a legend already created in ggplot?
If I got you right, besides getting rid of the second legend (which can be simply achievd by setting showlegend = FALSE) you want one legend to control both the points and the labels. This can be achieved via legendgroups. Instead of adding labels with one add_text you could (or have to? Sorry. Still a plotly newbie so perhaps there is a simpler approach) add the labels via two add_text calls one for each col. Instead of copy and paste (which is probably okay for just two cols, but with more cols ...) you can add these via the magic of purrr::reduce to the ggplotly object. Try this:
library(ggplot2)
library(plotly)
library(purrr)
x=1:10
df2 = data.frame(x,y = 2*x+rnorm(length(x)),lab = as.factor(c("col1","col2")))
status_colors <- c("#0070C0", "#00B050", "#FFC000", "#C00000","darkgreen","purple","darkgrey","blue","salmon","darkorange","black","navy","darkblue")
status_levels <- c(sort(unique(df2$lab)))
p= ggplot(df2,aes(x=x, y=y, col = lab)) + geom_point() +
labs(col="labtest") +
scale_color_manual(values=status_colors,
labels=status_levels, drop = FALSE)
fig = ggplotly(p, tooltip = NULL)
purrr::reduce(c("col1", "col2"), ~ .x %>% add_text(
data = filter(df2, lab == .y),
x = ~x,
y = ~ifelse(y > 0, y + 0.05, y-0.05),
text = ~lab,
hovertext = ~lab,
hoverinfo = 'text',
mode ="text",
textfont = list(color= ~status_colors[lab], size =10),
marker = list(color= ~status_colors[lab], size = 0.00001),
showlegend = FALSE,
textposition = ~ifelse(y>0, "top center","bottom center"),
legendgroup = .y
), .init = fig)
BTW: I also simplified the code a little bit. You don't need df2$... because (gg)plotly already knows the data.

R Plotly linked subplot with percentage histogram and categories coloured

The Background
I am using the plotly API in R to create two linked plots. The first is a scatter plot and the second is a bar chart that should show the percentage of data belonging to each category, in the current selection. I can't make the percentages behave as expected.
The problem
The plots render correctly and the interactive selection works fine. When I select a set of data points in the top scatter plot, I would like to see the percentage of that selection that belongs to each category. Instead what I see is the percentage of points in that selection in that category that belong to that category, in other words always 100%. I guess this is because I set color = ~c which applies a grouping to the category.
The Example
Here is a reproducible example to follow. First create some dummy data.
library(plotly)
n = 1000
make_axis = function(n) c(rnorm(n, -1, 1), rnorm(n, 2, 0.25))
data = data.frame(
x = make_axis(n),
y = make_axis(n),
c = rep(c("A", "B"), each = n)
)
Create a sharedData object and supply it to plot_ly() for the base plot.
shared_data = data %>%
highlight_key()
baseplot = plot_ly(shared_data)
Make the individual panels.
points = baseplot %>%
add_markers(x = ~x, y = ~y, color = ~c)
bars = baseplot %>%
add_histogram(x = ~c, color = ~c, histnorm = "percent", showlegend = FALSE) %>%
layout(barmode = "group")
And put them together in a linked subplot with selection and highlighting.
subplot(points, bars) %>%
layout(dragmode = "select") %>%
highlight("plotly_selected")
Here is a screenshot of this to illustrate the problem.
An Aside
Incidentally when I set histnorm = "" in add_histogram() then I get closer to the expected behaviour but I do want percentages and not counts. When I remove color = ~c then I get closer to the expected behaviour but I do want the consistent colour scheme.
What have I tried
I have tried manually supplying the colours but then some of the linked selection breaks. I have tried creating a separate summarised data set from the sharedData object first and then plotting that but again this breaks the linkage between the plots.
If anyone has any clues as to how to solve this I would be very grateful.
To me it seems the behaviour you are looking for isn't implemented in plotly.
Please see schema(): object ► traces ► histogram ► attributes ► histnorm ► description
However, here is the closest I was able to achive via add_bars and perprocessing the data (Sorry for adding data.table, you will be able to do the same in base R, just personal preference):
library(plotly)
library(data.table)
n = 1000
make_axis = function(n) c(rnorm(n, -1, 1), rnorm(n, 2, 0.25))
DT = data.table(
x = make_axis(n),
y = make_axis(n),
c = rep(c("A", "B"), each = n)
)
DT[, grp_percent := rep(100/.N, .N), by = "c"]
shared_data = DT %>%
highlight_key()
baseplot = plot_ly(shared_data)
# Make the individual panels.
points = baseplot %>%
add_markers(x = ~x, y = ~y, color = ~c)
bars = baseplot %>%
add_bars(x = ~c, y = ~grp_percent, color = ~c, showlegend = FALSE) %>%
layout(barmode = "group")
subplot(points, bars) %>%
layout(dragmode = "select") %>%
highlight("plotly_selected")
Unfortunately, the resulting hoverinfo isn't really desirable.

Adding color and bubble size legend in R plotly

Probably an easy one.
I have an xy dataset I'd like to plot using R's plotly. Here are the data:
set.seed(1)
df <- data.frame(x=1:10,y=runif(10,1,10),group=c(rep("A",9),"B"),group.size=as.integer(runif(10,1,10)))
I'd like to color the data by df$group and have the size of the points follow df$group.size (i.e., a bubble plot). In addition, I'd like to have both legends added.
This is my naive attempt:
require(plotly)
require(dplyr)
main.plot <-
plot_ly(type='scatter',mode="markers",color=~df$group,x=~df$x,y=~df$y,size=~df$group.size,marker=list(sizeref=0.1,sizemode="area",opacity=0.5),data=df,showlegend=T) %>%
layout(title="Title",xaxis=list(title="X",zeroline=F),yaxis=list(title="Y",zeroline=F))
which comes out as:
and unfortunately messes up the legend, at least how I want it to be: a point for each group having the same size but different colors.
Then to add a legend for the group.size I followed this, also helped by aocall's answer:
legend.plot <- plot_ly() %>% add_markers(x = 1, y = unique(df$group.size),
size = unique(df$group.size),
showlegend = T,
marker = list(sizeref=0.1,sizemode="area")) %>%
layout(title="TITLE",xaxis = list(zeroline=F,showline=F,showticklabels=F,showgrid=F),
yaxis=list(showgrid=F))
which comes out as:
Here my problem is that the legend is including values that do not exist in my data.
then I combine them using subplot:
subplot(legend.plot, main.plot, widths = c(0.1, 0.9))
I get this:
where the legend title is eliminated
So I'd be helpful for some help.
Based on the updated request:
Note the changes in legend.plot (mapping values to a sequence of integers, then manually changing the axis tick text), and the use of annotations to get a legend title. As explained in this answer, only one title may be used, regardless of how many subplots are used.
The circle on the plot legend seems to correspond to the minimum point size of each trace. Thus, I've added a point at (12, 12), and restricted the range of the axes to ensure it isn't shown.
titleX and titleY control the display of axis labels, as explained here.
set.seed(1)
df <- data.frame(x=1:10,y=runif(10,1,10),group=c(rep("A",9),"B"),group.size=as.integer(runif(10,1,10)))
require(plotly)
require(dplyr)
## Take unique values before adding dummy value
unique_vals <- unique(df$group.size)
df <- rbind(c(12, 12, "B", 1), df)
df[c(1, 2, 4)] <- lapply(df[c(1, 2, 4)], as.numeric)
main.plot <-
plot_ly(type='scatter',
mode="markers",
color=~df$group,
x=~df$x,
y=~df$y,
size=~df$group.size,
marker=list(
sizeref=0.1,
sizemode="area",
opacity=0.5),
data=df,
showlegend=T) %>%
layout(title="Title",
xaxis=list(title="X",zeroline=F, range=c(0, 11)),
yaxis=list(title="Y",zeroline=F, range=c(0, 11)))
legend.plot <- plot_ly() %>%
add_markers(x = 1,
y = seq_len(length(unique_vals)),
size = sort(unique_vals),
showlegend = F,
marker = list(sizeref=0.1,sizemode="area")) %>%
layout(
annotations = list(
list(x = 0.2,
y = 1,
text = "LEGEND TITLE",
showarrow = F,
xref='paper',
yref='paper')),
xaxis = list(
zeroline=F,
showline=F,
showticklabels=F,
showgrid=F),
yaxis=list(
showgrid=F,
tickmode = "array",
tickvals = seq_len(length(unique_vals)),
ticktext = sort(unique_vals)))
subplot(legend.plot, main.plot, widths = c(0.1, 0.9),
titleX=TRUE, titleY=TRUE)
Firstly, you are only passing in the unique values to the legend. If you pass in all possible values (ie, seq(min(x), max(x), by=1), or in this case seq_len(max(x))) the legend will show the full range.
Secondly, sizeref and sizemode in the marker argument alter the way that point size is calculated. The following example should produce a more consistent plot:
set.seed(1)
df <- data.frame(x=1:10,y=runif(10,1,10),group=c(rep("A",9),"B"),group.size=as.integer(runif(10,1,10)))
require(plotly)
require(dplyr)
a <- plot_ly(type='scatter',mode="markers",
color=~df$group,
x=~df$x,
y=~df$y,
size=df$group.size,
marker = list(sizeref=0.1, sizemode="area"),
data=df,
showlegend=F) %>%
layout(title="Title",
xaxis=list(title="X",zeroline=F),
yaxis=list(title="Y",zeroline=F))
b <- plot_ly() %>% add_markers(x = 1, y = seq_len(max(df$group.size)),
size = seq_len(max(df$group.size)),
showlegend = F,
marker = list(sizeref=0.1, sizemode="area")) %>%
layout(
xaxis = list(zeroline=F,showline=F,showticklabels=F,showgrid=F),
yaxis=list(showgrid=F))
subplot(b, a, widths = c(0.1, 0.9))

How to plot horizontal lines between y-axis ticks in plotly?

Here is some example code to illustrate my issue.
library(plotly)
p <- plot_ly(x = mtcars$mpg, y = seq_along(rownames(mtcars)), text=rownames(mtcars),
type = 'scatter', mode = 'markers')
ax <- list(
title = "",
ticktext = rownames(mtcars),
tickvals = seq(1,32)
)
line <- list(
type = "line",
line = list(color = "pink"),
xref = "x",
yref = "y"
layer = 'below'
)
lines <- list()
for (i in seq_along(rownames(mtcars))) {
line[["x0"]] <- mtcars$mpg[i] - 1
line[["x1"]] <- mtcars$mpg[i] + 1
line[c("y0", "y1")] <- i
lines <- c(lines, list(line))
}
p <- layout(p, title = 'Highlighting with Lines', shapes = lines, yaxis=ax)
p
I would like to add horizontal lines through the plot to separate each y-axis label. I would prefer the line split the labels as well as the graph, but splitting just the graph would suffice. I have looked extensively through the plotly reference but have yet to find anything that appears to help. I was told that there might be some sort of solution through some custom JS in the y-axisof the layout section, but am unsure on how I would go about this / am not very JS savvy.
I was able to accomplish this by adding more lines to the lines list. Under the for loop shown above, if you add the code:
for (i in seq_along(rownames(mtcars))) {
line[["x0"]] <- 10
line[["x1"]] <- 35
line[c("y0", "y1")] <- i-.5
lines <- c(lines, list(line))
}
It will place a separating line in between each of the data lines.

Resources