cp's OEIS Frontend

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

%I A334850 #11 Feb 16 2025 08:34:00
%S A334850 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 A334850 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 A334850 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 A334850 Decimal expansion of the maximal curvature of y = Gamma(x), for x>0.
%C A334850 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 A334850 For the branch -3 < x < -2:
%C A334850 MC at x=-2.6209004043183225054792567933147...
%C A334850 R = 0.1025411250345462193237149178953328755...
%C A334850 For the branch -2 < x < -1:
%C A334850 MC at x=-1.57452893040224357315540638154037...
%C A334850 R = 0.043652981140784797188517226949156690045...
%C A334850 For the branch -1 < x < 0:
%C A334850 MC at x=-0.50414409519766396393374935693160...
%C A334850 R = 0.0315571147317663900987190484592293666...
%C A334850 For the branch 0 < x:
%C A334850 MC at x=0.97574729311153379112462151102264...
%C A334850 R = 0.7764237137148324259856982062600903642...
%H A334850 Eric Weisstein's World of Mathematics, <a href="https://mathworld.wolfram.com/GammaFunction.html">Gamma Function</a>
%t A334850 (* FIRST program *)
%t A334850 g[x_] := Gamma[x]; p[k_, x_] := PolyGamma[k, x]
%t A334850 solns = Map[#[[1]][[1]] &, GatherBy[Map[{#[[2]], Rationalize[#[[2]], 10^-30]} &,
%t A334850     Select[Table[{nn, #, Accuracy[#]} &[x /. FindRoot[
%t A334850          0 == (2 g[x]^2 p[0, x]^5 + 3 p[0, x] p[1, x] (-1 + g[x]^2 p[1, x]) +
%t A334850             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 A334850          WorkingPrecision -> 100]], {nn, -2.8, 2.5, .101}], #[[3]] > 40 &]], #[[2]] &]]
%t A334850 {coords, rads} = Chop[Transpose[Map[{{(-p[0, x] + x p[0, x]^2 - g[x]^2 p[0, x]^3 +
%t A334850            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 A334850 Show[Plot[g[x], {x, -3, 2}], Map[{Graphics[Circle[coords[[#]], rads[[#]]]],
%t A334850     Graphics[Point[coords[[#]]]]} &, Range[Length[rads]]],
%t A334850 AspectRatio -> Automatic, PlotRange -> {-4, 4}, ImageSize -> 600]
%t A334850 (* _Peter J. C. Moses_, Jun 17 2020 *)
%t A334850 (* Graphics output:: 4 osculating circles;
%t A334850 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 A334850 (* SECOND program: animation of osculating circle *)
%t A334850 Animate[Show[cent = {(-PolyGamma[0, x] + x PolyGamma[0, x]^2 -
%t A334850        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 A334850         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 A334850   Graphics[{PointSize[Large], Point[{x, Gamma[x]}]}],
%t A334850   Graphics[{PointSize[Large], Point[cent]}],
%t A334850   Graphics[Circle[cent, rad]], AxesOrigin -> {0, 0},
%t A334850   PlotRange -> {{0, 4}, {0, 6}}, ImageSize -> 400,
%t A334850   AspectRatio -> Automatic], {x, 0.4, 3.5}, AnimationRunning -> True]
%t A334850 (* _Peter J. C. Moses_, Jun 18 2020 *)
%Y A334850 Cf. A030171.
%K A334850 nonn,cons
%O A334850 0,1
%A A334850 _Clark Kimberling_, Jun 21 2020