Skip to main content
Corrected domain to (-1, 1) vice [0, 1)
Source Link
Bob Hanlon
  • 162.7k
  • 7
  • 81
  • 205
Clear[f1, f2, f3]

The recurrence relationship can be implemented using FixedPoint

f1[x_?NumericQ] :=
  FixedPoint[
     {(#[[1]] + #[[2]])/2, Sqrt[#[[1]]*#[[2]]]} &,
     {1 + x, 1 - x}][[1]] /; 0-1 <=< x < 1;

Or with NestWhile

f2[x_?NumericQ] :=
  NestWhile[
     {(#[[1]] + #[[2]])/2, Sqrt[#[[1]]*#[[2]]]} &,
     {1 + x, 1 - x}, Unequal @@ # &][[1]] /; 0-1 <=< x < 1;

Or, as suggested by Sasha, with ArithmeticGeometricMean

f3[x_] = FunctionExpand[
  ArithmeticGeometricMean[1 + x, 1 - x],
  0-1 <=< x < 1]

(*  Pi/(2 EllipticK[x^2])  *)

Plot[{f1[x], f2[x], f3[x]}, {x, 0-1, 1},
 PlotStyle -> {
   Directive[Lighter[Red], AbsoluteThickness[4]],
   Directive[Blue, AbsoluteDashing[{10, 10}]],
   Directive[Green, AbsoluteDashing[{20, 15}]]},
 PlotPoints -> 25,
 PlotRange -> {0, 1.02},
 PlotLegends -> {FixedPoint, NestWhile, AGM}]

enter image description hereenter image description here

Clear[f1, f2, f3]

The recurrence relationship can be implemented using FixedPoint

f1[x_?NumericQ] :=
  FixedPoint[
     {(#[[1]] + #[[2]])/2, Sqrt[#[[1]]*#[[2]]]} &,
     {1 + x, 1 - x}][[1]] /; 0 <= x < 1;

Or with NestWhile

f2[x_?NumericQ] :=
  NestWhile[
     {(#[[1]] + #[[2]])/2, Sqrt[#[[1]]*#[[2]]]} &,
     {1 + x, 1 - x}, Unequal @@ # &][[1]] /; 0 <= x < 1;

Or, as suggested by Sasha, with ArithmeticGeometricMean

f3[x_] = FunctionExpand[
  ArithmeticGeometricMean[1 + x, 1 - x],
  0 <= x < 1]

(*  Pi/(2 EllipticK[x^2])  *)

Plot[{f1[x], f2[x], f3[x]}, {x, 0, 1},
 PlotStyle -> {
   Directive[Lighter[Red], AbsoluteThickness[4]],
   Directive[Blue, AbsoluteDashing[{10, 10}]],
   Directive[Green, AbsoluteDashing[{20, 15}]]},
 PlotPoints -> 25,
 PlotRange -> {0, 1.02},
 PlotLegends -> {FixedPoint, NestWhile, AGM}]

enter image description here

Clear[f1, f2, f3]

The recurrence relationship can be implemented using FixedPoint

f1[x_?NumericQ] :=
  FixedPoint[
     {(#[[1]] + #[[2]])/2, Sqrt[#[[1]]*#[[2]]]} &,
     {1 + x, 1 - x}][[1]] /; -1 < x < 1;

Or with NestWhile

f2[x_?NumericQ] :=
  NestWhile[
     {(#[[1]] + #[[2]])/2, Sqrt[#[[1]]*#[[2]]]} &,
     {1 + x, 1 - x}, Unequal @@ # &][[1]] /; -1 < x < 1;

Or, as suggested by Sasha, with ArithmeticGeometricMean

f3[x_] = FunctionExpand[
  ArithmeticGeometricMean[1 + x, 1 - x],
  -1 < x < 1]

(*  Pi/(2 EllipticK[x^2])  *)

Plot[{f1[x], f2[x], f3[x]}, {x, -1, 1},
 PlotStyle -> {
   Directive[Lighter[Red], AbsoluteThickness[4]],
   Directive[Blue, AbsoluteDashing[{10, 10}]],
   Directive[Green, AbsoluteDashing[{20, 15}]]},
 PlotPoints -> 25,
 PlotRange -> {0, 1.02},
 PlotLegends -> {FixedPoint, NestWhile, AGM}]

enter image description here

Source Link
Bob Hanlon
  • 162.7k
  • 7
  • 81
  • 205

Clear[f1, f2, f3]

The recurrence relationship can be implemented using FixedPoint

f1[x_?NumericQ] :=
  FixedPoint[
     {(#[[1]] + #[[2]])/2, Sqrt[#[[1]]*#[[2]]]} &,
     {1 + x, 1 - x}][[1]] /; 0 <= x < 1;

Or with NestWhile

f2[x_?NumericQ] :=
  NestWhile[
     {(#[[1]] + #[[2]])/2, Sqrt[#[[1]]*#[[2]]]} &,
     {1 + x, 1 - x}, Unequal @@ # &][[1]] /; 0 <= x < 1;

Or, as suggested by Sasha, with ArithmeticGeometricMean

f3[x_] = FunctionExpand[
  ArithmeticGeometricMean[1 + x, 1 - x],
  0 <= x < 1]

(*  Pi/(2 EllipticK[x^2])  *)

Plot[{f1[x], f2[x], f3[x]}, {x, 0, 1},
 PlotStyle -> {
   Directive[Lighter[Red], AbsoluteThickness[4]],
   Directive[Blue, AbsoluteDashing[{10, 10}]],
   Directive[Green, AbsoluteDashing[{20, 15}]]},
 PlotPoints -> 25,
 PlotRange -> {0, 1.02},
 PlotLegends -> {FixedPoint, NestWhile, AGM}]

enter image description here