I have acquired some data at a fixed distance R and for various theta (from the vertical axis) and phi (from the x axis) angles so to obtain a 3D representation of the quantity of interest. Please note that while phi spans 360°, theta only spans from 70° to 90°.
I know how to generate a 3D plot with the plot3D package (namely, the persp3D function) or a contour plot, but I would like to draw such contours over a sphere using the theta and phi angles information.
Would you please point me to the appropriate online resource where I can find a suitable solution?
Many thanks and kind regards
Nicola
This isn't exactly a 3d representation (e.g. in rgl), but maybe it gets you started:
library(maps)
library(mapproj)
library(akima)
set.seed(11)
n <- 500
x <- runif(n, min=-180,max=180)
y <- runif(n, min=-90,max=90)
z <- x^2+y^3
PARAM <- NULL
PROJ <- "orthographic"
ORIENT <- c(45,15,0)
XLIM <- c(-180, 180)
YLIM <- c(-90, 90)
nlevels=20
pal <- colorRampPalette(
c("purple4", "blue", "cyan", "yellow", "red", "pink"))
map("world", col=NA, param=PARAM, proj=PROJ, orient=ORIENT, xlim=XLIM, ylim=YLIM)
P <- mapproject(x,y)
incl <- which(!is.na(P$x))
Field <- interp(P$x[incl],P$y[incl],z[incl],
xo=seq(min(P$x[incl]), max(P$x[incl]), length = 100),
yo=seq(min(P$y[incl]), max(P$y[incl]), length = 100)
)
image(Field, add=TRUE, col=pal(nlevels))
points(P$x, P$y, pch=".", cex=2, col=4)
Cont <- contour(Field, add=TRUE, n=nlevels, col="white")
lines(sin(seq(0,2*pi,,100)), cos(seq(0,2*pi,,100)), lwd=3)
Related
How do I make this map and its points align with my image?
[1]: https://i.stack.imgur.com/d6WRc.png
earth <- file.choose()
earth <- readJPEG(earth, native=TRUE)
par(mar=c(360,360,360,360))
grid.raster(earth)
maps:: map(add=TRUE)
points(x=cldrd$longitude, y=cldrd$latitude, col=c("magenta"), cex=(.7), pch=16)
points(x=outlrd$longitude, y=outlrd$latitude, col=c("black"), cex=(.2), pch=16)
inter <- gcIntermediate(c(10.451526,51.165691), c(-96.8410503,32.8143702), n=100, addStartEnd=TRUE, breakAtDateLine=F)
lines(inter, col=c("#00ffbf"), lwd=.05)
Read the image and georeference it (it would be preferable to start with georeferenced data, there is plenty to go around)
library(terra)
f <- "https://i.stack.imgur.com/d6WRc.png"
earth <- rast(f)
# eyeballing
ext(earth) <- c(-180, 180, -145, 145)
plotRGB(earth)
The image is so dark, that I figured I should add some lines for orientation
w <- geodata::world(path=".")
lines(w, col="gray")
Now your coordinates
crds <- rbind(c(10.451526,51.165691), c(-96.8410503,32.8143702))
points(crds, pch=20, col="red", cex=2)
library(geosphere)
inter <- gcIntermediate(crds[1,], crds[2,], n=100, addStartEnd=TRUE)
lines(inter, col="#00ffbf", lwd=2)
Hy there,
I use persp for a 3D-Plot and i am try to find out how persp define the ticks when the parameter ticktype="detailed" is set.
I want to draw lines into the box around a surface corresponding to the ticks. Up till now, frist I draw the surface without any labels and axes and add all lines and axes afterwords. To make it clear what I have done -> example code:
z <- matrix(rep(1:10, each=10), nrow=10, ncol=10)
x.axis <- 1:nrow(z)
y.axis <- 1:ncol(z)
max.y <- max(y.axis)
# Drawing the surface without the axes and no lines on the surface
pmat <- persp(z = z, x = x.axis, y = y.axis ,
lphi = 100, phi = 25, theta = -30,
axes=F,
border = NA, # no lines on the surface
col="deepskyblue",
expand = 0.5,
shade = 0.65)
Now I add the the lines on the surface with different color and the axes with ticks and labels:
par(new=T)
pmat <- persp(z = z, x = x.axis, y = y.axis ,
lphi = 100, phi = 25, theta = -30,
ticktype = "detailed",
expand = 0.5,
cex.lab=0.75,
col=NA,
border="grey80")
par(new=F)
To get lines on the box around the surface I use the following:
for (z_high in c(2,4,6,8)) {
lines(trans3d(x.axis, max.y, z_high, pmat) , col="black", lty=3)
}
As you can see, I use a own defined vector c(2,4,6,8) which represents the z-values for the box lines in the back. If the input surface now changes, I have to adapted this vector by my own. Is there a way to get the ticks for all axes in the persp plot? Did anyone know how persp define the ticks?
What is the easiest way in Rstudio to plot the 3D parametrization
g(t)=(cos(t)^2-0.5,sin(t)*cos(t),sin(t))
After I want to find values t1 and t2, for which g(t1)=g(t2) (hence I want to find self intersection)
Also how can i make a 2D of this parametrization
g(t)=((1+2*cos(t))*cos(t),(1+2*cos(t))*sin(t))
Regards,
s
Here is a solution for your 3D parametrization problem:
t <- seq(0, 2*pi, length.out=200)
gt <- data.frame(x=cos(t)^2-0.5, y=sin(t)*cos(t), z=sin(t))
library(plotly)
plot_ly(x=~x, y=~y, z=~z, data=gt, type="scatter3d", mode="lines")
For your 2D parametrization:
t <- seq(0, 2*pi, length.out=200)
gt <- data.frame(x=(1+2*cos(t))*cos(t),y=(1+2*cos(t))*sin(t))
plot(gt$x, gt$y, type="l", asp=1, xlab="x", ylab="y")
I've found a way to plot 3D bar chart (ggplot2 3D Bar Plot). Thank you #jbaums
However, is there a way to change the bottom facet to a map? So I can clearly visualize, for example, the population density using bar chart on a map to show the differences between different parts? Thank you in advance. plotting 3D bars on top of the map
Here's one way
# Plotting 3D maps using OpenStreetMap and RGL. For info see:
# http://geotheory.co.uk/blog/2013/04/26/plotting-3d-maps-with-rgl/
map3d <- function(map, ...){
if(length(map$tiles)!=1){stop("multiple tiles not implemented") }
nx = map$tiles[[1]]$xres
ny = map$tiles[[1]]$yres
xmin = map$tiles[[1]]$bbox$p1[1]
xmax = map$tiles[[1]]$bbox$p2[1]
ymin = map$tiles[[1]]$bbox$p1[2]
ymax = map$tiles[[1]]$bbox$p2[2]
xc = seq(xmin,xmax,len=ny)
yc = seq(ymin,ymax,len=nx)
colours = matrix(map$tiles[[1]]$colorData,ny,nx)
m = matrix(0,ny,nx)
surface3d(xc,yc,m,col=colours, ...)
return(list(xc=xc, yc=yc, colours=colours))
}
require(rgl)
require(OpenStreetMap)
map <- openproj(openmap(c(52.5227,13.2974),c(52.4329,13.5669), zoom = 10))
set.seed(1)
n <- 30
bbox <- unlist(map$bbox, use.names = F)
x <- do.call(runif, c(list(n), as.list(bbox[c(1,3)])))
y <- do.call(runif, c(list(n), as.list(bbox[c(4,2)])))
z <- runif(n, 0, .1)
m <- rbind(cbind(x,y,z=0), cbind(x,y,z))
m <- m[as.vector(mapply(c, 1:n, (n+1):(2*n))),]
open3d(windowRect=c(100,100,800,600))
coords <- map3d(map, lit=F)
segments3d(m, col="red", add=T)
which gives you something like:
And another way, which you can extend to use box3D to maybe make it more look like your example:
library(plot3D)
with(coords, {
image3D(
z = 0, x = xc, y = yc, colvar = colours, zlim = c(0,max(z)),
scale=F, theta = 0, bty="n")
segments3D(x,y,rep(0,length(x)),x,y,z, col="red", add=T)
})
I'm a beginner to R and I am trying to plot a surface plot on a specific grid. Basically I have a data-set of points from across the UK containing the longitude, latitude and amount of rainfall for a particular day. Using the following code I can plot this data onto a UK map:
dat <- read.table("~jan1.csv", header=T, sep=",")
names(dat) <- c("gauge", "date", "station", "mm", "lat", "lon", "location", "county", "days")
library(fields)
quilt.plot(cbind(dat$lon,dat$lat),dat$mm)
world(add=TRUE)
So far so good. I can also perform a thin plate spline interpolation (TPS) using:
fit <- Tps(cbind(dat$lon, dat$lat), dat$mm, scale.type="unscaled")
and then I can do a surface plot at a grid scale of my choice e.g.:
surface (fit, nx=100, ny=100)
This effectively gives me a gridded data plot at the resolution of 100*100.
Following help from another user I can now extract this data in a grid by using:
xvals <- seq(-10, 4, len=20)
yvals <- seq(49, 63, len=20)
griddf <- expand.grid(xvals, yvals)
griddg <- predict(fit, x=as.matrix(griddf) )
What I would like to do now is plot the surface plot again using the same grid as the predict function (i.e. same as xvals and yvals) as above? Do you know how I can do this?
Thanks for any help
Once you have predicted your new values in griddg, you can technically re-interpolate with Tps and then proceed with the surface plot and map as before:
Example:
xvals <- seq(-10, 4, len=20)
yvals <- seq(49, 63, len=20)
griddf <- expand.grid(lon=xvals, lat=yvals)
griddg <- predict(fit, x=as.matrix(griddf) )
dat2 <- cbind(griddf, mm=griddg)
head(dat2)
fit <- Tps(cbind(dat2$lon, dat2$lat), dat2$mm, scale.type="unscaled")
surface (fit, nx=100, ny=100)
world(add=TRUE)
For more control over your maps, you could also plot your new grid directly - This is probably more correct in that the above method essentially fits your interpolation Tps twice. This method requires some external functions, but you will have more flexibility in your mapping.
#option 2
source("matrix.poly.r") #http://menugget.blogspot.de/2012/04/create-polygons-from-matrix.html
source("val2col.R") # http://menugget.blogspot.de/2011/09/converting-values-to-color-levels.html
source("image.scale.R") # http://menugget.blogspot.de/2011/08/adding-scale-to-image-plot.html
#new grid and predition
xvals <- seq(-10, 4, len=100)
yvals <- seq(49, 63, len=100)
griddf <- expand.grid(lon=xvals, lat=yvals)
griddg <- predict(fit, x=as.matrix(griddf) )
#make polygons for new grid, calculate color levels
mat <- matrix(griddg, nrow=length(xvals), ncol=length(yvals))
poly <- matrix.poly(xvals, yvals, z=mat, n=seq(mat))
pal <- colorRampPalette(c("blue", "cyan", "yellow", "red"))
COL <- val2col(mat, col=pal(100))
#required packages
library(maps)
library(mapproj)
#plot
png("tmp.png", width=5, height=4, res=400, units="in")
layout(matrix(1:2, nrow=1, ncol=2), widths=c(4,1), heights=4)
par(mar=c(1,1,1,1))
map("world", proj="stereographic", orient=c(mean(yvals),mean(xvals),0), par=NULL, t="n", xlim=range(xvals), ylim=range(yvals))
for(i in seq(poly)){
polygon(mapproject(poly[[i]]), col=COL[i], border=COL[i], lwd=0.3)
}
map("world", proj="stereographic", orient=c(mean(yvals),mean(xvals),0), par=NULL, add=T)
map.grid(col=rgb(0,0,0,0.5), labels=F)
box()
par(mar=c(5,0,5,4))
image.scale(mat, col=pal(100), horiz=FALSE, axes=FALSE, xlab="", ylab="")
axis(4)
mtext("mm", side=4, line=2.5)
box()
dev.off()