𖣠⚪𔗢⚪ИN⚪Ⓞ⚪ꖴ⚪✤⚪ᗩ⚪ᙁ⚪ᑎ⚪ߦ⚪ꖴ⚪ИN⚪ᗩ⚪ᙏ⚪◯⚪ᗱᗴ⚪ᴥ⚪ᑎ⚪✤⚪ᗩ⚪ᗯ⚪ᴥ⚪ᑎ⚪ᑐᑕ⚪𔗢⚪𓊗⚪𔗢⚪𖣠⚪𔗢⚪𖡼⚪𔗢⚪𖣠⚪𔗢⚪𖡼⚪𔗢⚪𖣠⚪𔗢⚪𖡼⚪𔗢⚪𖣠⚪𔗢⚪𖡼⚪𔗢⚪🞋⚪𔗢⚪𖡼⚪𔗢⚪𖣠⚪𔗢⚪𖡼⚪𔗢⚪𖣠⚪𔗢⚪𖡼⚪𔗢⚪𖣠⚪𔗢⚪𖡼⚪𔗢⚪𖣠⚪𔗢⚪𓊗⚪𔗢⚪ᑐᑕ⚪ᑎ⚪ᴥ⚪ᗯ⚪ᗩ⚪✤⚪ᑎ⚪ᴥ⚪ᗱᗴ⚪◯⚪ᙏ⚪ᗩ⚪ИN⚪ꖴ⚪ߦ⚪ᑎ⚪ᙁ⚪ᗩ⚪✤⚪ꖴ⚪Ⓞ⚪ИN⚪𔗢⚪𖣠

