Using assign within ggplot loop gives incorrect plots - r

I'm creating three plots in a loop over I and using assign to save each plot. The y variable is scaled by the loop index. The scaling should ensure that the final panel of plots each has y going from 0 to 1. This isn't happening and the plots seem to be being changed as the loop runs. I'd be grateful if someone could explain this apparently odd behaviour.
library(dplyr)
library(ggplot2)
library(gridExtra)
loci = c(1,2,3)
x <- seq(0,1,0.01)
df <- expand.grid(x = x, loci = loci)
df <- df %>% mutate(y = loci * x)
cols = c("red", "blue", "green")
for (i in loci){
plot_this <- df %>% filter(loci == i)
my_plot = ggplot(plot_this) +
geom_point( aes( x = x, y = y/i), colour = cols[i]) +
ylim(0,3) + ggtitle(paste0("i = ", i))
assign(paste0("plot_", i), my_plot)
print(plot_1)
}
grid.arrange(plot_1, plot_2, plot_3, ncol = 3)

It's due to the lazy evaluation nature of ggplot, and more explanation can be found in this post.
"Looping" with lapply avoids the problem.
Data
library(ggplot2)
library(gridExtra)
library(dplyr)
loci = c(1,2,3)
x <- seq(0,1,0.01)
df <- expand.grid(x = x, loci = loci)
df <- df %>% mutate(y = loci * x)
cols = c("red", "blue", "green")
Code
my_plot <- lapply(loci, function(i) {
df %>%
filter(loci == i) %>%
ggplot() +
geom_point(aes(x = x, y = y/i), colour = cols[i]) +
ylim(0,3) +
ggtitle(paste0("i = ", i))
})
grid.arrange(my_plot[[1]], my_plot[[2]], my_plot[[3]], ncol = 3)
Created on 2022-04-26 by the reprex package (v2.0.1)

Related

How to draw a multi-colored dashed line (alternating colors for visual effect) [duplicate]

