I am attempting to map a panoramic image into polar coordinates using imageR, but get strange results.
As an example, I would like to take a square panorama like this one (courtesy of Flickr user gadl (Alexandre Duret-Lutz) under CC BY-NC-SA and edited into a square):
And remap it to something like this (which I've done in GIMP):
I've gotten pretty close in imageR with this code:
library(imager)
pano <- mirror(load.image("pano_image.jpg"), "y") # mirroring the image to map to center
map.shift <- function(x,y) list(x = y*cos(x), y = y*sin(x)) # Here, y is the radius and x is theta
polar_pano <- imwarp(pano, map = map.shift)
plot(polar_pano)
But I get the strange result:
I'm not sure why it is only mapping into one quadrant? (Note: I realize that the interpolation will be strange in this example--that is not the issue).
To confirm that this should work, here is a toy example:
library(ggplot)
test <- data.frame("val" = rep(100:1, each = 99), theta = rep(1:100, 99), r = rep(1:100, each = 99))
ggplot(test, aes(x = theta, y = r, col = val)) + geom_point()
# Now converting from polar to cartesian
test$x <- test$r*cos(test$theta)
test$y <- test$r*sin(teast$theta)
ggplot(test_p2c, aes(x = x, y = y, col = val)) + geom_point()
Your result only has one quadrant because the resulting transformation has both negative and positive values.
In your function, the result's top left is (-400, -400) and the bottom right is (400, 400). Halve and add 200 to make it (0, 0) and (400, 400).
Scale the trig parameters to go from -pi to pi.
For the bottom of the original image to become the center of the resulting circle, x needs to be the variable inside the trig functions.
library(imager)
pano <- load.image("pano_image.jpg")
pano <- mirror(load.image("pano_image.jpg"), "y")
map_shift <- function(x, y) {
list(
x = y * cos((x - 200) / 400 * 2 * pi) / 2 + 200,
y = y * sin((x - 200) / 400 * 2 * pi) / 2 + 200
)
}
polar_pano <- imwarp(pano, map = map_shift)
plot(polar_pano)
Related
The examples clearly show that geom_spoke draws lines originating at (x, y) of length radius pointing in the direction specified by angle:
ggplot(df, aes(x, y)) + geom_point() + geom_spoke(aes(angle = angle), radius = 0.5)
What is the simplest reusable way to center the spokes around (x, y)?
I prefer not to modify my data for it (that would be less easily reusable) or do inline trigonometry (also less reusable). I don’t mind if “radius” becomes “diameter” in the solution.
I think the easiest way to do this is going through the whole process of creating a Position subclass like e.g. in position_nudge
position_center_spoke <- function() PositionCenterSpoke
PositionCenterSpoke <- ggplot2::ggproto('PositionCenterSpoke', ggplot2::Position,
compute_panel = function(self, data, params, scales) {
# xend/yend is computed by this point, so shortcut!
data$x <- 2*data$x - data$xend
data$y <- 2*data$y - data$yend
#data$x <- data$x - data$radius*cos(data$angle)
#data$y <- data$y - data$radius*sin(data$angle)
# After shifting, the spoke needs to have diameter length,
# but I’m not sure if the radius is still used anywhere.
data$radius <- 2*data$radius
# Now the scales would need to be retrained,
# But compute_panel doesn’t allow that and
# compute_layer “should not be overridden”
data
}
)
Now you can easily use it:
expand.grid(x = 1:10, y=1:10) %>%
mutate(angle = runif(100, 0, 2*pi), speed = runif(100, 0, sqrt(0.1 * x))) %>%
ggplot(aes(x, y)) +
geom_point() +
geom_spoke(aes(angle = angle, radius = speed), position = 'center_spoke')
I am trying to calculate triangle area of pair of running points (X1, Y1,…. Xn, Yn) with a fix point (Cx,Cy) but without success. Can someone tell me please what is the problem so I can try to solve it?
Script:
library(ggplot2)
nElem <- 100
xData <- as.data.frame(seq(1,nElem,5))
yData <- as.data.frame(seq(5,nElem,5))
xyDATA<- cbind(xData,yData)
colnames(xyDATA) <- c("xCoord","yCoord")
Cx <- 10
Cy <- 1
ggplot(xyDATA) + geom_point(aes(x = xCoord, y = yCoord)) + geom_point(aes(x = Cx, y = Cy),colour="red",size=4)
for(i in 1:19)
{
Ax <- xyDATA[i,1]
Ay <- xyDATA[i,2]
Bx <- xyDATA[i+1,1]
By <- xyDATA[i+1,2]
s <- abs(0.5*((Ax*(By-Cy))+(Bx*(Cy-Ay))+(Cx*(Ay-By))))
# print(Ax)
# print(Ay)
# print(Bx)
# print(By)
print(s)
}
If you don't see the point graph drawn then you should modify ggplot line like:
p <- ggplot(xyDATA) + geom_point(aes(x = xCoord, y = yCoord)) +
geom_point(aes(x = Cx, y = Cy),colour="red",size=4)
print(p)
The print() method for the graph object produces the actual display.
Now the image is shown as:
For reasons I won't go into I need to plot a vertical normal curve on a blank ggplot2 graph. The following code gets it done as a series of points with x,y coordinates
dfBlank <- data.frame()
g <- ggplot(dfBlank) + xlim(0.58,1) + ylim(-0.2,113.2)
hdiLo <- 31.88
hdiHi <- 73.43
yComb <- seq(hdiLo, hdiHi, length = 75)
xVals <- 0.79 - (0.06*dnorm(yComb, 52.65, 10.67))/0.05
dfVertCurve <- data.frame(x = xVals, y = yComb)
g + geom_point(data = dfVertCurve, aes(x = x, y = y), size = 0.01)
The curve is clearly discernible but is a series of points. The lines() function in basic plot would turn these points into a smooth line.
Is there a ggplot2 equivalent?
I see two different ways to do it.
geom_segment
The first uses geom_segment to 'link' each point with its next one.
hdiLo <- 31.88
hdiHi <- 73.43
yComb <- seq(hdiLo, hdiHi, length = 75)
xVals <- 0.79 - (0.06*dnorm(yComb, 52.65, 10.67))/0.05
dfVertCurve <- data.frame(x = xVals, y = yComb)
library(ggplot2)
ggplot() +
xlim(0.58, 1) +
ylim(-0.2, 113.2) +
geom_segment(data = dfVertCurve, aes(x = x, xend = dplyr::lead(x), y = y, yend = dplyr::lead(y)), size = 0.01)
#> Warning: Removed 1 rows containing missing values (geom_segment).
As you can see it just link the points you created. The last point does not have a next one, so the last segment is removed (See the warning)
stat_function
The second one, which I think is better and more ggplotish, utilize stat_function().
library(ggplot2)
f = function(x) .79 - (.06 * dnorm(x, 52.65, 10.67)) / .05
hdiLo <- 31.88
hdiHi <- 73.43
yComb <- seq(hdiLo, hdiHi, length = 75)
ggplot() +
xlim(-0.2, 113.2) +
ylim(0.58, 1) +
stat_function(data = data.frame(yComb), fun = f) +
coord_flip()
This build a proper function (y = f(x)), plot it. Note that it is build on the X axis and then flipped. Because of this the xlim and ylim are inverted.
I have data that is computed on a 2D polar mesh:
# The mesh created is in two dimensions: r and theta.
# Mesh steps in theta are regular, while mesh steps in r are more refined
# close to the origin
nb.theta <- 50
theta.max <- 130
theta <- seq(0, theta.max, length.out = nb.theta)
nb.r <- 80
# r goes from r0 to rMax
q0 <- 1.1
z <- seq(1, nb.r)
rMax <- 30
r0 <- rMax / (q0 ^ nb.r - 1)
r <- r0 * (q0 ^ z - 1)
# Now let's add some data
mesh <- as.data.frame(expand.grid(r = r, theta = theta))
mesh$value <- mesh$r * mesh$theta / theta.max
Now, I want to plot the mesh in R (preferably with ggplot2). I tried:
ggplot(mesh, aes(r, theta, color = value)) + geom_point() + coord_polar(theta = "y")
But the result is far from satisfactory:
Ideally, I would like to have cells filled and not just points. I also would like the plot not to be a full circle: I only have data from 0 to 130 degrees.
Is this possible?
This should solve the circle issue:
ggplot(mesh, aes(r, theta, color = value)) +
geom_point() +
coord_polar(theta = "y") +
scale_y_continuous(limits=c(0,360))
We can use geom_tile rather than geom_point so that we fill the mesh. We need to calculate the width of each window. Here I've just set it to r/10 which is approximately correct. You will be able to calculate it exactly.
Adding ylim ensures that only part of the circle is filled.
mesh <- expand.grid(r = r, theta = theta)
mesh$value <- mesh$r * mesh$theta / theta.max
mesh$width <- mesh$r/10
ggplot(mesh, aes(r, theta, fill = value, width = width)) +
geom_tile() +
coord_polar(theta = "y") +
ylim(0, 360)
NB expand.grid returns a data.frame, so we don't need to convert it.
Given family of functions f(x;q) (x is argument and q is parameter) I'd like to visulaize this function family on x taking from the interval [0,1] for 9 values of q (from 0.1 to 0.9). So far my solution is:
f = function(p,q=0.9) {1-(1-(p*q)^3)^1024}
x = seq(0.0,0.99,by=0.01)
q = seq(0.1,0.9,by=0.1)
qplot(rep(x,9), f(rep(x,9),rep(q,each=100)), colour=factor(rep(q,each=100)),
geom="line", size=I(0.9), xlab="x", ylab=expression("y=f(x)"))
I get quick and easy visual with qplot:
My concern is that this method is rather memory hungry as I need to duplicate x for each parameter and duplicate each parameter value for whole x range. What would be alternative way to produce same graph without these duplications?
At some point ggplot will need to have the data available to plot it and the way that package works prohibits simply doing what you want. I suppose you could set up a blank plot if you know the x and y axis limits, and then loop over the 9 values of q, generating the data for that q, and adding a geom_line layer to the existing plot object. However, you'll have to produce the colours for each layer yourself.
If this is representative of the size of problem you have, I wouldn't worry too much about the memory footprint. We're only talking about a two vectors of length 900
> object.size(rnorm(900))
7240 bytes
and the 100 values over the range of x appears sufficient to give a smooth plot.
for loop to add layers to ggplot
require("ggplot2")
## something to replicate ggplot's colour palette, sure there is something
## to do this already in **ggplot** now...
ggHueColours <- function(n, h = c(0, 360) + 15, l = 65, c = 100,
direction = 1, h.start = 0) {
turn <- function(x, h.start, direction) {
(x + h.start) %% 360 * direction
}
if ((diff(h) %% 360) < 1) {
h[2] <- h[2] - 360 / n
}
hcl(h = turn(seq(h[1], h[2], length = n), h.start = h.start,
direction = direction), c = c, l = l)
}
f = function(p,q=0.9) {1-(1-(p*q)^3)^1024}
x = seq(0.0,0.99,by=0.01)
q = seq(0.1,0.9,by=0.1)
cols <- ggHueColours(n = length(q))
for(i in seq_along(q)) {
df <- data.frame(y = f(x, q[i]), x = x)
if(i == 1) {
plt <- ggplot(df, aes(x = x, y = y)) + geom_line(colour = cols[i])
} else {
plt <- plt + geom_line(data = df, colour = cols[i])
}
}
plt
which gives:
I'll leave the rest to you - I'm not familiar enough with ggplot to draw a legend manually.