I want to create a circle of area 100 as an sf object. I thought st_buffer() would do it, but the area is
slightly less than 100.
pt.df <- data.frame(pt = 1, x = 20, y = 20)
pt.sf <- st_as_sf(pt.df, coords = c("x", "y"))
circle1 <- st_buffer(pt.sf, dist = sqrt(100 / pi))
st_area(circle1) # 99.95431 on my PC
I can use a fudge factor to multiply the radius and I get what I want.
fudge <- sqrt( 100 / st_area(circle1) )
circle2 <- st_buffer(pt.sf, dist = fudge * sqrt(100 / pi))
st_area(circle2) # 100
But it seems silly to use a fudge factor.
Is there a way to create a circle of known area within the sf package without
a fudge factor in st_buffer ?
It's a float precision issue calculating the radius with a truncated form of pi. This will result in a circle that is slightly less than what your desired output is. You can see that pi can only be stored to machine precision:
.Machine$double.eps
# 2.22044604925031e-16
pi
# 3.14159265358979
If you want to correct it, you can use a linear correction on the area that you want. Note that this is still an approximation, but it should get you much closer to your desired result.
radius <- function(area){
A <- area + (area * 0.000457099999999997)
return(sqrt(A / pi))
}
system.file("shape/nc.shp", package="sf") %>%
st_read() %>%
st_centroid() %>%
st_transform(st_crs(5070)) %>%
st_buffer(radius(100)) %>%
st_area()
The main issue is that st_buffer works internally with polygons, not with circles. Increasing the nQuadSegs argument (default=30) allows you to use a better approximation to a circle, at the cost of memory and computation time (don't know if this is important to you):
library(sf)
pt.df <- data.frame(pt = 1, x = 20, y = 20)
pt.sf <- st_as_sf(pt.df, coords = c("x", "y"))
get_area <- function(nq) {
circle1 <- st_buffer(pt.sf, dist = sqrt(100 / pi), nQuadSegs=nq)
st_area(circle1)
}
sapply(c(30,100,300,1000), get_area)
## [1] 99.95431 99.99589 99.99954 99.99996
If you really want an area of exactly 100, then the 'fudge' that your question (and #AdamTrevisan's answer) suggest is the way to go (as increasing the number of segments to a million still only gets you to an area of 99.99999999997200461621). To be really clever, you might be able to use the formula for the area of an inscribed polygon to come up with a correction factor ...
Related
I want to buffer a spatial polygon P of area A so that the buffered feature P_buffered attains a defined area A_buffered. Function sf::st_buffer grows a feature by distance d (from edge) but not by area.
So far, I tried:
approximating d from some radial measure of P (radius of enclosing circle, diagonal of bbox), assuming that a radial increase by factor x will inflate the area by x² (roughly, depending on P's rotational symmetry).
approximating d iteratively by interval halving
The accuracy of (1) varies with the feature's shape while (2) is too slow (at least my implementation of it)
I'd be very grateful for hints towards some package with a corresponding function (pseudo::buffer_area()) or codewise solution I seem to be overlooking.
Re. accessing other GIS executables from R, please note that the code has to run on a machine where only the availability of R packages can be taken as granted.
example data: dput dump of an example polygon class sfcfor use with {sf}: https://gist.github.com/1O/bc3798468b48f19ab2533f16c99c2268
I still suggest a while loop (your second approach)... perhals someone can tweak the growth/decline aloritm...
library(sf)
points = matrix(c(0,0,20,0,10,10,0,10,0,0),ncol=2, byrow=TRUE)
pts = list(points)
pl1 = st_polygon(pts)
# x = polygon
# y = desired buffer area
# z = allowed delte from area
# example y = 100, z = 0.01, the bufferarea aloowed is bewteen 99 and 101
buffer_distance <- function(x, y, z) {
buff_dist <- 1
buffer_area <- st_area(st_buffer(x, buff_dist)) - st_area(x)
while (!data.table::between(buffer_area,
y - z * y,
y + z * y)) {
if (buffer_area > y) {
buff_dist <- buff_dist * (1 - y / st_area(st_buffer(x, buff_dist) ))
} else {
buff_dist <- buff_dist * (1 + y / st_area(st_buffer(x, buff_dist) ))
}
buffer_area <- st_area(st_buffer(x, buff_dist)) - st_area(x)
}
return(buff_dist)
}
buffer_distance(pl1, 100, 0.01)
#[1] 1.688372
st_area(st_buffer(pl1, buffer_distance(pl1, 100, 0.01))) - st_area(pl1)
# [1] 100.3634
plot(st_buffer(pl1, buffer_distance(pl1, 100, 0.01)))
plot(pl1, add = TRUE)
There actually is a straightforward solution: sf geometries can be scaled linearily by multiplying the geometry with a scalar like:
## scale feature to triple linear extent (e.g. height):
zoom = 3
scaled_feature = zoom * feature
## scale feature to triple area:
scaled_feature = sqrt(zoom) * feature
The necessary buffer distance calculates, e.g., as the difference between inscribed circle radii of feature and scaled feature.
Example:
library(spData) ## contains sample data, e.g. London areas
library(sf)
library(dplyr)
## original feature (example: Kingston upon Thames in London,
## reprojected area-preserving Lambert (LCC Europe, EPSG 3034)
feature <- spData::lnd[1,] %>% st_transform(3034) %>% st_geometry
zoom <- sqrt(1.5) ## to scale area by 1.5
feature_zoomed <- feature * zoom
## get radial buffer distance as half the vertical difference
## between bounding boxes of inscribed circles):
buffer_distance <- 0.5 * (
(feature_zoomed %>% st_inscribed_circle %>% st_bbox %>% .[c(4,2)] %>% dist) -
(feature %>% st_inscribed_circle %>% st_bbox %>% .[c(4,2)] %>% dist)
)
feature_buffered <- st_buffer(feature, buffer_distance)
Accuracy will vary with vertex count and st_buffer settings (segments, join style, end cap style), breaking up multipolygons into polygons (st_cast) and st_simplifying can help as well as feeding the initial buffer_distance into an approximation loop as demonstrated in #Wimpel 's answer.
I want to calculate a least-cost path using gdistance::shortestPath. I have a raster file showing the cost of passing each cell, but before using it, I try to mimic the example 1 in the pdf manual to see how the package works as below when we assume constant cost to travel across cells.
library(gdistance)
raster <- raster(ymn = 35.6, ymx = 35.76, xmx = 139.9, xmn = 139.6, res = 0.001)
raster[] <- 1
speed <- function(x){1/(x[2]+x[1])}
# 8 is possible connections
trraster <- transition(raster, transitionFunction=speed, 8)
trraster <- geoCorrection(trraster, scl=FALSE)
plot(raster(trraster))
adj <- adjacent(raster, cells=1:ncell(raster), pairs=TRUE, directions=8)
speed <- trraster
# this is the cost function
speed[adj] <-trraster[adj]
x <- geoCorrection(speed, scl=FALSE)
origin <- c(139.7761,35.7136)
goal <- c(139.7582,35.66639)
path <- shortestPath(x, origin, goal, output="SpatialLines")
plot(raster(speed))
lines(path)
Because this assume constant costs to travel (See raster[] <- 1 and speed <- function(x){1/(x[2]+x[1])}), the result must be a straight line, but the result is different as below.
It does not seem to allow us travel cells diagonally. What is wrong with the code? I set direction as 8, so we should be able to travel cells diagonally. I am using gdistance 1.3-6 and R 4.0.5.
I solved it by removing trraster <- geoCorrection(trraster, scl=FALSE). In the original pdf manual, they apply geoCorrection twice to adjust the distance between cells when they calculate the slope (height difference / distance) and conductance (speed / distance). However, in my case, speed is constant, so we only need to apply it once in x <- geoCorrection(speed, scl=FALSE).
I have a fairly complex problem that I don't really know where to start. I have a set of spatial points (X & Y) coordinates that also include information (Height).
set.seed(12345)
X = runif(100, 0, 45)
Y = runif(100, 0, 45)
Height = runif(100, 6, 9)
data <- data.frame("X" = X, "Y" = Y, "Height" = Height)
data$Radius_max = 1/3 * data$Height
The coordinates look something like this:
ggplot(data, aes(X, Y)) +
geom_point()
For each point, I need a buffer that is scaled by Height. The buffer is an equation that is scaled by height but is essentially a circular buffer similar to a cone. The following steps are what I've come up with to determine buffer size for each point:
Set bottom left point to radius_max.
Find the intersection of the radius at any given point relative to the next point.
Do this multiple times to refit a new radius for the intial point relative to new adjacent radii.
The reason for starting at an initial point is that each radii following will be constrained by the neighboring points (randomly generating points may or may not have this effect). No cone can be below another cone. Think trees. If possible, I would like to know the radius at 45 degree increments.
I'm ok with any solution and suspect there may be a way to do this with the spatial packages rather than doing some by hand. Where do I start?
I am not quite sure what you are after. Particularly the 45 degrees increments. Do you want the buffer to be circular? If so, perhaps the below is a solution.
Your example data
set.seed(12345)
X <- runif(100, 0, 45)
Y <- runif(100, 0, 45)
Height <- runif(100, 6, 9)
data <- data.frame("X" = X, "Y" = Y, "Height" = Height)
data$Radius_max <- 1/3 * data$Height
Possible solution
library(raster)
x <- pointDistance(data[,1:2], lonlat=FALSE)
diag(x) <- NA
mn <- apply(x, 1, min, na.rm=TRUE)
data$radius <- pmin(data$Radius_max, mn/2)
d <- SpatialPoints(data[, c('X', 'Y')], proj4string=CRS('+proj=utm +zone=1'))
b <- buffer(d, data$radius, dissolve=FALSE)
plot(b)
Could you help me to make a plot similar to this in R?
I would like to have it interactive such that I could rotate the sphere. I guess I should use rgl. I found an example similar to what I need here, however I couldn't find a way to draw a grid instead of a filled sphere.
UPD: A reproducible dataset that could help answering the question (I took it from here):
u <- runif(1000,0,1)
v <- runif(1000,0,1)
theta <- 2 * pi * u
phi <- acos(2 * v - 1)
x <- sin(theta) * cos(phi)
y <- sin(theta) * sin(phi)
z <- cos(theta)
library("lattice")
cloud(z ~ x + y)
Start with
library("rgl")
spheres3d(0,0,0,lit=FALSE,color="white")
spheres3d(0,0,0,radius=1.01,lit=FALSE,color="black",front="lines")
to create a "wireframe" sphere (I'm cheating a little bit here by drawing two spheres, one a little bit larger than the other ... there may be a better way to do this, but I couldn't easily/quickly figure it out).
from the Wolfram web page on sphere point picking (the source of your picture) we get
Similarly, we can pick u=cos(phi) to be uniformly distributed (so we have du=sin phi dphi) and obtain the points x = sqrt(1-u^2)*cos(theta); y = sqrt(1-u^2)*sin(theta); z=u with theta in [0,2pi) and u in [-1,1], which are also uniformly distributed over S^2.
So:
set.seed(101)
n <- 50
theta <- runif(n,0,2*pi)
u <- runif(n,-1,1)
x <- sqrt(1-u^2)*cos(theta)
y <- sqrt(1-u^2)*sin(theta)
z <- u
spheres3d(x,y,z,col="red",radius=0.02)
The spheres take a little more effort to render but are prettier than the results of points3d() (flat squares) ...
Wandering in late, I might suggest looking at the packages sphereplot and, if you're feeling really brave, gensphere for highly configurable general placement of points in 3-space.
sphereplot includes simple functions such as (quoting from the man pages)
pointsphere Random sphere pointing
Description Randomly generates data
points within a sphere that are uniformly distributed.
Usage
pointsphere(N = 100, longlim = c(0, 360), latlim = c(-90, 90), rlim =
c(0, 1))
Arguments
N Number of random points.
longlim Limits of longitude in degrees.
latlim Limits of latitude in degrees.
rlim Limits of radius.
My question is this.. I am working on some clustering algorithms.. For this first i am experimenting with 2d shapes..
Given a particular area say 500sq units .. I need to generate random shapes for a particular area
say a Rect, Square, Triangle of 500 sq units.. etc .. Any suggestions on how i should go about this problem.. I am using R language..
It's fairly straightforward to do this for regular polygon.
The area of an n-sided regular polygon, with a circumscribed circle of radius R is
A = 1/2 nR^2 * sin((2pi)/n)
Therefore, knowing n and A you can easily find R
R = sqrt((2*A)/(n*sin((2pi)/n))
So, you can pick the center, go at distance R and generate n points at 2pi/n angle increments.
In R:
regular.poly <- function(nSides, area)
{
# Find the radius of the circumscribed circle
radius <- sqrt((2*area)/(nSides*sin((2*pi)/nSides)))
# I assume the center is at (0;0) and the first point lies at (0; radius)
points <- list(x=NULL, y=NULL)
angles <- (2*pi)/nSides * 1:nSides
points$x <- cos(angles) * radius
points$y <- sin(angles) * radius
return (points);
}
# Some examples
par(mfrow=c(3,3))
for (i in 3:11)
{
p <- regular.poly(i, 100)
plot(0, 0, "n", xlim=c(-10, 10), ylim=c(-10, 10), xlab="", ylab="", main=paste("n=", i))
polygon(p)
}
We can extrapolate to a generic convex polygon.
The area of a convex polygon can be found as:
A = 1/2 * [(x1*y2 + x2*y3 + ... + xn*y1) - (y1*x2 + y2*x3 + ... + yn*x1)]
We generate the polygon as above, but deviate angles and radii from those of the regular polygon.
We then scale the points to get the desired area.
convex.poly <- function(nSides, area)
{
# Find the radius of the circumscribed circle, and the angle of each point if this was a regular polygon
radius <- sqrt((2*area)/(nSides*sin((2*pi)/nSides)))
angle <- (2*pi)/nSides
# Randomize the radii/angles
radii <- rnorm(nSides, radius, radius/10)
angles <- rnorm(nSides, angle, angle/10) * 1:nSides
angles <- sort(angles)
points <- list(x=NULL, y=NULL)
points$x <- cos(angles) * radii
points$y <- sin(angles) * radii
# Find the area of the polygon
m <- matrix(unlist(points), ncol=2)
m <- rbind(m, m[1,])
current.area <- 0.5 * (sum(m[1:nSides,1]*m[2:(nSides+1),2]) - sum(m[1:nSides,2]*m[2:(nSides+1),1]))
points$x <- points$x * sqrt(area/current.area)
points$y <- points$y * sqrt(area/current.area)
return (points)
}
A random square of area 500m^2 is easy - its a square of side sqrt(500)m. Do you care about rotations? Then rotate it by runif(x,0,2*pi). Do you care about its location? Add an (x,y) offset computed from runif or whatever.
Rectangle? Given the length of any one pair of sides you only have the freedom to choose the length of the other two. How do you choose the length of the first pair of sides? Well, you might want to use runif() between some 'sensible' limits for your application. You could use rnorm() but that might give you negative lengths, so maybe rnorm-squared. Then once you've got that side, the other side length is 500/L. Rotate, translate, and add salt and pepper to taste.
For triangles, the area formula is half-base-times-height. So generate a base length - again, runif, rnorm etc etc - then choose another point giving the required height. Rotate, etc.
Summarily, a shape has a number of "degrees of freedom", and constraining the area to be fixed will limit at least one of those freedoms[1], so if you start building a shape with random numbers you'll come to a point where you have to put in a computed value.
[1] exactly one? I'm not sure - these aren't degrees of freedom in the statistical sense...
I would suggest coding a random walk of adjacent tiny squares, so that the aggregation of the tiny squares could be of arbitrary shape with known area.
http://en.wikipedia.org/wiki/File:Random_walk_in2D.png
It would be very tough to make a generic method.
But you could code up example for 3, 4, 5 sided objects.
Here is an example of a random triangle.(in C#)
class Triangle
{
double Angle1;
double Angle2;
//double angle3; 180 - angle1 - angle2;
double Base;
}
Triangle randomTriangle(double area){
//A = (base*hieght)/2.0;
double angle1 = *random number < 180*;
double angle2 = *random number < (180 - angle1)*;
*use trig to get height in terms of angles and base*
double base = (area*2.0)/height;
return new Triangle(){Angle1 = angle1, Angle2 = angle2, Base = base};
}