This question already has answers here:
Alternating color of individual dashes in a geom_line
(4 answers)
Closed 8 months ago.
I was wondering if it is possible to create a multicolored dashed line in ggplot.
Basically I have a plot displaying savings based on two packages.
A orange line with savings based on package A
A green line with savings based on package B
I also have a third line and I would like that one to be dashed alterenating between orange and green. Is that something that somebody has been able to do?
Here is an example:
library(tidyverse)
S <- seq(0, 5, by = 0.05)
a <- S ^ 2
b <- S
a_b = a + b #This data should have the dashed multicolor line, since it is the sum of the other two lines.
S <- data.frame(S)
temp <- cbind(S, a, b, a_b)
temp <- gather(temp, variable, value, -S)
desiredOrder <- c("a", "b", "a_b")
temp$variable <- factor(temp$variable, levels = desiredOrder)
temp <- temp[order(temp$variable),]
p <- ggplot(temp, aes(x = S, y = value, colour = variable)) +
theme_minimal() +
geom_line(size = 1) +
scale_color_manual(name = "Legend", values = c("orange", "green", "#0085bd"),
breaks = c("a", "b", "a_b"))
p
I basically want to have a multicolored (dashed or dotted) line for "c"
This is, to my best knowledge, currently only possible via creation of new segments for each alternate color. This is fiddly.
Below I've tried a largely programmatic approach in which you can define the size of the repeating segment (based on your x unit). The positioning of y values is slightly convoluted and it will also result in slightly irregular segment lengths when dealing with different slopes. I also haven't tested it on many data, either. But I guess it's a good start :)
For the legend, I'm taking the same approach, by creating a fake legend and stitching it onto the other plot. The challenges here include:
positioning of legend elements relative to the plot
relative distance between the legend elements
update
For a much neater way to create those segments and a Stat implementation see this thread
library(tidyverse)
library(patchwork)
S <- seq(0, 5, by = 0.05)
a <- S^2
b <- S
a_b <- a + b
df <- data.frame(x = S, a, b, a_b) %>%
pivot_longer(-x, names_to = "variable", values_to = "value")
## a function to create modifiable cuts in order to get segments.
## this looks convoluted - and it is! there are a few if/else statements.
## Why? The assigment of new y to x values depends on how many original values
## you have.
## There might be more direct ways to get there
alt_colors <- function(df, x, y, seg_length, my_cols) {
x <- df[[x]]
y <- df[[y]]
## create new x for each tiny segment
length_seg <- seg_length / length(my_cols)
new_x <- seq(min(x, na.rm = TRUE), x[length(x)], length_seg)
## now we need to interpolate y values for each new x
## This is different depending on how many x and new x you have
if (length(new_x) < length(x)) {
ind_int <- findInterval(new_x, x)
new_y <- sapply(seq_along(ind_int), function(i) {
if (y[ind_int[i]] == y[ind_int[length(ind_int)]]) {
y[ind_int[i]]
} else {
seq_y <- seq(y[ind_int[i]], y[ind_int[i] + 1], length.out = length(my_cols))
head(seq_y, -1)
}
})
} else {
ind_int <- findInterval(new_x, x)
rle_int <- rle(ind_int)
new_y <- sapply(rle_int$values, function(i) {
if (y[i] == y[max(rle_int$values)]) {
y[i]
} else {
seq_y <- seq(y[i], y[i + 1], length.out = rle_int$lengths[i] + 1)
head(seq_y, -1)
}
})
}
## THis is also a bit painful and might cause other bugs that I haven't
## discovered yet.
if (length(unlist(new_y)) < length(new_x)) {
newdat <- data.frame(
x = new_x,
y = rep_len(unlist(new_y), length.out = length(new_x))
)
} else {
newdat <- data.frame(x = new_x, y = unlist(new_y))
}
newdat <- newdat %>%
mutate(xend = lead(x), yend = lead(y)) %>%
drop_na(xend)
newdat$color <- my_cols
newdat
}
## the below is just a demonstration of how the function would work
## using different segment widths
df_alt1 <-
df %>%
filter(variable == "a_b") %>%
alt_colors("x", "value", 1, c("orange", "green"))
df_alt.5 <-
df %>%
filter(variable == "a_b") %>%
alt_colors("x", "value", .5, c("orange", "green"))
df_ab <-
df %>%
filter(variable != "a_b") %>%
# for the identity mapping
mutate(color = ifelse(variable == "a", "green", "orange"))
## create data frame for the legend, also using the alt_colors function as per above
## the amount of x is a bit of trial and error, this is just a quick hack
## this is a trick to center the legend more or less relative to the main plot
y_leg <- ceiling(mean(range(df$value, na.rm = TRUE)))
dist_y <- 2
df_legend <-
data.frame(
variable = rep(unique(df$variable), each = 2),
x = 1:2,
y = rep(seq(y_leg - dist_y, y_leg + dist_y, by = dist_y), each = 2)
)
df_leg_onecol <-
df_legend %>%
filter(variable != "a_b") %>%
mutate(color = ifelse(variable == "a", "green", "orange"))
df_leg_alt <-
df_legend %>%
filter(variable == "a_b") %>%
alt_colors("x", "y", .5, c("orange", "green"))
## I am mapping the colors globally using identity mapping (see scale_identity).
p1 <-
ggplot(mapping = aes(x, value, colour = color)) +
theme_minimal() +
geom_line(data = df_ab, size = 1) +
geom_segment(data = df_alt1, aes(y = y, xend = xend, yend = yend), size = 1) +
scale_color_identity() +
ggtitle("alternating every 1 unit")
p.5 <-
ggplot(mapping = aes(x, value, colour = color)) +
theme_minimal() +
geom_line(data = df_ab, size = 1) +
geom_segment(data = df_alt.5, aes(y = y, xend = xend, yend = yend), size = 1) +
scale_color_identity() +
ggtitle("alternating every .5 unit")
p_leg <-
ggplot(mapping = aes(x, y, colour = color)) +
theme_void() +
geom_line(data = df_leg_onecol, size = 1) +
geom_segment(data = df_leg_alt, aes(xend = xend, yend = yend), size = 1) +
scale_color_identity() +
annotate(
geom = "text", y = unique(df_legend$y), label = unique(df_legend$variable),
x = max(df_legend$x + 1), hjust = 0
)
## set y limits to the range of the main plot
## in order to make the labels visible you need to adjust the plot margin and
## turn clipping off
p1 + p.5 +
(p_leg + coord_cartesian(ylim = range(df$value), clip = "off") +
theme(plot.margin = margin(r = 20, unit = "pt"))) +
plot_layout(widths = c(1, 1, .2))
Created on 2022-01-18 by the reprex package (v2.0.1)
(Copied this over from Alternating color of individual dashes in a geom_line)
Here's a ggplot hack that is simple, but works for two colors only. It results in two lines being overlayed, one a solid line, the other a dashed line.
library(dplyr)
library(ggplot2)
library(reshape2)
# Create df
x_value <- 1:10
group1 <- c(0,1,2,3,4,5,6,7,8,9)
group2 <- c(0,2,4,6,8,10,12,14,16,18)
dat <- data.frame(x_value, group1, group2) %>%
mutate(group2_2 = group2) %>% # Duplicate the column that you want to be alternating colors
melt(id.vars = "x_value", variable.name = "group", value.name ="y_value") # Long format
# Put in your selected order
dat$group <- factor(dat$group, levels=c("group1", "group2", "group2_2"))
# Plot
ggplot(dat, aes(x=x_value, y=y_value)) +
geom_line(aes(color=group, linetype=group), size=1) +
scale_color_manual(values=c("black", "red", "black")) +
scale_linetype_manual(values=c("solid", "solid", "dashed"))
Unfortunately the legend still needs to be edited by hand. Here's the example plot.

