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:
I have a plot where I draw arrows from points to points. I would like to put this arrow heads not to the end of the line, but to middle. Is there a simple way to do it other than placing extra arrows with half length of the according line?
My code is this:
plot(x, y, xlim=range(x), ylim=range(y), xlab="x", ylab="y", pch=16,
main="Filled Plane")
for(i in 1:20){
arrows(x[i], y[i], x[i+1], y[i+1], length = 0.25, angle = 30, col = i)
}
Make a custom function myArrow() and add one new argument cut to control the proportion of the arrows
myArrow <- function(x0, y0, x1, y1, cut = 1, ...){
x.new <- (1 - cut) * x0 + cut * x1
y.new <- (1 - cut) * y0 + cut * y1
# segments(x0, y0, x1, y1, ...)
arrows(x0, y0, x.new, y.new, ...)
}
Note1 : The computation of x.new and y.new in this custom function uses a simple mathematical concept, i.e. the Section Formula. The value of cut must be between 0 to 1.
Note2 : The use of this function is equivalent to that of the original functionarrows() other than that it has one more new argument cut.
Note3 : If you want complete lines behind the arrows, just remove the hash(#) in the function.
Plot and try different cut value. For example, I use cut = 0.7. (If you want the arrowheads to the middle, use cut = 0.5.)
# Toy Data
x <- seq(1, 5.5, by = 0.5)
y <- rep(c(1, 5), 5)
plot(x, y, pch = 16)
for(i in 1:9){
myArrow(x[i], y[i], x[i+1], y[i+1], cut = 0.7, col = i, lwd = 2)
}
Since you do not provide your x and y, I made up some data. There is no need for the loop. arrows will handle a vector of coordinates. One way is to draw a full-length arrow with no arrowhead and another that just goes halfway but has the arrowhead.
## Some bogus data
set.seed(123)
x = runif(4)
y = runif(4)
## Compute the midpoints
midx = diff(x)/2 + x[-length(x)]
midy = diff(y)/2 + y[-length(y)]
## Draw it
plot(x,y,xlim=range(x), ylim=range(y), xlab="x", ylab="y",
main="Filled Plane",pch=16)
arrows(x[-length(x)], y[-length(y)],x[-1],y[-1],
angle = 0, col = 1:3)
arrows(x[-length(x)], y[-length(y)],midx,midy,
length = 0.25, angle = 30, col = 1:3)
TL;DR: What is the most efficient way to crop a rectangular image to a circle?
Explanation/Background:
I'm working on some code in R that will display Spotify artist images as circles instead of the default rectanges/squares. I couldn't find any packages or commands that crop images in R, especially to a circle, so I wrote my own function, circ, which reads 3-Dimensional (or 4-Dimensional) RGB(A) arrays and crops them to a circle using the parametric equation of a circle to determine the x values for every unique y. Here's my psuedocode:
Given an RGB(A) array:
Find the center of the image, radius = min(x coord, y coord)
Pre-crop the image to a square of dimensions 2r x 2r
For every unique y value:
Determine the x coordinates on the circle
Make pixels outside of the circle transparent
Return the cropped image as an RGBA array
This function is a tremendous improvement over my previous one, which checked the position of every pixel to see if it was inside or outside of the circle, but I still feel like it could be sped up further.
Is there a way I could check maybe half of the y-values instead of all of them, and mirror across the circle? Is there an actual cropping function I could use instead? Any and all help is much appreciated!
Edited to add some copy-paste-run code (thanks #lukeA):
My original cropping method:
circ = function(a){
# First part of the function finds the radius of the circle and crops the image accordingly
xc = floor(dim(a[,,1])[2]/2) # X coordinate of the center
yc = floor(dim(a[,,1])[1]/2) # Y coordinate of the center
r = min(xc, yc) - 1 # Radius is the smaller of the two -1 to avoid reading nonexistent data
ma = array(data = c(a[,,1][(yc-r):(yc+r),(xc-r):(xc+r)], # Read in the cropped image
a[,,2][(yc-r):(yc+r),(xc-r):(xc+r)], # Of dimensions 2r x 2r, centered
a[,,3][(yc-r):(yc+r),(xc-r):(xc+r)], # Around (xc, yc)
rep(1,length(a[,,1][(yc-r):(yc+r),(xc-r):(xc+r)]))), # Add fourth alpha layer
dim = c(length((yc-r):(yc+r)),length((xc-r):(xc+r)),4))
if(yc > xc) yc = xc else if(xc > yc) xc = yc # Re-evaluate your center for the cropped image
xmax = dim(ma[,,1])[2]; ymax = dim(ma[,,1])[1] # Find maximum x and y values
# Second part of the function traces circle by the parametric eqn. and makes outside pixels transparent
for(y in 1:ymax){ # For every y in the cropped image
theta = asin((y - yc) / r) # y = yc + r * sin(theta) by parametric equation for a circle
x = xc + r * cos(theta) # Then we can find the exact x coordinate using the same formula
x = which.min(abs(1:xmax - x)) # Find which x in array is closest to exact coordinate
if(!x - xc == 0 && !xmax - x == 0){ # If you're not at the "corners" of the circle
ma[,,4][y,c(1:(xmax-x), (x+1):xmax)] = 0 # Make pixels on either side of the circle trans.
} else if(!xmax - x == 0) ma[,,4][y,] = 0 # This line makes tops/bottoms transparent
}
return(ma)
}
library(jpeg)
a = readJPEG("http://1.bp.blogspot.com/-KYvXCEvK9T4/Uyv8xyDQnTI/AAAAAAAAHFY/swaAHLS-ql0/s1600/pink-smiley-face-balls-laughing-HD-image-for-faacebook-sharing.jpg")
par(bg = "grey"); plot(1:2, type="n") # Color background to check transparency
rasterImage(circ(a),1,1,2,2)
Modified version (thanks #dww):
dwwcirc = function(a){
# First part of the function finds the radius of the circle and crops the image accordingly
xc = floor(dim(a[,,1])[2]/2) # X coordinate of the center
yc = floor(dim(a[,,1])[1]/2) # Y coordinate of the center
r = min(xc, yc) - 1 # Radius is the smaller of the two -1 to avoid reading nonexistent data
ma = array(data = c(a[,,1][(yc-r):(yc+r),(xc-r):(xc+r)], # Read in the cropped image
a[,,2][(yc-r):(yc+r),(xc-r):(xc+r)], # Of dimensions 2r x 2r, centered
a[,,3][(yc-r):(yc+r),(xc-r):(xc+r)], # Around (xc, yc)
rep(1,length(a[,,1][(yc-r):(yc+r),(xc-r):(xc+r)]))), # Add fourth alpha layer
dim = c(length((yc-r):(yc+r)),length((xc-r):(xc+r)),4))
if(yc > xc) yc = xc else if(xc > yc) xc = yc # Re-evaluate your center for the cropped image
xmax = dim(ma[,,1])[2]; ymax = dim(ma[,,1])[1] # Find maximum x and y values
x = rep(1:xmax, ymax) # Vector containing all x values
y = rep(1:ymax, each=xmax) # Value containing all y values
r2 = r^2
ma[,,4][which(( (x-xc)^2 + (y-yc)^2 ) > r2)] = 0
return(ma)
}
library(jpeg)
a = readJPEG("http://1.bp.blogspot.com/-KYvXCEvK9T4/Uyv8xyDQnTI/AAAAAAAAHFY/swaAHLS-ql0/s1600/pink-smiley-face-balls-laughing-HD-image-for-faacebook-sharing.jpg")
par(bg = "grey"); plot(1:2, type="n") # Color background to check transparency
rasterImage(dwwcirc(a),1,1,2,2)
Version using magick and plotrix (thanks #lukeA and #hrbrmstr):
library(plotrix)
jpeg(tf <- tempfile(fileext = "jpeg"), 1000, 1000)
par(mar = rep(0,4), yaxs="i", xaxs = "i")
plot(0, type = "n", ylim = c(0, 1), xlim = c(0,1), axes=F, xlab=NA, ylab=NA)
draw.circle(.5,.5,.5,col="black")
dev.off()
library(magick)
img = image_read("http://1.bp.blogspot.com/-KYvXCEvK9T4/Uyv8xyDQnTI/AAAAAAAAHFY/swaAHLS-ql0/s1600/pink-smiley-face-balls-laughing-HD-image-for-faacebook-sharing.jpg")
mask = image_read(tf)
radius = min(c(image_info(img)$width, image_info(img)$height))
mask = image_scale(mask, as.character(radius))
par(bg = "grey"); plot(1:2, type="n")
rasterImage(as.raster(image_composite(image = mask, composite_image = img, operator = "plus")),1,1,2,2)
I dunno about "efficiency", but I would not reinvent the wheel here. Like suggested in the comments by #hrbrmstr, you may wanna try magick, which gives you all the flexibility you might need:
png(tf <- tempfile(fileext = ".png"), 1000, 1000)
par(mar = rep(0,4), yaxs="i", xaxs="i")
plot(0, type = "n", ylim = c(0,1), xlim=c(0,1), axes=F, xlab=NA, ylab=NA)
plotrix::draw.circle(.5,0.5,.5, col="black")
dev.off()
library(magick)
fn <- "https://www.gravatar.com/avatar/f57aba01c52e5c67696817eb87df84f2?s=328&d=identicon&r=PG&f=1"
img <- image_read(fn)
mask <- image_read(tf)
mask <- image_scale(mask, as.character(image_info(img)$width))
Now
img
mask
image_composite(mask, img, "plus")
image_composite(mask, img, "minus")
Some other composite operators:
# https://www.imagemagick.org/Magick++/Enumerations.html#CompositeOperator
ops <- c("over", "in", "out", "atop", "xor", "plus", "minus", "add", "difference", "multiply")
for (op in ops) {
print(image_composite(img, mask, op))
print(op)
readline()
}
You can improve the performance of your circ function if you do a vectorised subset-assign operation on your array (instead of looping) using the the fact that (x-xc)^2 +(y-yc)^2 > r^2 for points outside a circle.
To do this, replace the 2nd part of your function with
# Second part of the function traces circle by...
x = rep(1:xmax, ymax)
y = rep(1:ymax, each=xmax)
r2 = r^2
ma[,,4][which(( (x-xc)^2 + (y-yc)^2 ) > r2)] <- 0
return(ma)
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.
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.