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.
Related
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:
The analysis with wavelets seems to be carried out as a discrete transform via matrix multiplication. So it is not surprising, I guess, that when plotting, for example, D4, the R package wmtsa returns the plot:
require(wmtsa)
filters <- wavDaubechies("d4")
plot(filters)
The question is how to go from this discretized plot to the plot in the Wikipedia entry:
Please note that I'm not interested in generating these curves precisely with wmtsa. Any other package will do - I don't have Matlab or Mathematica. But I wonder if the way to go is to start with translating this Mathematica chunk of code in this paper into R, rather than using built-in functions:
Wave1etTransform.m
c[k-1 := c[k] = Daubechies[4][[k+l]];
phi[l] = (l+Sqrt[3])/2 // N;
phi[2] = (l-Sqrt[3])/2 // N;
phi[xJ; xc=0 II x>=3] : = 0
phi[x-?NumberQ] := phi[x] =
N[Sqrt[2]] Sum[c[k] phi[2x-k],{k,0,3}];
In order to plot the wavelet and scaling function all you need are the four numbers shown in the first two plots. I'll focus on plotting the scaling function.
Integer shifts of the scaling function, 𝜑, form an orthonormal basis of the subspace V0 of the multiresolution analysis. We also have that V-1 ⊆ V0 and that 𝜑(x/2) ∈ V-1. Using this gives us the identity
𝜑(x/2) = ∑k ∈ ℤ hk𝜑(x-k)
Now we just need the values of hk. For the Daubechies wavelet these are the values show in the discrete plot you gave (and zero for every other value of k). For an exact value of the hk, first let 𝜇 = (1+sqrt(3))/2. Then we have that
h0 = 𝜇/4
h1 = (1+𝜇)/4
h2 = (2-𝜇)/4
h3 = (1-𝜇)/4
and hk = 0 otherwise.
Using these two things we are able to plot the function using what is known as the cascade algorithm. First notice that 𝜑(0) = 𝜑(0/2) = h0𝜑(0) + h1𝜑(0-1) + h2𝜑(0-2) + h3𝜑(0-3). The only way this equation can hold is if 𝜑(0) = 𝜑(-1) = 𝜑(-2) = 𝜑(-3) = 0. Extending this will show that for x ≦ 0 we have that 𝜑(x) = 0. Furthermore, a similar argument can show that 𝜑(x) = 0 for x ≥ 3.
Thus, we only need to worry about x = 1 and x = 2 to find non-zero values of 𝜑 for integer values of x. If we put x = 2 into the identity for 𝜑(x/2) we get that 𝜑(1) = h0𝜑(2) + h1𝜑(1). Putting x = 4 into the identity gives us that 𝜑(2) = h2𝜑(2) + h3𝜑(1).
We can rewrite the above two equations as a matrix multiplied by a vector equals a vector. In fact, it will be in the form v = Av (v is the same vector on both sides). This means that v is an eigenvector of the matrix A with eigenvalue 1. But v = (𝜑(1), 𝜑(2)) and so by finding this eigenvector using the standard methods we will be able to find the values of 𝜑(1) and 𝜑(2).
In fact, this gives us that 𝜑(1) = (1+sqrt(3))/2 and 𝜑(2) = (1-sqrt(3))/2 (this is where those values in the Mathematica code sample come from). Also note that we need to specifically chose the eigenvector of magnitude 2 for this algorithm to work so you must use those values for 𝜑(1) and 𝜑(2) even though you could rescale the eigenvector.
Now we can find the values of 𝜑(1/2), 𝜑(3/2), and 𝜑(5/2). For example, 𝜑(1/2) = h0𝜑(1) and 𝜑(3/2) = h1𝜑(2) + h2𝜑(1).
With these values, you can then find the values of 𝜑(1/4), 𝜑(3/4), and so on. Continuing this process will give you the value of 𝜑 for all dyadic rationals (rational numbers in the form k/2j.
The same process can be used to find the wavelet function. You only need to use the four different values shown in the first plot rather than the four shown in the second plot.
I recently implemented this Python. An R implementation will be fairly similar.
import numpy as np
import matplotlib.pyplot as plt
def cascade_algorithm(j: int):
mu = (1 + np.sqrt(3))/2
h_k = np.array([mu/4, (1+mu)/4, (2-mu)/4, (1-mu)/4])
# Array to store all the value of phi.
phi_vals = np.zeros((2, 3*2**j+1), dtype=np.float64)
for i in range(3*2**j+1):
phi_vals[0][i] = i/(2**j)
calced_vals = np.zeros((3*2**j+1), dtype=np.bool)
# Input values for 1 and 2.
phi_vals[1][1*2**j] = (1+np.sqrt(3))/2
phi_vals[1][2*2**j] = (1-np.sqrt(3))/2
# We now know the values for 0, 1, 2, and 3.
calced_vals[0] = True
calced_vals[1*2**j] = True
calced_vals[2*2**j] = True
calced_vals[3*2**j] = True
# Now calculate for all the dyadic rationals.
for k in range(1, j+1):
for l in range(1, 3*2**k):
x = l/(2**k)
if calced_vals[int(x*2**j)] != True:
calced_vals[int(x*2**j)] = True
two_x = 2*x
which_k = np.array([0, 1, 2, 3], dtype=np.int)
which_k = ((two_x - which_k > 0) & (two_x - which_k < 3))
phi = 0
for n, _ in enumerate(which_k):
if which_k[n] == True:
phi += h_k[n]*phi_vals[1][int((two_x-n)*2**j)]
phi_vals[1][int(x*2**j)] = 2*phi
return phi_vals
phi_vals = cascade_algorithm(10)
plt.plot(phi_vals[0], phi_vals[1])
plt.show()
If you just want to plot the graphs, then you can use the package "wavethresh" to plot for example the D4 with the following commands:
draw.default(filter.number=4, family="DaubExPhase", enhance=FALSE, main="D4 Mother", scaling.function = F) # mother wavelet
draw.default(filter.number=4, family="DaubExPhase", enhance=FALSE, main="D4 Father", scaling.function = T) # father wavelet
Notice that the mother wavelet and the father wavelets will be plotted depending on the variable "scaling.function". If true, then it plots the father wavelet (scaling), else it plots the mother wavelet.
If you want to generate it by yourself, without packages, I'd suggest you follow Daubechies-Lagarias algorithm, in this paper. It is not hard to implement.
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 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.
I am using R to visualize some data. I am found RGL to be a great library for plotting points.
points3d(x,y,z)
where x = c(x1,x2, ...), y = c(y1,y2,...), z = c(z1,z2, ...) and x,y,z have the same length, is a great function for plotting large sets of data.
Now, I would like to plot ellipses, mixed in with the data. I have a characterization of ellipses by a center point C, a vector describing the major axis U, and a vector describing the minor axis V. I obtain points P on the boundary of the ellipse by
P = U*cos(t) + V*sin(t) (t ranges between 0 and 2*pi)
obtaining vectors, xt, yt, and zt. Then I can plot the ellipse with
polygon3d(xt,yt,zt)
It works fine, but I'm guessing everyone reading is cringing, and will tell me that this is a bad way to do this. Indeed it takes a couple seconds to render each ellipse this way.
I don't think the ellipse3d function from the RGL package works here; at the very least, I am not working a matrix of covariances, nor do I understand how to get the ellipse I want from this function. Also, it returns an ellipsoid, not an ellipse.
****** EDIT ************
For a concrete example that takes awhile:
library(rgl)
open3d()
td <- c(0:359)
t <- td*pi/180
plotEllipseFromVector <- function(c,u,v){
xt <- c[1] + u[1]*cos(t) + v[1]*sin(t)
yt <- c[2] + u[2]*cos(t) + v[2]*sin(t)
zt <- c[3] + u[3]*cos(t) + v[3]*sin(t)
polygon3d(xt,yt,zt)
}
Input center point, major, and minor axis you want. It takes just over 2 seconds for me.
On the other hand, if I change t to be 0,20,40,... 340, then it works quite fast.