Multiple equally sized plots in an RMarkdown document

I would like to align the area of several plots, each of them created by separate chunks in an RMarkdown document (preferably .html) "nicely". My problem: Because of the different lengths of the y-axis texts. The plotted area doesn't overlap perfectly (A pity because my actual x-axis is months).
Setting the fig.width= and out.width= don't help here as they consider the axis text lengths.
Dummy Data chunk:
require(ggplot2)
df = expand.grid(y = LETTERS,
x = paste0('A', 1:10),
stringsAsFactors = FALSE)
set.seed(42)
df$fill = rnorm(nrow(df))
df2 = df
df2$y = unlist(lapply(lapply(df2$y, function(x) rep(x, 10)), paste0, collapse = ''))
Plot-Chunk1:
gg1 = ggplot(df, aes(y = y, x = x, fill = fill)) +
geom_tile()
gg1
Plot-Chunk2:
gg2 = ggplot(df2, aes(y = y, x = x, fill = fill)) +
geom_tile()
gg2
The plots in the RMarkdown document should look like that (red lines highlight the desired alignment):
I achieved this with the patchwork package. However, like this I can only use one chunk and not multiple.
Patchwork-Plot-Chunk:
require(patchwork)
gg1 / gg2 +
plot_annotation(tag_levels = 'A')
Edited (tidier?) solution: cowplot::align_plots
Having a bit of a play around with cowplot::align_plots, it would be possible to set a standard panel width to use across all graphs. But to do this across chunks when you're constructing each graph 'blind' to the forthcoming ones, you could create a 'template' plot with labels as wide as needed (gg_set below). Each subsequent graph would then adopt the sizing of this unused plot:
require(ggplot2)
df <- expand.grid(y = LETTERS,
x = paste0('A', 1:10),
stringsAsFactors = FALSE)
set.seed(42)
df$fill = rnorm(nrow(df))
df2 <- df
df2$y <-
unlist(lapply(lapply(df2$y, function(x)
rep(x, 5)), paste0, collapse = ''))
# df for setting max size needed - might need experimented with
dfset <- df
dfset$y <-
unlist(lapply(lapply(df$y, function(x)
rep(x, 10)), paste0, collapse = ''))
# 'template' plot
gg_set <- ggplot(dfset, aes(y = y, x = x, fill = fill)) +
geom_tile()
require(cowplot)
# Chunk 1
gg1 <- ggplot(df, aes(y = y, x = x, fill = fill)) +
geom_tile()
ggs <- align_plots(gg_set, gg1, align = "v")
# Only extracting relevant graph.
ggdraw(ggs[[2]])
# Chunk 2
gg2 <- ggplot(df2, aes(y = y, x = x, fill = fill)) +
geom_tile()
ggs <- align_plots(gg_set, gg2, align = "v")
ggdraw(ggs[[2]])
Created on 2021-12-17 by the reprex package (v2.0.1)
Untidy former solution
I've previously used an admittedly messy solution, which really just involves padding all labels with blank rows above and below to greater than the max length:
require(ggplot2)
#> Loading required package: ggplot2
df <- expand.grid(y = LETTERS,
x = paste0('A', 1:10),
stringsAsFactors = FALSE)
set.seed(42)
df$fill = rnorm(nrow(df))
df2 <- df
df2$y <-
unlist(lapply(lapply(df2$y, function(x)
rep(x, 10)), paste0, collapse = ''))
df$y <-
paste0(paste0(rep(" ", 40), collapse = ""), "\n", df$y, "\n", paste0(rep(" ", 40)))
df2$y <-
paste0(paste0(rep(" ", 40), collapse = ""), "\n", df2$y, "\n", paste0(rep(" ", 40)))
gg1 <- ggplot(df, aes(y = y, x = x, fill = fill)) +
geom_tile()
gg1
gg2 <- ggplot(df2, aes(y = y, x = x, fill = fill)) +
geom_tile()
gg2
I would hope their is a more formal solution which allows a static panel sizing, and I look forward to hearing other answers. But had used this as a quick fix!
Created on 2021-12-17 by the reprex package (v2.0.1)
The patchwork package also includes the function align_patches() which works similar to cowplot::align_plots().
gg_l = patchwork::align_patches(gg1,
gg2)
Plot-Chunk1:
gg_l[[1]]
Plot-Chunk2:
gg_l[[2]]
Data from question.

