Below you can see an example of the Pyramid population plot. This plot is prepared with ggplot2 and below you can see the plot.
library(ggplot2)
set.seed(1)
#create data frame
data <- data.frame(age = rep(1:100, 2), gender = rep(c("M", "F"), each = 100))
#add population variable
data$population <- 1/sqrt(data$age) * runif(200, 10000, 15000)
ggplot(data, aes(x = age, fill = gender,
y = ifelse(test = gender == "M",
yes = -population, no = population))) +
geom_bar(stat = "identity") +
scale_y_continuous(labels = abs, limits = max(data$population) * c(-1,1)) +
labs(title = "Population Pyramid", x = "Age", y = "Percent of population") +
coord_flip()
So now I want to do the same plot but with a Plotly package. I don't like to use ggplotly command and I tried to follow some examples but is not working :
plot_ly(data, x = population, y = age, group = gender, type = 'bar', orientation = 'h',
hoverinfo = 'y+text+name', text = abs_pop) %>%
layout(bargap = 0.1, barmode = 'overlay',
xaxis = list(tickmode = 'array', tickvals = c(-1000, -500, 0, 500, 1000),
ticktext = c('1000', '500', '0', '500', '1000')))
Can anybody help me with this problem and make this plot with Plotly.
You can use the following code:
library(plotly)
library(dplyr)
data %>%
mutate(population = ifelse(test = gender == "M", yes = -population, no = population)) %>%
mutate(abs_pop = abs(population)) %>%
plot_ly(x= ~population, y=~age, color=~gender) %>%
add_bars(orientation = 'h', hoverinfo = 'text', text = ~abs_pop) %>%
layout(bargap = 0.1, barmode = 'overlay',
xaxis = list(tickmode = 'array', tickvals = c(-15000, -10000, -5000, 0, 5000, 10000, 15000),
ticktext = c('15000', '10000', '5000', '0', '5000', '10000', '15000')))
Output:
Related
I'm trying to create a 2x2 subplot, with both plots in each column having the same y-axis title, like this :
i.e. one 'title' (here called annotations, cf. later) for the left column (blue+green) and one for the right column (yellow+red).
I can easily have a yaxis title for each plot but I'm stumped as to making shared ones.
I tried using annotations, like this (this is the code used to render the plot shown above) :
if (!require("plotly")) install.packages("plotly")
library(plotly)
group <- c("a", "b", "c")
values <- c(0, 5, 10)
df <- data.frame(group, values)
plot <- df %>%
plot_ly() %>%
add_trace(x = ~group, y = ~values, type = "scatter", mode = "line") %>%
layout(yaxis = list(ticks = "outside"), xaxis = list(showline = TRUE))
plot
subdf1 <- subplot(plot, plot, nrows = 1, margin = 0.06)
subdf2 <- subplot(plot, plot, nrows = 1, margin = 0.06)
subdf <- subplot(subdf1, subdf2, nrows = 2, margin = 0.06) %>%
layout(annotations = list(list(x = -0.1, y = 0.5, text = "<b>First annotation</b>", xref = "paper", yref = "paper", xanchor = "center", yanchor = "center", showarrow = FALSE, textangle = -90, font = list(color = "black", size = 16)),
list(x = 0.48, y = 0.5, text = "<b>Second annotation</b>", xref = "paper", yref = "paper", xanchor = "center", yanchor = "center", showarrow = FALSE, textangle = -90, font = list(color = "black", size = 16))))
subdf
My main gripe with this method is that when the plot is resized, the annotations (mainly the first one, in the negative range for x-axis placement) move around the x-axis.
Same plot but wider :
I used xref = "paper" as I thought it meant the whole plot area i.e. the whole white background, but in such case, my annotation wouldn't disappear (and wouldn't be in negatives, but I'm possibly not thinking about this the right way). I did try using xref = x but it won't go into negatives and instead just push the data to the right.
So all in all, two questions :
Is there a native way to have a shared axis title for subplots?
If not, is there a way to make sure that my annotations stay in the same relative place as the plots and axes when resizing the subplot?
If you aren't tied to using plotly, this can be done in a straightforward way using faceting in ggplot. It may require some rearranging of your data into tidy format but gives some serious flexibility while plotting!
library(ggplot2)
group <- c("a", "b", "c")
values <- c(0, 5, 10)
df <- data.frame(group, values)
df <- data.frame(group = rep(c('a','b','c'), 4),
values = rep(c(0,5,10), 4),
facet = rep(c('W','X','Y','Z'), each = 3))
ggplot(df, aes(x = group, y = values, colour = facet, group = 1)) +
geom_line(size = 1.1) +
geom_point(size = 2) +
facet_wrap(~facet) +
theme_bw() +
labs(x = 'Shared X axis title', y = 'Shared Y axis title', colour = 'Traces') +
theme(
strip.background = element_blank(),
strip.text.x = element_blank()
)
You could create a separate title in each layout of both subplots and combine them using titleY like this:
library(plotly)
library(dplyr)
group <- c("a", "b", "c")
values <- c(0, 5, 10)
df <- data.frame(group, values)
plot <- df %>%
plot_ly() %>%
add_trace(x = ~group, y = ~values, type = "scatter", mode = "line") %>%
layout(yaxis = list(ticks = "outside"), xaxis = list(showline = TRUE))
subdf1 <- subplot(plot, plot, nrows = 1) %>%
layout(yaxis = list(title = "First annotation"))
subdf2 <- subplot(plot, plot, nrows = 1) %>%
layout(yaxis = list(title = "Second annotation"))
subdf <- subplot(subdf1, subdf2, nrows = 2, titleY = TRUE)
subdf
Created on 2023-01-23 with reprex v2.0.2
Edit
Change margin in layout:
library(plotly)
library(dplyr)
group <- c("a", "b", "c")
values <- c(0, 5, 10)
df <- data.frame(group, values)
plot <- df %>%
plot_ly() %>%
add_trace(x = ~group, y = ~values, type = "scatter", mode = "line") %>%
layout(yaxis = list(ticks = "outside"), xaxis = list(showline = TRUE))
subdf1 <- subplot(plot, plot, nrows = 1, margin = 0.06)
subdf2 <- subplot(plot, plot, nrows = 1, margin = 0.06)
subdf <- subplot(subdf1, subdf2, nrows = 2, margin = 0.06) %>%
layout(margin = 0.01,
annotations = list(list(x = -0.1, y = 0.5, text = "<b>First annotation</b>", xref = "paper", yref = "paper", xanchor = "center", yanchor = "center", showarrow = FALSE, textangle = -90, font = list(color = "black", size = 16)),
list(x = 0.48, y = 0.5, text = "<b>Second annotation</b>", xref = "paper", yref = "paper", xanchor = "center", yanchor = "center", showarrow = FALSE, textangle = -90, font = list(color = "black", size = 16))))
subdf
Created on 2023-01-23 with reprex v2.0.2
I would like to add the regression line to my correlation scatter plot. Unfortunately this doesn't really work with plot_ly(). I've already tried some solutions from other posts in this forum, but it doesn't work.
My data frame looks like the following (only a smart part of it):
My code for the plot and the actual plot-output look like the following:
CorrelationPlot <- plot_ly(data = df.dataCorrelation, x = ~df.dataCorrelation$prod1,
y = ~df.dataCorrelation$prod2, type = 'scatter', mode = 'markers',
marker = list(size = 7, color = "#FF9999", line = list(color = "#CC0000", width = 2))) %>%
layout(title = "<b> Correlation Scatter Plot", xaxis = list(title = product1),
yaxis = list(title = product2), showlegend = FALSE)
What I want to have is something like this:
which I have produced with the ggscatter() function:
library(ggpubr)
ggscatter(df.dataCorrelation, x = "prod1", y = "prod2", color = "#CC0000", shape = 21, size = 2,
add = "reg.line", add.params = list(color = "#CC0000", size = 2), conf.int = TRUE,
cor.coef = TRUE, cor.method = "pearson", xlab = product1, ylab = product2)
HOW do I get the regression line with plot_ly()??
CODE EDITING:
CorrelationPlot <- plot_ly(data = df.dataCorrelation, x = ~df.dataCorrelation$prod1,
y = ~df.dataCorrelation$prod2, type = 'scatter', mode = 'markers',
marker = list(size = 7, color = "#FF9999",
line = list(color = "#CC0000", width = 2))) %>%
add_trace(x = ~df.dataCorrelation$fitted_values, mode = "lines", type = 'scatter',
line = list(color = "black")) %>%
layout(title = "<b> Correlation Scatter Plot", xaxis = list(title = product1),
yaxis = list(title = product2), showlegend = FALSE)
GIVES:
How do I get here a line for the regression line??
I don't think there's a ready function like ggscatter, most likely you have to do it manually, like first fitting the linear model and adding the values to the data.frame.
I made a data.frame that's like your data:
set.seed(111)
df.dataCorrelation = data.frame(prod1=runif(50,20,60))
df.dataCorrelation$prod2 = df.dataCorrelation$prod1 + rnorm(50,10,5)
fit = lm(prod2 ~ prod1,data=df.dataCorrelation)
fitdata = data.frame(prod1=20:60)
prediction = predict(fit,fitdata,se.fit=TRUE)
fitdata$fitted = prediction$fit
The upper and lower bounds of the line are simply 1.96* standard error of prediction:
fitdata$ymin = fitdata$fitted - 1.96*prediction$se.fit
fitdata$ymax = fitdata$fitted + 1.96*prediction$se.fit
We calculate correlation:
COR = cor.test(df.dataCorrelation$prod1,df.dataCorrelation$prod2)[c("estimate","p.value")]
COR_text = paste(c("R=","p="),signif(as.numeric(COR,3),3),collapse=" ")
And put it into plotly:
library(plotly)
df.dataCorrelation %>%
plot_ly(x = ~prod1) %>%
add_markers(x=~prod1, y = ~prod2) %>%
add_trace(data=fitdata,x= ~prod1, y = ~fitted,
mode = "lines",type="scatter",line=list(color="#8d93ab")) %>%
add_ribbons(data=fitdata, ymin = ~ ymin, ymax = ~ ymax,
line=list(color="#F1F3F8E6"),fillcolor ="#F1F3F880" ) %>%
layout(
showlegend = F,
annotations = list(x = 50, y = 50,
text = COR_text,showarrow =FALSE)
)
Another option is using ggplotly as
library(plotly)
ggplotly(
ggplot(iris, aes(x = Sepal.Length, y = Petal.Length))+
geom_point(color = "#CC0000", shape = 21, size = 2) +
geom_smooth(method = 'lm') +
annotate("text", label=paste0("R = ", round(with(iris, cor.test(Sepal.Length, Petal.Length))$estimate, 2),
", p = ", with(iris, cor.test(Sepal.Length, Petal.Length))$p.value),
x = min(iris$Sepal.Length) + 1, y = max(iris$Petal.Length) + 1, color="steelblue", size=5)+
theme_classic()
)
I am trying to replicate a plot from ggplot with the added functionality from Plotly with hover points, but it strips the annotations out and have tried everything to achieve the same view with no success .
library("ggplot2")
library("plotly")
test_data <- data.frame(A = c(1,5,7,4,2),
B = c(3,3,6,8,4))
my_days <- as.Date(c("2010-01-01", "2010-02-01",
"2010-03-01", "2010- 4-01",
"2010-05-01"))
df <- data.frame(test_data, my_days)
# Anotate Box
s_1 <- unique(min(df$my_days))
s_2 <- unique(max(df$my_days))
target <- 1
plot_out <- df %>%
group_by(my_days) %>%
summarise(prop = sum(A / B)) %>%
ggplot(aes(x =my_days, y = prop)) +
geom_line(color = "purple") +
annotate("rect", xmin = s_1, xmax = s_2, ymin = -Inf, ymax = target, alpha = .2, fill = "red") +
annotate("rect", xmin = s_1, xmax = s_2, ymin = target, ymax = Inf, alpha = .2, fill = "green")
plot_out # Plot with Colour
ggplotly(plot_out) # This gives the hover info points , but removes the annotates
Not a ggplotly solution but a plotly solution. (; At least in my opinion ggplotly is nice if you want to make a quick interactive version of a ggplot. However, ggplotly still has a lot of issues and is not able to convert every ggplot. Try this:
library("ggplot2")
library("plotly")
test_data <- data.frame(
A = c(1, 5, 7, 4, 2),
B = c(3, 3, 6, 8, 4)
)
my_days <- as.Date(c(
"2010-01-01", "2010-02-01",
"2010-03-01", "2010- 4-01",
"2010-05-01"
))
df <- data.frame(test_data, my_days)
# Anotate Box
s_1 <- unique(min(df$my_days))
s_2 <- unique(max(df$my_days))
target <- 1
p <- df %>%
group_by(my_days) %>%
summarise(prop = sum(A / B)) %>%
plot_ly(x = ~my_days, y = ~prop) %>%
add_lines(
line = list(color = "purple"),
hoverinfo = "text",
text = ~ paste0(
"mydays: ", my_days,
"\n", "prop: ", round(prop, 7)
)) %>%
# Add the rectangles and set x-axis as in ggplot
layout(
xaxis = list(
type = "date",
tickformat = "%b",
nticks = 5
),
shapes = list(
list(
type = "rect",
fillcolor = "red", opacity = 0.2,
x0 = s_1, x1 = s_2, xref = "x",
y0 = -Inf, y1 = target, yref = "y"
),
list(
type = "rect",
fillcolor = "green", opacity = 0.2,
x0 = s_1, x1 = s_2, xref = "x",
# Setting y1 to Inf results in a yaxis which spans up to 2.5. So I chose 1.8 to mimic the ggplot
y0 = target, y1 = 1.8, yref = "y"
)
)
)
p
Created on 2020-04-05 by the reprex package (v0.3.0)
Is there a way to insert a source annotation below the x-axis label in Plotly? I can get an annotation below the x-axis, but if I change the margins, the annotation gets cut off. For now, I am able to put an annotation between the x-axis and the x-axis label. Below is a MWE for the included chart.
df <- data.frame(x = 1:10, y = 1:10)
plot_ly(data = df, x = ~x, y = ~y, type = 'scatter', mode = 'lines') %>%
layout(title = 'Sample Chart',
margin = list(l = 50, r = 50, t = 60, b = 60),
annotations = list(text = 'Source: U.S. Census Bureau.',
font = list(size = 12),
showarrow = FALSE,
xref = 'paper', x = -0.03,
yref = 'paper', y = -0.2))
I would like to move the "Source: U.S. Census Bureau" below the x-axis title.
You need to add line breaks using html tags
plot_ly(data = df, x = ~x, y = ~y, type = 'scatter', mode = 'lines') %>%
+ layout(title = 'Sample Chart',xaxis=list(
+ title = 'x <br> Source: U.S. Census Bureau.'),
+ margin = list(l = 50, r = 50, t = 60, b = 60))
I would like to create a bar plot (with the plotly package), which (for some months) would have red horizontal line (gain to obtain). Plots below show my problem more precisely, I hope.
Code and data needed to obtain first plot:
library("plotly")
library("dplyr")
data.frame(miesiac_label = as.character(as.roman(c(1:12))),
miesiac = c(1:12),
ile = c(12000, 12100, 11100, 12000, 12000, 11900, 12200, 12100, 6000, 12100, 12100, 12100),
gain = c(rep(NA, 7), 11000, 12000, 12000, 12000, 12000)) -> dane
dane$miesiac_label <- factor(dane$miesiac_label, levels = dane[["miesiac_label"]])
plot_ly(dane) %>%
add_trace(x = ~miesiac_label, y = ~ile,
type = 'bar', marker = list(color = '#99d3df')) %>%
add_trace(x = ~miesiac_label, y = ~gain, name = 'Gain',
type = "scatter", mode='lines+markers', marker = list(color = 'red'),
line = list(color = 'red'))
I think that I should have a continuous scale to do this and after this just change x axis labels, but I don't know how to change those labels (I've tried to find it in google first, of course)...
Thanks a lot for your help!
Would something like that work for you. You could adjust the numbers in add_segments.
a <- list(
title = "miesiac_label",
showticklabels = TRUE,
tickmode= "array",
ticktext = as.character(as.roman(c(1:12))),
tickvals = c(1:12)
)
plot_ly(dane) %>%
add_bars(x = ~miesiac, y = ~ile) %>%
add_segments(x = 7.5, xend = 8.5, y = 10000, yend = ~10000, line = list(dash = "dash")) %>%
add_segments(x = 8.5, xend = 12.5, y = 12000, yend = ~12000, line = list(dash = "dash")) %>%
layout(showlegend = FALSE, xaxis = a)
I have managed to construct what you want using ggplot and the fantastic ggplotly()
Doing it normally for ggplot standards leads to hideous tooltips on hover, but that can be tweaked with the text aesthetic and the tooltip argument in the ggplotly call
for example:
ggplot(dane, aes(x = miesiac_label, y = ile)) +
geom_bar(aes(text = paste("x:", miesiac_label, "y:",ile)),
stat = "identity", fill = "#99d3df") +
geom_segment(aes(x = miesiac - 0.5, xend = miesiac + 0.5,
y = gain, yend = gain,
text = paste0("gain: ",gain))
, colour = "red"
, linetype = 2)
ggplotly(tooltip = "text")
Which results in the following plot: