Related
I have a smoothed time series and want to find the instantaneous velocity of the function at any point along the line.
What I want to do is take a series of values: ex(1,6,5,4,3,5,6,7,1)
and return the derivative of each relative to the function of the entire series, such that at every point in time, I know what direction the line is trending.
I am new to R, but know there must be a way.
Any tips?
Ex:
library(smoother)
data(BJsales)
m <- data.frame(BJsales)
x.smth <- as.data.frame(smth.gaussian(m$BJsales,tails=TRUE,alpha = 5))
x.smth.ts <- cbind(seq(1:nrow(m)),x.smth)
colnames(x.smth.ts) <- c("x","y")
x.smth.ts
plot(x.smth.ts$y~x.smth.ts$x)
Desired output:
df with 2 columns: x, deriv.of.y
Edit: Final Result thanks to G5W
TS with Color by Derivative
Your proposed example using the BJSales data is decidedly not differentiable,
so instead I will show the derivative of a much smoother function. If your real data is smooth, this should work for you.
The simplest way to approximate the derivative is simply to use finite differences.
f'(x) ≈ (f(x+h) - f(x))/h
## Smooth sample function
x = seq(0,10,0.1)
y = x/2 + sin(x)
plot(x,y, pch=20)
## Simplest - first difference
d1 = diff(y)/diff(x)
d1 = c(d1[1],d1)
Let's use it to plot a tangent line as an error check. I picked a place to draw the tangent line arbitrarily: the 18th point, x=1.7
plot(x,y, type="l")
abline(y[18]-x[18]*d1[18], d1[18])
To get the data.frame that you requested, you just need
Derivative = data.frame(x, d1)
I'm working on some bioacoustical analysis and got stuck with an issue that I believe it can be worked out mathematically. I'll use an sound sample from seewavepackage:
library(seewave)
library(tuneR)
data(tico)
By storing a spectrogram (i.e. graphic representation of the sound wave tico) in an R object, we can now deal with the wave file computationally.
s <- spectro(tico, plot=F)
class(s)
>[1] "list"
length(s)
>[1] 3
The object created s consists in two numerical vectors x = s$time, y = s$freq representing the X and Y axis, respectively, and a matrix z = s$amp of amplitude values with the same dimensions of x and y. Z is a virtually a 3D matrix that can be plotted using persp3D (plot3D), plot_ly (plotly) or plot3d (rgl). Alternatively, the wave file can be plotted in 3D using seewave if one wishes to visualize it as an interative rgl plot.
spectro3D(tico)
That being said, the analysis I'm conducting aims to calculate contours of relative amplitude:
con <- contourLines(x=s$time, y=s$freq, z=t(s$amp), levels=seq(-25, -25, 1))
Select the longest contour:
n.con <- numeric(length(con))
for(i in 1:length(con)) n.con[i] <- length(con[[i]]$x)
n.max <- which.max(n.con)
con.max <- con[[n.max]]
And then plot the selected contour against the spectrogram of tico:
spectro(tico, grid=F, osc=F, scale=F)
polygon(x=con.max$x, y=con.max$y, lwd=2)
Now it comes the tricky part. I must find a way to "subset" the matrix of amplitude values s$amp using the coordinates of the longest contour con.max. What I aim to achieve is a new matrix containing only the amplitude values inside the polygon. The remaining parts of the spectrogram should then appear as blank spaces.
One approach I though it could work would be to create a loop that replaces every value outside the polygon for a given amplitude value (e.g. -25 dB). I once did an similar approach to remove the values below -30 dB and it worked out perfectly:
for(i in 1:length(s$amp)){if(s$amp[i] == -Inf |s$amp[i] <= -30)
{s$amp[i] <- -30}}
Another though would be to create a new matrix with the same dimensions of s$amp, subset s$amp using the coordinates of the contour, then replace the subset on the new matrix. Roughly:
mt <- matrix(-30, nrow=nrow(s$amp), ncol = ncol(s$amp))
sb <- s$amp[con.max$y, con.max$x]
new.mt <- c(mt, sb)
s$amp <- new.mt
I'll appreciate any help.
I'm looking for some help understanding how to implement a 2-dimensional kernel density method, with a isotropic variance, and a bivariate normal kernel, kind of, but instead of using the typical distance, because the data is on the surface of the earth, I need to use a great-circle distance.
I'd like to replicate this in R, but I can't figure out how to use a distance metric other than the simple euclidean distance for any of the built in estimators, and since it uses a complex method with convolutions to add the kernels. Does anyone have a way to program an arbitrary kernel?
I ended up modifying the kde2d function from the MASS library. Some significant revision was needed, as is shown below. That said, the code is very flexible, allowing an arbitrary 2-d kernel to be used. (rdist.earth() was used for the great circle distance, h is the chosen bandwidth, in this case, in km, and n is the number of grid points in each direction to be used. rdist.earth requires the "fields" library)
The function could be modified to perform calculations in more than 2d, but the grid gets large very fast in higher dimensions. (Not that it's small now.)
Comments and suggestions on elegance or performance are welcome!
kde2d_mod <- function (data, h, n = 200, lims = c(range(data$lat), range(data$lon))) {
#Data is a matrix: lon,lat for each source. (lon,lat to match rdist.earth format.)
print(Sys.time()) #for timing
nx <- dim(data)[1]
if (dim(data)[2] != 2)
stop("data vectors have only lat-long data")
if (any(!is.finite(data)))
stop("missing or infinite values in the data are not allowed")
if (any(!is.finite(lims)))
stop("only finite values are allowed in 'lims'")
#Grid:
g<-grid(n,lims) #Function to create grid.
#The distance matrix gets large... Can we work around it? YES WE CAN!
sets<-ceiling(dim(g)[1]/10000)
#Allocate our output:
z<-rep(as.double(0),dim(g)[1])
for (i in (1:sets)-1) {
g_subset=g[(i*10000+1):(min((i+1)*10000,dim(g)[1])),]
a_matrix<-rdist.earth(g_subset,data,miles=FALSE)
z[(i*10000+1):(min((i+1)*10000,dim(g)[1]))]<- apply( #Here is my kernel...
a_matrix,1,FUN=function(X)
{sum(exp(-X^2/(2*(h^2))))/(2*pi*nx)}
)
rm(a_matrix)
}
print(Sys.time())
#Un-transpose the final data.
z<-t(matrix(z,n,n))
dim(z)<-c(n^2,1)
z<-as.vector(z)
return(z)
}
The key point here is that any kernel can be used in that inner loop; the downside is that this is evaluated at grid points, so a high-res grid is needed to run this; FFT would be great, but I didn't attempt it.
Grid Function:
grid<- function(n,lims) {
num <- rep(n, length.out = 2L)
gx <- seq.int(lims[1L], lims[2L], length.out = num[1L])
gy <- seq.int(lims[3L], lims[4L], length.out = num[2L])
v1=rep(gy,length(gx))
v2=rep(gx,length(gy))
v1<-matrix(v1, nrow=length(gy), ncol=length(gx))
v2<-t(matrix(v2, nrow=length(gx), ncol=length(gy)))
grid_out<-c(unlist(v1),unlist(v2))
grid_out<-aperm(array(grid_out,dim=c(n,n,2)),c(3,2,1) ) #reshape
grid_out<-unlist(as.list(grid_out))
dim(grid_out)<-c(2,n^2)
grid_out<-t(grid_out)
return(grid_out)
}
You can plot the values using image.plot, with the v1 and v2 matrices for your x,y points:
kde2d_mod_plot<-function(kde2d_mod_output,n,lims) ){
num <- rep(n, length.out = 2L)
gx <- seq.int(lims[1L], lims[2L], length.out = num[1L])
gy <- seq.int(lims[3L], lims[4L], length.out = num[2L])
v1=rep(gy,length(gx))
v2=rep(gx,length(gy))
v1<-matrix(v1, nrow=length(gy), ncol=length(gx))
v2<-t(matrix(v2, nrow=length(gx), ncol=length(gy)))
image.plot(v1,v2,matrix(kde2d_mod_output,n,n))
map('world', fill = FALSE,add=TRUE)
}
I am trying to find the orthogonal distance between a set of location coordinates and a set of lines (roads or rivers). The set of points are in the form of latitude/longitude pairs, and the lines are in a shapefile (.shp). Plotting them on a map is not a problem, using either maptools or PBSmapping. But my basic problem is to find the minimum distance one has to travel from a location to reach a road or a river. Is there any way to do this in R?
If I understand correctly, you can do this simply enough with gDistance in the rgeos package.
Read in the lines as SpatialLines/DataFrame and points as SpatialPoints/DataFrame and then loop over each point calculating the distance each time:
require(rgeos)
## untested code
shortest.dists <- numeric(nrow(sp.pts))
for (i in seq_len(nrow(sp.pts)) {
shortest.dists[i] <- gDistance(sp.pts[i,], sp.lns)
}
Here sp.pts is the Spatial points object, and sp.lns is the Spatial lines object.
You must loop so that you only compare a single coordinate in sp.pts with the entirety of all lines geometries in sp.lns, otherwise you get the distance from an aggregate value across all points.
Since your data are in latitude/longitude you should transform both the lines and points to a suitable projection since the gDistance function assumes Cartesian distance.
MORE DISCUSSION AND EXAMPLE (edit)
It would be neat to get the nearest point on the line/s rather than just the distance, but this opens another option which is whether you need the nearest coordinate along a line, or an actual intersection with a line segment that is closer than any existing vertex. If your vertices are dense enough that the difference doesn't matter, then use spDistsN1 in the sp package. You'd have to extract all the coordinates from every line in the set (not hard, but a bit ugly) and then loop over each point of interest calculating the distance to the line vertices - then you can find which is the shortest and select that coordinate from the set of vertices, so you can have the distance and the coordinate easily. There's no need to project either since the function can use ellipsoidal distances with longlat = TRUE argument.
library(maptools)
## simple global data set, which we coerce to Lines
data(wrld_simpl)
wrld_lines <- as(wrld_simpl, "SpatialLinesDataFrame")
## get every coordinate as a simple matrix (scary but quick)
wrld_coords <- do.call("rbind", lapply(wrld_lines#lines, function(x1) do.call("rbind", lapply(x1#Lines, function(x2) x2#coords[-nrow(x2#coords), ]))))
Check it out interactively, you'll have to modify this to save the coords or minimum distances. This will plot up the lines and wait for you to click anywhere in the plot, then it will draw a line from your click to the nearest vertex on a line.
## no out of bounds clicking . . .
par(mar = c(0, 0, 0, 0), xaxs = "i", yaxs = "i")
plot(wrld_lines, asp = "")
n <- 5
for (i in seq_len(n)) {
xy <- matrix(unlist(locator(1)), ncol = 2)
all.dists <- spDistsN1(wrld_coords, xy, longlat = TRUE)
min.index <- which.min(all.dists)
points(xy, pch = "X")
lines(rbind(xy, wrld_coords[min.index, , drop = FALSE]), col = "green", lwd = 2)
}
The geosphere package has the dist2line function that does this for lon/lat data. It can use Spatial* objects or matrices.
line <- rbind(c(-180,-20), c(-150,-10), c(-140,55), c(10, 0), c(-140,-60))
pnts <- rbind(c(-170,0), c(-75,0), c(-70,-10), c(-80,20), c(-100,-50),
c(-100,-60), c(-100,-40), c(-100,-20), c(-100,-10), c(-100,0))
d <- dist2Line(pnts, line)
d
Illustration of the results
plot( makeLine(line), type='l')
points(line)
points(pnts, col='blue', pch=20)
points(d[,2], d[,3], col='red', pch='x')
for (i in 1:nrow(d)) lines(gcIntermediate(pnts[i,], d[i,2:3], 10), lwd=2)
Looks like this can be done in the sf package using the st_distance function.
You pass your two sf objects to the function. Same issue as with the other solutions in that you need to iterate over your points so that the function calculates the distance between every point to every point on the roadways. Then take the minimum of the resulting vector for the shortest distance.
# Solution for one point
min(st_distance(roads_sf, points_sf[1, ]))
# Iterate over all points using sapply
sapply(1:nrow(points_sf), function(x) min(st_distance(roads_sf, points_sf[x, ])))
I would like to identify linear features, such as roads and rivers, on raster maps and convert them to a linear spatial object (SpatialLines class) using R.
The raster and sp packages can be used to convert features from rasters to polygon vector objects (SpatialPolygons class). rasterToPolygons() will extract cells of a certain value from a raster and return a polygon object. The product can be simplified using the dissolve=TRUE option, which calls routines in the rgeos package to do this.
This all works just fine, but I would prefer it to be a SpatialLines object. How can I do this?
Consider this example:
## Produce a sinuous linear feature on a raster as an example
library(raster)
r <- raster(nrow=400, ncol=400, xmn=0, ymn=0, xmx=400, ymx=400)
r[] <- NA
x <-seq(1, 100, by=0.01)
r[cellFromRowCol(r, round((sin(0.2*x) + cos(0.06*x)+2)*100), round(x*4))] <- 1
## Quick trick to make it three cells wide
r[edge(r, type="outer")] <- 1
## Plot
plot(r, legend=FALSE, axes=FALSE)
## Convert linear feature to a SpatialPolygons object
library(rgeos)
rPoly <- rasterToPolygons(r, fun=function(x) x==1, dissolve=TRUE)
plot(rPoly)
Would the best approach be to find a centre line through the polygon?
Or is there existing code available to do this?
EDIT: Thanks to #mdsumner for pointing out that this is called skeletonization.
Here's my effort. The plan is:
densify the lines
compute a delaunay triangulation
take the midpoints, and take those points that are in the polygon
build a distance-weighted minimum spanning tree
find its graph diameter path
The densifying code for starters:
densify <- function(xy,n=5){
## densify a 2-col matrix
cbind(dens(xy[,1],n=n),dens(xy[,2],n=n))
}
dens <- function(x,n=5){
## densify a vector
out = rep(NA,1+(length(x)-1)*(n+1))
ss = seq(1,length(out),by=(n+1))
out[ss]=x
for(s in 1:(length(x)-1)){
out[(1+ss[s]):(ss[s+1]-1)]=seq(x[s],x[s+1],len=(n+2))[-c(1,n+2)]
}
out
}
And now the main course:
simplecentre <- function(xyP,dense){
require(deldir)
require(splancs)
require(igraph)
require(rgeos)
### optionally add extra points
if(!missing(dense)){
xy = densify(xyP,dense)
} else {
xy = xyP
}
### compute triangulation
d=deldir(xy[,1],xy[,2])
### find midpoints of triangle sides
mids=cbind((d$delsgs[,'x1']+d$delsgs[,'x2'])/2,
(d$delsgs[,'y1']+d$delsgs[,'y2'])/2)
### get points that are inside the polygon
sr = SpatialPolygons(list(Polygons(list(Polygon(xyP)),ID=1)))
ins = over(SpatialPoints(mids),sr)
### select the points
pts = mids[!is.na(ins),]
dPoly = gDistance(as(sr,"SpatialLines"),SpatialPoints(pts),byid=TRUE)
pts = pts[dPoly > max(dPoly/1.5),]
### now build a minimum spanning tree weighted on the distance
G = graph.adjacency(as.matrix(dist(pts)),weighted=TRUE,mode="upper")
T = minimum.spanning.tree(G,weighted=TRUE)
### get a diameter
path = get.diameter(T)
if(length(path)!=vcount(T)){
stop("Path not linear - try increasing dens parameter")
}
### path should be the sequence of points in order
list(pts=pts[path+1,],tree=T)
}
Instead of the buffering of the earlier version I compute the distance from each midpoint to the line of the polygon, and only take points that are a) inside, and b) further from the edge than 1.5 of the distance of the inside point that is furthest from the edge.
Problems can arise if the polygon kinks back on itself, with long segments, and no densification. In this case the graph is a tree and the code reports it.
As a test, I digitized a line (s, SpatialLines object), buffered it (p), then computed the centreline and superimposed them:
s = capture()
p = gBuffer(s,width=0.2)
plot(p,col="#cdeaff")
plot(s,add=TRUE,lwd=3,col="red")
scp = simplecentre(onering(p))
lines(scp$pts,col="white")
The 'onering' function just gets the coordinates of one ring from a SpatialPolygons thing that should only be one ring:
onering=function(p){p#polygons[[1]]#Polygons[[1]]#coords}
Capture spatial lines features with the 'capture' function:
capture = function(){p=locator(type="l")
SpatialLines(list(Lines(list(Line(cbind(p$x,p$y))),ID=1)))}
Thanks to #klewis at gis.stackexchange.com for linking to this elegant algorithm for finding the centre line (in response to a related question I asked there).
The process requires finding the coordinates on the edge of a polygon describing the linear feature and performing a Voronoi tessellation of those points. The coordinates of the Voronoi tiles that fall within the polygon of the linear feature fall on the centre line. Turn these points into a line.
Voronoi tessellation is done really efficiently in R using the deldir package, and intersections of polygons and points with the rgeos package.
## Find points on boundary of rPoly (see question)
rPolyPts <- coordinates(as(as(rPoly, "SpatialLinesDataFrame"),
"SpatialPointsDataFrame"))
## Perform Voronoi tessellation of those points and extract coordinates of tiles
library(deldir)
rVoronoi <- tile.list(deldir(rPolyPts[, 1], rPolyPts[,2]))
rVoronoiPts <- SpatialPoints(do.call(rbind,
lapply(rVoronoi, function(x) cbind(x$x, x$y))))
## Find the points on the Voronoi tiles that fall inside
## the linear feature polygon
## N.B. That the width parameter may need to be adjusted if coordinate
## system is fractional (i.e. if longlat), but must be negative, and less
## than the dimension of a cell on the original raster.
library(rgeos)
rLinePts <- gIntersection(gBuffer(rPoly, width=-1), rVoronoiPts)
## Create SpatialLines object
rLine <- SpatialLines(list(Lines(Line(rLinePts), ID="1")))
The resulting SpatialLines object:
You can get the boundary of that polygon as SpatialLines by direct coercion:
rLines <- as(rPoly, "SpatialLinesDataFrame")
Summarizing the coordinates down to a single "centre line" would be possible, but nothing immediate that I know of. I think that process is generally called "skeletonization":
http://en.wikipedia.org/wiki/Topological_skeleton
I think ideal solution would be to build such negative buffer which dynamically reach the minimum width and doesn't break when value is too large; keeps continued object and eventually, draws a line if the value is reached. But unfortunately, this may be very compute demanding because this would be done probably in steps and checks if the value for particular point is enough to have a point (of our middle line). Possible it's ne need to have infinitive number of steps, or at least, some parametrized value.
I don't know how to implement this for now.