Facet Labels not being retained when printing ggplot objects stored in a list

Here is the data that I will be using to give context to my question:
library(dplyr)
library(tidyr)
library(ggplot2)
set.seed(1)
f1 <- sample(c(letters[1:3],NA),100, prob = c(rep((0.9/3),times = 3),0.1),replace = T)
f2 <- sample(c(letters[1:3],NA),100, prob = c(rep((0.8/3),times = 3),0.2),replace = T)
f3 <- sample(c(letters[1:3],NA),100, prob = c(rep((0.95/3),times = 3),0.01),replace = T)
sample_dat <- tibble(
x1 = factor(f1, level=letters[1:3]),
x2 = factor(f2, level=letters[1:3]),
x3 = factor(f3, level=letters[1:3]),
grpA = factor(sample(c("grp1","grp2"),100, prob=c(0.3, 0.7) ,replace=T),
levels = c("grp1", "grp2"))
)
sample_dat
here is a function that I created to prepare the data for plotting:
plot_data_prepr <- function(dat, groupvar, mainvar){
groupvar <- sym(groupvar)
mainvar <- sym(mainvar)
plot_data <- dat %>%
group_by(!!groupvar) %>%
count(!!mainvar, .drop = F) %>% drop_na() %>%
mutate(pct = n/sum(n),
pct2 = ifelse(n == 0, 0.005, n/sum(n)),
grp_tot = sum(n),
pct_lab = paste0(format(pct*100, digits = 1),'%'),
pct_pos = pct2 + .02)
return(plot_data)
}
here is the application of the function to produce the data sets I will use for plotting
plot_data_prepr(dat = sample_dat, groupvar = "grpA", mainvar = "x1")
plot_data_prepr(dat = sample_dat, groupvar = "grpA", mainvar = "x2")
plot_data_prepr(dat = sample_dat, groupvar = "grpA", mainvar = "x3")
here I use a for loop to plot the data and dynamically change the labels of the facets -- if one runs this in
rstudio as an RMarkdown file, one can see that the plots are produced and the labels for the facets are
each distinct as they should be given the different degrees of missingness and sampling densities for the
'grpA' variable.
plot_list <- vector('list', length = 0)
for (fct in names(sample_dat)[1:3]){
mvar <- fct
smvar <- sym(mvar)
gvar <- "grpA"
sgvar <- sym(gvar)
dd <- plot_data_prepr(dat = sample_dat, groupvar = gvar, mainvar = mvar)
pre_lookup <- dd %>%
select(!!sgvar, grp_tot) %>%
group_by(!!sgvar) %>%
summarise(lookup = mean(grp_tot))
lookup <- pre_lookup$lookup
my_label <- function(x) {
var <- names(x)[1]
list(paste0(x[[var]], " (N = ", lookup, ")"))
}
plot <- ggplot(dd,
mapping = aes(x=!!smvar, y = pct2, fill = !!smvar)) +
geom_bar(stat = 'identity') +
ylim(0,1.3) +
geom_text(aes(x=!!smvar, label=pct_lab, y = pct_pos + .02)) +
facet_grid(as.formula(paste0(".~", gvar)), labeller = my_label) +
ggtitle(paste(gvar,"by",mvar))
plot_list[[fct]] <- plot
print(plot)
}
Here's my problem -- when I print the plots which are stored in the list,
they all seem to retain the facet label from the last plot, instead of retaining
the distinct facet-labels they displayed when they were originally generated.
for (name in names(sample_dat)[1:3]){
print(plot_list[[name]])
}
Basically, I would like to be able to print the plots from the list
when I need them and have them display their distinct facet labels
as they had been displayed when the plots were originally produced.
Perhaps someone in the community could help me?
I would suggest you try to avoid the loop for the plots building. It uses to create that kind of issues as you have with labels or sometimes with data. Here, I have packaged your loop in a function and stored the results in a list. Also, you can use lapply() with the names of your data in order to directly create the list with the plots. Here the code:
#Function for plot
myplotfun <- function(fct)
{
mvar <- fct
smvar <- sym(mvar)
gvar <- "grpA"
sgvar <- sym(gvar)
dd <- plot_data_prepr(dat = sample_dat, groupvar = gvar, mainvar = mvar)
pre_lookup <- dd %>%
select(!!sgvar, grp_tot) %>%
group_by(!!sgvar) %>%
summarise(lookup = mean(grp_tot))
lookup <- pre_lookup$lookup
my_label <- function(x) {
var <- names(x)[1]
list(paste0(x[[var]], " (N = ", lookup, ")"))
}
plot <- ggplot(dd,
mapping = aes(x=!!smvar, y = pct2, fill = !!smvar)) +
geom_bar(stat = 'identity') +
ylim(0,1.3) +
geom_text(aes(x=!!smvar, label=pct_lab, y = pct_pos + .02)) +
facet_grid(as.formula(paste0(".~", gvar)), labeller = my_label) +
ggtitle(paste(gvar,"by",mvar))
return(plot)
}
Now, we create a list:
#Create a list
plot_list <- lapply(names(sample_dat)[1:3],myplotfun)
Finally, the plots as you used in the last loop:
#Loop
for (i in 1:length(plot_list)){
plot(plot_list[[i]])
}
Outputs:
The problem is your my_label function has a free variable lookup that's only resolved when you actually plot the function. After your for-loop runs, then you it only contains the last value in the loop. To capture the current loop value, you can place it inside an enclosure. So you could change the my_label function to
my_labeler <- function(lookup) {
function(x) {
var <- names(x)[1]
list(paste0(x[[var]], " (N = ", lookup, ")"))
}
}
and then call facet_grid with
facet_grid(as.formula(paste0(".~", gvar)), labeller = my_labeler(lookup))
But I agree with #Duck that avoiding the for-loop in this case would be easier.

