A334850 - OEIS

%I #10 Jun 23 2020 05:55:48

%S 7,7,6,4,2,3,7,1,3,7,1,4,8,3,2,4,2,5,9,8,5,6,9,8,2,0,6,2,6,0,0,9,0,3,

%T 6,4,2,3,6,4,3,2,1,7,3,7,9,8,2,7,1,0,6,7,5,9,1,2,0,1,9,9,6,9,9,5,0,7,

%U 3,6,6,0,0,8,8,4,8,1,0,5,1,1,4,3,7,8,0,2,2,1,6,4,1,3,6,2,3,9,6

%N Decimal expansion of the maximal curvature of y = Gamma(x), for x>0.

%C Each branch of y = Gamma(x) has a point of maximal curvature (MC), at which the osculating circle has minimal radius (R).  The branch in Quadrant I has MC at (x, Gamma(x)), where x = 0.9757... and R = 0.77642... Details for 4 branches (shown by 1st Mathematica program):

%C For the branch -3 < x < -2:

%C MC at x=-2.6209004043183225054792567933147...

%C R = 0.1025411250345462193237149178953328755...

%C For the branch -2 < x < -1:

%C MC at x=-1.57452893040224357315540638154037...

%C R = 0.043652981140784797188517226949156690045...

%C For the branch -1 < x < 0:

%C MC at x=-0.50414409519766396393374935693160...

%C R = 0.0315571147317663900987190484592293666...

%C For the branch 0 < x:

%C MC at x=0.97574729311153379112462151102264...

%C R = 0.7764237137148324259856982062600903642...

%H Eric Weisstein's World of Mathematics, <a href="http://mathworld.wolfram.com/GammaFunction.html">Gamma Function</a>

%t (* FIRST program *)

%t g[x_] := Gamma[x]; p[k_, x_] := PolyGamma[k, x]

%t solns = Map[#[[1]][[1]] &, GatherBy[Map[{#[[2]], Rationalize[#[[2]], 10^-30]} &,

%t     Select[Table[{nn, #, Accuracy[#]} &[x /. FindRoot[

%t          0 == (2 g[x]^2 p[0, x]^5 + 3 p[0, x] p[1, x] (-1 + g[x]^2 p[1, x]) +

%t             p[0, x]^3 (-1 + 3 g[x]^2 p[1, x]) - (1 +  g[x]^2 p[0, x]^2) p[2, x]), {x, nn},

%t          WorkingPrecision -> 100]], {nn, -2.8, 2.5, .101}], #[[3]] > 40 &]], #[[2]] &]]

%t {coords, rads} = Chop[Transpose[Map[{{(-p[0, x] + x p[0, x]^2 - g[x]^2 p[0, x]^3 +

%t            x p[1, x])/(p[0, x]^2 + p[1, x]), (1 + g[x]^2 (2 p[0, x]^2 + p[1, x]))/(g[x] (p[0, x]^2 + p[1, x]))}, Sqrt[(1 + g[x]^2 p[0, x]^2)^3/(g[x]^2 (p[0, x]^2 + p[1, x])^2)]} /. x -> # &, solns]]]

%t Show[Plot[g[x], {x, -3, 2}], Map[{Graphics[Circle[coords[[#]], rads[[#]]]],

%t     Graphics[Point[coords[[#]]]]} &, Range[Length[rads]]],

%t AspectRatio -> Automatic, PlotRange -> {-4, 4}, ImageSize -> 600]

%t (* _Peter J. C. Moses_, Jun 17 2020 *)

%t (* Graphics output:: 4 osculating circles;

%t Numerical output: first 4 numbers are x-coordinates of touchpoints of osculating circles with graph of gamma function; next 8 numbers are in pairs: (x,y) for the centers of the four circles; last 4 numbers are radii of the 4 circles *)

%t (* SECOND program: animation of osculating circle *)

%t Animate[Show[cent = {(-PolyGamma[0, x] + x PolyGamma[0, x]^2 -

%t        Gamma[x]^2 PolyGamma[0, x]^3 + x PolyGamma[1, x])/(PolyGamma[0, x]^2 + PolyGamma[1, x]), (1 + Gamma[x]^2 (2 PolyGamma[0, x]^2 + PolyGamma[1, x]))/(Gamma[x] (PolyGamma[0, x]^2 + PolyGamma[1, x]))}; rad = Sqrt[(1 +

%t         Gamma[x]^2 PolyGamma[0, x]^2)^3/(Gamma[x]^2 (PolyGamma[0, x]^2 + PolyGamma[1, x])^2)]; Plot[Gamma[x], {x, 0, 4}],

%t   Graphics[{PointSize[Large], Point[{x, Gamma[x]}]}],

%t   Graphics[{PointSize[Large], Point[cent]}],

%t   Graphics[Circle[cent, rad]], AxesOrigin -> {0, 0},

%t   PlotRange -> {{0, 4}, {0, 6}}, ImageSize -> 400,

%t   AspectRatio -> Automatic], {x, 0.4, 3.5}, AnimationRunning -> True]

%t (* _Peter J. C. Moses_, Jun 18 2020 *)

%Y Cf. A030171.

%K nonn,cons

%O 0,1

%A _Clark Kimberling_, Jun 21 2020