I am trying to transform an image (represented as a matrix) in R, into polar coordinate space with the origin being 0,0 (top left corner). Given the 215x215 matrix x which looks like:
x0 = as.vector(col(x))
y0 = as.vector(row(x))
r = sqrt( (x0^2) + (y0^2) )#x
a = atan(y0/x0)#y
m = as.matrix(data.frame(y=a, x=r))
m = round(m)
m[m>215] = NA
m[m==0] = NA
xn = x[m]
xn = matrix(xn, 215, 215)
However, xn just looks like:
When I expect this:
Any idea what i'm doing wrong?
There is a problem with the angle: atan returns an angle in radians.
if you round it, there is not much information left...
Try with:
a = atan(y0/x0) * 215 / (pi/2)
It is not the image you expect, which is apparently the inverse transformation,
with the center in the middle of the image.
# Load the image
library(png)
library(RCurl)
d <- readPNG( getBinaryURL( "http://i.stack.imgur.com/rMR3C.png" ) )
image(d, col=gray(0:255/255))
# Origin for the polar coordinates
x0 <- ncol(d)/2
y0 <- nrow(d)/2
# The value of pixel (i,j) in the final image
# comes from the pixel, in the original image,
# with polar coordinates (r[i],theta[i]).
# We need a grid for the values of r and theta.
r <- 1:ceiling(sqrt( max(x0,nrow(d))^2 + max(y0,ncol(d))^2))
theta <- -pi/2 + seq(0,2*pi, length = 200)
r_theta <- expand.grid(r=r, theta=theta)
# Convert those polar coordinates to cartesian coordinates:
x <- with( r_theta, x0 + r * cos(theta) )
y <- with( r_theta, y0 + r * sin(theta) )
# Truncate them
x <- pmin( pmax( x, 1 ), ncol(d) )
y <- pmin( pmax( y, 1 ), nrow(d) )
# Build an empty matrix with the desired size and populate it
r <- matrix(NA, nrow=length(r), ncol=length(theta))
r[] <- d[cbind(x,y)]
image(r, col=gray(0:255/255))
Related
I am trying to replicate the following visual with the following Matlab code:
% Pumpkin
[X,Y,Z]=sphere(200);
R=1-(1-mod(0:.1:20,2)).^2/12;
x=R.*X; y=R.*Y; z=Z.*R;
c=hypot(hypot(x,y),z)+randn(201)*.03;
surf(x,y,(.8+(0-(1:-.01:-1)'.^4)*.3).*z,c, 'FaceColor', 'interp', 'EdgeColor', 'none')
% Stem
s = [ 1.5 1 repelem(.7, 6) ] .* [ repmat([.1 .06],1,10) .1 ]';
[t, p] = meshgrid(0:pi/15:pi/2,0:pi/20:pi);
Xs = -(.4-cos(p).*s).*cos(t)+.4;
Zs = (.5-cos(p).*s).*sin(t) + .55;
Ys = -sin(p).*s;
surface(Xs,Ys,Zs,[],'FaceColor', '#008000','EdgeColor','none');
% Style
colormap([1 .4 .1; 1 1 .7])
axis equal
box on
material([.6 1 .3])
lighting g
camlight
I am working on the bottom but have not gotten very far (see here for reference). The code that I have is:
library(pracma)
library(rgl)
sphere <- function(n) {
dd <- expand.grid(theta = seq(0, 2*pi, length.out = n+1),
phi = seq(-pi, pi, length.out = n+1))
with(dd,
list(x = matrix(cos(phi) * cos(theta), n+1),
y = matrix(cos(phi) * sin(theta), n+1),
z = matrix(sin(phi), n+1))
)
}
# Pumpkin
sph<-sphere(200)
X<-sph[[1]]
Y<-sph[[2]]
Z<-sph[[3]]
R<- 1-(1-seq(from=0, to=20,by=0.1))^2/12
x<-R * X
y<-R * Y
z<-Z * R
c<-hypot(hypot(x,y),z)+rnorm(201)*0.3
persp3d(x,y,(0.8+(0-seq(from=1, to=-1, by=-0.01)^4)*0.3)*z,col=c)
and it gives me the following.
What is it that's going wrong in my present code? What would be a suggested fix?
As #billBokeey mentioned, there's a missing mod modulo operator function for periodic scaling factors.
In addition, the scaling on the z-axis 0.8 + (0-seq(from=1, to=-1, by=-0.01)^4) * 0.3 doesn't go well with the output from your sphere function. We maybe use Z[1,] to replace seq(from=1, to=-1, by=-0.01). phi = seq(-pi, pi, length.out = n+1)) shoud be seq(-pi/2, pi/2, length.out = n+1)) instead.
Finally, the color c needs to be convert to RGB code for persp3d.
Here's the result look like from the code below.
library(rgl)
sphere <- function(n) {
dd <- expand.grid(theta = seq(0, 2*pi, length.out = n+1),
phi = seq(-pi/2, pi/2, length.out = n+1))
with(dd,
list(x = matrix(cos(phi) * cos(theta), n+1),
y = matrix(cos(phi) * sin(theta), n+1),
z = matrix(sin(phi), n+1))
)
}
# Unit ball
sph <- sphere(200)
X <- sph[[1]]
Y <- sph[[2]]
Z <- sph[[3]]
# scaling
R <- 1 - (1 - seq(from=0, to=20, by=0.1) %% 2) ^ 2 / 12 # Modulo Operator %%
R2 <- 0.8 + (0 - seq(from=1, to=-1, by=-0.01)^4)*0.2 # didn't match with the order of z from sphere function
#R2 <- 0.8 - Z[1,]^4 * 0.2
x <- R * X # scale rows for wavy side
y <- R * Y # scale rows for wavy side
z <- t(R2 * t(Z)) # scale columns by transpose for flat oval shape
# color according to distance to [0,0,0]
hypot_3d <- function(x, y, z) {
return(sqrt(x^2 + y^2 + z^2))
}
c_ <- hypot_3d(x,y,z) + rnorm(201) * 0.03
color_palette <- terrain.colors(20) # color look-up table
col <- color_palette[ as.numeric(cut(c_, breaks = 20)) ] # assign color to 20 levels of c_
persp3d(x, y, z, color = col, aspect=FALSE)
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)
f(x,y)= (1/25)*(20-x)/x 10<x<20, x/2 <y <x
0 o.t
I have to create this image through this expression.
but
x <- seq(10, 20, length=20)
y <- seq(10, 20, length=20)
f <- function(x,y){(1/25)*(20-x)/5}
z <- outer(x,y,f)
persp(x,y,z,theta=30,phi=30, expand=0.5,col=rainbow(19), border=NA)
what is wrong?
You should mask z based on the constraint. As a suggestion, you can use an amazing interactive rgl package in R.
#source: https://stackoverflow.com/questions/50079316/plot3d-how-to-change-z-axis-surface-color-to-heat-map-color
map2color <- function(x, pal, limits = range(x,na.rm=T)){
pal[findInterval(x, seq(limits[1], limits[2], length.out = length(pal) + 1),
all.inside=TRUE)]
}
x <- seq(10, 20, length=20)
y <- seq(10, 20, length=20)
mask <- sapply(x,function(m) sapply(y,function(n) if((n>m/2)&(n<m)){(1/25)*(20-m)/5}else{ NA }))
z <- outer(x,y,f)
z <- z * mask
#persp(x,y,z, col= map2color(z, rainbow(100)),border = NA)
library(rgl)
persp3d(x,y,z,col = map2color(z, rainbow(100)),theta=30,phi=30)
#SRhm's answer is probably the best choice, but if you want to live on the bleeding edge, you can get rid of the jagged diagonal edge using a development version of rgl (from R-forge), at least version 0.100.8.
This version supports triangulations with boundaries using the tripack package. So you set up a grid of values over the x-y range, then define the boundaries of the region using the equations, and you get smooth edges. For example:
library(tripack)
library(rgl)
g <- expand.grid(x=10:20, y=5:20)
keep <- with(g, 10 < x & x < 20 & x/2 < y & y < x)
g2 <- g[keep,]
tri <- tri.mesh(g2)
# Set up boundary constraints
cx <- c(10:20, 20: 10)
cy <- c(seq(5, 10, len=11), 20:10)
tri2 <- add.constraint(tri, cx, cy, reverse = TRUE)
# This isn't necessary, but shows where the formula will be evaluated
plot(tri2)
It might be better to fill in some of the left and right edges with more points to avoid those big triangles,
but skip that for now.
z <- with(tri2, (1/25)*(20-x)/x)
# Now plot it, using the map2color function #SRhm found:
#source: https://stackoverflow.com/questions/50079316/plot3d-how-to-change-z-axis-surface-color-to-heat-map-color
map2color <- function(x, pal, limits = range(x,na.rm=T)){
pal[findInterval(x, seq(limits[1], limits[2], length.out = length(pal) + 1),
all.inside=TRUE)]
}
persp3d(tri2, z, col = map2color(z, rainbow(100)))
After rotation, you get this view:
I'm just playing around with the image of circles under the complex map exp(z).
I couldn't find a built in R function to generate the points on a circle of given radius so I wrote one myself (integrating the equations of motion numerically):
# Integration points:
N <- 10000
e <- 0.001
dt <- seq(0, e*(N-1), by=e)
Rp = pi # radius of point circle
Rv = pi # radius of vector circle
# Initial conditions:
px <- c(Rp)
py <- c(0)
vx <- c(0)
vy <- c(Rv)
Rp <- c()
Rv <- c()
ax <- c()
ay <- c()
for (i in(2:N)) {
Rp[i-1] <- sqrt(px[i-1]^2 + py[i-1]^2)
Rv[i-1] <- sqrt(vx[i-1]^2 + vy[i-1]^2)
ax[i-1] <- -(Rv[i-1]^2/Rp[i-1]^2)*px[i-1] # acceleration toowards
ay[i-1] <- -(Rv[i-1]^2/Rp[i-1]^2)*py[i-1] # center of circle
px[i] <- px[i-1] + e*vx[i-1] # dp_x = epsilon * v_x
py[i] <- py[i-1] + e*vy[i-1] # dp_y = epsilon * v_y
vx[i] <- vx[i-1] + e*ax[i-1] # dv_x = epsilon * a_x
vy[i] <- vy[i-1] + e*ay[i-1] # dv_y = epslon * a_y
}
complex(real=px,imaginary=py)
This seems like a lot of work just to get a circle, and the program is slow. Is there a built in R function to do this for me?
par(mfrow=c(1,2))
plot(cbind(px,py))
plot(exp(zs))
Thanks!
Parameterize on angle:
circle_xy = function(n, r, close_loop = FALSE) {
theta = seq(0, 2 * pi, length.out = n + 1)
if(!close_loop) theta = theta[-(n + 1)]
cbind(x = r * cos(theta), y = r * sin(theta))
}
Gives x-y coords for n evenly spaced points on a circle of radius r. If close_loop = TRUE, the first point is repeated at the end. Takes about 0.2 seconds to generate 1MM points on my laptop.
And there is plot.formula function that would take that to an instantiation:
plot( y ~ x, data = xy<- circle_xy(100,1), type="l")
I would like to achieve that the points I add to the plot have their size adjusted to obtain a better 3D impression. I know that I somehow have to use the transformation matrix that is returned to compute the length of the vector orthogonal to the 2d plane to the respective point in 3d, but I don't know how to do that.
Here is an example:
x1 <- rnorm(100)
x2 <- 4 + rpois(100, 4)
y <- 0.1*x1 + 0.2*x2 + rnorm(100)
dat <- data.frame(x1, x2, y)
m1 <- lm(y ~ x1 + x2, data=dat)
x1r <- range(dat$x1)
x1seq <- seq(x1r[1], x1r[2], length=30)
x2r <- range(dat$x2)
x2seq <- seq(x2r[1], x2r[2], length=30)
z <- outer(x1seq, x2seq, function(a,b){
predict(m1, newdata=data.frame(x1=a, x2=b))
})
res <- persp(x1seq, x2seq, z)
mypoints <- trans3d(dat$x1, dat$x2, dat$y, pmat=res)
points(mypoints, pch=1, col="red")
You can use the function presented here to determine distance to the observer, then scale the pointsize (cex) to that distance:
# volcano data
z <- 2 * volcano # Exaggerate the relief
x <- 10 * (1:nrow(z)) # 10 meter spacing (S to N)
y <- 10 * (1:ncol(z)) # 10 meter spacing (E to W)
# draw volcano and store transformation matrix
pmat <- persp(x, y, z, theta = 35, phi = 40, col = 'green4', scale = FALSE,
ltheta = -120, shade = 0.75, border = NA, box = TRUE)
# take some xyz values from the matrix
s = sample(1:prod(dim(z)), size=500)
xx = x[row(z)[s] ]
yy = y[col(z)[s]]
zz = z[s] + 10
# depth calculation function (adapted from Duncan Murdoch at https://stat.ethz.ch/pipermail/r-help/2005-September/079241.html)
depth3d <- function(x,y,z, pmat, minsize=0.2, maxsize=2) {
# determine depth of each point from xyz and transformation matrix pmat
tr <- as.matrix(cbind(x, y, z, 1)) %*% pmat
tr <- tr[,3]/tr[,4]
# scale depth to point sizes between minsize and maxsize
psize <- ((tr-min(tr) ) * (maxsize-minsize)) / (max(tr)-min(tr)) + minsize
return(psize)
}
# determine distance to eye
psize = depth3d(xx,yy,zz,pmat,minsize=0.1, maxsize = 1)
# from 3D to 2D coordinates
mypoints <- trans3d(xx, yy, zz, pmat=pmat)
# plot in 2D space with pointsize related to distance
points(mypoints, pch=8, cex=psize, col=4)