3D surface plot in R with plot3D or plotly - r

I want to produce a 3D surface in R where y is flux, x is Age and z is precipitation. I have a range of age between 0 and 152 and a range of precipitation 0 and 2600.
I also have two functions where flux is function of Age or Precipitation:
Flux= 0.387217066*(Age^0.328086337)*(exp(-0.004177033*Age)
and
Flux= 1.117997*(1-exp(-exp(-5.426564)*(Preci-(-220.745499))
What I want to achieve is something a bit like this:
I have tried to do it with the package plot3D in R without success (see below)
Age<- as.matrix(seq(0:152))
Preci<-as.matrix(seq(from=10, to=2600, by=17))
Flux= as.matrix(0.387217066*(Age^0.328086337)*(exp(-0.004177033*Age)) - 1.117997*(1-exp(-exp(-5.426564)*(Preci-(-220.745499)))))
surf3D(Age, Preci, Flux, colvar = Flux, colkey = FALSE, facets = FALSE)
I got this error message
Error in if (is.na(var)) ispresent <- FALSE else if (length(var) == 1) if (is.logical(var)) if (!var) ispresent <- FALSE :
argument is of length zero

Here's a start, using emdbook::curve3d() as a wrapper for lattice::wireframe (see the sys3d argument to ?curve3d). It's not obvious to me why it would make sense to combine your functions of flux as a function of age vs precip by subtracting one from the other, but as that's what you did above ...
## for readability, put numeric values in a separate vector
params <- c(a0=0.387217066,a1=0.328086337,a2=0.004177033,
p0=1.117997,p1=5.426564,p2=-220.745499)
library("emdbook")
curve3d(with(as.list(params),
a0*(Age^a1)*exp(-a2*Age)-
p0*(1-exp(-exp(-p1)*(Preci-p2)))),
varnames=c("Age","Preci"),
xlim=c(0,200),ylim=c(10,2600),
sys3d="wireframe",
col="gray",
zlab="Flux")
curve3d also returns a list with components $x, $y, $z that you can use as input to other 3D graphing frameworks.

Related

Plotting Maxwellian Distribution in Julia

I have a list of positive and negative values and a single temperature. I am trying to plot the Maxwell-Boltzmann Distribution using the equation for particles moving in only one direction.
m_e = 9.11E-28 # electron mass [g]
k = 1.38E-16 # boltzmann constant [erg*K^-1]
v = range(1e10, -1e10, step=-1e8) # velocity [cm/s]
T_M = 1e6 # temperature of Maxwellian [K]
function Maxwellian(v_Max, T_Max)
normal = (m_e/(2*pi*k*T_Max))^1.5
exp_term = exp(-((m_e).*v_Max.*v_Max)/(3*k*T_Max))
return normal*exp_term
end
# Initially comparing chosen distribution f_s to Maxwellian F_s
plot(v, Maxwellian.(v, T_M), label= L"F_s" * " (Maxwellian)")
xlabel!("velocity (cm/s)")
ylabel!("probability density")
However, when, plotting this, my whole function is 0:
I tested out if I wrote my function correctly by replacing return normal*exp_term with return exp_term (i.e. ignoring any normalization constants) and this seems to produce the distinct of the bell curve:
Yet, without the normalization constant, this will not preserve the area under the curve. I was wondering what may I be doing incorrectly with setting up my Maxwellian function and the constant in front of the exponential.
If you print the normalization term on its own:
julia> (m_e/(2*pi*k*T_M))^1.5
1.0769341115495682e-27
you can see that it is 10 orders of magnitude smaller than the Y-axis scale used for the plot. You can set the Y-axis limits during the plots with ylims argument, or after the plot with:
julia> ylims!(-1e-28, 2e-27)
which changes the plot to:

Difference between plots in IDL

I'm working with two plots of density as a function of distance on IDL. What I'd like to do with them is convert them into plots of distance as a function of density and plot their difference, in order to obtain the shift in distance as a function of density. The issue I'm having is that one of the equations for density as a function of distance is non invertible.
Any idea on what I could do to overcome this problem?
Thanks in advance. Here are the tewo plots that I'm trying to invert and take the difference of.
lowe = ALOG10(10.)
uppe = ALOG10(170.)
re = DINDGEN(100)*(uppe - lowe)/(100 - 1L) + lowe
r = 10^(re)
loweB = ALOG10(10.)
uppeB = ALOG10(170.)
reB = DINDGEN(100)*(uppeB - loweB)/(100 - 1L) + loweB
rB = 10^(reB)
pl = plot(r,density_r(r), /XLOG, /YLOG)
plB = plot(r,freq_ratB(r), /OVERPLOT, /XLOG, /YLOG)
end
FUNCTION density_r, r
return, 4.8e9/r^14 + 3e8/r^6 + 1.4e6/r^2.3
END
FUNCTION freq_ratB, r
return, 10.*(r/215.)^(-2.8)
END
It is easy to plot distance as a function of density — just change the order of the arguments to plot, i.e.:
p_r = plot(density_r(r), r, /xlog, /ylog)
plB_r = plot(freq_ratB(r), r, /overplot, /xlog, /ylot)
But to subtract the two plots, the x-coordinates of your difference plot must be the same for the two operands of the difference. You can write an equation to invert one of your functions:
; intvert freq_ratB
function r_freq_ratB, density
compile_opt strictarr
return, 215.0 * exp((alog(density) - log(10.0)) / (-2.8))
end
So then you can plot the difference:
p_difference = plot(density, r - r_freq_ratB(density))
If you couldn't invert one of your functions, e.g., you were plotting observational data, then you would have to interpolate.

Return the frequency in a bin of a 2D histogram in Julia

Suppose I have some 2D data points, and using the Plots package in Julia, a 2D histogram can be easily plotted. My task is to define a function that maps between a data point to the frequency of data points of the bin to which that point belongs to. Are there any functions that serve well for this task?
For example, as in the following 2D histogram:
And I would like to define a function, such that when I input an arbitrary data points that is within the domain of this histogram, the function will output the frequency of the corresponding bin. In the image above, when I input (0.1, 0.1), the function should output, say, 375 (I suppose the brightest grid there represents the frequency of 375). Are there any convenient functions in Julia to achieve the aforementioned task?
Edit:
using Plots
gr()
histogram2d(randn(10000), randn(10000), nbins=20)
A histogram is created from 10000 2D data points generated from standard normal distribution. Is there any function in Julia to input a 2D point and output the frequency of the bin to which the point belongs to? It is possible to write one myself by creating arrays and bins and counting the number of elements in the bin of an inputted data point but this will be the tedious way.
I'm not 100% sure whether this is what StatsPlots is doing, but one approach could be to use StatsBase's histogram which works for N dimensions:
using StatsBase, StatsPlots, Distributions
# Example data
data = (randn(10_000), randn(10_000))
# Plot StatsPlots 2D histogram
histogram2d(data)
# Fit a histogram with StatsBase
h = fit(Histogram, data)
x = searchsortedfirst(h.edges[1], 0.1) # returns 10
y = searchsortedfirst(h.edges[2], 0.1) # returns 11
h.weights[x, y] # returns 243
# Or as a function
function get_freq(h, xval, yval)
x = searchsortedfirst(h.edges[1], xval)
y = searchsortedfirst(h.edges[2], yval)
h.weights[x, y]
end
get_freq(h, 1.4, 0.6) # returns 32

Subset 3D matrix using polygon coordinates

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.

R rgl 3d log scale plot and Antenna pattern plots

first of all before my sharing my problem I want to share a bit of code that might be helpful for some people outside there. I have been looking quite some time code to plot in 3d antenna measurements but I could not find code that does that. The problem is that antenna measurements have polar coordinates and typical 3d plot functions use cartesian coordinates. So my code below does just that (I am not an advanced programmer so I am sure someone might be able to optimize it for its use). The code can be run directly and I added comments to make it easier readable.
require("rgl")
require("fields")
degreeToRadian<-function(degree){
return (0.01745329252*degree)
}
turnPolarToX<-function(Amplitude,Coordinate){
return (Amplitude*cos(degreeToRadian(Coordinate)))
}
turnPolarToY<-function(Amplitude,Coordinate){
return (Amplitude*sin(degreeToRadian(Coordinate)))
}
# inputs for the code
test<-runif(359,min=-50,max=-20) # the 359 elements correspond to the polar coordinates of 1 to 359
test2<-runif(359,min=-50,max=-20) # the 359 elements correspond to the polar coordinates of 1 to 359
test3<-runif(359,min=-50,max=-20) # the 359 elements correspond to the polar coordinates of 1 to 359
# My three input vectors above are considered to be dBm values, typically unit for antenna or propagation measurements
# I want to plot those on three different 3d planes the XY, the YZ and the ZX. Since the rgl does not support
# polar coordinates I need to cast my polar coordinates to cartesian ones, using the three functions
# defined at the beginning. I also need to change my dBm values to their linear relative ones that are the mW
# Convert my dBm to linear ones
test<-10^(test/10)
test2<-10^(test2/10)
test3<-10^(test3/10)
# Start preparing the data to be plotted in cartesian domain
X1<-turnPolarToX(test,1:359)
Y1<-turnPolarToY(test,1:359)
Z1<-rep(0,359)
X2<-turnPolarToX(test2,1:359)
Y2<-rep(0,359)
Z2<-turnPolarToY(test2,1:359)
X3<-rep(0,359)
Y3<-turnPolarToX(test3,1:359)
Z3<-turnPolarToY(test3,1:359)
# Time for the plotting now
Min<-min(test,test2,test3)
Max<-max(test,test2,test3)
bgplot3d( suppressWarnings (
image.plot( legend.only=TRUE, legend.args=list(text='dBm/100kHz'), zlim=c(Min,Max),col=plotrix::color.scale(seq(Min,Max,length.out=21),c(0,1,1),c(0,1,0),0,xrange=c(Min,Max)))
) # zlim is the colorbar numbers
)
# for below alternatively you can also use the lines3d to get values
points3d(X1,Y1,Z1,col=plotrix::color.scale(test,c(0,1,1),c(0,1,0),0,xrange=c(Min,Max)),add=TRUE)
points3d(X2,Y2,Z2,col=plotrix::color.scale(test2,c(0,1,1),c(0,1,0),0,xrange=c(Min,Max)),add=TRUE)
points3d(X3,Y3,Z3,col=plotrix::color.scale(test3,c(0,1,1),c(0,1,0),0,xrange=c(Min,Max)),add=TRUE)
The problem I have now is that my plotting ideally I would like to be on a log scale that the rgl packet does not support! If I try to use log on my X,Y,Z to compress them I get an error that log is not defined for negative numbers (of course that is correct). How would you think to solve that problem on compressing the axes values when log scale plotting is not supported?
I would like to thank you for your reply
Regards
Alex
It doesn't make sense to apply a log scale to X, Y and Z. Just apply it to your original data, and transform the logged values to polar coordinates.
Since your logged test values are negative, you probably will want to apply an offset; polar coordinates with negative radius values are pretty hard to interpret.
Once you have done that, you can use the axis3d() function to add an axis with arbitrary labels to the plot. For example, if you want the origin to correspond to -50 dBm, you'd skip the transformation to linear coordinates and just add 50. You need to undo this when calculating labels. Here's your example, modified:
require("rgl")
require("fields")
degreeToRadian<-function(degree){
return (0.01745329252*degree)
}
turnPolarToX<-function(Amplitude,Coordinate){
return (Amplitude*cos(degreeToRadian(Coordinate)))
}
turnPolarToY<-function(Amplitude,Coordinate){
return (Amplitude*sin(degreeToRadian(Coordinate)))
}
# inputs for the code
test<-runif(359,min=-50,max=-20) # the 359 elements correspond to the polar coordinates of 1 to 359
test2<-runif(359,min=-50,max=-20) # the 359 elements correspond to the polar coordinates of 1 to 359
test3<-runif(359,min=-50,max=-20) # the 359 elements correspond to the polar coordinates of 1 to 359
# Add an offset of 50 to the values.
test <- test + 50
test2 <- test2 + 50
test3 <- test3 + 50
# Start preparing the data to be plotted in cartesian domain
X1<-turnPolarToX(test,1:359)
Y1<-turnPolarToY(test,1:359)
Z1<-rep(0,359)
X2<-turnPolarToX(test2,1:359)
Y2<-rep(0,359)
Z2<-turnPolarToY(test2,1:359)
X3<-rep(0,359)
Y3<-turnPolarToX(test3,1:359)
Z3<-turnPolarToY(test3,1:359)
# Time for the plotting now
Min<-min(test,test2,test3)
Max<-max(test,test2,test3)
bgplot3d( suppressWarnings (
image.plot( legend.only=TRUE, legend.args=list(text='dBm/100kHz'), zlim=c(Min,Max)-50,col=plotrix::color.scale(seq(Min-50,Max-50,length.out=21),c(0,1,1),c(0,1,0),0,xrange=c(Min,Max)-50))
) # zlim is the colorbar numbers
)
# for below alternatively you can also use the lines3d to get values
points3d(X1,Y1,Z1,col=plotrix::color.scale(test,c(0,1,1),c(0,1,0),0,xrange=c(Min,Max)),add=TRUE)
points3d(X2,Y2,Z2,col=plotrix::color.scale(test2,c(0,1,1),c(0,1,0),0,xrange=c(Min,Max)),add=TRUE)
points3d(X3,Y3,Z3,col=plotrix::color.scale(test3,c(0,1,1),c(0,1,0),0,xrange=c(Min,Max)),add=TRUE)
# Add axes
labels <- pretty(c(-50, -20))
axis3d("x", at = labels + 50, labels = labels, pos = c(NA, 0, 0) )
axis3d("y", at = labels + 50, labels = labels, pos = c(0, NA, 0) )
axis3d("z", at = labels + 50, labels = labels, pos = c(0, 0, NA) )
One my system it produces this display:
You might want to add circles to show how the scale continues around in each plane. This code would do it:
theta <- seq(0, 2*pi, len = 100)
for (i in seq_along(labels)) {
x <- (labels[i] + 50)*cos(theta)
y <- (labels[i] + 50)*sin(theta)
lines3d(x, y, 0)
lines3d(x, 0, y)
lines3d(0, x, y)
}
I find the plot too busy with those added, but you can try it and decide for yourself.

Resources