Plotting 3D maps with RGL - r

I'm trying to plot flat maps in RGL's 3d environment because it should enable maps to be custom zoomed/tilted for a projection that best suits both the data and required output image aspect. This thread describes the process for plotting images using rgl.surface(). But its not clear if this method is adaptable for OSM/other map objects. Very grateful for any ideas you may have.
This is the starting point, which fails because Error in is.matrix(z) : 'z' is missing. Any idea how I can insert some zeros for z coordinates?
require(rgl)
open3d() # R crashes if this is done later(?)
#Sys.setenv(NOAWT=1) # fix an {OSM} X11 issue in Mac
require(OpenStreetMap)
require(ggplot2)
lat <- c(53, 50); lon <- c(-5, 1)
map <- openmap(c(lat[1],lon[1]),c(lat[2],lon[2]), 5, 'osm')
map <- openproj(map)
rgl.surface(map)

You need to create a matrix of zeroes for heights and use the col= argument to surface3d to set the colour of the image.
Getting all the dimensions and ordering and all that out of the map object is a faff, so here's a function to do it:
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,...)
}
Which gives us:
Now, note it only works if there's one tile in the returned map, but the principle is there.
Also, I'm not totally convinced the coordinate alignment is exact. The coordinates may be centre of pixels or edges of the image, so maybe there's a +1 missing somewhere. And I'm not sure if it applies to the gray border or not.

Related

How to get the best polygon point pattern data in spatstat analysis in R

I have a dataset of spatial locations data. I want to do a point pattern analysis using the spatstat package in R using this data. I want the best polygon area for the analysis instead of the rectangle area. The code I have is
original_data = read.csv("/home/hudamoh/PhD_Project_Moh_Huda/Dataset_files/my_coordinates.csv")
plot(original_data$row, original_data$col)
which results in a plot that looks like this
Setting the data for point pattern data
point_pattern_data = ppp(original_data$row, original_data$col, c(0, 77), c(0, 116))
plot(point_pattern_data)
summary(point_pattern_data)
resulting in a plot that looks like this
#The observed data has considerably wide white spaces, which I want to remove for a better analysis area. Therefore, I want to make the point pattern a polygon instead of a rectangle. The vertices for the polygon are the pairs of (x,y) below to avoid white space as much as possible.
x = c(3,1,1,0.5,0.5,1,2,2.5,5.5, 16,21,28,26,72,74,76,75,74,63,58,52,47,40)
y = c(116,106,82.5,64,40,35,25,17.5,5,5,5,10,8,116,100,50,30,24,17,10,15,15,8)
I find these vertices above manually by considering the plot below (with the grid lines)
plot(original_data$row,original_data$col)
grid(nx = 40, ny = 25,
lty = 2, # Grid line type
col = "gray", # Grid line color
lwd = 2) # Grid line width
So I want to make the point pattern polygon. The code is
my_data_poly = owin(poly = list(x = c(3,1,1,0.5,0.5,1,2,2.5,5.5, 16,21,28,26,72,74,76,75,74,63,58,52,47,40), y = c(116,106,82.5,64,40,35,25,17.5,5,5,5,10,8,116,100,50,30,24,17,10,15,15,8)))
plot(my_data_poly)
but it results in an error. The error is
I fix it by
my_data_poly = owin(poly = list(x = c(116,106,82.5,64,40,35,25,17.5,5,5,5,10,8,116,100,50,30,24,17,10,15,15,8), y = c(3,1,1,0.5,0.5,1,2,2.5,5.5, 16,21,28,26,72,74,76,75,74,63,58,52,47,40)))
plot(my_data_poly)
It results in a plot
However, this is not what I want. How to get the observed area as a polygon in point pattern data analysis?
This should be a reasonable solution to the problem.
require(sp)
poly = Polygon(
cbind(original_data$col,
original_data$row)
))
This will create a polygon from your points. You can use this document to understand the sp package better
We don’t have access to the point data you read in from file, but if you just want to fix the polygonal window that is not a problem.
You need to traverse the vertices of your polygon sequentially and anti-clockwise.
The code connects the first point you give to the next etc. Your vertices are:
library(spatstat)
x = c(3,1,1,0.5,0.5,1,2,2.5,5.5, 16,21,28,26,72,74,76,75,74,63,58,52,47,40)
y = c(116,106,82.5,64,40,35,25,17.5,5,5,5,10,8,116,100,50,30,24,17,10,15,15,8)
vert <- ppp(x, y, window = owin(c(0,80),c(0,120)))
plot.ppp(vert, main = "", show.window = FALSE, chars = NA)
text(vert)
Point number 13 is towards the bottom left and 14 in the top right, which gives the funny crossing in the polygon.
Moving the order around seems to help:
xnew <- c(x[1:11], x[13:12], x[23:14])
ynew <- c(y[1:11], y[13:12], y[23:14])
p <- owin(poly = cbind(xnew, ynew))
plot(p, main = "")
It is unclear from your provided plot of the data that you really should apply point pattern analysis.
The main assumption underlying point process modelling as implemented in spatstat
is that the locations of events (points) are random and the process that
generated the random locations is of interest.
Your points seem to be on a grid and maybe you need another tool for your analysis.
Of course spatstat has a lot of functionality for simply handling and summarising data like this so you may still find useful tools in there.