ClearAll[iCurvaturePlotHelper,CurvaturePlot]
iCurvaturePlotHelper[f_?(Head[#]=!=List&),{t_,tmin_,tmax_},{{x0_,y0_},θ0_},opts:OptionsPattern[]]:=Module[{sol,θ,x,y,if},sol=NDSolve[{θ'[t]==f,x'[t]==Cos[θ[t]],y'[t]==Sin[θ[t]],θ[tmin]==θ0,x[tmin]==x0,y[tmin]==y0},{x,y},{t,tmin,tmax},opts];
if={x[#],y[#]}&/. First[sol];
if]
CurvaturePlot[f_,{t_,tmin_,tmax_},opts:OptionsPattern[]]:=CurvaturePlot[f,{t,tmin,tmax},{{0,0},0},opts]
CurvaturePlot[f_,{t_,tmin_,tmax_},p:{{x0_,y0_},θ0_},opts:OptionsPattern[]]:=Module[{θ,x,y,sol,rlsplot,rlsndsolve,if,ifs},rlsplot=FilterRules[{opts},Options[ParametricPlot]];
rlsndsolve=FilterRules[{opts},Options[NDSolve]];
If[Head[f]===List,ifs=iCurvaturePlotHelper[#,{t,tmin,tmax},p,Evaluate@(Sequence@@rlsndsolve)]&/@f;
ParametricPlot[Evaluate[#[tplot]&/@ifs],{tplot,tmin,tmax},Evaluate@(Sequence@@rlsplot)],if=iCurvaturePlotHelper[f,{t,tmin,tmax},p,Evaluate@(Sequence@@rlsndsolve)];
ParametricPlot[Evaluate[if[tplot]],{tplot,tmin,tmax},Evaluate@(Sequence@@rlsplot)]]]

ariasD[0] = 1;
ariasD[n_Integer?Positive] := ariasD[n] = Sum[2^((k (k - 1) - n (n - 1))/2) ariasD[k]/(n - k + 1)!, {k, 0, n - 1}]/(2^n - 1);
iFabiusF[x_] := Module[{prec = Precision[x], n, p, q, s, tol, w, y, z},
  If[x < 0, Return[0, Module]]; tol = 10^(-prec);
  z = SetPrecision[x, Infinity]; s = 1; y = 0;
  z = If[0 <= z <= 2, 1 - Abs[1 - z],
    q = Quotient[z, 2];
    If[ThueMorse[q] == 1, s = -1];
    1 - Abs[1 - z + 2 q]];
  While[z > 0,
   n = -Floor[RealExponent[z, 2]]; p = 2^n;
   z -= 1/p; w = 1;
   Do[w = ariasD[m] + p z w/(n - m + 1); p /= 2, {m, n}];
   y = w - y;
   If[Abs[w] < Abs[y] tol, Break[]]];
  SetPrecision[s Abs[y], prec]]
FabiusF[Infinity] = Interval[{-1, 1}];
FabiusF[x_?NumberQ] /; If[Im[x] == 0, TrueQ[Composition[BitAnd[#, # - 1] &, Denominator][x] == 0], False] := iFabiusF[x]
Derivative[n_Integer][FabiusF] := 2^(n (n + 1)/2) FabiusF[2^n #] &
SetAttributes[FabiusF, {NumericFunction, Listable}];

ᔓᔕ={WorkingPrecision->10,MaxRecursion->0,Ticks->{Automatic,Automatic},ImageSize->320,PlotRange->Full,Frame->True,Axes->False,GridLines->{{0},{0}},PlotStyle->GrayLevel[168/256],FrameStyle->GrayLevel[178/256]};
Π=2;ᑐᑕ=4;M=.5;ΠΠ=4;
ᗱᗴ=Evaluate[SetPrecision[SetAccuracy[(1-Abs[((-1)^Floor[(x/Pi*ᑐᑕ+1)/2] Abs[(1-Abs[Mod[x/Pi*ᑐᑕ+1,2]-1]^Π)]^(1/Π))/2+.5]),Infinity],Infinity]];

Manipulate(MoreInfoOpenerButtonTemplate[Manipulate, This section contains the Manipulate input cell and its evaluated output cell. Make all control labels or labels in the output as descriptive as possible, with only proper nouns and proper adjectives capitalized. More description of the controls can be provided in the Details section below, if necessary. If you change this Manipulate after creating screenshots and/or thumbnails, use Update Thumbnail & Snapshots in the toolbar to update any copies in later sections. You can control the Flash preview for the Demonstration with the AutorunSequencing option. Use SaveDefinitions->True if you provided initialization code in the previous section.])

Grid[{{Manipulate[Column[{CurvaturePlot[Evaluate[SetPrecision[SetAccuracy[(1-Abs[((-1)^Floor[(x/Pi*ᑐᑕ+1)/2] Abs[(1-Abs[Mod[x/Pi*ᑐᑕ+1,2]-1]^Π)]^(1/Π))/2+.5])-M,Infinity],Infinity]],{x,0,4π},Evaluate[ᔓᔕ],FrameTicks->{Range[-16,16,1/2],Range[-4,4,1/2]},PlotPoints->1+2^ΠΠ],Plot[Evaluate[SetPrecision[SetAccuracy[.5-(1-Abs[((-1)^Floor[(x/Pi*ᑐᑕ+1)/2] Abs[(1-Abs[Mod[x/Pi*ᑐᑕ+1,2]-1]^Π)]^(1/Π))/2+.5])-M,Infinity],Infinity]],{x,0,4π},Evaluate[ᔓᔕ],AspectRatio->1/8,FrameTicks->{Range[-16*Pi,16*Pi,Pi/2],Range[-1,1,1/2]},PlotPoints->1+2^ΠΠ]}],{{Π,1},0,16,.25},{{ᑐᑕ,4},0,16,.25},{{M,0},0,1,.125},{{ΠΠ,8},0,16,1},FrameMargins->0]}}]

({{}})({{}})({{}})({{}})({{}})

Details (optional) (MoreInfoOpenerButtonTemplate[Details, This optional section is for a more detailed description of the Demonstration than the caption, but it should still be as concise as possible. This section may also include numbered snapshot captions (e.g., Snapshot 1: phrase or sentence without an initial capital and without a period, unless more than one sentence is used) and explanations of the Manipulate control labels. Define any symbols undefined so far. Include only text in this section — no code, graphics, etc. Do not change the cell style or copy cells from other sections. 

A book reference uses this format: 
    L. D. Schmidt, The Engineering of Chemical Reactions, New York: Oxford University Press, 1998. 

An article reference uses this format: 
    D. Pearson, "A Polynomial-Time Algorithm for the Change-Making Problem," Operations Research Letters, 33(3), 2005 pp. 231–234.])

Related Links (optional) (MoreInfoOpenerButtonTemplate[Related Links, Provide hyperlinks (not just bare URLs) to any relevant wolfram.com pages, with the page title as the linked text. Links to NKS | Online should use the section title, not a page number. Links to non-Wolfram sites go in the Details section.
])