How is the binning done in stat_summary_bin in ggplot2?

I'm trying to add some custom features to a bin-scatter plot using ggplot2. The original way that I was doing the bin-scatter was with stat_summary_bin(fun.y="mean"). This seems to produce a reasonable binning, but when I try to reproduce it by binning manually, I keep getting slightly different results -- especially at the right tail.
Can anyone help me figure out how the binning in stat_summary_bin is done? I need to figure out if this is a reliable form of bin-scattering that I can use...
library(tidyverse)
library(mltools)
#>
#> Attaching package: 'mltools'
#> The following object is masked from 'package:tidyr':
#>
#> replace_na
x = runif(1000, 0, 10)
y = x + rnorm(1000, 0.5, 2)
plot(x,y)
df <- data.frame(x = x, y = y)
p <- df %>%
ggplot(aes(x = x, y = y)) +
stat_summary_bin(aes(color ="stat summary"),fun.y = "mean", size = 2.5, geom="point", bins=20)
p
## Attempt 1 at binning
df$x_bin <- mltools::bin_data(df$x, bins=20, binType = "explicit")
df_binned <- df %>%
group_by(x_bin) %>%
mutate(
x_binned = mean(x),
y_binned = mean(y)
) %>%
ungroup()
p <- p + geom_point(aes(x = df_binned$x_binned, y = df_binned$y_binned, color = "manual bin"), size = 2.5)
p
## Attempt 2 at binning
xbreaks = quantile(df$x, probs = seq(0,1,0.05))
df_binned$x_bin_2 <- cut(df$x, xbreaks, include.lowest = T)
df_binned <- df_binned %>%
group_by(x_bin_2) %>%
mutate(
x_binned2 = mean(x),
y_binned2 = mean(y)
) %>%
ungroup()
p <- p + geom_point(aes(x = df_binned$x_binned2, y = df_binned$y_binned2, color = "2nd manual bin"), size = 2.5)
p
Created on 2018-09-09 by the reprex
package (v0.2.0).