Creating my own spider chart in R without using any libraries

I need to create something like a spider chart in R without using any libraries. That’s my code for now. It creates a figure with points number equal to the length of vector ‘a’. However, I’d like each point to be at the distance from the coordinates center equal to a respective number in a vector, for example one point at a distance 1, another at 2, so on. Is it possible to do so?
a <- 1:6
angle <- seq(0, 2*pi, (2*pi)/length(a))
x <- cos(angle)
y <- sin(angle)
plot(x, y,
type = "l")
See ?stars:
a <- 1:6
stars(matrix(a, nrow=1), scale=FALSE)
For future reference, using R's built-in help search would have found this with ??spider

Identifying common borders of polygons using the Simple Features library from R

I'm trying to identify the common borders of two different polygons using the sf_intersection() function from the sf package.
I tried this simple approach in my data, which comes from a shapefile, but it's not working exactly as I expected.
My data is the shapefile names "zones" from this repository, and this is what I've tried:
library(sf)
library(ggplot2)
zones <- st_read('./Data/zones.shp')
zones$id <- seq(nrow(zones))
borders <- st_intersection(zones, zones)
borders <- borders[borders$id != borders$id.1, ]
ggplot() +
geom_sf(data = zones, color='red', fill=NA) +
geom_sf(data = borders, color = 'navy')
The final plot yields this result:
If you look carefully, you'll note that there are some portions of the inner line of the polygons that are not part of the line in borders (they are red and not blue).
I don't know why this is happening. Any hint or advice will be much appreciated. Thanks!
It is local imprecision in the borders. With most vector data formats, shared POLYGON borders are duplicated in each of the neighbours. It doesn't take very much for slight differences in the coordinates to make the intersection of the two borders incomplete.
That's not a solution, I'm afraid.
This section shows the kind of problem. The view window is:
> par('usr')
[1] 764968.2 765650.8 2945266.2 2945890.9
That sliver is only about 3 metres wide.
EDIT: Just to add my attempt at a solution using st_snap. This seems to do the trick in some places but not consistently. It doesn't feel like it is working as intended. Also, just to note the projection uses US feet as units, which confused me.
z1 <- st_geometry(zones[1,])
z2 <- st_geometry(zones[2,])
z1 <- st_cast(z1, 'LINESTRING')
z2 <- st_cast(z2, 'LINESTRING')
z1s <- st_snap(z1, z2, 1000)
border <- st_intersection(z1s, z2)
That snap tolerance is way over the top - the gaps between the zone seem to be < 10 feet - but even with this huge tolerance the actual border has missing sections. More oddly, the result has a totally unexpected extension that heads off >6500 feet from the actual intersection.
#David_O identifies the issue - the POLYGON borders don't actually touch throughout the shared boundary so st_intersection won't identify them as such.
One workaround may be to st_buffer your zones object before intersecting, although this is admittedly a crude workaround:
borders <- st_intersection(st_buffer(zones, 5), st_buffer(zones, 5))
borders <- borders[borders$id != borders$id.1, ]
ggplot() +
geom_sf(data = zones, color='red', fill="transparent") +
geom_sf(data = borders, color = 'navy')

Drawing a smooth implicit surface with misc3d

