I have two density plots created by R's plotly:
set.seed(1)
dens.1 <- density(runif(1000,0,100))
dens.2 <- density(runif(1000,100,10000))
df.1 <- data.frame(x=dens.1$x,y=dens.1$y)
df.2 <- data.frame(x=dens.2$x,y=dens.2$y)
library(plotly)
pl.1 <- plot_ly(x=~df.1$x,y=~df.1$y,type='scatter',mode='lines',line=list(color="#A9A9A9")) %>%
layout(xaxis=list(title="Count",zeroline=F),yaxis=list(title="Density",zeroline=F)) %>%
layout(title="Data1")
pl.2 <- plot_ly(x=~df.2$x,y=~df.2$y,type='scatter',mode='lines',line=list(color="#A9A9A9")) %>%
layout(xaxis=list(title="Count",zeroline=F),yaxis=list(title="Density",zeroline=F)) %>%
layout(title="Data2")
Now, I'd like to plot them together. So I used plotly's subplot:
subplot(list(pl.1,pl.2),nrows=1,shareX=F,shareY=F,titleX=T,titleY=T) %>% layout(showlegend=F)
but that only retains the plot title of pl.2:
How do I get both titles on that plot?
To get what you want and according to this (https://rpubs.com/bcd/subplot-titles) you could use:
a <- list(
text = "Data 1",
font = f,
xref = "paper",
yref = "paper",
yanchor = "bottom",
xanchor = "center",
align = "center",
x = 0.5,
y = 1,
showarrow = FALSE
)
b <- list(
text = "Data 2",
font = f,
xref = "paper",
yref = "paper",
yanchor = "bottom",
xanchor = "center",
align = "center",
x = 0.5,
y = 1,
showarrow = FALSE
)
pl.1 <- plot_ly(x=~df.1$x,y=~df.1$y,type='scatter',mode='lines',line=list(color="#A9A9A9")) %>%
layout(xaxis=list(title="Count",zeroline=F),yaxis=list(title="Density",zeroline=F)) %>%
layout(annotations = a)
pl.2 <- plot_ly(x=~df.2$x,y=~df.2$y,type='scatter',mode='lines',line=list(color="#A9A9A9")) %>%
layout(xaxis=list(title="Count",zeroline=F),yaxis=list(title="Density",zeroline=F)) %>%
layout(annotations = b)
subplot(list(pl.1,pl.2),nrows=1,shareX=F,shareY=F,titleX=T,titleY=T) %>% layout(showlegend=F)
Related
I started using a crosstalk package and faced an issue, which could not resolve. I have problem with changing a size of possible options in filter_checkbox, anyone know is it possible to do that?
Please find below a screenshot and part of my code.
I could not find any working solutions or tutorials how exactly it should be done. Below is my code:
enter image description here
infra_1m <- highlight_key(
x = belfius %>%
filter(
domain_tribe == "Infrastructure Service",
man_vs_auto == "Monitoring created incidents"
) %>%
filter(domain_squad %in% c("Platform Support Wintel","Platform Support Wintel AD","Platform Support Unix")),
#filter_1_month() %>%
#mutate(category=fct_lump(category,10)) %>%
#filter(category != "Other"),
~ domain_squad)
infra_1m_plot <- plot_ly(
data=infra_1m,
width = 1100,
height = 500) %>%
filter_1_month() %>%
mutate(category=fct_lump(category,10)) %>%
filter(category != "Other") %>%
group_by(category,domain_squad) %>%
summarise(n=n()) %>%
#ungroup() %>%
mutate(category = fct_reorder(category, n, sum)) %>%
add_bars(
y=~fct_reorder(category,n,sum),
x=~n,
text=~n,
textfont=t,
color=~domain_squad,
colors=~colorset,
marker=list(line=list(color = 'rgb(0,0,0)',
width = 1.5)),
alpha=.7,
textposition = "inside",
textfont=t
) %>% layout(barmode="stack")
infra_1w_plot <- plot_ly(
data=infra_1m,
width = 1100,
height = 500) %>%
filter_1_week() %>%
mutate(category=fct_lump(category,10)) %>%
filter(category != "Other") %>%
group_by(category,domain_squad) %>%
summarise(n=n()) %>%
mutate(category = fct_reorder(category, n, sum)) %>%
add_bars(
y=~fct_reorder(category,n,sum),
x=~n,
text=~n,
textfont=t,
color=~domain_squad,
colors=~colorset,
marker=list(line=list(color = 'rgb(0,0,0)',
width = 1.5)),
alpha=.7,
textposition = "inside",
textfont=t
) %>% layout(barmode="stack")
bscols(
widths = c(1, 2),
filter_checkbox(
id = "domain_squad",
label = "Squad",
sharedData = infra_1m,
group = ~ domain_squad,
),
subplot(infra_1m_plot, infra_1w_plot) %>%
layout(showlegend = FALSE,
annotations = list(
list(
x = 0.2,
y = 1.0,
text = "Last Month",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "bottom",
showarrow = FALSE
),
list(
x = 0.8,
y = 1,
text = "Last Week",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "bottom",
showarrow = FALSE
)
))
)
I have paired map display, with common frame slider, that currently looks as follows:
I would like instead for there to be a common colorbar for both sub-maps, going the full distance down the display. (Instead of, at present, two colorbars a and b, which both go down half the display height.)
Bonus kudos for a solution that allows the limits of the colorbars to be set too!
The code to reproduce the figure:
library(sf)
library(plotly)
library(tidyr)
library(dplyr)
fname <- system.file("shape/nc.shp", package="sf")
nc <- st_read(fname)
plot_ly(nc)
num_features <- dim(nc)[1]
# for each feature, imagine 10 years of data
years <- 2000:2010
# for each feature, and for each of the 10 years, imagine there are two variables a and b
nc_names <- nc[,"NAME"] %>% st_drop_geometry()
set.seed(12)
fake_dta <-
expand_grid(nc_names, year = years) %>%
mutate(a = runif(n()),
b = runif(n())
) %>%
mutate(
text_a = glue::glue("In {NAME} in {year}, a was {round(a, 2)}"),
text_b = glue::glue("In {NAME} in {year}, b was {round(b, 2)}")
)
# Join the data back
nc2 <- nc %>%
left_join(fake_dta)
# Question is how to plot both a and b as two maps, side by side, sharing the same
# time slider
# to map a
map_a <-
plot_ly(nc2) %>%
add_sf(
split = ~NAME,
color = ~a,
frame = ~year,
stroke = I("black"),
text = ~text_a,
hoveron = "fills", hoverinfo = "text",
showlegend = FALSE,
type = "scatter",
mode = "lines"#,
) %>%
add_annotations(
text = "A",
x = 0.5, y = 1,
yref = "paper",
xref = "paper",
yanchor = "bottom",
valign = "middle",
align = "center",
showarrow = FALSE,
font = list(size = 15)
) %>%
layout(
showlegend = FALSE,
shapes = list(
type = "rect",
x0 = 0,
x1 = 1,
xref = "paper",
y0 = 0,
y1 = 16,
yanchor = 1,
yref = "paper",
ysizemode = "pixel",
fillcolor = toRGB("gray80"),
line = list(color = "transparent")
)
)
map_a
# to map b
map_b <-
plot_ly(nc2) %>%
add_sf(
split = ~NAME,
color = ~b,
frame = ~year,
stroke = I("black"),
text = ~text_b,
hoveron = "fills", hoverinfo = "text",
showlegend = FALSE,
type = "scatter",
mode = "lines"#,
) %>%
add_annotations(
text = "B",
x = 0.5, y = 1,
yref = "paper",
xref = "paper",
yanchor = "bottom",
valign = "middle",
align = "center",
showarrow = FALSE,
font = list(size = 15)
) %>%
layout(
showlegend = FALSE,
shapes = list(
type = "rect",
x0 = 0,
x1 = 1,
xref = "paper",
y0 = 0,
y1 = 16,
yanchor = 1,
yref = "paper",
ysizemode = "pixel",
fillcolor = toRGB("gray80"),
line = list(color = "transparent")
)
)
map_b
# These produce warnings: line.color doesn't (yet) support data arrays
# Only one fillcolor per trace allowed
# and both together
subplot(map_a, map_b)
I have created this contour plot with 5 subplots and common legend. As can be in the figure here, the min and max colors of the legend are based only on first subplot and not correct across all 5 plots.
Is there a way to fix this? I am guessing it is small fix somewhere.
Below the code I am using:
library(plotly)
VSL <- c(79000, 161000, 327000)
SCC <- c(35, 50, 100)
#Baseline
fig1 <- plot_ly(x=~VSL,y=~SCC,
z = matrix(c(8.8,11.5,20.4,11.4,14.1,23.0,16.8,19.5,28.4), nrow = 3, ncol = 3),
type = "contour",coloraxis = 'coloraxis', contours = list(showlabels = TRUE,labelfont = list(size = 20, color = 'black')))
#EV Currentgrid
fig2 <- plot_ly(x=~VSL,y=~SCC,
z = matrix(c(8.2,10.6,18.6,11.0,13.4,21.3,16.7,19.1,27.0), nrow = 3, ncol = 3),
type = "contour",coloraxis = 'coloraxis', contours = list(showlabels = TRUE,labelfont = list(size = 20, color = 'black')))
#,contours = list(start = 6,end = 32,size = 2)
#EV Coal
fig3 <- plot_ly(x=~VSL,y=~SCC,
z = matrix(c(9.6,12.3,21.5,12.9,15.6,24.8,19.6,22.3,31.5), nrow = 3, ncol = 3),
type = "contour",coloraxis = 'coloraxis', contours = list(showlabels = TRUE,labelfont = list(size = 20, color = 'black')))
#EV NG
fig4 <- plot_ly(x=~VSL,y=~SCC,
z = matrix(c(7.4,9.7,17.1,9.6,11.9,19.4,14.2,16.4,23.9), nrow = 3, ncol = 3),
type = "contour",coloraxis = 'coloraxis', contours = list(showlabels = TRUE,labelfont = list(size = 20, color = 'black')))
#EV WWS
fig5 <- plot_ly(x=~VSL,y=~SCC,
z = matrix(c(6.4,8.3,14.5,8.5,10.4,16.6,12.8,14.6,20.9), nrow = 3, ncol = 3),
type = "contour",coloraxis = 'coloraxis', contours = list(showlabels = TRUE,labelfont = list(size = 20, color = 'black')))
fig <- subplot(fig1,fig2,fig3,fig4,fig5, shareY = TRUE)
annotations = list(
list(
x = 0.08,
y = 1,
text = "Baseline",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "bottom",
showarrow = FALSE
),
list(
x = 0.3,
y = 1,
text = "EV Current grid",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "bottom",
showarrow = FALSE
),
list(
x = 0.5,
y = 1,
text = "EV Coal",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "bottom",
showarrow = FALSE
),
list(
x = 0.7,
y = 1,
text = "EV NG",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "bottom",
showarrow = FALSE
),
list(
x = 0.9,
y = 1,
text = "EV WWS",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "bottom",
showarrow = FALSE
),
list(
x = 1.05,
y = 1,
text = "Total damages",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "bottom",
showarrow = FALSE
),
list(
x = 1.05,
y = 0.97,
text = "(billion$)",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "bottom",
showarrow = FALSE
),
list(
x = 0.5,
y = -0.157,
text = "VSL",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "bottom",
showarrow = FALSE
))
fig <- fig %>% layout(coloraxis=list(colorscale='RdBu'),annotations = annotations)
fig
You need to manually define a start end end value for the contour range. There is a lot of awkward code duplication in your example, so I've created a shorter & tidier example.
# This is your z-data; I recommend storing this as a `list`
# so you can loop over it using `lapply` or `purrr::map`.
z_data <- list(
fig1 = matrix(
c(8.8,11.5,20.4,11.4,14.1,23.0,16.8,19.5,28.4),
nrow = 3, ncol = 3),
fig2 = matrix(
0.1 * c(8.2,10.6,18.6,11.0,13.4,21.3,16.7,19.1,27.0),
nrow = 3, ncol = 3))
# Define the contour properties; `start`/`end` define the min/max
# values of the shown contour range
contours <- list(
showlabels = TRUE,
start = floor(min(unlist(z_data))),
end = ceiling(max(unlist(z_data))),
labelfont = list(size = 20, color = "black"))
# Create a `list` of `plot_ly` objects
lst <- lapply(z_data, function(z)
plot_ly(
x = ~VSL,y = ~SCC, z = z,
type = "contour",coloraxis = "coloraxis", contours = contours))
# `subplot` accepts a `list` of `plot_ly` objects
subplot(lst, shareY = TRUE)
my title alignment is not working left in chart. how to align title left.
I am trying to align title left in my graph below but not working for me please help what am i missing here or which line i have to update
df <- data.frame("LOC" =c("CA","NY","WA","TX"),
"TAX" = c(3421.00,5640.00,7880.32,4569.00))
ttl ="Tax collection"
g <- plot_ly(df, x =~TAX, y = ~ LOC, type = 'bar',width = 1200, height =900, showlegend=F
, text = ~paste0(roundUp(TAX*100), "%"), textposition = "outside",
marker = list(color = "blue"))
tit <- list(
text = ttl,
font = cht_ttl,
xref = "paper",
yref = "paper",
xanchor = "right",
x = 0.1,
y = 1,
showarrow = FALSE
)
ax <- list(
title = "",
showgrid = FALSE,
range = c(0, 1)
)
chart <- g %>% layout(annotations = tit,
xaxis = ax,
yaxis = list (title = " "),font=chrt_title, showline = TRUE)
chart
Use xanchor = 'left' with x value less than 0.
library(plotly)
tit <- list(
text = ttl,
font = chrt_title,
xref = "paper",
yref = "paper",
xanchor = "left",
x = -0.04,
y = 1,
showarrow = FALSE
)
chart <- g %>% layout(annotations = tit,
xaxis = ax,
yaxis = list (title = " "),
font=chrt_title, showline = TRUE)
chart
I'm trying to create an annotated Sankey diagram. I'd like the final version to look along the lines of this manually annotated diagram:
The easy part of getting the Sankey diagram:
sankey_diagram <- plot_ly(
type = "sankey",
orientation = "h",
node = list(
label = c("Node_A_1", "Node_A_2", "Node_B_2", "Node_B_3", "Node_C_1", "Node_C_2"),
color = c("blue", "blue", "blue", "blue", "blue", "blue"),
pad = 15,
thickness = 35,
line = list(
color = "black",
width = 0.5
)
),
link = list(
source = c(0,1,0,2,3,3),
target = c(2,3,3,4,4,5),
value = c(8,4,2,8,4,2)
)
) %>%
layout(
font = list(
size = 15
)
)
At first I thought that if I want to get annotated "columns" I should turn to the annotations section of the plotly's documentation. The problem with annotations is that they are spatially limited to (at least I think so) the area of the graph. This is the code in the annotation-based approach:
# properties that hide the axes
ax <- list(
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
sankey_diagram %>%
add_annotations(
x=-1,
y=-5,
xref = "x",
yref = "y",
text = "Column A",
xanchor = 'right',
showarrow = F
) %>%
add_annotations(
x=0,
y=-5,
xref = "x",
yref = "y",
text = "Column B",
xanchor = 'right',
showarrow = F
) %>%
add_annotations(
x=1,
y=-5,
xref = "x",
yref = "y",
text = "Column C",
xanchor = 'right',
showarrow = F
) %>% add_annotations(
x=1,
y=1,
xref = "x",
yref = "y",
text = "",
xanchor = 'right',
showarrow = F
) %>%
layout(xaxis = ax, yaxis = ax)
The problem is that annotations land on the bottom of the graph but not under it.
The second approach is based on subplots. I create two subplots - the first one is Sankey, the other one is an empty one except for the annotations - and put them one in a row:
columns_plot <- plot_ly() %>% add_annotations(
x=-1,
y=-5,
xref = "x",
yref = "y",
text = "Column A",
xanchor = 'right',
showarrow = F
) %>%
add_annotations(
x=0,
y=-5,
xref = "x",
yref = "y",
text = "Column B",
xanchor = 'right',
showarrow = F
) %>%
add_annotations(
x=1,
y=-5,
xref = "x",
yref = "y",
text = "Column C",
xanchor = 'right',
showarrow = F
) %>% add_annotations(
x=1,
y=1,
xref = "x",
yref = "y",
text = "",
xanchor = 'right',
showarrow = F
) %>%
layout(xaxis = ax, yaxis = ax)
p <- subplot(sankey_diagram, columns_plot, nrows = 2, shareX = TRUE, margin = 0.1)
p %>%
layout(xaxis = ax, yaxis = ax)
For some strange reason plotly puts the columns_plot on top of the sankey_diagram. I suspect that the second approach is the correct one but still I can't get the result depicted in the first paragraph of this question.