Related
I've been trying to create a combination of radar/polar chart of a given vector of polygon vertices, without packages, but just with base R, which I really struggle with. So far, with some help, I have reached the following point:
a <- a <- abs(rnorm(5, mean = 4, sd = 2))
names(a) <- LETTERS[1:5]
stars(matrix(a,nrow=1),axes=TRUE, scale=FALSE,col.lines="blue",radius=FALSE)
center <- c(x=2.1, y=2.1) #the starchart for some reason chooses this as a center
half <- seq(0, pi, length.out = 51)
angle=45
for (D in a) {
Xs <- D * cos(half); Ys <- D * sin(half)
lines(center["x"] + Xs, center["y"] + Ys, col = "gray", xpd = NA, lty="dashed")
lines(center["x"] + Xs, center["y"] - Ys, col = "gray", xpd = NA, lty="dashed")
}
which gives me something this:
What I would need to take further is:
center this mixed radar/polar chart at (0,0) and mark the center
color the polygon area transparently
add radii starting from the outermost circle and reaching the center through the polygon vertices
put the vector name labels on the ends of the radii on the outermost circle
So, the final result should look something like this:
I have experimented with the polygon(), symbols() functions and par() graphic parametres, but I am really struggling to combine them...My problem is that I don't understand how the stars() function plot coordinates selection relates to my input.
Did not liked the stars functions... so I made a full rondabout with polygon:
polar_chart <- function(values){
k <- length(values)
m <- max(values)
# initialise plot
plot(1, type="n", xlab="", ylab="", xlim=1.2*m*c(-1,1), ylim=1.2*m*c(-1,1))
# radial lines & letters
sapply(k:1, function(x){
text(1.1*m*cos(-(x-1)*2*pi/k + 2*pi/3), 1.1*m*sin(-(x-1)*2*pi/k + 2*pi/3),
LETTERS[x], cex = 0.75)
lines(c(0, m*cos((x-1)*2*pi/k + 2*pi/3)), c(0, m*sin((x-1)*2*pi/k + 2*pi/3)),
col = "grey",lty="dashed")
})
# circles
aux <- seq(2*pi + 0.1, 0, -0.1)
sapply(values, function(x) lines(x*cos(aux), x*sin(aux), col = "grey",lty="dashed"))
# polygon
x <- values*cos(-(1:k-1)*2*pi/k + 2*pi/3)
y <- values*sin(-(1:k-1)*2*pi/k + 2*pi/3)
polygon(c(x, x[1]),c(y, y[1]), col = "red", border = "blue", density = 50)
}
values <- abs(rnorm(5, mean = 4, sd = 2))
polar_chart(values)
And returns a plot like the following:
There's a nice answer around to plot a miniature plot within a plot. I wrapped it in a function which works fine for a single plot.
myPlot <- function(x, y) {
# main plot
plot(x)
# calculate position of inset
pp <- par("plt")
x0 <- pp[2] - (pp[2] - pp[1]) * 0.225
x1 <- pp[2] - .01
y0 <- pp[4] - (pp[4] - pp[3]) * 0.225
y1 <- pp[4] - .01
# set position for inset
op <- par(fig=c(x0, x1, y0, y1), mar=c(0, 0, 0, 0), new=TRUE)
# add inset grey background
plot.new()
u <- par("usr")
rect(u[1], u[2], u[4], u[3], col="grey80")
# add inset
par(new=TRUE)
plot(y, col=2)
par(op)
}
myPlot(x, y)
However, when I useMap to loop over several data lists, in order to make multiple plots of this type side by side, there seems to be a mess with the pars. The miniature appears as a new plot and not within the main plot. Also a new device is opened after one iteration (i.e. old plot gets overwritten).
op1 <- par(mfrow=c(1, 2))
Map(function(x, y) myPlot(x, y), list(d0, d0), list(d0_inset, d0_inset))
par(op1)
When I use Map(function(x, y) myPlot(x, y), list(d0, d0), list(d0_inset, d0_inset)) alone, though, there are two perfect plots in the plot queue (of RStudio). Thus the plot.new() and par(new=TRUE) might not be the issue here.
What I actually want is this:
myPlot() should throw a number of main plots with miniatures inside corresponding to the length of the data lists when using Map and fit it into the par(mfrow=...).
Does anyone have a clue how to solve this using base R functionalities?
Data:
x <- data.frame(x = rnorm(150, sd=5), y = rnorm(150, sd=5))
y <- data.frame(x = rnorm(1500, sd=5), y = rnorm(1500, sd=5))
There's a couple of points here Jay. The first is that if you want to continue to use mfrow then it's best to stay away from using par(fig = x) to control your plot locations, since fig changes depending on mfrow and also forces a new plot (though you can override that, as per your question). You can use plt instead, which makes all co-ordinates relative to the space within the fig co-ordinates.
The second point is that you can plot the rectangle without calling plot.new()
The third, and maybe most important, is that you only need to write to par twice: once to change plt to the new plotting co-ordinates (including a new = TRUE to plot it in the same window) and once to reset plt (since new will reset itself). This means the function is well behaved and leaves the par as they were.
Note I have added a parameter, at, that allows you to specify the position and size of the little plot within the larger plot. It uses normalized co-ordinates, so for example c(0, 0.5, 0, 0.5) would be the bottom left quarter of the plotting area. I have set it to default at somewhere near your version's location.
myPlot <- function(x, y, at = c(0.7, 0.95, 0.7, 0.95))
{
# Helper function to simplify co-ordinate conversions
space_convert <- function(vec1, vec2)
{
vec1[1:2] <- vec1[1:2] * diff(vec2)[1] + vec2[1]
vec1[3:4] <- vec1[3:4] * diff(vec2)[3] + vec2[3]
vec1
}
# Main plot
plot(x)
# Gray rectangle
u <- space_convert(at, par("usr"))
rect(u[1], u[3], u[2], u[4], col="grey80")
# Only write to par once for drawing insert plot: change back afterwards
plt <- par("plt")
plt_space <- space_convert(at, plt)
par(plt = plt_space, new = TRUE)
plot(y, col = 2)
par(plt = plt)
}
So we can test it with:
x <- data.frame(x = rnorm(150, sd = 5), y = rnorm(150, sd = 5))
y <- data.frame(x = rnorm(1500, sd = 5), y = rnorm(1500, sd = 5))
myPlot(x, y)
par(mfrow = c(1, 2))
myPlot(x, y)
myPlot(x, y)
par(mfrow = c(2, 2))
for(i in 1:4) myPlot(x, y)
I wrote following R script:
#energy diagram
x <- c(0.1, 0.3, 0.5, 0.7, 0.9 ) #chosen randomly, reaction axis
y <- c(-5.057920, -5.057859, -5.057887,-5.057674, -5.057919 ) #energy of the educt, intermediate, transtition states and product
plot(x,y, type="p",
xlim=c(0,1),
ylim=c(-5.058,-5.0575),
xlab="reaction axis",
ylab=expression(paste(E[el] ," / ",10^6," ",kJ/mol)),
xaxt="n" #hide x-axis
)
#h- and v-lines, so i can draw curves by hand
abline(v=seq(0,1,0.1),h=seq(-5.0600,-5.0500,0.00005),col="black",lty=1,lwd=1)
abline(h=c(-5.057920, -5.057859, -5.057887,-5.057674), col="blue", lty=1,lwd=0.7)
Is it possible to draw a curve through the points that would look like a energy diagram. An example of an energy diagram is here:
A lot could be done to streamline / vectorize this code, but for a smallish diagram this works pretty well:
# get that data
x <- c(0.1, 0.3, 0.5, 0.7, 0.9 ) # reaction axis
y <- c(-5.057920, -5.057859, -5.057887,-5.057674, -5.057919 ) # energies
I'm going to make a little Bezier curve to connect each point to the next---this way we can make sure the smooth line passes through the data, not just close to it. I'll give each point a single 'control point' to define the slope. By using the same y-values for a point and it's control point, the slope at the point will be 0. I'll call the offset between the point and the control point delta. We'll start with one point-pair:
library(Hmisc)
delta = 0.15
bezx = c(0.1, 0.1 + delta, 0.3 - delta, 0.3)
bezy = rep(y[1:2], each = 2)
plot(bezx, bezy, type = 'b', col = "gray80")
lines(bezier(bezx, bezy), lwd = 2, col = "firebrick4")
Here I plotted the points and control points in gray, and the smooth line in red so we can see what's going on.
It looks promising, let's turn it into a function that we can apply to each pair of points:
bezf = function(x1, x2, y1, y2, delta = 0.15) {
bezier(x = c(x1, x1 + delta, x2 - delta, x2), y = c(y1, y1, y2, y2))
}
You can play with the delta parameter, I think 0.1 looks pretty good.
plot(x, y, xlab = "Reaction coordinate", ylab = "E", axes = F)
box(bty = "L")
axis(side = 2)
for(i in 1:(length(x) - 1)) {
lines(bezf(x1 = x[i], x2 = x[i + 1], y1 = y[i], y2 = y[i + 1], delta = 0.1))
}
You can of course tweak the plot, add labels, and ablines as in your original. (Use my for loop with the lines command to draw only the smoothed lines.) I left the points on to show that we are passing through them, not just getting close.
I prefer plotting in ggplot2, if you do too you'll need to extract the data into a data.frame:
bezlist = list()
for (i in 1:(length(x) - 1)) {
bezlist[[i]] = bezf(x1 = x[i], x2 = x[i + 1], y1 = y[i], y2 = y[i + 1], delta = 0.1)
}
xx = unlist(lapply(bezlist, FUN = '[', 'y'))
yy = unlist(lapply(bezlist, FUN = '[', 'y'))
bezdat = data.frame(react = xx, E = yy)
library(ggplot2)
ggplot(bezdat, aes(x = react, y = E)) +
geom_line() +
labs(x = "Reaction coordinate")
You could use a spline fit. Define some points along the energy diagram, and then fit to them using a spline function. The more points that you provide, the better that your fit will be. You can check out the smooth.splines function in the stats package for one implementation of the spline fit.
How to fill area under and above (sp)line with gradient color?
This example has been drawn in Inkscape - BUT I NEED vertical gradient - NOT horizontal.
Interval from zero to positive == from white to red.
Interval from zero to negative == from white to red.
Is there any package which could do this?
I fabricated some source data....
set.seed(1)
x<-seq(from = -10, to = 10, by = 0.25)
data <- data.frame(value = sample(x, 25, replace = TRUE), time = 1:25)
plot(data$time, data$value, type = "n")
my.spline <- smooth.spline(data$time, data$value, df = 15)
lines(my.spline$x, my.spline$y, lwd = 2.5, col = "blue")
abline(h = 0)
And here's an approach in base R, where we fill the entire plot area with rectangles of graduated colour, and subsequently fill the inverse of the area of interest with white.
shade <- function(x, y, col, n=500, xlab='x', ylab='y', ...) {
# x, y: the x and y coordinates
# col: a vector of colours (hex, numeric, character), or a colorRampPalette
# n: the vertical resolution of the gradient
# ...: further args to plot()
plot(x, y, type='n', las=1, xlab=xlab, ylab=ylab, ...)
e <- par('usr')
height <- diff(e[3:4])/(n-1)
y_up <- seq(0, e[4], height)
y_down <- seq(0, e[3], -height)
ncolor <- max(length(y_up), length(y_down))
pal <- if(!is.function(col)) colorRampPalette(col)(ncolor) else col(ncolor)
# plot rectangles to simulate colour gradient
sapply(seq_len(n),
function(i) {
rect(min(x), y_up[i], max(x), y_up[i] + height, col=pal[i], border=NA)
rect(min(x), y_down[i], max(x), y_down[i] - height, col=pal[i], border=NA)
})
# plot white polygons representing the inverse of the area of interest
polygon(c(min(x), x, max(x), rev(x)),
c(e[4], ifelse(y > 0, y, 0),
rep(e[4], length(y) + 1)), col='white', border=NA)
polygon(c(min(x), x, max(x), rev(x)),
c(e[3], ifelse(y < 0, y, 0),
rep(e[3], length(y) + 1)), col='white', border=NA)
lines(x, y)
abline(h=0)
box()
}
Here are some examples:
xy <- curve(sin, -10, 10, n = 1000)
shade(xy$x, xy$y, c('white', 'blue'), 1000)
Or with colour specified by a colour ramp palette:
shade(xy$x, xy$y, heat.colors, 1000)
And applied to your data, though we first interpolate the points to a finer resolution (if we don't do this, the gradient doesn't closely follow the line where it crosses zero).
xy <- approx(my.spline$x, my.spline$y, n=1000)
shade(xy$x, xy$y, c('white', 'red'), 1000)
Here's one approach, which relies heavily on several R spatial packages.
The basic idea is to:
Plot an empty plot, the canvas onto which subsequent elements will be laid down. (Doing this first also lets you retrieve the user coordinates of the plot, needed in subsequent steps.)
Use a vectorized call to rect() to lay down a background wash of color. Getting the fiddly details of the color gradient is actually the trickiest part of doing this.
Use topology functions in rgeos to find first the closed rectangles in your figure, and then their complement. Plotting the complement with a white fill over the background wash covers up the color everywhere except within the polygons, just what you want.
Finally, use plot(..., add=TRUE), lines(), abline(), etc. to lay down whatever other details you'd like the plot to display.
library(sp)
library(rgeos)
library(raster)
library(grid)
## Extract some coordinates
x <- my.spline$x
y <- my.spline$y
hh <- 0
xy <- cbind(x,y)
## Plot an empty plot to make its coordinates available
## for next two sections
plot(data$time, data$value, type = "n", axes=FALSE, xlab="", ylab="")
## Prepare data to be used later by rect to draw the colored background
COL <- colorRampPalette(c("red", "white", "red"))(200)
xx <- par("usr")[1:2]
yy <- c(seq(min(y), hh, length.out=100), seq(hh, max(y), length.out=101))
## Prepare a mask to cover colored background (except within polygons)
## (a) Make SpatialPolygons object from plot's boundaries
EE <- as(extent(par("usr")), "SpatialPolygons")
## (b) Make SpatialPolygons object containing all closed polygons
SL1 <- SpatialLines(list(Lines(Line(xy), "A")))
SL2 <- SpatialLines(list(Lines(Line(cbind(c(0,25),c(0,0))), "B")))
polys <- gPolygonize(gNode(rbind(SL1,SL2)))
## (c) Find their difference
mask <- EE - polys
## Put everything together in a plot
plot(data$time, data$value, type = "n")
rect(xx[1], yy[-201], xx[2], yy[-1], col=COL, border=NA)
plot(mask, col="white", add=TRUE)
abline(h = hh)
plot(polys, border="red", lwd=1.5, add=TRUE)
lines(my.spline$x, my.spline$y, col = "red", lwd = 1.5)
Another possibility which uses functions from grid and gridSVG packages.
We start by generating additional data points by linear interpolation, according to methods described by #kohske here. The basic plot will then consist of two separate polygons, one for negative values and one for positive values.
After the plot has been rendered, grid.ls is used to show a list of grobs, i.e. all building block of the plot. In the list we will (among other things) find two geom_area.polygons; one representing the polygon for values <= 0, and one for values >= 0.
The fill of the polygon grobs is then manipulated using gridSVG functions: custom color gradients are created with linearGradient, and the fill of the grobs are replaced using grid.gradientFill.
The manipulation of grob gradients is nicely described in chapter 7 in the MSc thesis of Simon Potter, one of the authors of the gridSVG package.
library(grid)
library(gridSVG)
library(ggplot2)
# create a data frame of spline values
d <- data.frame(x = my.spline$x, y = my.spline$y)
# create interpolated points
d <- d[order(d$x),]
new_d <- do.call("rbind",
sapply(1:(nrow(d) -1), function(i){
f <- lm(x ~ y, d[i:(i+1), ])
if (f$qr$rank < 2) return(NULL)
r <- predict(f, newdata = data.frame(y = 0))
if(d[i, ]$x < r & r < d[i+1, ]$x)
return(data.frame(x = r, y = 0))
else return(NULL)
})
)
# combine original and interpolated data
d2 <- rbind(d, new_d)
d2
# set up basic plot
ggplot(data = d2, aes(x = x, y = y)) +
geom_area(data = subset(d2, y <= 0)) +
geom_area(data = subset(d2, y >= 0)) +
geom_line() +
geom_abline(intercept = 0, slope = 0) +
theme_bw()
# list the name of grobs and look for relevant polygons
# note that the exact numbers of the grobs may differ
grid.ls()
# GRID.gTableParent.878
# ...
# panel.3-4-3-4
# ...
# areas.gTree.834
# geom_area.polygon.832 <~~ polygon for negative values
# areas.gTree.838
# geom_area.polygon.836 <~~ polygon for positive values
# create a linear gradient for negative values, from white to red
col_neg <- linearGradient(col = c("white", "red"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(1, "npc"), y1 = unit(0, "npc"))
# replace fill of 'negative grob' with a gradient fill
grid.gradientFill("geom_area.polygon.832", col_neg, group = FALSE)
# create a linear gradient for positive values, from white to red
col_pos <- linearGradient(col = c("white", "red"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(0, "npc"), y1 = unit(1, "npc"))
# replace fill of 'positive grob' with a gradient fill
grid.gradientFill("geom_area.polygon.836", col_pos, group = FALSE)
# generate SVG output
grid.export("myplot.svg")
You could easily create different colour gradients for positive and negative polygons. E.g. if you want negative values to run from white to blue instead, replace col_pos above with:
col_pos <- linearGradient(col = c("white", "blue"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(0, "npc"), y1 = unit(1, "npc"))
This is a terrible way to trick ggplot into doing what you want. Essentially, I make a giant grid of points that are under the curve. Since there is no way of setting a gradient within a single polygon, you have to make separate polygons, hence the grid. It will be slow if you set the pixels too low.
gen.bar <- function(x, ymax, ypixel) {
if (ymax < 0) ypixel <- -abs(ypixel)
else ypixel <- abs(ypixel)
expand.grid(x=x, y=seq(0,ymax, by = ypixel))
}
# data must be in x order.
find.height <- function (x, data.x, data.y) {
base <- findInterval(x, data.x)
run <- data.x[base+1] - data.x[base]
rise <- data.y[base+1] - data.y[base]
data.y[base] + ((rise/run) * (x - data.x[base]))
}
make.grid.under.curve <- function(data.x, data.y, xpixel, ypixel) {
desired.points <- sort(unique(c(seq(min(data.x), max(data.x), xpixel), data.x)))
desired.points <- desired.points[-length(desired.points)]
heights <- find.height(desired.points, data.x, data.y)
do.call(rbind,
mapply(gen.bar, desired.points, heights,
MoreArgs = list(ypixel), SIMPLIFY=FALSE))
}
xpixel = 0.01
ypixel = 0.01
library(scales)
grid <- make.grid.under.curve(data$time, data$value, xpixel, ypixel)
ggplot(grid, aes(xmin = x, ymin = y, xmax = x+xpixel, ymax = y+ypixel,
fill=abs(y))) + geom_rect()
The colours aren't what you wanted, but it is probably too slow for serious use anyway.
I have a plot with two logarithmic axes. I'd like to add a circle to a certain position of the plot. I tried to use plotrix, but this does not give options for "log-radius".
# data to plot
x = 10^(-1 * c(5:0))
y = x ^-1.5
#install.packages("plotrix", dependencies=T)
# use require() within functions
library("plotrix")
plot (x, y, log="xy", type="o")
draw.circle(x=1e-2, y=1e2, radius=1e1, col=2)
How can I add a circle to my log-log plot?
As krlmlr suggests, the easiest solution is to slightly modify plotrix::draw.circle(). The log-log coordinate system distorts coordinates of a circle given in the linear scale; to counteract that, you just need to exponentiate the calculated coordinates, as I've done in the lines marked with ## <- in the code below:
library("plotrix")
draw.circle.loglog <-
function (x, y, radius, nv = 100, border = NULL, col = NA, lty = 1,
lwd = 1)
{
xylim <- par("usr")
plotdim <- par("pin")
ymult <- (xylim[4] - xylim[3])/(xylim[2] - xylim[1]) * plotdim[1]/plotdim[2]
angle.inc <- 2 * pi/nv
angles <- seq(0, 2 * pi - angle.inc, by = angle.inc)
if (length(col) < length(radius))
col <- rep(col, length.out = length(radius))
for (circle in 1:length(radius)) {
xv <- exp(cos(angles) * log(radius[circle])) * x[circle] ## <-
yv <- exp(sin(angles) * ymult * log(radius[circle])) * y[circle] ## <-
polygon(xv, yv, border = border, col = col[circle], lty = lty,
lwd = lwd)
}
invisible(list(x = xv, y = yv))
}
# Try it out
x = 10^(-1 * c(5:0))
y = x ^-1.5
plot (x, y, log="xy", type="o")
draw.circle.loglog(x = c(1e-2, 1e-3, 1e-4), y = c(1e2, 1e6, 1e2),
radius = c(2,4,8), col = 1:3)
A work around would be to apply log10 explicitly.
plot (log10(x), log10(y), type="o")
draw.circle(x=log10(1e-2), y=log10(1e2), radius=log10(1e1), col=2)
Edit (using symbols):
plot (x, y, log="xy", type="o",xlim=c(1e-5,1), ylim=c(1,1e8))
par(new=T)
symbols(x=1e-2, y=1e2, circles=1e1, xlim=c(1e-5,1), ylim=c(1,1e8),
xaxt='n', yaxt='n', ann=F, log="xy")
The function draw.circle from the plotrix package looks like that on my system:
> draw.circle
function (x, y, radius, nv = 100, border = NULL, col = NA, lty = 1,
lwd = 1)
{
xylim <- par("usr")
plotdim <- par("pin")
ymult <- (xylim[4] - xylim[3])/(xylim[2] - xylim[1]) * plotdim[1]/plotdim[2]
angle.inc <- 2 * pi/nv
angles <- seq(0, 2 * pi - angle.inc, by = angle.inc)
if (length(col) < length(radius))
col <- rep(col, length.out = length(radius))
for (circle in 1:length(radius)) {
xv <- cos(angles) * radius[circle] + x
yv <- sin(angles) * radius[circle] * ymult + y
polygon(xv, yv, border = border, col = col[circle], lty = lty,
lwd = lwd)
}
invisible(list(x = xv, y = yv))
}
<environment: namespace:plotrix>
What happens here is essentially that the circle is approximated by a polygon of 100 vertices (parameter nv). You can do either of the following:
Create your own version of draw.circle that does the necessary coordinate transformation to "undo" the log transform of the axes.
The function invisibly returns the list of coordinates that are used for plotting.
(If you pass a vector as radius, then only the coordinates of the last circle are returned.) You might be able to apply a transform to those coordinates and call polygon on the result. Pass appropriate values for border, col, lty and/or lwd to hide the polygon drawn by the functions itself.
The first version sounds easier to me. Simply replace the + x by a * x, same for y, inside the for loop, and you're done. Equivalently, for the second version, you subtract x and then multiply by x each coordinate, same for y. EDIT: These transformations are slightly wrong, see Josh's answer for the correct ones.