The misc3d package provides a great implementation of the marching cubes algorithm, allowing to plot implicit surfaces.
For example, let's plot a Dupin cyclide:
a = 0.94; mu = 0.56; c = 0.34 # cyclide parameters
f <- function(x, y, z, a, c, mu){ # implicit equation f(x,y,z)=0
b <- sqrt(a^2-c^2)
(x^2+y^2+z^2-mu^2+b^2)^2 - 4*(a*x-c*mu)^2 - 4*b^2*y^2
}
# define the "voxel"
nx <- 50; ny <- 50; nz <- 25
x <- seq(-c-mu-a, abs(mu-c)+a, length=nx)
y <- seq(-mu-a, mu+a, length=ny)
z <- seq(-mu-c, mu+c, length=nz)
g <- expand.grid(x=x, y=y, z=z)
voxel <- array(with(g, f(x,y,z,a,c,mu)), c(nx,ny,nz))
# plot the surface
library(misc3d)
surf <- computeContour3d(voxel, level=0, x=x, y=y, z=z)
drawScene.rgl(makeTriangles(surf))
Nice, except that the surface is not smooth.
The documentation of drawScene.rgl says: "Object-specific rendering features such as smoothing and material are controlled by setting in the objects." I don't know what does that mean. How to get a smooth surface?
I have a solution but not a straightforward one: this solution consists in building a mesh3d object from the output of computeContour3d, and to include the surface normals in this mesh3d.
The surface normals of an implicit surface defined by f(x,y,z)=0 are simply given by the gradient of f. It is not hard to derive the gradient for this example.
gradient <- function(xyz,a,c,mu){
x <- xyz[1]; y <- xyz[2]; z <- xyz[3]
b <- sqrt(a^2-c^2)
c(
2*(2*x)*(x^2+y^2+z^2-mu^2+b^2) - 8*a*(a*x-c*mu),
2*(2*y)*(x^2+y^2+z^2-mu^2+b^2) - 8*b^2*y,
2*(2*z)*(x^2+y^2+z^2-mu^2+b^2)
)
}
Then the normals are computed as follows:
normals <- apply(surf, 1, function(xyz){
gradient(xyz,a,c,mu)
})
Now we are ready to make the mesh3d object:
mesh <- list(vb = rbind(t(surf),1),
it = matrix(1:nrow(surf), nrow=3),
primitivetype = "triangle",
normals = rbind(-normals,1))
class(mesh) <- c("mesh3d", "shape3d")
And finally to plot it with rgl:
library(rgl)
shade3d(mesh, color="red")
Nice, the surface is smooth now.
But is there a more straightforward way to get a smooth surface, without building a mesh3d object? What do they mean in the documentation: "Object-specific rendering features such as smoothing and material are controlled by setting in the objects."?
I don't know what the documentation is suggesting. However, you can do it via a mesh object slightly more easily than you did (though the results aren't quite as nice), using the addNormals() function to calculate the normals automatically rather than by formula.
Here are the steps:
Compute the surface as you did.
Create the mesh without normals. This is basically what you did, but using tmesh3d():
mesh <- tmesh3d(t(surf), matrix(1:nrow(surf), nrow=3), homogeneous = FALSE)
Calculate which vertices are duplicates of which others:
verts <- apply(mesh$vb, 2, function(column) paste(column, collapse = " "))
firstcopy <- match(verts, verts)
Rewrite the indices to use the first copy. This is necessary, since the misc3d functions give a collection of disconnected triangles; we need to work out which are connected.
it <- as.numeric(mesh$it)
it <- firstcopy[it]
dim(it) <- dim(mesh$it)
mesh$it <- it
At this point, there are a lot of unused vertices in the mesh; if memory was a problem you might want to add a step to remove them. I'm going to skip that.
Add the normals
mesh <- addNormals(mesh)
Here are the before and after shots. Left is without normals, right is with them.
It's not quite as smooth as your solution using computed normals, but it's not always easy to find those.
There's an option smooth in the makeTriangles function:
drawScene.rgl(makeTriangles(surf, smooth=TRUE))
I think the result is equivalent to #user2554330's solution, but this is more straightforward.
EDIT
The result is highly better with the rmarchingcubes package:
library(rmarchingcubes)
contour_shape <- contour3d(
griddata = voxel, level = 0,
x = x, y = y, z = z
)
library(rgl)
tmesh <- tmesh3d(
vertices = t(contour_shape[["vertices"]]),
indices = t(contour_shape[["triangles"]]),
normals = contour_shape[["normals"]],
homogeneous = FALSE
)
open3d(windowRect = c(50, 50, 562, 562))
view3d(zoom=0.8)
shade3d(tmesh, color = "darkred")

Determine which points lay outside an irregularly-shaped data footprint in R?

I have a series of points in an area whose 'footprint' shape is highly irregular:
I'd like to determine all of the coordinates within the footprint's vertices. The end goal is to determine which data points lay outside this footprint.
Does anyone have an efficient way to go about doing this??
My best idea to approaching this is to draw a polygon based on the green area's vertices and then use said polygon's coordinates to determine 'outlier' points' (though, I'm not sure how to do that yet -- one step at a time!).
However, when I try creating a convex hull, it obviously creates problems because of the irregular shape of my green space. [Anyone know of a way to create CONCAVE hulls?]
Alternatively, is there a way to draw polygons manually using a 'click the graph' type method?
...Again, if you have a better solution to my problem than using polygons, please by all means suggest that solution!
Alternatively, is there a way to draw polygons manually using a 'click
the graph' type method?
Here's one idea. First, some random points:
library(manipulate)
library(sp)
set.seed(1)
par(pch = 19, cex=.5)
x <- runif(1000)
y <- runif(1000)
Now, draw and capture the polygon:
coords <- data.frame()
manipulate({
plot(y~x)
res <- manipulatorMouseClick()
coords <<- rbind(coords, data.frame(x=res$userX, y=res$userY))
if (length(coords)) lines(coords)
})
And determine which points are inside/outside of it (see ?point.in.polygon):
res <- point.in.polygon(x, y, coords$x, coords$y)!=0
plot(y~x, col = res + 1L)
lines(coords)

Resources