Thin Plate Spline for 3D surface prediction in R - r

I tried this answer
get a surface plot in R
but it hasn't really helped.
I would like to perform a TPS (using Tps from Fields{}) on an XYZ dataframe where xy are co-orinates and z is a thickness. Then I would like to visualise the plot firstly before TPS and then after TPS..? Is this possible.
Then I would like to extract predicted thicknesses for a given set of new xy co-ordinates..?
Please let me know if this is possible
My Dataframe looks like this, dataframe is called LSP:
time PART MEAS PARTSUB XLOC YLOC
xxxx 1 1.956 a -3465 -94350
xxxx 1 1.962 a -3465 -53850
xxxx 1 1.951 a 50435 -40350
xxxx 1 1.958 a -57365 -40350
So I tried this:
LSP.spline <- Tps(LSP[,5:6], LSP$MEAS)
out.p <- predict.surface(LSP.spline, xy = c(1,2))
plot.surface(out.p, type="p")
But out.p is just NULL..?
so attempting the plot gives me:
Error in nrow(z) : argument "z" is missing, with no default
Any help is appreciated.
Paul.

predict.surface is now an obsolete / deprecated function. Use predictSurface instead.
fit<- Tps( BD[,1:4], BD$lnya) # fit surface to data
# evaluate fitted surface for first two
# variables holding other two fixed at median values
out.p<- predictSurface(fit)
surface(out.p, type="C")
Thanks for that - how about my second question....how can I extract predicted surface thickness values for a given set of XY locations..?
Use predict function. Have a read on ?predict.Tps. For the above example, let's say we want to predict at the first 4 locations in BD[, 1:4], we can do
predict(fit, x = BD[1:4, 1:4])
# [,1]
#[1,] 11.804124
#[2,] 11.804124
#[3,] 8.069056
#[4,] 9.501551
In general, pass x a two-column matrix.

Related

How to simply extract specific values of regression curve?

I would like to extract several predicted y-values for the x-values given from this graph :
I know that it is possible to get the x and y coordinates of the curve by using the following function :
coordinate <- ggplot_build(curve)$data[[2]][,c("x","y")]
head(coordinate,n = 6L)
# x y
1 0.1810660 32845.225
2 0.4810660 27635.136
3 0.7553301 23904.792
4 1.3295942 18316.923
5 1.8288582 15092.595
6 5.0312446 8018.707
Is there a function that allows you to directly obtain the predicted value of y for a given x value that does not appear in coordinate such as for example 3.5?
As Gregor mentions, you should fit a model aside of the plot.
Best you can do to "simply" obtain a value otherwise is an interpolating spline
sfun = splinefun(coordinate)
sfun(3.5)

How to visualize a distance matrix on the map by the thickness or color of the line connect the adjacent localities in R?

Suppose I have two datasets: (1) a data frame: coordinates of localities, each with ID; and (2) a linguistic distance matrix which reflects the linguistic distance between these localities.
# My data are similar to this structure
# dataframe
id <- c("A","B","C","D","E")
x_coor <- c(0.5,1,1,1.5,2)
y_coor <- c(5.5,3,7,6.5,5)
my.data <- data.frame(id = id, x_coor = x_coor, y_coor = y_coor)
# linguistic distance matrix
A B C D
B 308.298557
C 592.555483 284.256926
D 141.421356 449.719913 733.976839
E 591.141269 282.842712 1.414214 732.562625
Now, I want to visualize the linguistic distance between every two sites onto a map by the thickness or color of the line connect the adjacent localities in R.
Just like this:
enter image description here
My idea is to generate the delaunay triangulation by deldir or tripack package in R.
# generate delaunay triangulation
library(deldir)
de=deldir(my.data$x_coor,my.data$y_coor)
plot.deldir(de,wlines="triang",col='blue',wpoints = "real",cex = 0.1)
text(my.data$x_coor,my.data$y_coor,my.data$id)
this is the plot:
enter image description here
My question is how to reflect the linguistic distance by the thickness or color of the edges of triangles? Is there any other better method?
Thank you very much!
What you want to do in respect of the line widths can be done "fairly
easily" by the deldir package. You simply call plot.deldir() with the
appropriate value of "lw" (line width).
At the bottom of this answer is a demonstration script "demo.txt" which shows how to do this in the case of your example. In particular this script shows
how to obtain the appropriate value of lw from the "linguistic distance
matrix". I had to make some adjustments in the way this matrix was
presented. I.e. I had to convert it into a proper matrix.
I have rescaled the distances to lie between 0 and 10 to obtain the
corresponding values of the line widths. You might wish to rescale in a different manner.
In respect of colours, there are two issues:
(1) It is not at all clear how you would like to map the "linguistic
distances" to colours.
(2) Unfortunately the code for plot.deldir() is written in a very
kludgy way, whence the "col" argument to segments() cannot be
appropriately passed on in the same manner that the "lw" argument can.
(I wrote the plot.deldir() code a long while ago, when I knew far less about
R programming than I know now! :-))
I will adjust this code and submit a new version of deldir to CRAN
fairly soon.
#
# Demo script
#
# Present the linguistic distances in a useable way.
vldm <- c(308.298557,592.555483,284.256926,141.421356,449.719913,
733.976839,591.141269,282.842712,1.414214,732.562625)
ldm <- matrix(nrow=5,ncol=5)
ldm[row(ldm) > col(ldm)] <- vldm
ldm[row(ldm) <= col(ldm)] <- 0
ldm <- (ldm + t(ldm))/2
rownames(ldm) <- LETTERS[1:5]
colnames(ldm) <- LETTERS[1:5]
# Set up the example data. It makes life much simpler if
# you denote the "x" and "y" coordinates by "x" and "y"!!!
id <- c("A","B","C","D","E")
x_coor <- c(0.5,1,1,1.5,2)
y_coor <- c(5.5,3,7,6.5,5)
# Eschew nomenclature like "my.data". Such nomenclature
# is Micro$oft-ese and is an abomination!!!
demoDat <- data.frame(id = id, x = x_coor, y = y_coor)
# Form the triangulation/tessellation.
library(deldir)
dxy <- deldir(demoDat)
# Plot the triangulation with line widths proportional
# to "linguistic distances". Note that plot.deldir() is
# a *method* for plot, so you do not have to (and shouldn't)
# type the ".deldir" in the plotting command.
plot(dxy,col=0) # This, and plotting with "add=TRUE" below, is
# a kludge to dodge around spurious warnings.
ind <- as.matrix(dxy$delsgs[,c("ind1","ind2")])
lwv <- ldm[ind]
lwv <- 10*lwv/max(lwv)
plot(dxy,wlines="triang",col='grey',wpoints="none",
lw=10*lwv/max(lwv),add=TRUE)
with(demoDat,text(x,y,id,col="red",cex=1.5))

