Problems with continously varying Tube radius

Question

Problem

I am trying to plot Tubes made from the Tube function with varying radii. At one point there is a discontinuity and the radius of the tube is much large than it should be. I want to correct this error.

Context

I have a parametric curve, $g(t)$, which I will call the g curve. I am trying to plot level sets of a function which surrounds the g curve. The radius of the level set varies with the parameter $t$. When $t=0$ the radius is at its maximum and when $t=t_{max}$ the radius is at it's minimum. Attempt at plotting 4 of these levels sets, using Tube is based of the answer to a similar question.

The problem with my attempt is that for some reason the radius of the tube is too large at one end. This is clearly an error as the function with defines the radius is continuous but there is a huge discontinuity in the plot. I do not know what is causing the issue.

Notes

• If there is something about this form of radialfun that is causing the error please let me know.
• If you have any questions feel free to ask.

Example Code

(*Simulation Parameters and definitions*)
(*---------------------------------*)
Clear[f]
Clear[i, P, B]
f[P_, B_] := 1/2 P + 10 B/(1 + B);
tmax = 25;
eps = 0.001;
randNum = 100;
A = {{1/20, 1/4, 1/50}, {1/4, 1/26, 1/40}};
point = {16.666666666666735`, 0.`, 8.333333333333345`};

(*ODE System*)
ODEsys = {i'[t] == f[P[t], B[t]] - i[t], 
   P'[t] == 
    P[t] (1 - A[[1, 1]] P[t] - A[[1, 2]] B[t] - A[[1, 3]] i[t]), 
   B'[t] == B[t] (1 - A[[2, 2]] B[t] - A[[2, 3]] i[t])};

(*Generating parametric g curve.*)
(* Consider this section a  *)
(*--------------------------*)
set = List[];

While[Length[set] < randNum, 
 holdSet = 
  Join[set, Map[point + # &, RandomReal[{-eps, eps}, {randNum, 3}]]];
 set = Select[holdSet, #[[2]] >= 0 &];]

set = Drop[set, -(randNum - Length[set])];

(*Simulation*)
sol = ParametricNDSolveValue[{ODEsys, {P[0] == init1, B[0] == init2, 
     i[0] == init0}}, {P, B, i}, {t, 0, tmax}, {init1, init2, init0}];

(*Averging solution over multiple inital conditions.*)
gCurve[t_] := 
  Evaluate[Mean[Through /@ (sol[#[[1]], #[[2]], #[[3]]][t] & /@ set)]];
gPlot = ParametricPlot3D[gCurve[t], {t, 0, tmax}, PlotRange -> All, 
   ImageSize -> Large, PlotStyle -> Black];

(* Plot tubes of varying radiuses *)
(*----------------------------*)

(* Function which varies radius along the tube *)
radialfun[x_, radius_] := radius (Abs[x - 25]/50)^(1.20);

(* Controls the number of points plotted, 600+ gives a high quality \
plot *)
numPoints = 50;

(* Controls opacity *)
a = 0.2;

{plot, vals} = 
  Reap[ParametricPlot3D[gCurve[t], {t, 0, tmax}, 
    EvaluationMonitor :> Sow[t], MaxRecursion -> 0, 
    Method -> {"TubePoints" -> numPoints}, PlotPoints -> numPoints, 
    PlotStyle -> RGBColor[0., 0.5, 0.73, a] ]];
(* Plot different level sets of tubes*)
TubePlot1 = 
  plot /. Line[pts_, rest___] :> 
    Tube[pts, radialfun[vals[[1]], 1], rest];
TubePlot2 = 
  plot /. Line[pts_, rest___] :> 
    Tube[pts, radialfun[vals[[1]], 4], rest];
TubePlot3 = 
  plot /. Line[pts_, rest___] :> 
    Tube[pts, radialfun[vals[[1]], 10], rest];
TubePlot4 = 
  plot /. Line[pts_, rest___] :> 
    Tube[pts, radialfun[vals[[1]], 15], rest];

(*Show the plots of the different level tube sets*)
Show[gPlot, TubePlot1, TubePlot2, TubePlot3, TubePlot4, 
 LabelStyle -> Automatic, BoxStyle -> Dashing[{0.02, 0.02}], 
 Boxed -> None, PlotRangePadding -> 0, AxesOrigin -> Automatic, 
 AxesEdge -> {{1, 1, 1}, None, Automatic}, Ticks -> Automatic, 
 AxesStyle -> Thickness[0.005], ImageSize -> Large, 
 ImageResolution -> Automatic, PlotRangeClipping -> True, 
 PlotRange -> {{0, Automatic}, {0, Automatic}, {0, Automatic}}]

Picture

Answer 1

It is necessary to set the shape of the Tube at the ends

(*Simulation Parameters and \
definitions*)(*---------------------------------*)Clear[f]
Clear[i, p, b]
f[p_, b_] := 1/2 p + 10 b/(1 + b);
tmax = 25;
eps = 0.001;
randNum = 100;
A = {{1/20, 1/4, 1/50}, {1/4, 1/26, 1/40}};
point = {16.666666666666735`, 0.`, 8.333333333333345`};

