R: Deduplicating Legends in Plotly - r

I am working with the R programming language. I have the following data:
myFun <- function(n = 5000) {
a <- do.call(paste0, replicate(5, sample(LETTERS, n, TRUE), FALSE))
paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE))
}
var1 <- c("a", "b", "c", "d", "e")
var1 <- sample(var1, 100, replace=TRUE, prob=c(0.2, 0.2, 0.2, 0.2, 0.2))
var2 = rnorm(100, 100,100)
var3 = rnorm(100,100,100)
var4 = rnorm(100, 100,100)
label1 = myFun(100)
label2 = myFun(100)
label3 = myFun(100)
label4 = myFun(100)
my_data =data.frame(var1, var2, var3, var4, label1, label2, label3, label4)
I am trying to make a Bubble Plot using the Plotly library. Here is the code I am using:
library(plotly)
p = plot_ly(my_data, x = ~ var2, y = ~ var3, color = ~ var1, type = "scatter", mode = "markers", size = ~var4, marker = list(symbol = 'circle', sizemode = 'diameter', line = list(width = 2, color = '#FFFFFF'), opacity =0.4, autosize = T))
p = p %>% layout ( axis = list(title = 'Title 1'), yaxis = list(title = 'title 2'), legend = list(title = list(text = '<b> var1 </b>')))
p = p %>% layout(title = paste0('Main Title', '<br>', 'sup', 'Subtitle' ))
annotation_row = my_data[1,]
annotation = list( x = my_data$var2, y = my_data$var3, text = my_data$var1, xref = "x", yref = "y", showarrow = TRUE, arrowhead = 7, ax = 20, ay = -40)
p = p %>% add_trace (text = paste("Var 1:", my_data$var1, "<br> Var 2: ", my_data$var2, "<br> Var 3: ", my_data$var3 ), hoverinfo = "text" )
p = p %>% layout(annotations = annotation)
htmltools::save_html(html = p, file = "file.html")
The plot runs fine, but I am noticing two problems:
The values in the legend are appearing twice (e.g. a,b,c,d,e,a,b,c,d,e)
(Even though the plot in this example appears fine) When I run this code on my real data, the plot is appearing "horizontally stretched" (e.g.https://stackoverflow.com/questions/73552382/r-forcing-plotly-to-save-full-sized-plots). I tried different options to fix this "horizontal stretching"
For example (instead of "autosize", I tried to manually specify the height and width) :
p = plot_ly(my_data, x = ~ var2, y = ~ var3, color = ~ var1, type = "scatter", mode = "markers", size = ~var4, marker = list(symbol = 'circle', sizemode = 'diameter', line = list(width = 2, color = '#FFFFFF'), opacity =0.4, height = 1000, width = 1000))
Can someone please show me how to fix this problem?
Is it possible to undo this "legend duplication" and re-write the plotly code in such a way that the "horizontal stretching" problem is fixed?
Thanks!

Related

How to add multiple shapes on plot_ly slider chart?

I am trying to visualize multiple periods in a time-series/candlestick chart, highlighting certain dates by vertical lines. Similar to the sinus wave example here: https://plotly.com/r/sliders/
aval <- list(setNames(xts(matrix(data = rnorm(1:28), ncol = 4), as.Date(1:7)), c("Open","High","Low","Close")),
setNames(xts(matrix(data = rnorm(1:52), ncol = 4), as.Date(1:13)), c("Open","High","Low","Close")),
setNames(xts(matrix(data = rnorm(1:20), ncol = 4), as.Date(1:5)), c("Open","High","Low","Close")))
Looping through the list, I can achieve my desired result with respect to the vertical lines:
for (i in 1:length(aval)) {
fig <- plot_ly()
b <- data.frame(Date=index(aval[[i]]), coredata(aval[[i]]))
line <- list(type = "line", line = list(color = 'magenta'), # , dash = "dot", width = 0.5
xref = "x", yref = "paper", x0 = NA, x1 = NA, y0 = 0, y1 = 1)
l <- list(line, line)
l[[1]][['x0']] <- l[[1]][['x1']] <- b[1+1,1]
l[[2]][['x0']] <- l[[2]][['x1']] <- b[nrow(b)-1,1]
fig <- add_trace(fig, type = "candlestick", x = b[,1], open = b[,2], close = b[,5], high = b[,3], low = b[,4],
showlegend = FALSE) %>%
layout(xaxis = list(rangeslider = list(visible = F), type = "category"), shapes = l, font = list(size = 10))
fig <- fig %>% config(displayModeBar = FALSE)
print(fig)
}
However, using the slider layout, I am only able to use one vertical line, see:
n <- length(aval)
steps <- list()
fig <- plot_ly()
for (i in 1:length(aval)) {
b <- data.frame(Date=index(aval[[i]]), coredata(aval[[i]])[,c('Open','High','Low','Close')])
toggle <- ifelse(i == 1, TRUE, FALSE)
line <- list(type = "line", line = list(color = 'magenta', dash = "dot", width = 0.5),
xref = "x", yref = "paper", x0 = b[1+1,1], x1 = b[1+1,1], y0 = 0, y1 = 1)
fig <- add_trace(fig, type = "candlestick", x = b[,1], open = b[,2], close = b[,5], high = b[,3], low = b[,4],
visible = toggle, showlegend = FALSE) %>%
layout(xaxis = list(rangeslider = list(visible = F), type = "category"), shapes = line, font = list(size = 10))
step <- list(args = list('visible', rep(FALSE, length(aval))), label = i, method = 'restyle')
step$args[[2]][i] = TRUE
steps[[i]] = step
}
fig <- fig %>% layout(sliders = list(list(active = 0, steps = steps))) %>% config(displayModeBar = FALSE)
fig
Using a list of shapes, analog to my first example, does not seem to work:
steps <- list()
fig <- plot_ly()
for (i in 1:length(aval)) {
b <- data.frame(Date=index(aval[[i]]), coredata(aval[[i]])[,c('Open','High','Low','Close')])
toggle <- ifelse(i == 1, TRUE, FALSE)
line <- list(type = "line", line = list(color = 'magenta', dash = "dot", width = 0.5),
xref = "x", yref = "paper", x0 = NA, x1 = NA, y0 = 0, y1 = 1)
l <- list(line, line)
l[[1]][['x0']] <- l[[1]][['x1']] <- b[1+1,1] # as.character
l[[2]][['x0']] <- l[[2]][['x1']] <- b[nrow(b)-1,1]
fig <- add_trace(fig, type = "candlestick", x = b[,1], open = b[,2], close = b[,5], high = b[,3], low = b[,4],
visible = toggle, showlegend = FALSE) %>%
layout(xaxis = list(rangeslider = list(visible = F), type = "category"), shapes = l, font = list(size = 10))
step <- list(args = list('visible', rep(FALSE, length(aval))), label = i, method = 'restyle')
step$args[[2]][i] = TRUE
steps[[i]] = step
}
fig <- fig %>% layout(sliders = list(list(active = 0, steps = steps))) %>% config(displayModeBar = FALSE)
fig
Can anybody help me? Is this related to the visibility argument in steps, perhaps?

R Plotly - button is not updating with correct data (bar chart with color)

I am trying to add custom button to update the y axis, here is a small example that is similar.
When I click on “frq” or “count” the correct bar chart appears, but the values are wrong (its take only one value for each city and put it in all gender categories bars)
library(plotly)
library(dplyr)
library(tidyr)
Occupation = c("Tel Aviv", "Paris", "Amsterdam", "Kyoto")
Gender = c("F", "M", "[missing]")
df <- crossing(Occupation, Gender) %>%
mutate(n = row_number()) %>%
group_by(.data[["Occupation"]]) %>%
mutate(frq = round(100 * (n / sum(n)), 1))
chart_type <- list(
type = "buttons",
direction = "right",
xanchor = 'center',
yanchor = "top",
pad = list('r' = 0, 't' = 10, 'b' = 10),
x = 0.1,
y = 1.20,
buttons = list(
list(
method = "update",
args = list(list(y = list(df$n))),
label = "count"
),
list(
method = "update",
args = list(list(y = list(df$frq))),
label = "frq"
)
)
)
df %>%
plot_ly(
x = ~ Occupation,
y = ~ n,
color = ~ Gender,
text = ~ n,
textposition = 'auto',
type = "bar"
) %>%
layout(updatemenus = list(chart_type))
Another version:
chart_type <- list(
type = "buttons",
direction = "right",
xanchor = 'center',
yanchor = "top",
pad = list('r'= 0, 't'= 10, 'b' = 10),
x = 0.1,
y = 1.20,
buttons = list(
list(method = "update",
args = list(list(visible = c(TRUE, FALSE)
)),
label = "count"),
list(method = "update",
args = list(list(visible = c(FALSE, TRUE)
)),
label = "frq")
))
df %>%
plot_ly(mode = 'markers',type = "bar") %>%
add_trace(x = ~Occupation, y = ~n, color = ~Gender,
text=~n, textposition = 'auto', visible = FALSE,
colorbar = list()) %>%
add_trace(x = ~Occupation, y = ~frq, color = ~Gender,
text=~frq, textposition = 'auto', visible = TRUE,
colorbar = list()) %>%
layout(updatemenus = list(chart_type))
After the click:

R Plotly scatter ternary colorbar

I am using Plotly to make a scatter ternary plot. I want to color points by one of the values in the data frame (titled mu). However, the colorbar isn't showing. Here is my code:
library(plotly)
df <- eqData0
# axis layout
axis <- function(title) {
list(
title = title,
titlefont = list(
size = 20
),
tickfont = list(
size = 15
),
tickcolor = 'rgba(0,0,0,0)',
ticklen = 5
)
}
fig <- df %>% plot_ly()
fig <- fig %>% add_trace(
type = 'scatterternary',
mode = 'markers',
a = ~u1eq,
b = ~u2eq,
c = ~bueq,
marker = list(
symbol = 100,
color = ~mu,
size = 14,
line = list('width' = 2),
colorscale = 'YlGnBu'
),
colorbar = list(
xanchor = 'middle',
yanchor = 'middle'
)
)
m <- list(
l = 50,
r = 50,
b = 100,
t = 100,
pad = 4
)
fig <- fig %>% layout(autosize = F, width = 500, height = 500, margin = m,
ternary = list(
sum = 1,
aaxis = axis(TeX("$u_1$")),
baxis = axis(TeX("$u_2$")),
caxis = axis(TeX("$\\bar{u}$"))
)
)
fig <- fig %>% config(mathjax = 'cdn')
fig
Somehow the colorbar is still not showing! I'm not sure why because all the Plotly scatterplot examples online make getting the colorbar to show up seem easy.
It looks like you were missing showscale=TRUE in the trace definition.
Trying:
#fake data:
df <- data.frame(u1eq = c(0.2, 0.3, 0.5), u2eq=c(0.6, 0.3, 0.1), bueq=c(0.2, 0.4, 0.4), mu=c(1, 1.8, 2))
# axis layout
axis <- function(title) {
list(
title = title,
titlefont = list(
size = 20
),
tickfont = list(
size = 15
),
tickcolor = 'rgba(0,0,0,0)',
ticklen = 5
)
}
fig <- df %>% plot_ly()
fig <- fig %>% add_trace(
type = 'scatterternary',
mode = 'markers',
a = ~u1eq,
b = ~u2eq,
c = ~bueq,
marker = list(
colorscale = 'YlGnBu',
symbol = 100,
color = ~mu,
size = 14,
line = list('width' = 2),
showscale = TRUE
)
)
m <- list( l = 50, r = 50, b = 100, t = 100, pad = 4)
fig <- fig %>% layout(autosize = F, width = 500, height = 500, margin = m,
ternary = list(
sum = 1,
aaxis = axis(TeX("$u_1$")),
baxis = axis(TeX("$u_2$")),
caxis = axis(TeX("$\\bar{u}$")) )
) %>% config(mathjax = 'cdn')
fig

Set text size within marker in r plotly bubble chart

The labels within bubbles are appearing with size proportional to size argument. However I want to keep the labels in constant sizes.
Which argument should I use to keep them at constant size ?
Code that I am using is provided below.
df = data.frame( x = c( 3, 2, 2, 4, 6, 8 ), y = c( 3, 2, 3, 4, 6, 7 ), size = c( 20, 20, 20, 30, 40, 40 ), labels = letters[1:6] )
evo_bubble <- function(plot_data ,x_var, y_var, z_var, t_var) {
# Trasform data into dataframe and quos
df <- data.frame(plot_data)
xenc <- enquo(x_var)
yenc <- enquo(y_var)
zenc <- enquo(z_var)
tenc <- enquo(t_var)
df <- df %>% mutate( bubble_size = !!zenc*50 ) # Modify the denominator if you want to change the dimension of the bubble
# Set parameters for the plot
bubble_pal <- c("white", "#AECEE8" )
gray_axis <- '#dadada'
font_size <- list(size = 12, family = 'Lato')
width <- 0.5
legend_name <- Hmisc::capitalize( quo_name(zenc) ) # WATCH OUT! it works only with the package with Hmisc
decimal <- ',.2f'
sep <- ','
#x_name <- capitalize(quo_name(xenc))
y_name <- Hmisc::capitalize(quo_name(yenc))
p <- plot_ly(df, x = xenc, y = yenc, name = '', text = tenc, type = "scatter", mode = 'markers+text',
hoverlabel = list(font = font_size), size = zenc, color = zenc, hoverinfo = "text+y", colors= bubble_pal,
marker = list(size = df$bubble_size, line = list(color = gray_axis)) ) %>% hide_colorbar()
p <- p %>% layout(xaxis = list(zeroline = F,
title = '',
linecolor = gray_axis,
titlefont = font_size,
tickfont = font_size,
rangemode='tozero',
gridcolor = gray_axis,
gridwidth = width,
hoverformat = decimal,
mirror = "ticks",
tickmode = 'array',
tickcolor = gray_axis,
linewidth = width,
showgrid = F ),
yaxis = list(title = y_name,
zerolinecolor = gray_axis,
linecolor = gray_axis,
mirror = "ticks",
hoverformat = '.2f',
linewidth = width,
tickcolor = gray_axis,
tickformat = '.2f',
titlefont = font_size,
tickfont = font_size,
showgrid = FALSE) ) %>%
config(displayModeBar = F)
return(p)
}
evo_bubble( df, x, y, size, labels )
Expected image :
Obtained image :
Please ignore the colors in plot.
You can use add_text to get the desired result:
library(plotly)
library(dplyr)
DF = data.frame( x = c( 3, 2, 2, 4, 6, 8 ), y = c( 3, 2, 3, 4, 6, 7 ), size = c( 20, 20, 20, 30, 40, 40 ), labels = letters[1:6] )
evo_bubble <- function(plot_data, x_var, y_var, z_var, t_var) {
# browser()
# Trasform data into dataframe and quos
DF <- data.frame(plot_data)
xenc <- enquo(x_var)
yenc <- enquo(y_var)
zenc <- enquo(z_var)
tenc <- enquo(t_var)
DF <- DF %>% mutate( bubble_size = !!zenc*50 ) # Modify the denominator if you want to change the dimension of the bubble
# Set parameters for the plot
bubble_pal <- c("white", "#AECEE8" )
gray_axis <- '#dadada'
font_size <- list(size = 12, family = 'Lato')
width <- 0.5
legend_name <- Hmisc::capitalize( quo_name(zenc) ) # WATCH OUT! it works only with the package with Hmisc
decimal <- ',.2f'
sep <- ','
#x_name <- capitalize(quo_name(xenc))
y_name <- Hmisc::capitalize(quo_name(yenc))
p <- plot_ly(DF, x = xenc, y = yenc, name = '', type = "scatter", mode = 'markers',
hoverlabel = list(font = font_size), size = zenc, color = zenc, hoverinfo = "text+y", colors= bubble_pal,
marker = list(size = DF$bubble_size, line = list(color = gray_axis))) %>%
add_text(text = tenc, textfont = font_size, textposition = "middle center") %>% hide_colorbar()
p <- p %>% layout(xaxis = list(zeroline = F,
title = '',
linecolor = gray_axis,
titlefont = font_size,
tickfont = font_size,
rangemode='tozero',
gridcolor = gray_axis,
gridwidth = width,
hoverformat = decimal,
mirror = "ticks",
tickmode = 'array',
tickcolor = gray_axis,
linewidth = width,
showgrid = F ),
yaxis = list(title = y_name,
zerolinecolor = gray_axis,
linecolor = gray_axis,
mirror = "ticks",
hoverformat = '.2f',
linewidth = width,
tickcolor = gray_axis,
tickformat = '.2f',
titlefont = font_size,
tickfont = font_size,
showgrid = FALSE) ) %>%
config(displayModeBar = F)
return(p)
}
evo_bubble( DF, x, y, size, labels )

How to add Data markers in Waterfall chart in Plotly

I am trying to plot waterfall chart with the following code. The only issue I am facing currently is the data marker which is not at the correct place. I want the data marker to be just below the end of each bar.
source('./r_files/flatten_HTML.r')
library("plotly")
dataset <- data.frame(Category = c("Akash Jain","Ankit Jain","Pankaj Jain","Nitin Pandey","Gopal Pandit","Ramnath Agarwal"),
TH = c(-62,-71,-1010,44,-44,200))
#dataset <- data.frame(Category = Values$Category, TH = Values$TH)
#dataset <- as.data.frame(cbind(Values$Category,Values$TH))
dataset$Category = dataset$Category
dataset$TH = dataset$TH
dataset$SortedCategoryLabel <- sapply(dataset$Category, function(x) gsub(" ", " <br> ", x))
dataset$SortedCategory <- factor(dataset$SortedCategoryLabel, levels = dataset$SortedCategoryLabel)
dataset$id <- seq_along(dataset$TH)
dataset$type <- ifelse(dataset$TH > 0, "in", "out")
dataset$type <- factor(dataset$type, levels = c("out", "in"))
dataset$end <- cumsum(dataset$TH)
dataset$start <- c(0, head(dataset$end, -1))
Hover_Text <- paste(dataset$Category, "= ", dataset$TH, "<br>")
dataset$colors <- ifelse(dataset$type =="out","red","green")
g <- plot_ly(dataset, x = ~SortedCategory, y = ~start, type = 'bar', marker = list(color = 'rgba(1,1,1, 0.0)'), hoverinfo = 'text') %>%
add_trace(y = dataset$TH , marker = list(color = ~colors), hoverinfo = "text", text = Hover_Text ) %>%
layout(title = '',
xaxis = list(title = ""),
yaxis = list(title = ""),
barmode = 'stack',
margin = list(l = 50, r = 30, b = 50, t = 20),
showlegend = FALSE) %>%
add_annotations(text = dataset$TH,
x = dataset$SortedCategoryLabel,
y = dataset$end,
xref = "dataset$SortedCategoryLabel",
yref = "dataset$end",
font = list(family = 'Arial',
size = 14,
color = "black"),
showarrow = FALSE)
g
Attached the screenshot of the waterfall chart.
So for the first bar, I need the data marker to be just below the end of red bar. Currently it is overlapping with the bar. And similarly for others.
Any help would be really appreciated.
Regards,
Akash
You should specify valign and height inside add_annotations:
vert.align <- c("bottom","top")[as.numeric(dataset$TH>0)+1]
g <- plot_ly(dataset, x = ~SortedCategory, y = ~start, type = 'bar',
marker = list(color = 'rgba(1,1,1, 0.0)'), hoverinfo = 'text') %>%
add_trace(y = dataset$TH , marker = list(color = ~colors), hoverinfo = "text",
text = Hover_Text ) %>%
layout(title = '',
xaxis = list(title = ""),
yaxis = list(title = ""),
barmode = 'stack',
margin = list(l = 50, r = 30, b = 50, t = 20),
showlegend = FALSE) %>%
add_annotations(text = dataset$TH,
x = dataset$SortedCategoryLabel,
y = dataset$end,
xref = "x",
yref = "y",
valign=vert.align, height=40,
font = list(family = 'Arial',
size = 14,
color = "black"),
showarrow = FALSE)
g

Resources