15
You might be interested in the approach with optimal transport.
Let $F(x)=\int_{-\infty}^x f(y)\,dy$ and $G(x)=\int_{-\infty}^x g(y)\,dy$ be the repartition functions. Then $T(x)=G^{-1}\bigl(F(x)\bigr)$ is the optimal transport map from $f$ to $g$. The map $T_t(x)=(1-t)x+tT(x)$ is the displacement geodesic, so that the intermediate densities are given by $(...
13
One good way to interpolate a function of this nature is to take its Log, interpolate, and take Exp of the result.
lntrp = Interpolation[data4[100] /. {x_, y_} -> {x, Log[y]}]
Plot[Exp[lntrp[x]], {x, 99.98, 100.01}, PlotRange -> All]
7
Clear["Global`*"]
f[x_] := Exp[-(x + 3)^2]
g[x_] := 1/2 Exp[-(x - 3)^2/4]
Treating f and g as unnormalized distributions
distf = ProbabilityDistribution[f[x],
{x, -Infinity, Infinity}, Method -> "Normalize"];
distg = ProbabilityDistribution[g[x],
{x, -Infinity, Infinity}, Method -> "Normalize"];
disth = TransformedDistribution[(x + y)/2,
{...
3
if0 = Interpolation[data0,
"ExtrapolationHandler" -> {Automatic, "WarningMessage" -> False}];
difference = {#, #2 - if0 @ #} & @@@ data9k;
ListLinePlot[{data0, data9k, difference}, ImageSize -> Large,
PlotLegends -> {"data0", "data9k", "difference"}]
An alternative approach is to use TemporalData:
td0 = TemporalData[#2, {#}, ...
2
This is not complete answer, I only show how to overcome your issues with Plot.
Your first check
Do[Print[Plot[
Evaluate[Lh[hfuns[[i]], x] - hvals[[i]]*hfuns[[i]][x]], {x,
0, π}]], {i, 6}]
can be done in the following way:
GraphicsGrid@
Partition[
Table[Plot[
Evaluate[(Lh[hfuns[[i]], x]) - hvals[[i]]*hfuns[[i]][x]],
{x, ...
2
This is an extended comment versus an answer, but you can improve your interpolation by performing it on log-log transformed. If you ListPlot mydata, you will see that much of the data is up against the x=0 axis.
ListPlot[mydata]
Since your data looks much nicer and spread out on a ListLogLogPlot, you can perform the interpolation on Log-Log transformed ...
2
Too long for a comment to John Doty's answer:
While the answer might suit your needs (i.e. a smooth curve that passes through your points and remains positive), I would not say that it is a good way of interpolating.
In the example below, I illustrate two bad properties of taking the exponential of log-interpolated values:
sensitivity to vertical ...
2
BezierCurve only is a Graphics3D-object. Use BezierFunction to describe a function.
Examplary here I give the calculation of the curvature kappa of the BezierFunction
pts = Table[{2 Cos[t], 2 Sin[t], 3*t}, {t, 0, 6, 0.01}];
x = BezierFunction[pts]
kappa = Sqrt[#.#] &[ D[x'[u]/Sqrt[x'[u].x'[u]], u]/Sqrt[x'[u].x'[u]]];
Plot[kappa, {u, 0, 1}, PlotRange -&...
1
Linear interpolation doesn't show this over/under-swinging behavior of polynomial interpolation of higher order.
Clear[Interpolate]
Interpolate[100] = Interpolation[data4[100], InterpolationOrder -> 1];
Plot[Interpolate[100][x], {x, 100.0033, 100.0034}, PlotRange -> {-2*10^4, +10*10^4}]
Alternatively, if you don't want to use linear interpolation ...
1
I could get some results by defining before the my data block:
diffeq = {T'[t]/T[t] == -1/(1 + (1/3)*T[t]/f[T[t]]*f'[T[t]])}
boundary = {T[-40] == 10^10}
odeqs = diffeq~Join~boundary
Where I took freedom to change 0.3 to (1/3), since they're not equal and your equation seems to use the latter.
And then using after defining f[x_]:
sol = NDSolve[odeqs, T, {...
Only top voted, non community-wiki answers of a minimum length are eligible
