I need to find the volume from the surface down to a specific contour in R. Taking the contour example from the R help files:
x <- 10*1:nrow(volcano)
y <- 10*1:ncol(volcano)
contour(x,y,volcano)
given the resulting graph, how do I find the volume from a specific contour line up to the surface.
In practice, I will use bkde2D to get a density map for a scatter plot. From this I can make the contour plot, but I would like to determine the volume defined by various density cutoffs in the resulting plot.
Function contour just draw the contour lines but doesn't return any values. What you need to use is function contourLines.
cL <- contourLines(x,y,volcano)
From there, you can calculate the area of each contour lines the following way:
area <- rep(0,length(cL))
for(i in 1:length(cL)){
d <- data.frame(cL[[i]]$x,cL[[i]]$y)
sa <- sb <- 0
for(j in 1:(nrow(d)-1)){
sa <- sa+d[j,1]*d[j+1,2]
sb <- sb+d[j,2]*d[j+1,1]
}
area[i] <- abs((sa-sb)/2)
}
area
[1] 1.413924e+05 3.109685e+04 2.431528e+04 2.049473e+04 6.705976e+04 3.202145e+05 1.720469e+03
[8] 2.926802e+05 2.335421e+05 1.834791e+05 1.326162e+05 4.672784e+02 9.419792e+04 5.121851e+03
[15] 5.126860e+04 3.660862e-01 1.216750e+03 2.051307e+04 4.670745e+02 4.146927e+03
Now, if you want the volume between two contour lines (say between levels 120 and 130):
level1 <- 120
level2 <- 130
levels <- unlist(lapply(cL,function(x)x$level))
base <- (1:length(cL))[level==level1]
top <- (1:length(cL))[level==level2]
vol <- (level[top]-level[base])*(area[base]+area[top])/2
vol
[1] 2631111
And that's as far as I can go because I don't see how to proceed if the next contour line is split into several sectors.
Related
I have two numerical variables that I plotted in the following by means command density in R. The code is the following:
d0<-density(T0,n=2^14)
df_density0<-data.frame(x=d0$x,y=d0$y,stringsAsFactors = FALSE)
d1<-density(T1,n=2^14)
df_density1<-data.frame(x=d1$x,y=d1$y,stringsAsFactors = FALSE)
Initially, I had left the number of equally spaced points n at the default value 512, but then I realized that the area under a density plot d1 was not equal to 1 (it was around 13). Then I selected the proper number n in order to obtain an AUC (area under curve) near to 1 for both the density plots. In this way:
library(zoo)
x <- df_density0$x
y <- df_density0$y
id <- order(x)
AUC0 <- sum(diff(x[id])*rollmean(y[id],2))
x <- df_density1$x
y <- df_density1$y
id <- order(x)
AUC1 <- sum(diff(x[id])*rollmean(y[id],2))
For n=2^14 I obtained AUC0 and AUC1 equal to 0.9999... I plotted these density curves and I obtained the following graphic (blue is for T0 and red is for T1):
Since these graphs were indistinguishable from each other, I selected a logarithmic scale for the vertical axis:
Is it possible that I get such a result? Should I change the kernel field in the density function?
Ps. To draw these graphs I exported d0 and d1 in two csv files to import them into LaTeX. Anyway, I obtained the same plots in R. Moreover,
> nrow(T0)
[1] 9760
> nrow(T1)
[1] 1963
I have two sets of data
I had plotted two probability density functions. Now I want the area between the two probability density functions, which are in certain x range.
I tried to integrate the area, trapezoidal rule etc:
Calculating the area between a curve and a straight line without finding the function
Error calculating the area between two lines using "integrate"
How to measure area between 2 distribution curves in R / ggplot2
but all are in vain.
Here is the link to the data i am working on.
https://sheet.zoho.com/sheet/editor.do?doc=1ff030ea1af35f06f8303927d7ea62b3c4b04bdae021555e8cc43ed0569cb2aaceb26368f93db4d15ac66cf7662d9a7873e889e1763139a49ffd68e7843e0b44
dens.pre=density(TX/10)
dens.post=density(TX30/10)`
plot(dens.pre,col="green")
lines(dens.post,col="red")
locator()
#$x
#[1] 18.36246
#$y
#[1] 0.05632428
abline(v=18.3,col="red")
Finding the area between the two curves for X > 18.3.
Area between the curves:
With trapezoidal rule you could probably calculate it like this:
d0 <- dens.pre
d1 <- dens.post
f0 <- approxfun(d0$x, d0$y)
f1 <- approxfun(d1$x, d1$y)
# defining x range of the density overlap
ovrng <- c(18.3, min(max(d0$x), max(d1$x)))
# dividing it to sections (for example n=500)
i <- seq(min(ovrng), max(ovrng), length.out=500)
# calculating the distance between the density curves
h1 <- f0(i)-f1(i)
h2 <- f1(i)-f0(i)
#and using the formula for the area of a trapezoid we add up the areas
area1<-sum( (h1[-1]+h1[-length(h1)]) /2 *diff(i) *(h1[-1]>=0+0)) # for the regions where d1>d0
area2<-sum( (h2[-1]+h2[-length(h2)]) /2 *diff(i) *(h2[-1]>=0+0)) # for the regions where d1<d0
area_total <- area1 + area2
area_total
Though, since you are interested only in the area where one curve remain below the other for the whole range, this can be shortened:
d0 <- dens.pre
d1 <- dens.post
f0 <- approxfun(d0$x, d0$y)
f1 <- approxfun(d1$x, d1$y)
# defining x range of the density overlap
ovrng <- c(18.3, min(max(d0$x), max(d1$x)))
# dividing it to sections (for example n=500)
i <- seq(min(ovrng), max(ovrng), length.out=500)
# calculating the distance between the density curves
h1 <- f1(i)-f0(i)
#and using the formula for the area of a trapezoid we add up the areas where d1>d0
area<-sum( (h1[-1]+h1[-length(h1)]) /2 *diff(i) *(h1[-1]>=0+0))
area
#We can plot the region using
plot(d0, main="d0=black, d1=green")
lines(d1, col="green")
jj<-which(h>0 & seq_along(h) %% 5==0); j<-i[jj];
segments(j, f1(j), j, f1(j)-h[jj])
There are other (and more detailed) solutions here and here
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 have two sets of points in the ten-dimensional space (or 2 data frames with 1000 rows and 10 columns). I need to construct two 95% confidence ellipsoids and calculate intersection volume between them. Maybe someone can help me?
The first set of points is a and there are only two variables in ellipse construction, but I need 10:
a <- read.csv("Y:/1.csv", header=FALSE, sep=";")
library("car")
x <- a$V1
y <- a$V2
with(a, dataEllipse(x, y, level=0.95, fill=TRUE, fill.alpha=0.1))
enter image description here
or another way I know to build the confidence ellipse for 2-dimensional space:
library("ggplot2")
x <- a$V1
y <- a$V2
qplot(data = a, x, y) + stat_ellipse()
enter image description here
I can't find some tools to construct ellipsoids in the 10-dimensional space and calculate intersection volume.
I have a 3-tuple data set (X,Y,Z points) that I want to plot using R.
I want to create a surface plot from the data, and superimpose a contour map on the surface plot, so as to create the impression of the contour map being the "shadow" or projection from the surface plot. The contour map is to appear below the surface plot.
My data set looks somewhat like this:
Axis | Data Type
-------------------
X | Date value
Y | Float value
Z | Float value
How can I achieve this?
Edit:
I just saw that you pointed out one of your dimensions is a date. In that case, have a look at Jeff Ryan's chartSeries3d which is designed to chart 3-dimensional time series. Here he shows the yield curve over time:
Original Answer:
As I understand it, you want a countour map to be the projection on the plane beneath the 3D surface plot. I don't believe that there's an easy way to do this other than creating the two plots and then combining them. You may find the spatial view helpful for this.
There are two primary R packages for 3D plotting: rgl (or you can use the related misc3d package) and scatterplot3d.
rgl
The rgl package uses OpenGL to create interactive 3D plots (read more on the rgl website). Here's an example using the surface3d function:
library(rgl)
data(volcano)
z <- 2 * volcano # Exaggerate the relief
x <- 10 * (1:nrow(z)) # 10 meter spacing (S to N)
y <- 10 * (1:ncol(z)) # 10 meter spacing (E to W)
zlim <- range(z)
zlen <- zlim[2] - zlim[1] + 1
colorlut <- terrain.colors(zlen,alpha=0) # height color lookup table
col <- colorlut[ z-zlim[1]+1 ] # assign colors to heights for each point
open3d()
rgl.surface(x, y, z, color=col, alpha=0.75, back="lines")
The alpha parameter makes this surface partly transparent. Now you have an interactive 3D plot of a surface and you want to create a countour map underneath. rgl allows you add more plots to an existing image:
colorlut <- heat.colors(zlen,alpha=1) # use different colors for the contour map
col <- colorlut[ z-zlim[1]+1 ]
rgl.surface(x, y, matrix(1, nrow(z), ncol(z)),color=col, back="fill")
In this surface I set the heights=1 so that we have a plane underneath the other surface. This ends up looking like this, and can be rotated with a mouse:
scatterplot3d
scatterplot3d is a little more like other plotting functions in R (read the vignette). Here's a simple example:
temp <- seq(-pi, 0, length = 50)
x <- c(rep(1, 50) %*% t(cos(temp)))
y <- c(cos(temp) %*% t(sin(temp)))
z <- c(sin(temp) %*% t(sin(temp)))
scatterplot3d(x, y, z, highlight.3d=TRUE,
col.axis="blue", col.grid="lightblue",
main="scatterplot3d - 2", pch=20)
In this case, you will need to overlay the images. The R-Wiki has a nice post on creating a tanslucent background image.