calculating area of most suitable raster habitat in R

I have run Maxent for multiple species under present conditions and also under future climate change scenarios. I was quantifying changes between present and future suitable habitat using the nicheOverlap function and Schoener's D statistic. Quite a few of the organisms in my study are just moving farther up mountains so there is a lot of overlap as the future distribution is inside the present distribution (just occupying less area at higher elevations). By looking at the ascii files in QGIS I can see that there is less suitable habitat in terms of area in the future, so I want to quantify this. I have scoured the internet for a good way to calculate area for rasters and never found anything that perfectly suited my fancy. I therefore wrote up something that is an amalgamation of bits and pieces of various scripts. It is pasted below.
Two questions:
1) do you all agree this is doing what I think it is doing (calculating area in square kilometers)?
2) is there a way to simplify this? Specifically you'll see I go from a raster to a dataframe back to raster? Maybe I could stay in rasters?
Thanks for any input!
Rebecca
####
library(raster)
#load rasters
m <- raster("SpeciesA_avg.asc")
mf <- raster("SpeciesA_future_layers_avg.asc")
#change to dataframe
m.df <- as.data.frame(m, xy=TRUE)
#get rid of NAs
m.df1 <- na.omit(m.df)
#keep only cells that that have a suitability score above 0.5 (scores range from 0 to 1)
m.df2 <- m.df1[m.df1$SpeciesA_avg> 0.5,]
#re-rasterize just the suitable area
m.raster <- rasterFromXYZ(m.df2)
##same as above but for future projection
mf.df <- as.data.frame(mf, xy=TRUE)
mf.df1 <- na.omit(mf.df)
mf.df2 <- mf.df1[mf.df1$SpeciesA_future_layers_avg>0.5,]
mf.raster <-rasterFromXYZ(mf.df2)
#get sizes of all cells in current distribution raster
#note my original layers were 30 seconds or 1 km2.
cell_size<-area(m.raster, na.rm=TRUE, weights=FALSE)
#delete NAs from all raster cells. It looks like these come back when switching from dataframe to raster
cell_size1<-cell_size[!is.na(cell_size)]
#compute area [km2] of all cells in raster
raster_area_present<-length(cell_size1)*median(cell_size1)
raster_area_present
#get sizes of all cells in future raster [km2]
cell_size<-area(mf.raster, na.rm=TRUE, weights=FALSE)
#delete NAs from vector of all raster cells
cell_size1<-cell_size[!is.na(cell_size)]
#compute area [km2] of all cells in geo_raster
raster_area_future<-length(cell_size1)*median(cell_size1)
raster_area_future
##calculate change in area
dif_area <- raster_area_present - raster_area_future
dif_area
When you ask a question, you should provide a simple self-contained example. Not just dump your script that points to files we do not have. Writing a simple example teaches your R, and often helps you solve the problem by yourself. Anyway, I here is some example data and solution to your problem, I think:
library(raster)
#example data
m <- mf <- raster(ncol=10, nrow=10, vals=0)
m[,1] <- NA
m[,3:7] <- 1
mf[,6:9] <- 1
# get rid of NAs (the example has none); should not be needed
m <- reclassify(m, cbind(NA, NA, 0))
mf <- reclassify(mf, cbind(NA, NA, 0))
# keep cells > 0.5 (scores range from 0 to 1)
m <- round(m)
mf <- round(mf)
# now combine the two layers, for example:
x <- m + mf * 10
# area of each cell
a <- area(x)
# sum area by class
z <- zonal(a, x, sum)
# zone value
#[1,] 0 152327547
#[2,] 1 152327547
#[3,] 10 101551698
#[4,] 11 101551698
zone 0 is "not current, nor future", 1 is "current only", 10 is "future only" and 11 is "current and future"
The areas are in m^2.
You may want to check out this tutorial on maxent and other spatial distribution models: http://rspatial.org/sdm/

