(* Content-type: application/vnd.wolfram.mathematica *)
(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)
(* CreatedBy='Mathematica 12.1' *)
(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[ 158, 7]
NotebookDataLength[ 14083122, 277200]
NotebookOptionsPosition[ 14082410, 277180]
NotebookOutlinePosition[ 14082839, 277197]
CellTagsIndexPosition[ 14082796, 277194]
WindowFrame->Normal*)
(* Beginning of Notebook Content *)
Notebook[{
Cell[BoxData[{
RowBox[{
RowBox[{
RowBox[{"FabiusF", "::", "usage"}], "=",
"\"\<FabiusF[x] gives the value of the Fabius function F(x) for a \
non-negative real argument x.\>\""}], ";"}], "\n",
RowBox[{
RowBox[{"Macros`SetArgumentCount", "[",
RowBox[{"FabiusF", ",", "1"}], "]"}], ";"}], "\n",
RowBox[{
RowBox[{
RowBox[{"SyntaxInformation", "[", "FabiusF", "]"}], "=",
RowBox[{"{",
RowBox[{"\"\<ArgumentsPattern\>\"", "\[Rule]",
RowBox[{"{", "_", "}"}]}], "}"}]}], ";"}], "\n",
RowBox[{
RowBox[{
RowBox[{"SetAttributes", "[",
RowBox[{"FabiusF", ",",
RowBox[{"{",
RowBox[{"NumericFunction", ",", "Listable"}], "}"}]}], "]"}], ";"}],
"\[IndentingNewLine]"}], "\n",
RowBox[{
RowBox[{
RowBox[{
RowBox[{"Derivative", "[", "n_Integer", "]"}], "[", "FabiusF", "]"}], ":=",
RowBox[{
RowBox[{
RowBox[{"2", "^",
RowBox[{"(",
RowBox[{"n", " ",
RowBox[{
RowBox[{"(",
RowBox[{"n", "+", "1"}], ")"}], "/", "2"}]}], ")"}]}], " ",
RowBox[{"FabiusF", "[",
RowBox[{
RowBox[{"2", "^", "n"}], " ", "#"}], "]"}]}], "&"}]}],
"\[IndentingNewLine]", "\n",
RowBox[{"(*",
RowBox[{
RowBox[{"https", ":"}], "//",
RowBox[{
RowBox[{
RowBox[{"mathematica", ".", "stackexchange", ".", "com"}], "/", "a"}],
"/", "13245"}]}], "*)"}]}], "\[IndentingNewLine]",
RowBox[{
RowBox[{
RowBox[{"powerOfTwoQ", "[", "n_", "]"}], ":=",
RowBox[{
RowBox[{"IntegerQ", "[", "n", "]"}], "&&",
RowBox[{
RowBox[{"BitAnd", "[",
RowBox[{"n", ",",
RowBox[{"n", "-", "1"}]}], "]"}], "\[Equal]", "0"}]}]}],
"\[IndentingNewLine]"}], "\n",
RowBox[{
RowBox[{
RowBox[{"FabiusF", "[", "Infinity", "]"}], "=",
RowBox[{"Interval", "[",
RowBox[{"{",
RowBox[{
RowBox[{"-", "1"}], ",", "1"}], "}"}], "]"}]}], ";"}], "\n",
RowBox[{
RowBox[{
RowBox[{
RowBox[{"FabiusF", "[",
RowBox[{"x_", "?", "NumberQ"}], "]"}], "/;",
RowBox[{"If", "[",
RowBox[{
RowBox[{
RowBox[{"0", "\[LessEqual]",
RowBox[{"Re", "[", "x", "]"}]}], "&&",
RowBox[{
RowBox[{"Im", "[", "x", "]"}], "\[Equal]", "0"}]}], ",",
RowBox[{"powerOfTwoQ", "[",
RowBox[{"Denominator", "[", "x", "]"}], "]"}], ",",
RowBox[{
RowBox[{"Message", "[",
RowBox[{
RowBox[{"FabiusF", "::", "realnn"}], ",", "x"}], "]"}], ";",
"False"}]}], "]"}]}], ":=",
RowBox[{"iFabiusF", "[", "x", "]"}]}], "\[IndentingNewLine]"}], "\n",
RowBox[{
RowBox[{
RowBox[{"ariasD", "[", "0", "]"}], "=", "1"}], ";"}], "\n",
RowBox[{
RowBox[{
RowBox[{
RowBox[{"ariasD", "[",
RowBox[{"n_Integer", "?", "Positive"}], "]"}], ":=",
RowBox[{
RowBox[{"ariasD", "[", "n", "]"}], "=",
RowBox[{
RowBox[{"Sum", "[",
RowBox[{
RowBox[{
RowBox[{"2", "^",
RowBox[{"(",
RowBox[{
RowBox[{"(",
RowBox[{
RowBox[{"k", " ",
RowBox[{"(",
RowBox[{"k", "-", "1"}], ")"}]}], "-",
RowBox[{"n", " ",
RowBox[{"(",
RowBox[{"n", "-", "1"}], ")"}]}]}], ")"}], "/", "2"}],
")"}]}], " ",
RowBox[{
RowBox[{"ariasD", "[", "k", "]"}], "/",
RowBox[{
RowBox[{"(",
RowBox[{"n", "-", "k", "+", "1"}], ")"}], "!"}]}]}], ",",
RowBox[{"{",
RowBox[{"k", ",", "0", ",",
RowBox[{"n", "-", "1"}]}], "}"}]}], "]"}], "/",
RowBox[{"(",
RowBox[{
RowBox[{"2", "^", "n"}], "-", "1"}], ")"}]}]}]}], ";"}],
"\[IndentingNewLine]"}], "\n",
RowBox[{
RowBox[{
RowBox[{"tri", "[", "x_", "]"}], ":=",
RowBox[{"Piecewise", "[",
RowBox[{
RowBox[{"{",
RowBox[{"{",
RowBox[{
RowBox[{"2", "-", "x"}], ",",
RowBox[{"x", ">", "1"}]}], "}"}], "}"}], ",", "x"}], "]"}]}],
"\[IndentingNewLine]"}], "\n",
RowBox[{
RowBox[{"iFabiusF", "[", "x_", "]"}], ":=",
RowBox[{"Module", "[",
RowBox[{
RowBox[{"{",
RowBox[{
RowBox[{"prec", "=",
RowBox[{"Precision", "[", "x", "]"}]}], ",",
RowBox[{"s", "=", "1"}], ",",
RowBox[{"y", "=", "0"}], ",",
RowBox[{"z", "=",
RowBox[{"SetPrecision", "[",
RowBox[{"x", ",", "Infinity"}], "]"}]}], ",", "n", ",", "p", ",", "q",
",", "tol", ",", "w"}], "}"}], ",",
RowBox[{
RowBox[{"z", "=",
RowBox[{"If", "[",
RowBox[{
RowBox[{"0", "\[LessEqual]", "z", "\[LessEqual]", "2"}], ",",
RowBox[{"tri", "[", "z", "]"}], ",",
RowBox[{
RowBox[{"q", "=",
RowBox[{"Quotient", "[",
RowBox[{"z", ",", "2"}], "]"}]}], ";", "\[IndentingNewLine]",
RowBox[{"(*",
RowBox[{
RowBox[{"can", " ", "replace", " ",
RowBox[{"ThueMorse", "[", "]"}], " ", "with", " ", "the", " ",
"implementation", " ", "in", " ",
RowBox[{"https", ":"}]}], "//",
RowBox[{
RowBox[{
RowBox[{"mathematica", ".", "stackexchange", ".", "com"}], "/",
"a"}], "/", "89351"}]}], "*)"}],
RowBox[{"If", "[",
RowBox[{
RowBox[{
RowBox[{"ThueMorse", "[", "q", "]"}], "\[Equal]", "1"}], ",",
RowBox[{"s", "=",
RowBox[{"-", "1"}]}]}], "]"}], ";",
RowBox[{"tri", "[",
RowBox[{"z", "-",
RowBox[{"2", " ", "q"}]}], "]"}]}]}], "]"}]}], ";",
"\[IndentingNewLine]",
RowBox[{"tol", "=",
RowBox[{"10", "^",
RowBox[{"(",
RowBox[{"-", "prec"}], ")"}]}]}], ";", "\[IndentingNewLine]",
RowBox[{"While", "[",
RowBox[{
RowBox[{"z", ">", "0"}], ",",
RowBox[{
RowBox[{"n", "=",
RowBox[{"-",
RowBox[{"Floor", "[",
RowBox[{"RealExponent", "[",
RowBox[{"z", ",", "2"}], "]"}], "]"}]}]}], ";",
RowBox[{"p", "=",
RowBox[{"2", "^", "n"}]}], ";",
RowBox[{"z", "-=",
RowBox[{"1", "/", "p"}]}], ";",
RowBox[{"w", "=", "1"}], ";", "\[IndentingNewLine]",
RowBox[{"Do", "[",
RowBox[{
RowBox[{
RowBox[{"w", "=",
RowBox[{
RowBox[{"ariasD", "[", "m", "]"}], "+",
RowBox[{"p", " ", "z", " ",
RowBox[{"w", "/",
RowBox[{"(",
RowBox[{"n", "-", "m", "+", "1"}], ")"}]}]}]}]}], ";",
RowBox[{"p", "/=", "2"}]}], ",",
RowBox[{"{",
RowBox[{"m", ",", "n"}], "}"}]}], "]"}], ";",
"\[IndentingNewLine]",
RowBox[{"y", "=",
RowBox[{"w", "-", "y"}]}], ";", "\[IndentingNewLine]",
RowBox[{"If", "[",
RowBox[{
RowBox[{
RowBox[{"Abs", "[", "w", "]"}], "<",
RowBox[{
RowBox[{"Abs", "[", "y", "]"}], " ", "tol"}]}], ",",
RowBox[{"Break", "[", "]"}]}], "]"}]}]}], "]"}], ";",
"\[IndentingNewLine]",
RowBox[{"SetPrecision", "[",
RowBox[{
RowBox[{"s", " ",
RowBox[{"Abs", "[", "y", "]"}]}], ",", "prec"}], "]"}]}]}],
"]"}]}]}], "Input",
CellChangeTimes->{{3.9005889211734176`*^9, 3.90058892271342*^9}, {
3.9005891244477296`*^9, 3.900589150097766*^9}},
TextAlignment->Center,
CellLabel->"In[5]:=",ExpressionUUID->"06fa0d48-06c9-421b-ad36-d16081eb5b97"],
Cell[BoxData[""], "Input",
CellChangeTimes->{{3.900589136107746*^9, 3.9005891448577585`*^9}},
TextAlignment->Center,ExpressionUUID->"e430173f-432a-4260-b7d9-419fc7821594"],
Cell[CellGroupData[{
Cell[BoxData[
RowBox[{"Table", "[",
RowBox[{
RowBox[{"{",
RowBox[{"x", ",",
RowBox[{"FabiusF", "[", "x", "]"}]}], "}"}], ",",
RowBox[{"{",
RowBox[{"x", ",",
RowBox[{"{",
RowBox[{
RowBox[{"Range", "[",
RowBox[{"0", ",", "65536"}], "]"}], "/", "65536"}], "}"}]}], "}"}]}],
"]"}]], "Input",
TextAlignment->Center,
CellLabel->"In[19]:=",ExpressionUUID->