Higher precision with special functions [closed]

Question

I'm currently working with the HeunB function, and am finding that its numerical precision is not sufficient at large arguments - in particular I have the function $\text{HeunB}\left[-k^2,1-\beta ,\frac{1}{2},0,2 \beta ,t\right]$, which from what I can tell, for $\beta\geq 0$ and $t\gg 1/\sqrt{\beta}$, grows like $e^{-\beta t^2/2}$.

This is a problem since my calculation ultimately comes down to the cancellation between two such functions, and requires more digits than mathematica is willing to give me:

Manipulate[ LogLogPlot[{Abs[\[Xi] 2 E^(\[Beta] \[Xi]^2) ( HeunB[-k^2, 1, 3/2, 0, 2 \[Beta], t] HeunB[-k^2, 1 - \[Beta], 1/ 2, 0, 2 \[Beta], \[Xi]] - Sqrt[\[Xi]/t] HeunB[-k^2, 1, 3/2, 0, 2 \[Beta], \[Xi]] HeunB[-k^2, 1 - \[Beta], 1/2, 0, 2 \[Beta], t])]}, {\[Xi], 0, t}, PlotPoints -> 4, GridLines -> {{Sqrt[2/\[Beta]]}, {}}, PlotRange -> {0.000001, 100}], {k, 0, 10}, {\[Beta], 0.1, 10}, {t, 1, 20}]

Plotting the above function, you'll notice a dramatic numerical blow up as you take $t$ and $\beta$ larger.

Is there any way to get mathematica to spit out more digits?

Answer 1

$Version

(* "13.2.1 for Mac OS X ARM (64-bit) (January 27, 2023)" *)

ClearAll["Global`*"];

Don't use machine precision and specify a WorkingPrecision

Manipulate[
 {k, β, t} = Rationalize[{kv, βv, tv}];
 LogLogPlot[{Abs[ξ 2 E^(β ξ^2) (HeunB[-k^2, 1, 3/2, 0, 
         2 β, t]*
         HeunB[-k^2, 1 - β, 1/2, 0, 2 β, ξ] -
       Sqrt[ξ/t] HeunB[-k^2, 1, 3/2, 0, 2 β, ξ]*
         HeunB[-k^2, 1 - β, 1/2, 0, 2 β, t])]},
  {ξ, 0, t},
  GridLines -> {{Sqrt[2/β]}, {}},
  PlotRange -> {10^-8, 100},
  MaxRecursion -> 5,
  WorkingPrecision -> 25],
 {{kv, 10, "k"}, 0, 10, 0.1, Appearance -> "Labeled"},
 {{βv, 10, "β"}, 0.1, 10, 0.1, Appearance -> "Labeled"},
 {{tv, 10, "t"}, 1, 20, 0.1, Appearance -> "Labeled"},
 SynchronousUpdating -> False,
 TrackedSymbols :> {kv, βv, tv}]

EDIT: To get the full plot, i.e., out to ξ = t, much higher precision is required. This significantly slows down the plotting. The plot is split in two parts so that the higher precision is only used for the larger values of ξ

Manipulate[{k, β, t} = Rationalize[{kv, βv, tv}];
 Block[{$MaxExtraPrecision = 200},
  Show[
   LogLogPlot[
    {Abs[ξ 2 E^(β ξ^2) (HeunB[-k^2, 1, 3/2, 0, 2 β, t]*
          HeunB[-k^2, 1 - β, 1/2, 0, 2 β, ξ] -
         Sqrt[ξ/t] HeunB[-k^2, 1, 3/2, 0, 2 β, ξ]*
          HeunB[-k^2, 1 - β, 1/2, 0, 2 β, t])]},
    {ξ, 0, t/4},
    GridLines -> {{Sqrt[2/β]}, {}},
    PlotRange -> {{0, t}, {10^-8, 300}},
    MaxRecursion -> 5,
    WorkingPrecision -> 25,
    Exclusions -> None],
   LogLogPlot[
    {Abs[ξ 2 E^(β ξ^2) (HeunB[-k^2, 1, 3/2, 0, 2 β, t]*
          HeunB[-k^2, 1 - β, 1/2, 0, 2 β, ξ] -
         Sqrt[ξ/t] HeunB[-k^2, 1, 3/2, 0, 2 β, ξ]*
          HeunB[-k^2, 1 - β, 1/2, 0, 2 β, t])]},
    {ξ, t/4, t},
    GridLines -> {{Sqrt[2/β]}, {}},
    PlotRange -> {{0, t}, {10^-8, 300}},
    MaxRecursion -> 5,
    WorkingPrecision -> 400,
    Exclusions -> None]]],
 {{kv, 10, "k"}, 0, 10, 0.1, Appearance -> "Labeled"},
 {{βv, 10, "β"}, 0.1, 10, 0.1, Appearance -> "Labeled"},
 {{tv, 10, "t"}, 1, 20, 0.1, Appearance -> "Labeled"},
 SynchronousUpdating -> False,
 TrackedSymbols :> {kv, βv, tv}]