I'm working with this function here:
library(ggplot2)
getp1 <- function(names, data, colors) {
num_lines <- length(names)
p1_colors <- colors
names(p1_colors) <- names
p1 <- ggplot(data.frame(x = c(0,720)), aes(x)) +
stat_function(fun=data[[1]], geom="line", aes(colour=names[1]), size=1) +
stat_function(fun=data[[2]], geom="line", aes(colour=names[2])) +
stat_function(fun=data[[3]], geom="line", aes(colour=names[3])) +
stat_function(fun=data[[4]], geom="line", aes(colour=names[4])) +
scale_x_continuous(name="") + scale_y_continuous(name="") +
scale_colour_manual(name = "", guide = FALSE, values = p1_colors)
return(p1)
}
Right now, I get four data lines from this. But I want it to plot exactly num_lines lines, so I guess I need to find some way to "copy" the stat_function() bit num_lines times. Any idea how I can do that?
Completely fail to see the purpose of this and may have misunderstood the question. But I think that you can just use lapply to achieve what you want.
library(ggplot2)
# your version, changed so it works for me...
# (may already be something else than you expected?)
getp1_old <- function(names, data, colors) {
p1 <- ggplot(data.frame(x = c(0,720)), aes(x)) +
stat_function(fun=data[[1]], geom="line", colour=colors[1], size=1) +
stat_function(fun=data[[2]], geom="line", colour=colors[2]) +
stat_function(fun=data[[3]], geom="line", colour=colors[3]) +
stat_function(fun=data[[4]], geom="line", colour=colors[4]) +
scale_x_continuous(name="") + scale_y_continuous(name="") +
scale_colour_manual(guide = FALSE, values = colors)
return(p1)
}
# my version, with lapply
getp1_new <- function(names, data, colors) {
num_lines <- length(names)
stat_fct_combine <- lapply(1:num_lines, function(index){
stat_function(fun=data[[index]], geom="line", colour=colors[index])
})
p1 <- ggplot(data.frame(x = c(0,720)), aes(x)) +
stat_fct_combine +
scale_x_continuous(name="") +
scale_y_continuous(name="") +
scale_colour_manual(guide = FALSE, values = colors)
return(p1)
}
# reproducible example
nms <- paste0('nr', 1:6)
dta <- list(function(x) 1, function(x) 2, function(x) 3, function(x) 4,
function(x) 5, function(x) 6)
cols <- rep(c('red', 'green', 'black', 'blue'), length=6)
# example plots
getp1_old(nms, dta, cols)
getp1_new(nms[1:4], dta, cols)
getp1_new(nms, dta, cols)
Related
I can't seem to find a way to combine two ggplots having different function ranges.
library(ggplot2)
myfun <- function(x) {
1/(1 + exp(-x))}
ggplot( NULL,aes(x)) +
stat_function(data=data.frame(x=c(0, 20)),fun=myfun, geom="line") +
stat_function(data=data.frame(x=c(10, 20)),fun=1/myfun, geom="line")
EDIT: Had a mistake in the question: 1/myfunc instead of myfunc in the second function data.
I am not sure if this is what you want, but I give your function two different colors based on two ranges. You can use the following code:
library(ggplot2)
myfun <- function(x) {
1/(1 + exp(-x))}
ggplot(NULL) +
stat_function(data= data.frame(x = c(0, 10)), aes(x, color = "blue"), fun=myfun, xlim = c(0,10)) +
stat_function(data= data.frame(x = c(10, 20)), aes(x, color = "red"), fun=myfun, xlim = c(10,20)) +
scale_color_manual(labels = c("blue", "red"), values = c("blue", "red"))
Output:
As you can see in the plot, the function is plotted within two different ranges.
Answer to edited question
I would suggest to just make a second function like this:
library(ggplot2)
myfun1 <- function(x) {
1/(1 + exp(-x))}
myfun2 <- function(x) {
1/(1/(1 + exp(-x)))}
ggplot( NULL) +
stat_function(data=data.frame(x=c(0, 20)),fun=myfun1, geom="line") +
stat_function(data=data.frame(x=c(10, 20)),fun=myfun2, geom="line")
Output:
I am trying to use geom_rect in a for loop, but it does not respect my limits. It does if I call it outside of the context of a for loop. Is this a bug? Or is there something I don't understand about geom_rect? outPlot_free and outPlot1 should be identical (since .2 = .2/1), but the rectangles in outPlot1 are truncated, and interestingly they are identical to outPlot2, outPlot3 and outPlot4.
library('ggplot2')
library('ggrepel')
sum_df <- data.frame(matrix(NA, nrow=10, ncol=3))
colnames(sum_df) <- c("Variable", "Male", "Female")
sum_df$Variable <- c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j")
covar = .7*.1*.1
Sigma = matrix(ncol=2,nrow=2,c(.2^2,covar,covar,.2^2))
temp = eigen(Sigma)
SqrtSigma = temp$vectors%*%diag(sqrt(temp$values))%*%t(temp$vectors)
XYvec = c(0,0) + SqrtSigma%*%rnorm(2)
for(i in 1:10){
XYvec = c(0,0) + SqrtSigma%*%rnorm(2)
sum_df$Female[i] = XYvec[1]
sum_df$Male[i] = XYvec[2]
}
outPlot_free <- ggplot(sum_df, aes(x=Male, y=Female)) + theme_minimal() +
geom_rect(aes(xmin=-.2, xmax=.2, ymin=-Inf, ymax=Inf), fill="grey97", color=NA, alpha=.5, size=0) +
geom_rect(aes(ymin=-.2, ymax=.2, xmin=-Inf, xmax=Inf), fill="grey97", color=NA, alpha=.5, size=0) +
geom_point() + geom_text_repel(aes(label=Variable)) +
scale_x_continuous(limits=c(-1, 1), breaks=round(seq(-1, 1, .1), digits=2)) +
scale_y_continuous(limits=c(-1, 1), breaks=round(seq(-1, 1, .1), digits=2)) +
geom_abline(intercept=0, slope=1, linetype="dotdash", alpha=.5) +
scale_color_manual(values=c("grey60", "black")) + xlab("Female") + ylab("Male") +
geom_hline(yintercept=.2, linetype="dashed", color="slateblue") + geom_vline(xintercept=.2, linetype="dashed", color="slateblue") +
geom_hline(yintercept=-.2, linetype="dashed", color="slateblue") + geom_vline(xintercept=-.2, linetype="dashed", color="slateblue")
for (q in 1:4) {
covar = .7*.1*.1
Sigma = matrix(ncol=2,nrow=2,c(.2^2,covar,covar,.2^2))
temp = eigen(Sigma)
SqrtSigma = temp$vectors%*%diag(sqrt(temp$values))%*%t(temp$vectors)
XYvec = c(0,0) + SqrtSigma%*%rnorm(2)
for(i in 1:10){
XYvec = c(0,0) + SqrtSigma%*%rnorm(2)
sum_df$Female[i] = XYvec[1]
sum_df$Male[i] = XYvec[2]
}
outPlot <- ggplot(sum_df, aes(x=Male, y=Female)) + theme_minimal() +
geom_rect(aes(xmin=-.2/q, xmax=.2/q, ymin=-Inf, ymax=Inf), fill="grey97", color=NA, alpha=.5, size=0) +
geom_rect(aes(ymin=-.2/q, ymax=.2/q, xmin=-Inf, xmax=Inf), fill="grey97", color=NA, alpha=.5, size=0) +
geom_point() + geom_text_repel(aes(label=Variable)) +
scale_x_continuous(limits=c(-1, 1), breaks=round(seq(-1, 1, .1), digits=2)) +
scale_y_continuous(limits=c(-1, 1), breaks=round(seq(-1, 1, .1), digits=2)) +
geom_abline(intercept=0, slope=1, linetype="dotdash", alpha=.5) +
scale_color_manual(values=c("grey60", "black")) + xlab("Female") + ylab("Male") +
geom_hline(yintercept=.2, linetype="dashed", color="slateblue") + geom_vline(xintercept=.2, linetype="dashed", color="slateblue") +
geom_hline(yintercept=-.2, linetype="dashed", color="slateblue") + geom_vline(xintercept=-.2, linetype="dashed", color="slateblue")
assign(paste0("outPlot", q), outPlot)
}
outPlot_free
outPlot1
outPlot2
outPlot3
outPlot4
Created on 2019-11-09 by the reprex package (v0.3.0)
outPlot_free and outPlot1 should be identical except for the plotted points, since they were independently simulated.
The problem you're running into is lazy evaluation in R. It's a common problem when writing code containing loops, in particular if you're approaching the language from a procedural mindset. For more details, see e.g. here: http://adv-r.had.co.nz/Functions.html
In the following example, the first is what you're doing (in effect), and the second is what you should be doing.
# doesn't work as expected, as the variable i in the function call
# is evaluated only after the loop is run
x <- list()
for (i in 1:3) {
x[[i]] <- function() {i}
}
x[[1]]()
#> [1] 3
x[[2]]()
#> [1] 3
x[[3]]()
#> [1] 3
# by writing a function generator, we can bind the variable i
# to the specific function we're generating in each iteration
# of the loop
x <- list()
f_generator <- function(i) {
force(i)
function() {i}
}
for (i in 1:3) {
x[[i]] <- f_generator(i)
}
x[[1]]()
#> [1] 1
x[[2]]()
#> [1] 2
x[[3]]()
#> [1] 3
Created on 2019-11-09 by the reprex package (v0.3.0)
In the context of your code, write a function that generates the plot, call force() on all the arguments to that function, and then inside the for() loop call that function to create the specific plot objects you need. See the following example.
library(ggplot2)
library(cowplot)
# this doesn't work, the line in the first plot should be placed
# at y = 1 but is placed at y = 2
plots <- list()
for (i in 1:2) {
data <- data.frame(x = c(0, 1))
plots[[i]] <- ggplot(data, aes(x, y = i)) + geom_line() + ylim(0, 3)
}
plot_grid(plotlist = plots, labels = c(1:2))
# this does work
plots <- list()
plot_fun <- function(i) {
force(i)
data <- data.frame(x = c(0, 1))
ggplot(data, aes(x, y = i)) + geom_line() + ylim(0, 3)
}
for (i in 1:2) {
plots[[i]] <- plot_fun(i)
}
plot_grid(plotlist = plots, labels = c(1:2))
And finally, once you have written a function that generates your plots, the idiomatic approach in R would be to not write a for loop but instead use lapply() or map(). It turns out that if you get used to using these functions instead of for loops you're much less likely to run into the problem you're experiencing, because R is not a procedural language.
# this replaces the for loop
plots <- lapply(1:2, plot_fun)
plot_grid(plotlist = plots, labels = c(1:2))
Created on 2019-11-09 by the reprex package (v0.3.0)
By using this function, I can add outliers values into the plot of mpg
outlier_values. <- lapply(mtcars[-c(8,9)], function(x){outlier_values <- boxplot.stats(x)$out})
boxplot(mtcars$mpg, main="Pressure Height", boxwex=0.1)
mtext(paste("Outliers: ", paste(outlier_values., collapse=", ")), cex=0.6)
Buy now I want to add the outlier values (outlier1) to the plot of all variables:
library(reshape2)
library(ggplot2)
outlier <- do.call("cbind", lapply(mtcars[-c(8,9)], function(x) boxplot.stats(x)$out))
outlier1 <- melt(outlier)
mtcars_m = melt(mtcars[,-c(8,9)])
names(mtcars_m)=c("X2","CI")
box.plot<- ggplot(mtcars_m, aes(X2, CI,fill=Models)) +
geom_boxplot(width = 0.1) +
facet_wrap(~ Models, scales = "free") +
guides(fill=FALSE) +
labs(x="", y="") +
ggtitle("Box Plots")
How can I do that?
Your code contains some variables which are undefined (Models). I assume you meant X2. Here is the ggplot2 solution:
outlier1 <- melt(data.frame(outlier))
colnames(mtcars_m) <- colnames(outlier1) <- c("X2","CI")
mtcars_m$Outlier <- FALSE
outlier1$Outlier <- TRUE
ggData <- rbind(mtcars_m, outlier1)
ggplot(ggData, aes(x=X2, y=CI, fill=X2) ) +
geom_boxplot() +
geom_point(aes(colour=Outlier)) +
labs(x="",y="") +
ggtitle("Box Plots") +
guides(fill=FALSE) +
facet_wrap(~ X2, scales = "free")
I would like to re-order the elements in a legend, as they appear top to bottom in an R ggplot. That is: I'd like the order dictated by comparing the Y value at the right most point X axis point. In the following data, I'd like the legend to read from the top: bush, foo, baz, bar.
Update: following #alexwhan comments, I have added the data to the script.
Update 2: this is now exactly what I was hoping for, thanks to #thomas-kern on #R (bosie) irc.freenode. The trick was to add both, i.e.
scale_linetype_discrete(breaks = ord$Variant) + scale_shape_discrete(breaks = ord$Variant)
Here's my R:
library(plyr)
library(ggplot2)
require(grid)
args <- commandArgs(trailingOnly = TRUE)
lines <- "
X,Variant,Y
1,foo,123
1,bar,134
1,baz,135
1,bush,136
2,foo,221
2,bar,104
2,baz,155
2,bush,336
"
con <- textConnection(lines)
DF <- read.csv(con, header=TRUE)
close(con)
cdata <- ddply(DF, .(Variant,X), summarise, N = length(Y), mean=round(mean(Y),2), sd=round(sd(Y),2), se=round(sd(Y)/sqrt(length(Y)),2))
ord <- cdata[cdata$X == max(cdata$X),]
ord <- ord[order(ord$Variant, decreasing=T),]
pdf("out.pdf")
none <- element_blank()
bp <- ggplot(cdata, aes(x=X, y=mean, group=Variant)) + xlab("X label") + geom_line(aes(linetype=Variant)) + geom_point(aes(shape=Variant)) + ylab("Y Value") + labs(title = "mytitle") + scale_linetype_discrete(breaks = ord$Variant) + scale_shape_discrete(breaks = ord$Variant)
print(bp + theme(legend.justification=c(1,0), legend.position=c(1,0), legend.key.width=unit(3,"line"), legend.title=element_blank(), text = element_text(size=18)) + theme(panel.background = element_rect(fill='white', colour='black')) + theme(panel.grid.major = none, panel.grid.minor = none))
dev.off()
This generates exactly what I'm after:
It really helps if you provide the data your plot is made with. Here's an example of how to approach with some data I made up:
dat <- data.frame(x = c(1,2), y = rnorm(8), group = rep(c("bar", "baz", "bush", "foo"), each = 2))
ord <- dat[dat$x == max(dat$x),]
ord <- ord[order(ord$y, decreasing=T),]
ggplot(dat, aes(x, y)) + geom_point(aes(shape = group)) + geom_line(aes(group = group)) +
scale_shape_discrete(breaks = ord$group)
I want to plot y=log(1+x) and y=x in the range [-0.25, 0.25]. Here is my code so far -
library(ggplot2)
log1plusx <- function(x) log(1+x)
self <- function(x) x
ggplot(data.frame(x=c(-0.25, 0.25)), aes(x=x)) + stat_function(fun=log1plusx, color="red") + stat_function(fun=self, color="blue")
I can't figure out how to add the legends for these two lines. Tried using guide_legend, but nothing works so far.
Any ideas?
Partial answer:
ggplot(data.frame(x=c(-0.25, 0.25)), aes(x=x)) +
geom_path(aes(colour="red"), stat="function", fun=log1plusx)+
geom_path(aes(colour="blue"), stat="function", fun=self) +
scale_colour_identity("Function", guide="legend",
labels = c("log1plusx", "self"),
breaks = c("red", "blue"))
Though in my opinion you'll be better off building a data.frame before plotting.
Here is how I solved it. Other ideas are welcome.
log1plusx <- function(x) log(1+x)
self <- function(x) x
plot.range1 <- data.frame(x=c(-0.25, 0.25), Functions = factor(1))
plot.range2 <- data.frame(x=c(-0.25, 0.25), Functions = factor(2))
ggplot(NULL, aes(x=x, colour=Functions)) +
stat_function(data = plot.range1, fun = log1plusx) +
stat_function(data = plot.range2, fun = self) +
scale_colour_manual(values = c("red", "green"), labels = c("log(1+x)", "x")) +
theme(axis.title.y=element_blank())