連分数の2つの表示

ClearAll["`*"]

§1.連分数の分数表示

Manipulate[
Module[{w,cf,val,tr1,tr2,cftext,given,str,first,last,contents},
w=Switch[mode,frac,w1/w2,root,Sqrt[w1],cube,CubeRoot[w1],g,(1+Sqrt[5])/2,pi,Pi,e,E];
cf=Flatten[ContinuedFraction[w,terms]]//Quiet;
val=TraditionalForm[FromContinuedFraction[cf]];
tf1=If[mode===frac||mode===root||mode===cube,True,False];
tf2=If[mode===frac,True,False];
cftext=If[mode===frac||mode===root||mode===g,ToString[ContinuedFraction[w]],
StringReplace[ToString[ContinuedFraction[w,10]],"}"->"...}"]]//Quiet;
given=ToString[TraditionalForm[w]];
str=ToString/@cf;
first=First[cf];
last=Last[str];
contents=If[terms===1,first,first+Fold[1/(#2+#1)&,ToString[TraditionalForm[1/last]],Reverse[Drop[Drop[str,-1],1]]]];
If[terms>1,Grid[{{given," = ",cftext},{" "," ≃ ",contents},{" "," = "<>ToString[val], " ≃ "<>ToString[N[val]]}},Alignment->{{Center,Left,Left},{Center,Left,Left},{Center,Left,Left}}],
Grid[{{given," = ",cftext},{" "," ≃ ",contents},{"  "," "," "}},Alignment->Left]]],

{mode,{frac->"(w1/w2)",root->"(Sqrt[w1])",cube->"(w1^(1/3))",g->"golden ratio",pi->"π",e->"e"}},{w1,30,Enabled->Dynamic[tf1]},{w2,11,Enabled->Dynamic[tf2]},{terms,1,30,1,Appearance->"Labeled"},TrackedSymbols:>{w1,w2,mode,terms}]

§2.連分数の図形的表示

Manipulate[
Module[{w,a,cf,txt,d,x,y,rec},
w=Switch[mode,frac,w1/w2,root,Sqrt[w1],cube,CubeRoot[w1],g,(1+Sqrt[5])/2,pi,Pi,e,E];
a=ContinuedFraction[w,10]//Quiet;
m=Length[a];
tf1=If[mode===frac||mode===root||mode===cube,True,False];
tf2=If[mode===frac,True,False];
cf=If[mode===frac||mode===root||mode===g,ToString[ContinuedFraction[w]],
StringReplace[ToString[ContinuedFraction[w,20]],"}"->"...}"]]//Quiet;
txt=ToString[TraditionalForm[w]]<>"="<>cf;
d[n_]:=Simplify[d[n-2]-a[[n-1]]*d[n-1]];
d[1]=1;
d[2]=w-a[[1]]*d[1];
x[n_]:=Simplify[x[n-1]+((-1)^n+1)/2*a[[n-1]] d[n-1]];
y[n_]:=Simplify[y[n-1]-((-1)^(n-1)+1)/2*a[[n-1]] d[n-1]];
x[1]=0;
y[1]=1;
rec[n_]:=
If[OddQ[n],Table[Line[{{d[n]*k,0},{d[n]*k,-d[n]}}],{k,0,a[[n]]}],
Table[Line[{{0,-d[n]*k},{d[n],-d[n]*k}}],{k,0,a[[n]]}]]//Translate[#,{x[n],y[n]}]&;
rec[0]=Line[{{0,1},{0,0},{w,0},{w,1},{0,1}}];
Graphics[Table[rec[i],{i,0,n}],PlotLabel->txt]]//Quiet,

{mode,{frac->"(w1/w2)",root->"(Sqrt[w1])",cube->"(w1^(1/3))",g->"golden ratio",pi->"π",e->"e"}},{w1,30,Enabled->Dynamic[tf1]},{w2,11,Enabled->Dynamic[tf2]},{n,0,Dynamic[m],1,Appearance->"Labeled"},TrackedSymbols:>{w1,w2,mode,n}]