(*ODE System*)
ODEsys = {i'[t] == f[P[t], B[t]] - i[t], 
   P'[t] == 
    P[t] (1 - A[[1, 1]] P[t] - A[[1, 2]] B[t] - A[[1, 3]] i[t]), 
   B'[t] == B[t] (1 - A[[2, 2]] B[t] - A[[2, 3]] i[t])};

(*Generating parametric g curve.*)
(*Consider this section a*)
(*--------------------------*)
set = List[];

While[Length[set] < randNum, 
 holdSet = 
  Join[set, Map[point + # &, RandomReal[{-eps, eps}, {randNum, 3}]]];
 set = Select[holdSet, #[[2]] >= 0 &];]

set = Drop[set, -(randNum - Length[set])];

(*Simulation*)
sol = ParametricNDSolveValue[{ODEsys, {P[0] == init1, B[0] == init2, 
     i[0] == init0}}, {P, B, i}, {t, 0, tmax}, {init1, init2, init0}];

(*Averging solution over multiple inital conditions.*)
gCurve[t_] := 
  Evaluate[Mean[Through /@ (sol[#[[1]], #[[2]], #[[3]]][t] & /@ set)]];
gPlot = ParametricPlot3D[gCurve[t], {t, 0, tmax}, PlotRange -> All, 
   ImageSize -> Large, PlotStyle -> Black];

(*Plot tubes of varying radiuses*)
(*----------------------------*)

(*Function which varies radius along the tube*)
radialfun[x_, radius_] := radius (Abs[x - 25]/50)^(1.20);

(*Controls the number of points plotted,600+gives a high quality plot*)


numPoints = 50;

(*Controls opacity*)
a = 0.2;

{plot, vals} = 
  Reap[ParametricPlot3D[gCurve[t], {t, 0, tmax}, 
    EvaluationMonitor :> Sow[t], MaxRecursion -> 0, 
    Method -> {"TubePoints" -> numPoints}, PlotPoints -> numPoints, 
    PlotStyle -> RGBColor[0., 0.5, 0.73, a]]];
(*Plot different level sets of tubes*)
TubePlot1 = 
  plot /. Line[pts_, rest___] :> {CapForm["Butt"], 
     Tube[pts, radialfun[vals[[1]], 1], rest]};
TubePlot2 = 
  plot /. Line[pts_, rest___] :> {CapForm["Butt"], 
     Tube[pts, radialfun[vals[[1]], 4], rest]};
TubePlot3 = 
  plot /. Line[pts_, rest___] :> {CapForm["Butt"], 
     Tube[pts, radialfun[vals[[1]], 10], rest]};
TubePlot4 = 
  plot /. Line[pts_, rest___] :> {CapForm["Butt"], 
     Tube[pts, radialfun[vals[[1]], 15], rest]};

(*Show the plots of the different level tube sets*)
Show[gPlot, TubePlot1, TubePlot2, TubePlot3, TubePlot4, 
 LabelStyle -> Automatic, BoxStyle -> Dashing[{0.02, 0.02}], 
 Boxed -> None, PlotRangePadding -> 0, AxesOrigin -> Automatic, 
 AxesEdge -> {{1, 1, 1}, None, Automatic}, Ticks -> Automatic, 
 AxesStyle -> Thickness[0.005], ImageSize -> Large, 
 ImageResolution -> Automatic, PlotRangeClipping -> True, 
 PlotRange -> {{-5, Automatic}, {-10, Automatic}, {-5, Automatic}}]

The peculiarity of the curve along which the Tube is constructed is the concentration of points at the ends, with a uniform breakdown of t along the curve. The function radialfun[] changes almost linearly by vals[[1]]. Therefore, a sharp expansion effect occurs at the edges.

{ListPlot[{radialfun[vals[[1]], 1], radialfun[vals[[1]], 4], 
  radialfun[vals[[1]], 10], radialfun[vals[[1]], 15]}],
ListPointPlot3D[Table[gCurve[t], {t, 0, tmax, .02*tmax}]]}