Using loop for gpplot2 cause issue on displaying the legends

I have an R code that creates a linear regression. I am having some problems with the legends in a graph. I would like to use the dates specified in the trendDateRange as the legend with different colors. Since these dates are in YYYY-MM-DD format. I only need the YYYY-MM. So for example, the trendDateRage1 = c("2015-01-01", "2015-12-31") and I want to display "2015-01 - 2015-12" as a legend with a any colour. When I run this in a for loop, it's only displaying 1 legend which uses the last trendDateRange i.e trendDateRange3 which displays "2013-01 - 2013-12". It does not display the legend for the other 2 dates. I do not have any problem with graphs although they're using the same colour. I would like to see different colours for each legend even though they have different line types.
If I run the code below showing individual graphs, it's working with the proper legend. I get the legend for each graph.
Month_Names <- c("2010-11","2010-12",
"2011-01","2011-02","2011-03","2011-04","2011-05","2011-06","2011-07","2011-08","2011-09","2011-10","2011-11","2011-12",
"2012-01","2012-02","2012-03","2012-04","2012-05","2012-06","2012-07","2012-08","2012-09","2012-10","2012-11","2012-12",
"2013-01","2013-02","2013-03","2013-04","2013-05","2013-06","2013-07","2013-08","2013-09","2013-10","2013-11","2013-12",
"2014-01","2014-02","2014-03","2014-04","2014-05","2014-06","2014-07","2014-08","2014-09","2014-10","2014-11","2014-12",
"2015-01","2015-02","2015-03","2015-04","2015-05","2015-06","2015-07","2015-08","2015-09","2015-10","2015-11","2015-12",
"2016-01","2016-02","2016-03","2016-04","2016-05","2016-06","2016-07","2016-08","2016-09","2016-10","2016-11","2016-12",
"2017-01")
Actual_volume <- c(54447,57156,
52033,49547,58718,53109,56488,60095,54683,60863,56692,55283,55504,56633,
53267,52587,54680,55569,60013,56985,59709,61281,54188,59832,56489,55819,
59295,52692,56663,59698,61232,57694,63111,60473,58984,64050,54957,63238,
59460,54430,58901,61088,60496,62984,66895,62720,65591,67815,58289,72002,
61054,60329,69283,68002,63196,72267,71058,69539,71379,70925,68704,76956,
65863,70494,77348,70214,74770,77480,69721,83034,76761,77927,79768,81836,
75381)
df_data <- data.frame(Month_Names, Actual_volume)
trendDateRange1 <- c("2010-11-01", "2017-01-31")
trendDateRange2 <- c("2012-01-01", "2012-12-31")
trendDateRange3 <- c("2013-01-01", "2013-12-31")
numoftrends <- 3
list_of_df <- list()
list_of_df<- lapply(1:numoftrends, function(j) {
trend.period <- get(paste0("trendDateRange", j))
trend1 <- substr(trend.period[1], 1, 7)
trend2 <- substr(trend.period[2], 1, 7)
TRx <- subset(df_data, as.character(Month_Names) >= trend1 &
as.character(Month_Names) <= trend2)
})
i = 1
trend.period <- get(paste0("trendDateRange", i))
trend1 <- substr(trend.period[1], 1, 7)
trend2 <- substr(trend.period[2], 1, 7)
Trend.dates <- paste0(trend1, '-' ,trend2)
plot = ggplot() +
geom_line(data = list_of_df[[i]],
aes(x = Month_Names, y = Actual_volume, group = 1 , colour = Trend.dates),
lty = i + 1)
print(ggplotly(plot))
i = 2
trend.period <- get(paste0("trendDateRange", i))
trend1 <- substr(trend.period[1], 1, 7)
trend2 <- substr(trend.period[2], 1, 7)
Trend.dates <- paste0(trend1, '-' ,trend2)
plot = ggplot() +
geom_line(data = list_of_df[[i]],
aes(x=Month_Names, y = Actual_volume, group = 1 , colour = Trend.dates),
lty = i + 1)
print(ggplotly(plot))
i = 3
trend.period <- get(paste0("trendDateRange", i))
trend1 <- substr(trend.period[1], 1, 7)
trend2 <- substr(trend.period[2], 1, 7)
Trend.dates <- paste0(trend1, '-' ,trend2)
plot = ggplot() +
geom_line(data = list_of_df[[i]],
aes(x = Month_Names, y = Actual_volume, group = 1 , colour = Trend.dates),
lty = i+1)
print(ggplotly(plot))
But when I put this in the loop to make it one graph with each legend it does not work
plot = ggplot()
for (i in seq_along(list_of_df)) {
trend.period = get(paste0("trendDateRange", i))
trend1 = substr(trend.period[1], 1, 7)
trend2 = substr(trend.period[2], 1, 7)
Trend.dates = paste0(trend1, '-' ,trend2)
plot = plot + geom_line(aes(x = Month_Names, y = Actual_volume, group = 1 , colour = Trend.dates),
data = list_of_df[[i]], lty = i + 1)
}
print(ggplotly(plot))
You'll have a much easier time working with ggplot2 if you combine the three datasets into one with an aesthetic that separates them, rather than adding them together in a for loop.
There are a number of ways you could do this, but here's an example using the dplyr and tidyr packages. It would replace everything after your df_data <- line.
library(ggplot2)
library(dplyr)
library(tidyr)
trends <- data_frame(Start = c("2010-11", "2012-01", "2013-01"),
End = c("2017-01", "2012-12", "2013-12"))
combined_data <- df_data %>%
crossing(trends) %>%
mutate(Month_Names = as.character(Month_Names),
TrendName = paste(Start, End, sep = "-")) %>%
filter(Month_Names >= Start,
Month_Names <= End)
# rotated x-axes to make plot slightly more readable
ggplot(combined_data, aes(Month_Names, y = Actual_volume,
group = TrendName,
color = TrendName)) +
geom_line() +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
If you combine your list into a data.frame with an ID representing which element the observation came from and parse the dates, getting a decent plot is pretty simple:
library(dplyr)
library(ggplot2)
list_of_df %>%
bind_rows(.id = 'id') %>%
mutate(date = as.Date(paste0(Month_Names, '-01'))) %>%
ggplot(aes(date, Actual_volume, color = id)) +
geom_line()
or without dplyr,
df <- do.call(rbind,
Map(function(df, i){df$id <- i; df},
df = list_of_df,
i = as.character(seq_along(list_of_df))))
df$date <- as.Date(paste0(df$Month_Names, '-01'))
ggplot(df, aes(date, Actual_volume, color = id)) + geom_line()
which returns the same thing.
If you'd like more descriptive group labels, set the names of the list elements or define id as a string pasted together from the formatted minimums and maximums of the parsed dates.
Here is a solution using ggplotly.
nrows <- unlist(lapply(list_of_df,nrow))
df <- data.frame(do.call(rbind,list_of_df), Grp = factor(rep(1:3, nrows)))
plot <- ggplot(aes(x=Month_Names, y=Actual_volume, group = Grp,
colour=Grp), data=df) + geom_line()
print(ggplotly(plot))

Resources