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

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, 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, 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

Offset

0,1

Comments

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):

For the branch -3 < x < -2:

MC at x=-2.6209004043183225054792567933147...

R = 0.1025411250345462193237149178953328755...

For the branch -2 < x < -1:

MC at x=-1.57452893040224357315540638154037...

R = 0.043652981140784797188517226949156690045...

For the branch -1 < x < 0:

MC at x=-0.50414409519766396393374935693160...

R = 0.0315571147317663900987190484592293666...

For the branch 0 < x:

MC at x=0.97574729311153379112462151102264...

R = 0.7764237137148324259856982062600903642...

Links

Table of n, a(n) for n=0..98.

Eric Weisstein's World of Mathematics, Gamma Function

Mathematica

(* FIRST program *)
g[x_] := Gamma[x]; p[k_, x_] := PolyGamma[k, x]
solns = Map[#[[1]][[1]] &, GatherBy[Map[{#[[2]], Rationalize[#[[2]], 10^-30]} &,
    Select[Table[{nn, #, Accuracy[#]} &[x /. FindRoot[
         0 == (2 g[x]^2 p[0, x]^5 + 3 p[0, x] p[1, x] (-1 + g[x]^2 p[1, x]) +
            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},
         WorkingPrecision -> 100]], {nn, -2.8, 2.5, .101}], #[[3]] > 40 &]], #[[2]] &]]
{coords, rads} = Chop[Transpose[Map[{{(-p[0, x] + x p[0, x]^2 - g[x]^2 p[0, x]^3 +
           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]]]
Show[Plot[g[x], {x, -3, 2}], Map[{Graphics[Circle[coords[[#]], rads[[#]]]],
    Graphics[Point[coords[[#]]]]} &, Range[Length[rads]]],
AspectRatio -> Automatic, PlotRange -> {-4, 4}, ImageSize -> 600]
(* Peter J. C. Moses, Jun 17 2020 *)
(* Graphics output:: 4 osculating circles;
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 *)
(* SECOND program: animation of osculating circle *)
Animate[Show[cent = {(-PolyGamma[0, x] + x PolyGamma[0, x]^2 -
       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 +
        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}],
  Graphics[{PointSize[Large], Point[{x, Gamma[x]}]}],
  Graphics[{PointSize[Large], Point[cent]}],
  Graphics[Circle[cent, rad]], AxesOrigin -> {0, 0},
  PlotRange -> {{0, 4}, {0, 6}}, ImageSize -> 400,
  AspectRatio -> Automatic], {x, 0.4, 3.5}, AnimationRunning -> True]
(* Peter J. C. Moses, Jun 18 2020 *)

Crossrefs

Cf. A030171.

Sequence in context: A019619 A177436 A318139 * A199793 A202949 A354641

Adjacent sequences: A334847 A334848 A334849 * A334851 A334852 A334853

Keyword

nonn,cons

Author

Clark Kimberling, Jun 21 2020

Status

approved