I have been trying to create a plot where I have some points that I want to be interactive with hover-info etc but I want to include two polygon areas without any of the interactive stuff.
For MWE:
library(plotly)
data("iris")
xsq <- function(x) sqrt(x)
x <- c( c(seq(0,10,0.001),0,0), c(0.5,10,10,0.5))
y <- c( c(xsq(x[1:length(seq(0,10,0.001))]),xsq(max(x)),0), c(0,2,0,0))
## produce the plotly plot
plot_ly(x = x, y = y, alpha = 0.1, opacity=0.1) %>%
add_polygons(hoverinfo = "none", color = I("red"),showlegend=F) %>%
add_polygons(x = c(0.5,10,10,0.5), y=c(0,2,0,0), hoverinfo = "none",
color = I("blue"), showlegend=F) %>%
add_markers(x=iris$Sepal.Length,y=iris$Sepal.Width-2, opacity=1, alpha=1,
color=iris$Species, hoverinfo="text", text=iris$Species)
This is sort of giving me what I want but I have a couple of problems:
The hover informative for the points in the polygon regions are not appearing
If I select a group, then the two polygons also disappear from view. I would like to keep the polygon present at all times even when only a single groups of points is to be selected
I was also trying to use ggplot but wasn't having any luck there.
Basically what I think I want is a way to add two static polygons to a plotly plot. Does anyone have any other suggestions/ideas?
Thanks.
So after some extensive searching and experimentation, I worked out how to solve problem 1. One needs to include hoveron="points" for the polygon layers. e.g.,
plot_ly(x = x, y = y, alpha = 0.1, opacity=0.1) %>%
add_polygons(hoverinfo = "none", color = I("red"),showlegend=F, hoveron="points") %>%
add_polygons(x = c(0.5,10,10,0.5), y=c(0,2,0,0), hoverinfo = "none",
color = I("blue"), showlegend=F, hoveron="points") %>%
add_markers(x=iris$Sepal.Length,y=iris$Sepal.Width-2, opacity=1, alpha=1,
color=iris$Species, hoverinfo="text", text=iris$Species)
Related
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()
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.
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.
A feature of plotly that I really like is the ability to dive into the data by clicking on specific groupings in the legend. For example, if I set a column to color for a scatter plot, I can filter on the various color variables. However, I only know how to create this filter when assigning the column to color. Is there a way to assign a variable to the legend to filter without changing the design of the plot. For example is there a function like legend_filter in plotly I could use:
iris2 <- iris
iris2$sample <- sample(c('A','B'), nrow(iris2), replace = T)
p <- plot_ly(data = iris2, x = ~Sepal.Length, y = ~Petal.Length, color = ~Species,
# legend_filter = ~sample
)
p
such that 'A' and 'B' show up in the side bar to interactively click on, but aren't referenced on the graph?
Thanks
This method lets you toggle all of A and B on off as a group by clicking any one of the entries.
Legend is definitely cluttered side, and you have to add another set of markers for each level of your grouping variable. I don't think this is really the end result you're looking for, but I figured I might as well post anyway in case any pieces of it are useful.
plot_ly() %>%
add_markers(data = iris2[iris2$sample == "A",],
x = ~Sepal.Length,
y = ~Petal.Length,
color = ~Species,
legendgroup = "A",
name = "A") %>%
add_markers(data = iris2[iris2$sample == "B",],
x = ~Sepal.Length,
y = ~Petal.Length,
color = ~Species,
legendgroup = "B",
name = "B")
Yields
I am trying to produce a dumbell plot in R. In this case, there are four rows, and they need to have different and specific colors each. I define the colors as part of the dataset using colorRampPalette(). Then when I produce the plot, the colors get mixed in inappropriate ways. See the image below, and in particular the legend.
As you can see, the orange is supposed to be #7570B3 according to the legend. But this is not correct. The color 7570B3 is purple ! For this reason, the colors that I had defined in the dataset are mixed in the plot. "Alt 2" sound be in orange and "Alt 3" should be in purple.
Does anyone know how to fix this ? Any help would be very appreciated.
Here is a simple version of the code:
table_stats_scores <- data.frame(alt=c("alt1","alt2","alt3","alt4"),
average=c(15,20,10,5),
dumb_colors= colorRampPalette(brewer.pal(4,"Dark2"))(4),
min=c(10,15,5,0),max=c(20,25,15,10)
)
table_stats_scores # This is the dataset
table_stats_scores <- table_stats_scores[order(-
table_stats_scores$average),] # ordering
table_stats_scores$alt <- factor(table_stats_scores$alt,
levels = table_stats_scores$alt[order(table_stats_scores$average)])
# giving factor status to alternatives so that plot_ly() picks up on this
p <- plot_ly(table_stats_scores, x=table_stats_scores$average, color = ~
dumb_colors,
y=table_stats_scores$alt,text=table_stats_scores$alt) %>%
add_segments(x = ~min, xend = ~max, y = ~alt, yend = ~alt,name = "Min-Max
range", showlegend = FALSE, line = list(width = 4)) %>%
add_markers(x = ~average, y = ~alt, name = "Mean",
marker=list(size=8.5),showlegend = FALSE) %>%
add_text(textposition = "top right") %>%
layout(title = "Scores of alternatives",
xaxis = list(title = "scores"),
yaxis = list(title = "Alternatives")
)
p
Yes color can be an issue in plotly, because there are several ways to specify it, and the assignment order of the various elements from the dataframe can be hard to keep in sync.
The following changes were made:
added a list of brighter colors to your dataframe because I couldn't easily visualize the brewer.pal colors. Better to debug with something obvious.
changed the color parameter to the alt column, because it is really just used only indirectly to set the color, and mostly it determines the text in the legend.
added the colors to the text parameter (instead of alt) so I could see if it was assigning the colors correctly.
changed the sort order to the default "ascending" on the table_stat_scores sort because otherwise it assigned the colors in the incorrect order (don't completely understand this - seems like there is some mysterious sorting/re-ordering going on internally)
added a colors parameter to the add_segments and add_markers so that they set the color in the same way using the same column.
I think this gets you want you want:
library(plotly)
library(RColorBrewer)
table_stats_scores <- data.frame(alt=c("alt1","alt2","alt3","alt4"),
average=c(15,20,10,5),
dumb_colors= colorRampPalette(brewer.pal(4,"Dark2"))(4),
min=c(10,15,5,0),max=c(20,25,15,10)
)
table_stats_scores # This is the dataset
table_stats_scores$bright_colors <- c("#FF0000","#00FF00","#0000FF","#FF00FF")
table_stats_scores <- table_stats_scores[order(table_stats_scores$average),] # ordering
table_stats_scores$alt <- factor(table_stats_scores$alt,
levels = table_stats_scores$alt[order(table_stats_scores$average)])
# giving factor status to alternatives so that plot_ly() picks up on this
p <- plot_ly(table_stats_scores, x=~average, color = ~alt, y=~alt,text=~bright_colors) %>%
add_segments(x = ~min, xend = ~max, y = ~alt, yend = ~alt,name = "Min-Max range",
colors=~bright_colors, showlegend = FALSE, line = list(width = 4)) %>%
add_markers(x = ~average, y = ~alt, name = "Mean",
marker=list(size=8.5,colors=~bright_colors),showlegend = FALSE) %>%
add_text(textposition = "top right") %>%
layout(title = "Scores of alternatives",
xaxis = list(title = "scores"),
yaxis = list(title = "Alternatives")
)
p
yielding this: