I have 3D meshes representing closed surfaces not necessarily convex for which I would like to get orthographic projections onto arbitrary directions (to put in context, the 3D meshes represent satellites and the end goal is to use the projections to calculate atmospheric drag).
As a first step, I am just aiming to compute the surface area of the resulting projection. Is there any way to perform such operation with rgl? Since the meshes represent closed surfaces, the projections will not contain multiple disconnected polygons.
I believe I can get the set of triangles/quads visible from a given direction by using the facing3d() function, specifying the direction in the up argument. But I am unsure on how to proceed from there.
You can do the projections using the rgl::shadow3d() function, and calculate area using geometry::polyarea(). For example,
library(rgl)
library(geometry)
satellite <- translate3d(icosahedron3d(), x = 0, y = 0, z = 5)
vertices <- asEuclidean2(satellite$vb)
xrange <- range(vertices[1,])
yrange <- range(vertices[2,])
floor <- mesh3d(x = c(2*xrange, 2*rev(xrange)),
y = rep(2*yrange, each = 2),
z = 0, quads = 1:4)
open3d()
#> glX
#> 1
shadow <- shadow3d(floor, satellite, plot = FALSE,
minVertices=1000 # Need this to get a good shadow
)
shade3d(satellite, col= "red")
shade3d(floor, col = "white", polygon_offset = 1, alpha = 0.1)
shade3d(shadow, col = "gray")
vertices <- unique(t(asEuclidean2(shadow$vb)))[,1:2]
hull <- chull(vertices)
hullx <- vertices[hull,1]
hully <- vertices[hull,2]
plot(c(hullx, hullx[1]), c(hully, hully[1]), type = "l")
polyarea(hullx, hully)
#> [1] 3.266855
Created on 2022-12-13 with reprex v2.0.2
Related
I'm working with two dataframes in R: a "red" dataframe and a "black" dataframe. In both there are two columns representing the coordinates.
I used a plot to explain what I want to do.
I would like to select all the points from the "red" dataframe that are beyond the "black" line. E.g. all the points excluded from the area of the polygon delimited by the black points.
My previous answer only showed how not to draw the points outside the polygon. To actually identify the points outside the polygon, you can use the function pip2d from the package ptinpoly. It returns negative values for points outside the polygon.
Example:
library(ptinpoly)
poly.vertices <- data.frame(x=c(20,40,80,50,40,30), y=c(30,20,70,80,50,60))
p <- data.frame(x=runif(100, min=0, max=100), y=runif(100, min=0, max=100))
outside <- (pip2d(as.matrix(poly.vertices), as.matrix(p)) < 0)
plot(p$x, p$y, col=ifelse(outside, "red", "black"))
polygon(poly.vertices$x, poly.vertices$y, border="blue", col=NA)
The same should be achieved with the function PtInPoly from the package DescTools, which returns zero for points outside the polygon. The implementation of ptinpoly, however, has the advantage of implmenting the particularly efficient algorithm described in
J. Liu, Y.Q. Chen, J.M. Maisog, G. Luta: "A new point containment test algorithm based on preprocessing and determining triangles." Computer-Aided Design, Volume 42, Issue 12, December 2010, Pages 1143-1150
Edit: Out of curiosity, I have compared the runtime of ptinpoly::pip2d and DescTools::PtInPoly with microbenchmark and N=50000 points, and pip2d turned out to be considerably faster:
> microbenchmark(outside.pip2d(), outside.PtInPoly())
Unit: milliseconds
expr min lq mean median uq max
outside.pip2d() 3.375084 3.421631 4.459051 3.48939 4.251395 65.97793
outside.PtInPoly() 27.537927 27.666688 28.739288 27.97984 28.514595 90.11313
neval
100
100
You could use the sf package to define a convex hull and intersect your target points with that polygon.
Define a convex hull based on black:
library(sf)
set.seed(99)
red <- data.frame(x = runif(100,-10,10), y = runif(100,-4,4))
black <- data.frame(x = runif(100,-8,8), y = runif(100,-4,3))
# Convert df to point feature
blk <- st_as_sf(black, coords = c("x", "y"))
# Convert to multipoint
blk_mp <- st_combine(blk)
# Define convex hull
blk_poly <- st_convex_hull(blk_mp)
plot(black)
points(red, col = "red")
plot(blk_poly, add = TRUE)
Intersecting red with the convex hull returns red within that polygon:
rd <- st_as_sf(red, coords = c("x", "y"))
rd_inside <- st_intersection(rd, blk_poly)
plot(black)
points(red)
plot(blk_poly, add = TRUE)
plot(rd_inside, pch = 24, col = "red", bg = "red", add = TRUE)
One possible solution is to draw the polygon after the points and fill its outer area white. This cannot be done directly with polygon or polypath, because these functions can only fill the interiour of a polygon. You can however fill the area between two polygons with polypath. Thus you can add a second polygon that encompasses (or goes beyond) the borders of your plot.
Here is an example that works in base R:
p.outer <- list(x=c(0,100,100,0), y=c(0,0,100,100))
p.inner <- list(x=c(20,40,80,50,40,30), y=c(30,20,70,80,50,60))
plot(p.outer, type="n")
points(runif(100, min=0, max=100), runif(100, min=0, max=100))
polypath(x=c(p.outer$x, NA, p.inner$x), y = c(p.outer$y, NA, p.inner$y), col ="white", rule="evenodd")
Using the function PtInPoly of package DescTools, as suggested by #cdalitz, I resolved the problem. This function returned a data frame of the coordinates of the points (in my case the red coordinates) and a third column "pip" of 1 (if the point is within the polygon) and 0s (if outside the polygon).
I will use another dataset to show you the result:
try <- DescTools::PtInPoly(pnts = red[,c("x","y")], poly.pnts = black[,c("x","y")])
ggplot()+
geom_point(try, mapping = aes(x = x, y = y, color = as.character(pip))) +
geom_polygon(data = black, mapping = aes(x,y))
Seems that you can reconstruct the edges of the black polygon by simply joining every point to its nearest neighbor and its nearest neighbor in the opposite direction. Then perform point-in-polygon tests.
If the coordinates of a point do not fall exactly on a line segment in a linnet object, how does lpp() handle that point?
Does it get dropped? Or snapped to the nearest segment?
It is “snapped” (projected) to the nearest segment no matter how far away this is.
Thus you should probably prepare your data with some more steps before calling lpp.
Below is a simple example which you could try to mimick if all your points
are in a ppp called X and the main component of your linnet is called L.
Of course you need to adapt distance thresholds etc. but hopefully it helps you
in the right direction.
library(spatstat)
set.seed(42)
X <- runifpoint(10)
L <- simplenet
proj <- project2segment(X, as.psp(L))
i <- which(proj$d<.05)
Xclose <- X[i]
Xfinal <- lpp(Xclose, simplenet)
plot(L)
plot(X, add = TRUE, col = "red")
plot(Xclose, add = TRUE, pch = 2, col = "blue")
plot(Xfinal)
I have a series of polygons and points with each polygon containing a point. I want to determine the maximum distance of each point to the edge of the polygon containing it is contained within in R.
I looked at using the rgeos gDistance function but this returns 0 for points within polygons.
Using an example polygon and a point that falls within the polygon this is what i've coded so far but i'm getting a distance of 0 rather than the distance from a point to polygon edges.
pt1 = readWKT("POINT(0.5 0.25)")
p1 = readWKT("POLYGON((0 0,1 0,1 1,0 1,0 0))")
gDistance(pt1, p1)
# 0
Does a function exist in R or an R package that can determine distances for points within polygons to the polygon edge?
Much appreciated within advance.
Solution using spatstat and the built-in dataset chorley:
library(spatstat)
W <- Window(chorley) # Polygonal window of the choley dataset
p <- list(x = c(350, 355), y = c(415, 425)) # Two points in polygon
plot(W, main = "")
points(p, col = c("red", "blue"), cex = 1.5)
v <- vertices(W) # Polygon vertices
d <- crossdist(v$x, v$y, p$x, p$y) # 2-column matrix of cross distances
i1 <- which.max(d[,1]) # Index of max dist for first (red) point
i2 <- which.max(d[,2]) # Index of max dist for second (blue) point
plot(W, main = "")
points(p, col = c("red", "blue"), cex = 1.5)
points(v$x[c(i1,i2)], v$y[c(i1,i2)], col = c("red", "blue"), cex = 1.5)
d[i1,1] # Max dist for first (red) point
#> [1] 21.35535
d[i2,2] # Max dist for second (blue) point
#> [1] 15.88226
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")
I have this simple data.frame
lat<-c(1,2,3,10,11,12,20,21,22,23)
lon<-c(5,6,7,30,31,32,50,51,52,53)
data=data.frame(lat,lon)
The idea is to find the spatial clusters based on the distance
First, I plot the map (lon,lat) :
plot(data$lon,data$lat)
so clearly I have three clusters based in the distance between the position of points.
For this aim, I've tried this code in R :
d= as.matrix(dist(cbind(data$lon,data$lat))) #Creat distance matrix
d=ifelse(d<5,d,0) #keep only distance < 5
d=as.dist(d)
hc<-hclust(d) # hierarchical clustering
plot(hc)
data$clust <- cutree(hc,k=3) # cut the dendrogram to generate 3 clusters
This gives :
Now I try to plot the same points but with colors from clusters
plot(data$x,data$y, col=c("red","blue","green")[data$clust],pch=19)
Here the results
Which is not what I'm looking for.
Actually, I want to find something like this plot
Thank you for help.
What about something like this:
lat<-c(1,2,3,10,11,12,20,21,22,23)
lon<-c(5,6,7,30,31,32,50,51,52,53)
km <- kmeans(cbind(lat, lon), centers = 3)
plot(lon, lat, col = km$cluster, pch = 20)
Here's a different approach. First it assumes that the coordinates are WGS-84 and not UTM (flat). Then it clusters all neighbors within a given radius to the same cluster using hierarchical clustering (with method = single, which adopts a 'friends of friends' clustering strategy).
In order to compute the distance matrix, I'm using the rdist.earth method from the package fields. The default earth radius for this package is 6378.388 (the equatorial radius) which might not be what one is looking for, so I've changed it to 6371. See this article for more info.
library(fields)
lon = c(31.621785, 31.641773, 31.617269, 31.583895, 31.603284)
lat = c(30.901118, 31.245008, 31.163886, 30.25058, 30.262378)
threshold.in.km <- 40
coors <- data.frame(lon,lat)
#distance matrix
dist.in.km.matrix <- rdist.earth(coors,miles = F,R=6371)
#clustering
fit <- hclust(as.dist(dist.in.km.matrix), method = "single")
clusters <- cutree(fit,h = threshold.in.km)
plot(lon, lat, col = clusters, pch = 20)
This could be a good solution if you don't know the number of clusters (like the k-means option), and is somewhat related to the dbscan option with minPts = 1.
---EDIT---
With the original data:
lat<-c(1,2,3,10,11,12,20,21,22,23)
lon<-c(5,6,7,30,31,32,50,51,52,53)
data=data.frame(lat,lon)
dist <- rdist.earth(data,miles = F,R=6371) #dist <- dist(data) if data is UTM
fit <- hclust(as.dist(dist), method = "single")
clusters <- cutree(fit,h = 1000) #h = 2 if data is UTM
plot(lon, lat, col = clusters, pch = 20)
As you have a spatial data to cluster, so DBSCAN is best suited for you data.
You can do this clustering using dbscan() function provided by fpc, a R package.
library(fpc)
lat<-c(1,2,3,10,11,12,20,21,22,23)
lon<-c(5,6,7,30,31,32,50,51,52,53)
DBSCAN <- dbscan(cbind(lat, lon), eps = 1.5, MinPts = 3)
plot(lon, lat, col = DBSCAN$cluster, pch = 20)