How do I select data inside a density curve in R?

I have a 2 varaible data set that I have to plot (na and ob). I applied the kde2d kernel and plotted 1 to 4 sigma density curves (confidencebound). I need to select those points that are inside 2 sigma curves (letting out all those between 1 and 2 sigmas), but not just in the plot, I neet select them from the data set, put them in a new list. Could you please help me with this?
kde_BPT <- kde2d(na,ob, n=1000, lims=c(-2,2,-1.5,1.5))
confidencebound <- quantile(kde_BPT$z, probs=c(0.685,0.955,0.9975,0.99995), na.rm = TRUE)
The data are to large to paste here. I put here the plot if that helps, I need to know which data points (any colour) are in the area between the contour curves of 1 and 2 (sigmas).
The plot
Thanks for your help.

Plotting Probability Density Heatmap Over Time in R

Let's say I have the output of a monte-carlo simulation of one variable over several different iterations (think millions). For each iteration, I have the values of the variable at each point in time (ranging from t=1 to t=365).
I would like to produce the following plot:
For each point in time, t, on the x axis and for each possible value "y" in a given range, set the color of x,y to "k" where "k" is a count of how many observations are within a vicinity of distance "d" to x,y.
I know you can easily make density heatmaps for 1D data, but is there a good package for doing this on 2 dimensions? Do I have to use kriging?
Edit: The data structure is currently a matrix.
data matrix
day number
[,1] [,2] [,3] [,4] [,5] ... [,365]
iteration [1,] 0.000213 0.001218 0.000151 0.000108 ... 0.000101
[2,] 0.000314 0.000281 0.000117 0.000103 ... 0.000305
[3,] 0.000314 0.000281 0.000117 0.000103 ... 0.000305
[4,] 0.000171 0.000155 0.000141 0.000219 ... 0.000201
.
.
.
[100000000,] 0.000141 0.000148 0.000144 0.000226 ... 0.000188
I want to, for each "day" have the pixels running vertically across that "day" to represent the probability density of the iteration's values for that day in color. The result should look like a heatmap.
Here is one solution to what I think you are after.
Generate data.
myData <- mapply(rnorm, 1000, 200, mean=seq(-50,50,0.5))
This is a matrix with 1000 rows (observations) and 201 time points. In each time point the mean of data there shifts gradually from -50 to 50. By 0.5 each time.
Get densities.
myDensities <- apply(myData, 2, density, from=-500, to=500)
This will give you a list of densities for each column. In order for them to be plottable side by side we specified the ranges (from -500 to 500) manually.
Obtain density values from the list.
Ys <- sapply(myDensities, "[", "y")
This is again a list. You need to get a matrix from that.
Get matrix from list.
img <- do.call(cbind, Ys)
This simply combines all Ys elements by column.
Plot.
filled.contour(x=1:ncol(img), y=myDensities[[1]]$x, t(img))
I use filled.contour for that. But you can look around for other 2-D plot functions. I also used values obtained from the densities D[[1]]$x.
And here is the result:
The shift from -50 to 50 is visible.
Not sure if this can work well with millions of time points. But plotting million probably makes little sense since you will in any case by limited by the number of pixels. Some kind of pre-processing might be necessary.
Another way to present data over time is to create a video.
The following uses the same matrix data as Karolis:
library(av)
myData <- mapply(rnorm, 1000, 200, mean=seq(-50,50,0.5))
# create function that includes a for loop, the output from
# each iteration of the for loop will become one frame in
# the animation.
make_plot <- function(myData){
xrange = range(myData)
for(i in seq_along(myData[1,])){
d <- density(myData[,i],
bandwidth = 45) # returns the density data
plot(d,
xlim=xrange,
ylim=c(0, 0.003),
main = paste("Density, day:",i))
}
}
# create video
av_capture_graphics(make_plot(myData),
output = "Density change over time.mp4",
width = 720,
height = 480,
framerate = 120)

Resources