The polygon function in R seems rather simple...however I can't get it to work.
It easily works with this code:
x <- seq(-3,3,0.01)
y1 <- dnorm(x,0,1)
y2 <- 0.5*dnorm(x,0,1)
plot(x,y1,type="l",bty="L",xlab="X",ylab="dnorm(X)")
points(x,y2,type="l",col="red")
polygon(c(x,rev(x)),c(y2,rev(y1)),col="skyblue")
When adopting this to something else, it doesn't work. Here some stuff to reproduce the issue:
lowerbound = c(0.05522914,0.06567045,0.07429926,0.08108482,0.08624472,0.09008050,0.09288837,0.09492226)
upperbound = c(0.1743657,0.1494058,0.1333106,0.1227383,0.1156714,0.1108787,0.1075915,0.1053178)
lim = c(100,200,400,800,1600,3200,6400,12800)
plot(upperbound, ylim=c(0, 0.2), type="b", axes=FALSE)
lines(lowerbound, type="b", col="red")
atvalues <- seq(1:8)
axis(side=1, at=atvalues, labels=lim)
axis(side=2, at=c(0,0.05,0.1,0.15,0.2), labels=c(0,0.05,0.1,0.15,0.2))
polygon(lowerbound,upperbound, col="skyblue")
It also doesn't work when only segmenting a subset when directly calling the coordinates:
xpoly <- c(100,200,200,100)
ypoly <- c(lowerbound[1], lowerbound[2], upperbound[2], upperbound[1])
polygon(xpoly,ypoly, col="skyblue")
What am I missing?
Plotting the whole polygon
You need to supply both x and y to polygon. Normally, you'd also do that for plot, but if you don't it will just use the Index as x, that is integers 1 to n. We can use that to make an x range. seq_along will create a 1:n vector, where n is the length of another object.
x <- c(seq_along(upperbound), rev(seq_along(lowerbound)))
y <- c(lowerbound, rev(upperbound))
plot(upperbound, ylim=c(0, 0.2), type="b", axes=FALSE)
lines(lowerbound, type="b", col="red")
atvalues <- seq(1:8)
axis(side=1, at=atvalues, labels=lim)
axis(side=2, at=c(0,0.05,0.1,0.15,0.2), labels=c(0,0.05,0.1,0.15,0.2))
polygon(x = x, y = y, col="skyblue")
Plotting a subset
For a subset, I would create the y first, and then use the old x to easily get `x values:
y2 <- c(lowerbound[1:2], upperbound[2:1])
x2 <- x[which(y2 == y)]
polygon(x2, y2, col="skyblue")
How I would do it
Creating something like this is much easier in ggplot2, where geom_ribbon does a lot of the heavy lifting. We just have to make an actual data.frame, an stop relying on indices.
Full polygon:
library(ggplot2)
ggplot(d, aes(x = x, ymin = low, ymax = up)) +
geom_ribbon(fill = 'skyblue', alpha = 0.5) +
geom_line(aes(y = low), col = 'red') +
geom_line(aes(y = up), col = 'black') +
scale_x_continuous(trans = 'log2') +
theme_bw()
Subset:
ggplot(d, aes(x = x, ymin = low, ymax = up)) +
geom_ribbon(data = d[1:2, ], fill = 'skyblue', alpha = 0.5) +
geom_line(aes(y = low), col = 'red') +
geom_line(aes(y = up), col = 'black') +
scale_x_continuous(trans = 'log2') +
theme_bw()
Related
I'm trying to plot some nonparametric regression curves with ggplot2. I achieved It with the base plot()function:
library(KernSmooth)
set.seed(1995)
X <- runif(100, -1, 1)
G <- X[which (X > 0)]
L <- X[which (X < 0)]
u <- rnorm(100, 0 , 0.02)
Y <- -exp(-20*L^2)-exp(-20*G^2)/(X+1)+u
m <- lm(Y~X)
plot(Y~X)
abline(m, col="red")
m2 <- locpoly(X, Y, bandwidth = 0.05, degree = 0)
lines(m2$x, m2$y, col = "red")
m3 <- locpoly(X, Y, bandwidth = 0.15, degree = 0)
lines(m3$x, m3$y, col = "black")
m4 <- locpoly(X, Y, bandwidth = 0.3, degree = 0)
lines(m4$x, m4$y, col = "green")
legend("bottomright", legend = c("NW(bw=0.05)", "NW(bw=0.15)", "NW(bw=0.3)"),
lty = 1, col = c("red", "black", "green"), cex = 0.5)
With ggplot2 have achieved plotting the linear regression:
With this code:
ggplot(m, aes(x = X, y = Y)) +
geom_point(shape = 1) +
geom_smooth(method = lm, se = FALSE) +
theme(axis.line = element_line(colour = "black", size = 0.25))
But I dont't know how to add the other lines to this plot, as in the base R plot. Any suggestions? Thanks in advance.
Solution
The shortest solution (though not the most beautiful one) is to add the lines using the data= argument of the geom_line function:
ggplot(m, aes(x = X, y = Y)) +
geom_point(shape = 1) +
geom_smooth(method = lm, se = FALSE) +
theme(axis.line = element_line(colour = "black", size = 0.25)) +
geom_line(data = as.data.frame(m2), mapping = aes(x=x,y=y))
Beautiful solution
To get beautiful colors and legend, use
# Need to convert lists to data.frames, ggplot2 needs data.frames
m2 <- as.data.frame(m2)
m3 <- as.data.frame(m3)
m4 <- as.data.frame(m4)
# Colnames are used as names in ggplot legend. Theres nothing wrong in using
# column names which contain symbols or whitespace, you just have to use
# backticks, e.g. m2$`NW(bw=0.05)` if you want to work with them
colnames(m2) <- c("x","NW(bw=0.05)")
colnames(m3) <- c("x","NW(bw=0.15)")
colnames(m4) <- c("x","NW(bw=0.3)")
# To give the different kernel density estimates different colors, they must all be in one data frame.
# For merging to work, all x columns of m2-m4 must be the same!
# the merge function will automatically detec columns of same name
# (that is, x) in m2-m4 and use it to identify y values which belong
# together (to the same x value)
mm <- Reduce(x=list(m2,m3,m4), f=function(a,b) merge(a,b))
# The above line is the same as:
# mm <- merge(m2,m3)
# mm <- merge(mm,m4)
# ggplot needs data in long (tidy) format
mm <- tidyr::gather(mm, kernel, y, -x)
ggplot(m, aes(x = X, y = Y)) +
geom_point(shape = 1) +
geom_smooth(method = lm, se = FALSE) +
theme(axis.line = element_line(colour = "black", size = 0.25)) +
geom_line(data = mm, mapping = aes(x=x,y=y,color=kernel))
Solution which will settle this for everyone and for eternity
The most beautiful and reproducable way though will be to create a custom stat in ggplot2 (see the included stats in ggplot).
There is this vignette of the ggplot2 team to this topic: Extending ggplot2. I have never undertaken such a heroic endeavour though.
I'm trying to add error bars to line graphs to the following script.
#####Plot FW roses####
ntreatments <- max(df$Treats)
#get the range for the x and y axis
x2range <- range(df$Days)
y2range <- range(df$FWs)
# set up plot
plot(x2range, y2range,
type = "n",
xlab= "Time (days)",
ylab= "Fresh weight (g)")
colors <- c("blue", "red", "black", "darkgreen", "Purple")
linetype <- c(1:ntreatments)
plotchar <- seq(18, 18+ntreatments, 1)
# add lines
for(i in 1:ntreatments) {
tr2 <- subset(df, Treats==i)
lines(tr2$Days, tr2$FWs, type="b",
lwd=1.5,
lty=linetype[i],
col=colors[i],
pch=plotchar[i])
}
# add a title and subtitle
title("Fresh weight")
# add a legend
legend(x2range[1],
y2range[2],
ncol = 2,
1:ntreatments,
cex=0.8,
col=colors,
pch=plotchar,
lty=linetype,
title="Treatment")
I have tried errbar(x2range, y2range, y2range+df$sd, y2range-df$sd)
But the result is that all errorbars gather at the beginning and the end of the graph and not on the corresponding y coordinates.
How can I solve this?
Since you don't provide any sample data, here is a simple example using some simulated data.
# Generate some sample data
set.seed(2017);
x <- seq(0, 1, length.out = 10);
y <- 1 + 4 * x + runif(10);
dy <- sqrt(y);
df <- data.frame(x = x, y = y, dy = dy);
Plot in base R and add error bars using segments.
# Plot in base R
plot(df$x, df$y, ylim = c(0, 8), type = "l");
segments(df$x, df$y - df$dy, df$x, df$y + df$dy);
Or plot using ggplot2.
# Plot in ggplot
ggplot(df, aes(x = x, y = y)) +
geom_line() +
geom_errorbar(aes(ymin = y - dy, ymax = y + dy));
I have a parameterized contour that I'm plotting in R. What I'm trying to do is add arrows along the curve to show the viewer which direction the curve is going in.
Here's the code I'm using to generate the curve:
library(ggplot2)
library(grid)
set.seed(9)
T<-sort(runif(2^12,min=2^-5, max=16))
U<-function(t) exp(4*log(t) - 4*t)*(cos(log(t) + 3*t))
#Re(t^(4+1i)*t)*exp(-(4-3i)*t))
V<-function(t) exp(4*log(t) - 4*t)*(sin(log(t) + 3*t))
#Im(t^(4+1i)*t)*exp(-(4-3i)*t))
X<-sapply(T,U)
Y<-sapply(T,V)
df<-data.frame(X=X,Y=Y)
p<-ggplot(data=df,aes(x = df$X, y = df$Y))
p+theme_bw()+
geom_path(size=1,color='blue',linetype=1) #+
#geom_segment(aes(xend=c(tail(X, n=-1), NA), yend=c(tail(Y, n=-1), NA)),
#arrow=arrow(length=unit(0.2,"cm")),color='blue')
dev.off()
The last part I commented out:
#+
#geom_segment(aes(xend=c(tail(X, n=-1), NA), yend=c(tail(Y, n=-1), NA)),
#arrow=arrow(length=unit(0.2,"cm")),color='blue')
does something similar to what I want, but the arrows are very close together and the curve ends up looking "fuzzy" rather than directed.
Here's the fuzzy and non-fuzzy version of the curve:
Thank you!
It might look better if the arrows were more equally spaced along the curved path, e.g.
library(ggplot2)
library(grid)
set.seed(9)
T <- sort(runif(2^12,min=2^-5, max=16))
U <- function(t) exp(4*log(t) - 4*t)*(cos(log(t) + 3*t))
V <- function(t) exp(4*log(t) - 4*t)*(sin(log(t) + 3*t))
drough <- data.frame(x=sapply(T,U), y=sapply(T,V))
p <- ggplot(data = drough, aes(x = x, y = y)) +
geom_path()
## because the parametric curve was generated with uneven spacing
## we can try to resample more evenly along the path
parametric_smoothie <- function(x, y, N=1e2, phase=1, offset=0) {
lengths <- c(0, sqrt(diff(x)^2 + diff(y)^2))
l <- cumsum(lengths)
lmax <- max(l)
newpos <- seq(phase*lmax/N, lmax-phase*lmax/N, length.out = N) + offset*lmax/N
xx <- approx(l, x, newpos)$y
yy <- approx(l, y, newpos)$y
data.frame(x = xx, y = yy)
}
## this is a finer set of points
dfine <- parametric_smoothie(X, Y, 20)
gridExtra::grid.arrange(p + geom_point(data = drough, col="grey"),
p + geom_point(data = dfine, col="grey"), ncol=2)
## now we use this function to create N start points for the arrows
## and another N end points slightly apart to give a sense of direction
relay_arrow <- function(x, y, N=10, phase = 0.8, offset = 1e-2, ...){
start <- parametric_smoothie(x, y, N, phase)
end <- parametric_smoothie(x, y, N, phase, offset)
data.frame(xstart = start$x, xend = end$x,
ystart = start$y, yend = end$y)
}
breaks <- relay_arrow(drough$x, drough$y, N=20)
p + geom_point(data = breaks, aes(xstart, ystart), col="grey98", size=2) +
geom_segment(data = breaks, aes(xstart, ystart, xend = xend, yend = yend),
arrow = arrow(length = unit(0.5, "line")),
col="red", lwd=1)
One way to do it is to draw them on after. You can probably get the direction better by using the angle aesthetic (if it's easy enough to work out):
p<-ggplot(data=df,aes(x = X, y = Y))
p +
geom_path(size=1,color='blue',linetype=1)+
geom_segment(data = df[seq(1, nrow(df), 20), ], aes(x = X, y = Y, xend=c(tail(X, n=-1), NA), yend=c(tail(Y, n=-1), NA)),
arrow=arrow(length=unit(0.2,"cm"), type = "closed"), color="blue", linetype = 0, inherit.aes = FALSE)
Note the closed arrow type. I had to do that so they weren't interpreted as lines and hence disappear when linetype = 0.
Try this with slight modification of your code (you don't want to compromise the quality of the curve by having smaller number of points and at the same time you want to have smaller number of segments to draw the arrows for better quality of the arrows):
library(ggplot2)
library(grid)
set.seed(9)
T<-sort(runif(2^12,min=2^-5, max=16))
U<-function(t) exp(4*log(t) - 4*t)*(cos(log(t) + 3*t))
#Re(t^(4+1i)*t)*exp(-(4-3i)*t))
V<-function(t) exp(4*log(t) - 4*t)*(sin(log(t) + 3*t))
#Im(t^(4+1i)*t)*exp(-(4-3i)*t))
X<-sapply(T,U)
Y<-sapply(T,V)
df<-data.frame(X=X,Y=Y)
df1 <- df[seq(1,length(X), 8),]
p<-ggplot(data=df,aes(x = df$X, y = df$Y))
p+theme_bw()+
geom_path(size=1,color='blue',linetype=1) +
geom_segment(data=df1,aes(x=X, y=Y, xend=c(tail(X, n=-1), NA), yend=c(tail(Y, n=-1), NA)),
arrow=arrow(length=unit(0.3,"cm"),type='closed'),color='blue')
#dev.off()
I am trying to visualize heavily tailed raster data, and I would like a non-linear mapping of colors to the range of the values. There are a couple of similar questions, but they don't really solve my specific problem (see links below).
library(ggplot2)
library(scales)
set.seed(42)
dat <- data.frame(
x = floor(runif(10000, min=1, max=100)),
y = floor(runif(10000, min=2, max=1000)),
z = rlnorm(10000, 1, 1) )
# colors for the colour scale:
col.pal <- colorRampPalette(c("#00007F", "blue", "#007FFF", "cyan", "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"))
fill.colors <- col.pal(64)
This is how the data look like if not transformed in some way:
ggplot(dat, aes(x = x, y = y, fill = z)) +
geom_tile(width=2, height=30) +
scale_fill_gradientn(colours=fill.colors)
My question is sort of a follow-up question related to
this one or this one , and the solution given here actually yields exactly the plot I want, except for the legend:
qn <- rescale(quantile(dat$z, probs=seq(0, 1, length.out=length(fill.colors))))
ggplot(dat, aes(x = x, y = y, fill = z)) +
geom_tile(width=2, height=30) +
scale_fill_gradientn(colours=fill.colors, values = qn)
Now I want the colour scale in the legend to represent the non-linear distribution of the values (now only the red part of the scale is visible), i.e. the legend should as well be based on quantiles. Is there a way to accomplish this?
I thought the trans argument within the colour scale might do the trick, as suggested here , but that throws an error, I think because qnorm(pnorm(dat$z)) results in some infinite values (I don't completely understand the function though..).
norm_trans <- function(){
trans_new('norm', function(x) pnorm(x), function(x) qnorm(x))
}
ggplot(dat, aes(x = x, y = y, fill = z)) +
geom_tile(width=2, height=30) +
scale_fill_gradientn(colours=fill.colors, trans = 'norm')
> Error in seq.default(from = best$lmin, to = best$lmax, by = best$lstep) : 'from' must be of length 1
So, does anybody know how to have a quantile-based colour distribution in the plot and in the legend?
This code will make manual breaks with a pnorm transformation. Is this what you are after?
ggplot(dat, aes(x = x, y = y, fill = z)) +
geom_tile(width=2, height=30) +
scale_fill_gradientn(colours=fill.colors,
trans = 'norm',
breaks = quantile(dat$z, probs = c(0, 0.25, 1))
)
I believe you have been looking for a quantile transform. Unfortunately there is none in scales, but it is not to hard to build one yourself (on the fly):
make_quantile_trans <- function(x, format = scales::label_number()) {
name <- paste0("quantiles_of_", deparse1(substitute(x)))
xs <- sort(x)
N <- length(xs)
transform <- function(x) findInterval(x, xs)/N # find the last element that is smaller
inverse <- function(q) xs[1+floor(q*(N-1))]
scales::trans_new(
name = name,
transform = transform,
inverse = inverse,
breaks = function(x, n = 5) inverse(scales::extended_breaks()(transform(x), n)),
minor_breaks = function(x, n = 5) inverse(scales::regular_minor_breaks()(transform(x), n)),
format = format,
domain = xs[c(1, N)]
)
}
ggplot(dat, aes(x = x, y = y, fill = z)) +
geom_tile(width=2, height=30) +
scale_fill_gradientn(colours=fill.colors, trans = make_quantile_trans(dat$z))
Created on 2021-11-12 by the reprex package (v2.0.1)
How would you draw in R the graph of the equation
|y| = 1 - |x|
fun1 <- function(x) 1-abs(x)
fun2 <- function(x) -(1-abs(x))
plot (fun1, -1, 1,xlim=c(-2,2),ylim=c(-2,2),pty="s",col=2);abline(h=0,v=0)
plot (fun2, -1, 1,col=2,add=TRUE)
Here's an approach using ggplot.
x = seq(-1, 1, by = 0.01)
y = 1 - abs(x)
p1 = qplot(x, geom = 'blank') +
geom_point(aes(y = y), colour = 'blue') +
geom_point(aes(y = -y), colour = 'red')
x <- (-1):1
y <- 1 - abs(x)
plot(x, y, type="l")
lines(x, -y)