(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



<<FunctionApproximations`
(* Precision. *)
p=64;
(* Bessel function I_ 0 transplanted from [0,15] to [0,225]. *)
f1[x_]:=BesselI[0,Sqrt[x]];
(* Scaled Bessel function I_ 0 transplanted from [15,\[Infinity]) to [0,1/15]. *)
f2[0]:=f2[0]=1/Sqrt[2 \[Pi]];
f2[x_]:=With[{xx=1/x},Sqrt[xx]/Exp[xx] BesselI[0,xx]];
(* Desired errors. *)
SinglePrecision=5.96*10^(-08);
DoublePrecision=1.11*10^(-16);
ExtendedPrecision=1.00*10^(-20);
QuadruplePrecision=9.63*10^(-35);
(* Filters and sorts a list of results according to desired error and sorting criterion. *)
Choose[chk_][cmp_][t_]:=Sort[Select[Flatten[t,1],chk],cmp];
(* Build polynomial from coefficient list *)
BuildPolynomial[c_]:=FromDigits[Reverse[c],x];
(* Filter criteria. *)
ErrorCheck[err_][x_]:=Not[SameQ[x,Indeterminate]]&&Head[x]==ApproximationResult&&GetError[x]<=10^(-04)*err;
(* Sorting criteria. *)
GenericCriterion[f_,g_][x_,y_]:=Module[{d1=GetDegrees[x],d2=GetDegrees[y]},Return[f[d1[[1]],d1[[2]]]<f[d2[[1]],d2[[2]]]||(f[d1[[1]],d1[[2]]]==f[d2[[1]],d2[[2]]] && g[d1[[1]],d1[[2]]]<g[d2[[1]],d2[[2]]])]];
MinimumTotalCoefficients[x_,y_]:=GenericCriterion[Abs[Plus[#1,#2]]&,Abs[Subtract[#1,#2]]&];
MaximumSymmetry[x_,y_]:=GenericCriterion[Abs[Subtract[#1,#2]]&,Abs[Plus[#1,#2]]&][x,y];
(* Approximation functions. *)
ApproximateMiniMax[f_,a_,b_,m_,n_,p_]:=MiniMaxApproximation[f[x],{x,{a,b},m,n},WorkingPrecision->p];
(* Approximates a function. *)
Approximate[f_][g_][a_,b_,m_,n_,p_]:=Module[ {r=Quiet[Check[f[g,a,b,m,n,p],Indeterminate]]},If[SameQ[r,Indeterminate],Return[r],Return[ApproximationResult[{m,n},Abs[r[[2]][[2]]],CoefficientList[Numerator[r[[2]][[1]]],x],CoefficientList[Denominator[r[[2]][[1]]],x],{a,b}]]]];
(* Getters for different parts of approximation result. *)
GetDegrees[x_]:=x[[1]];
GetError[x_]:=x[[2]];
GetNumerator[x_]:=x[[3]];
GetDenominator[x_]:=x[[4]];
GetInterval[x_]:=x[[5]];
(* Compute approximations for a subset of a matrix of numerator/denominator degrees {m,n} *) 
Compute[t_,it_,f_,g_,a_,b_,p_]:=Module[{i=it[t],j=0,tt=t},For[j=1,j<=Length[i],j++,Print[i[[j,2,1]],",",i[[j,2,2]],",",tt[[i[[j,2,1]],i[[j,2,2]]]]];tt[[i[[j,2,1]],i[[j,2,2]]]]=Approximate[f][g][a,b,i[[j,1,1]],i[[j,1,2]],p]];Return[tt]];
(* Generic iterator. Take a matrix of numerator/denominator degrees {m,n} and return a flat list of those admissible for iteration. *)
Iterator[f_][t_]:=Module[{tt={},i=0,j=0},For[i=1,i<=Dimensions[t][[1]],i++,For[j=1,j<=Dimensions[t][[2]],j++,If[f[t[[i,j]]]==True,tt=Append[tt,{t[[i,j]],{i,j}}]]]];Return[tt]];
(* Iterate over elements where the difference between numerator and denominator degrees is bounded by below and from above. *)
DiagonalIterator[a_,b_]:=Iterator[#1[[2]]-#1[[1]]>=a&&#1[[2]]-#1[[1]]<=b&];
(* Iterate over all elements *)
AllIterator:=Iterator[True&];
(* Compute Chebyshev-Fourier coefficients. *)
ChebyshevFourierCoefficients[f_][a_,b_][n_]:=Module[{x=Table[f[a+(b-a)/2 (1+Cos[(\[Pi]*(j+1/2))/(n+1)])],{j,0,n}],F=Table[(2-DiscreteDelta[i])/2 Cos[(\[Pi]*(i)*(j+1/2))/(n+1)],{i,0,n},{j,0,n}]},Return[2/(n+1) F.x]];
(* Print coefficient list suitable for inclusion in C code. *)
PrintCoefficients[c_]:=Module[{s="",j=0},For[j=1,j<=Length[c],j++,s=s<>"K("<>ToString[CForm[c[[j]]]]<>"),\n"];Print[s]]
(* Print coefficients of numerator and denominator polynomials. *)
PrintResult[r_]:=Module[{d=GetDegrees[r],iv=GetInterval[r]},Print["Numerator"];Print[d[[1]]];PrintCoefficients[GetNumerator[r]];PrintCoefficients[ChebyshevFourierCoefficients[BuildPolynomial[GetNumerator[r]]/.x->#1&][iv[[1]],iv[[2]]][d[[1]]]];
Print["Denominator"];Print[d[[2]]];PrintCoefficients[GetDenominator[r]];PrintCoefficients[ChebyshevFourierCoefficients[BuildPolynomial[GetDenominator[r]]/.x->#1&][iv[[1]],iv[[2]]][d[[2]]]]]



