Machin-Like Formulas

Author

Eric W. Weisstein
January 25, 2018

This notebook downloaded from http://mathworld.wolfram.com/notebooks/SpecialFunctions/Machin-LikeFormulas.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Machin-LikeFormulas.html.

©2018 Wolfram Research, Inc. except for portions noted otherwise

Initializatioin

Code

MachinFormula[l_List]:=Module[{t=Transpose[Rest[l]]},
Pi First[l]==First[t].ArcCot/@(HoldForm/@Last[t])
]

Counts

Length/@(#[[1,1]]&/@DownValues[MachinList])

1-Term

Length[MachinList[1]]

MachinFormula/@MachinList[1]//ColumnForm//TraditionalForm

2-Term

Length[MachinList[2]]

FullSimplify[ReleaseHold[Last/@MachinFormula/@MachinList[2]]]

MachinFormula/@MachinList[2]//ColumnForm//TraditionalForm

FullSimplify[{(((((5+I)/(5-I))))^4)(((((239+I)/(239-I))))^(-1)),(((2+I)/(2-I)))(((3+I)/(3-I))),(((((2+I)/(2-I))))^2)(((((7+I)/(7-I))))^(-1)),(((((3+I)/(3-I))))^2)(((7+I)/(7-I)))}]

Reduce[Im[(1-I)^k(u+I)^m(v+I)^n]==0&&(u|v|k|m|n)∈Integers&&u>0&&v>0&&k>0,{u,v,k,m,n}]

FullSimplify[ComplexExpand[Im[(1-I)^k(u+I)^m(v+I)^n],(u|v|k|m|n)∈Integers&&u>0&&v>0&&k>0]]

Reduce[Sin[((k π)/4)-m Arg[I+u]-n Arg[I+v]]==0&&(u|v|k|m|n)∈Integers&&u>0&&v>0&&k>0,{u,v,k,m,n}]//Timing

Reduce[1+x^2==2y^n,{x,y,n},Integers]

Reduce[1+x^2==y^n,{x,y,n},Integers]

FullSimplify[5ArcTan[(1/7)]+2ArcTan[(3/79)]]

FullSimplify[2ArcTan[(1/(Sqrt[2]))]+ArcTan[(1/(Sqrt[8]))]]

3-Term

Length[MachinList[3]]

FullSimplify[ReleaseHold[Last/@MachinFormula/@MachinList[3]]]

MachinFormula/@MachinList[3]//ColumnForm//TraditionalForm

4 Terms

Length[MachinList[4]]

FullSimplify[ReleaseHold[Last/@MachinFormula/@MachinList[4]]]

MachinFormula/@MachinList[4]//ColumnForm//TraditionalForm

Checks

MachinDuplications

MachinCheck[]

MachinCheck[{19,21}]

HwangParse["Phosphine:Math Lists:Identity.hcl"]

MachinTeXTable

MachinCheck[]

Joerg

MachinListCheck[m_List]:=Module[{pi=MachinListFormula[m]},
  If[Abs[N[pi-Pi,10]]>10^(-9.),Print[N[pi,10]];False,True]
]

MachinListFormula[m_List]:=Module[{k,n=Length[m-1]},
  m[[1]] Sum[m[[k,1]] ArcCot[m[[k,2]]],
    {k,2,n}]
]

infile=OpenRead["Phosphine:arctan"];
Read[infile,Record,RecordSeparators->{"\\begin{eqnarray}\n"}];
Read[infile,String];
Do[list[i]={},{i,20}];
errors=0;
new=0;
While[True,
  str=Read[infile,Record,RecordSeparators->{"\\\\\n"}];
  If[str==EndOfFile,Break[]];
  str=StringReplace[str,{
    "0.5\,\\pi"->"2}",
    "0.75\,\\pi"->"4/3}",
    "1.\,\\pi"->"1}",
    "1.25\,\\pi"->"4/5}",
    "3.75\,\\pi"->"4/15}",
    "4.\,\pi"->"1/4}",
    "15.5\,\\pi"->"2/31}",
    "33.5\,\\pi"->"2/67}",
    "\\,\\ja{"->",",
    " \\ja{"->"1,",
    "  & = &  "->"x",
    "\\frac{\\pi}{"->"",
    "\\\\ \\nonumber & &\n"->"",
    "\n"->"",
    " "->"",
    "+"->"{",
    "-"->"{-"
   }];
   str=StringReplace[str,{"}{"->"},{","}x"->","}];
   str=StringDrop[str,{StringPosition[str,"\\"][[1,1]],StringLength[str]}];
   str=If[StringTake[str,1]=="{",
     str=str<>"}",
     str="{"<>str<>"}"
   ];
   s=ToExpression[str];
   s1=s[[1]];
   s2=Drop[s,1];
   s2=If[s1<0,Table[{-s2[[i,1]],s2[[i,2]]},{i,1,Length[s2]}],s2];
   s1=If[s1<0,-s1,s1];
   s2=Sort[s2,(#1[[2]]<#2[[2]])& ];
   s=Flatten[{s1,s2},1];
   n=Length[s]-1;
   ok=MachinListCheck[s];
   known=Intersection[{s},MachinList[n]]!={};
   If[!ok || !known,Print["check: ",ok," known: ",known," ",s]];
   If[ok && !known,list[n]=Append[list[n],s]];
   If[!ok,errors++];
   If[!known,new++];
 ]
 Close["Phosphine:arctan"];
 If[errors>0,Print["THERE WERE ",errors," ERRORS."],Print["NO ERRORS!"]];
 Print["There were ",new," new entries."]

outfile=OpenWrite["arctan.out"];
Do[
  If[list[i]!={},
    list[i]=Sort[list[i]];
    Write[outfile,"MachinList[",i,"]:={"];
    Do[
      Write[outfile,list[i][[j]],",  (* ja *)"],
      {j,1,Length[list[i]]}
    ];
    Write[outfile,"}"];
  ],   
  {i,2,20}];
Close[outfile];

Williams

SetOptions[$Output,PageWidth->Infinity];
infile=OpenRead["Phosphine:Mathematica:Eric:Machin.dat"];
machin=ReadList[infile,String];
NumMachin=Length[machin];
Close[infile];
machinfix={};
Do[
  s=StringToStream[machin[[i]]];
  machinfix=Append[machinfix,ReadList[s,{Number,Number}]],
  {i,1,NumMachin}
];
MachinFormula[n_]:=Sum[machinfix[[n,i,1]] ArcCot[machinfix[[n,i,2]]],{i,2,Length[machinfix[[n]]]}]*
  4/machinfix[[n,1,2]];
MachinPrint[n_]:=Module[{maxlen=110,k=machinfix[[n,1,2]],sgn,pos0,pos1,pos2,pos,num=Table[0,{i,1,10}]},
  str=If[k==2,"$\\f{1}{2} \pi = ","$\\f{"<>ToString[k]<>"}{4} \\pi = "];
  str=str<>ToString[machinfix[[n,2,1]]]<>"\\tan^{-1}(\\fu{"<>ToString[machinfix[[n,2,2]]]<>"})";
  Do[
    sgn=Sign[machinfix[[n,i,1]]];
    If[sgn==-1,
      str=str<>ToString[machinfix[[n,i,1]]]<>"\\tan^{-1}(\\fu{"<>ToString[machinfix[[n,i,2]]]<>"})",
      str=str<>"+"<>ToString[machinfix[[n,i,1]]]<>"\\tan^{-1}(\\fu{"<>ToString[machinfix[[n,i,2]]]<>"})"],
    {i,3,Length[machinfix[[n]]]}
  ];
  If[N[Abs[MachinFormula[n]-Pi]] < .0001,
    If[StringLength[str]<=maxlen,
      Print[str<>"$\\smallskip"];
        str="",
      pos0=StringPosition[StringTake[str,{1,maxlen}],"\\t"][[-1,1]];
      pos1=StringPosition[StringTake[str,{1,pos0}],"+"];
      pos1=If[pos1=={},0,pos1[[-1,1]]];
      pos2=StringPosition[StringTake[str,{1,pos0}],"-"];
      pos2=If[pos2=={},0,pos2[[-1,1]]];
      pos=Max[pos1,pos2]-1;
        Print[StringTake[str,pos],"$\\smallskip\\nobreak"];
        str=StringDrop[str,pos];
    ];
    While[StringLength[str]>maxlen,
      pos0=StringPosition[StringTake[str,{1,maxlen}],"\\t"][[-1,1]];
      pos1=StringPosition[StringTake[str,{1,pos0}],"+"];
      pos1=If[pos1=={},0,pos1[[-1,1]]];
      pos2=StringPosition[StringTake[str,{1,pos0}],"-"];
      pos2=If[pos2=={},0,pos2[[-1,1]]];
      pos=Max[pos1,pos2]-1;
      Print["$\\rsa{}  ",StringTake[str,pos],"$\\smallskip\\nobreak"];
      str=StringDrop[str,pos]
    ];
    If[StringLength[str]>0,Print["$\\rsa{}  ",str,"$\\smallskip"]];
  ];
  num
];
MachinList[m_,n_]:=Module[{},
  Print["\\input Phosphine:TeX:OzTeX:_science_tex"];
  Print["\\input Phosphine:TeX:Oztex:_twocolumns"];
  Print["\\def\\rsa{\\hskip20pt}"];
  Print[" "];
  Do[
    MachinPrint[i],
    {i,m,n}
  ];
];
MachinLength[n_]:=Module[{i},
  Do[
    If[N[Abs[MachinFormula[i]-Pi]] < .0001 && Length[machinfix[[i]]]==n+1,MachinPrint[i]],
    {i,1,NumMachin}
  ]
];
MachinLengthCount:=Module[{i,num=Table[0,{i,1,10}]},
  Do[
    If[N[Abs[MachinFormula[i]-Pi]] < .0001,num[[Length[machinfix[[i]]]-1]]++],
    {i,1,NumMachin}
  ];
  num
];

MachinFormula[60]

N[MachinFormula[60]]

Do[If[Abs[N[MachinFormula[i]-Pi]]>.001,Print[i]],{i,NumMachin}]

SetOptions[$Output,PageWidth->80]; Table[MachinFormula[i],{i,NumMachin}]//N

Table[MachinFormula[i],{i,NumMachin}]//N

SetOptions[$Output,PageWidth->Infinity]; MachinList[1,NumMachin]

MachinLengthCount

MachinLength[2]

MachinLength[3]

SetOptions[$Output,PageWidth->Infinity]; MachinLength[4]

SetOptions[$Output,PageWidth->Infinity]; MachinLength[5]

SetOptions[$Output,PageWidth->Infinity]; MachinLength[6]

Identities

Plot[-ArcCot[x]+2 ArcCot[2 x]-ArcCot[3 x+4 (x^3)],{x,-10,10}]

FullSimplify[2ArcCot[2x]-ArcCot[4(x^3)+3x]]

Table[-ArcCot[x]+2 ArcCot[2 x]-ArcCot[3 x+4 (x^3)]/.x->RandomComplexDisk[],{100}]//Chop//Union

Lehmer identities

Lehmer (1938)

eqn (21)

a={5,2};
m={7,79/3};

Total[1/Log10[m]]//N

FullSimplify[a.ArcCot[m]]

eqn on p. 664

a={17,6,18,1,-4,-2,-1,1};
m={38,273,323+1/4,853,2072,14633,19703,12545(Sqrt[3])+21728};

Seems to be wrong:

N[a.ArcCot[m],20]

N[π/6,20]

N[a.ArcCot[m]-π/6,20]

...even though computation of Lehmer's "measure" agrees:

Total[1/Log10[m]]//N