CellPrint[TextCell[Quiet[Manipulate[If[ToString[Criterio]≠ToString[Null],If[!StringContainsQ[ToString[g[x]],"If"]&&!StringContainsQ[ToString[g[x]],"I"],If[NumericQ[g[Quiet[w/.Quiet[FindInstance[Quiet[FunctionDomain[g[w],w]],{w},Reals][[1]]]]]],If[NumericQ[Nn],If[NumericQ[Limit[g[n],n->Infinity]],FuncionAitken[Nn],Text[Style["La sucesión no es convergente",12]]],Text[Style["Error en los datos",12]]],Text[Style["Error en los datos",12]]],Text[Style["Error en los datos",12]]],Text[Style["Error en los datos",12]]],Style["Propósito: implementa la función aceleradora de Aitken.",Bold,10],Spacer[{400,2}],{{Criterio,(((1+(1/n)))^n),"(Subscript[p, n])="}},Delimiter,{{Nn,6,"Iteraciones"}},Delimiter,Button["Cambiar sucesión",CrearFuncion[{Criterio}]],Alignment->Center,Deployed->False,AppearanceElements->"ResetButton",LocalizeVariables->True,ContinuousAction->True,ControlPlacement->Top,FrameLabel->{{None,None},{Column[{,Row[{Style["Autores: Juan Félix Ávila Herrera y Enrique Vílchez Quesada",Bold,10,RGBColor[0,0,0.5]]}],Row[{Style["Escuela de Informática | Universidad Nacional de Costa Rica",Bold,10,RGBColor[0.5,0.1,0]]}]},Center],Style["Función aceleradora de Aitken", Bold,14, RGBColor[0,0.33,0.33]]}},Initialization:>(Clear[VariableFuncioni,f,CrearFuncion,w,FuncionAitken];CrearFuncion[f_List]:=Module[{FuncionVariable},FuncionVariable[FuncionVariable_List]:=Module[{FuncionVariableAuxiliar,Simbolos,VariableAuxiliarSimbolos,VariableAuxiliarVariables={}},FuncionVariableAuxiliar[]:=FuncionVariable[[1]];Simbolos[VariableFuncion_]:=DeleteDuplicates[Cases[DownValues[VariableFuncion],_Symbol,Infinity]];VariableAuxiliarSimbolos=Sort[Simbolos[FuncionVariableAuxiliar]];For[VariableFuncioni=1,VariableFuncioni≤Length[VariableAuxiliarSimbolos],If[NumericQ[VariableAuxiliarSimbolos[[VariableFuncioni]]]==False,VariableAuxiliarVariables=Append[VariableAuxiliarVariables,VariableAuxiliarSimbolos[[VariableFuncioni]]]];VariableFuncioni++];VariableAuxiliarVariables];Clear[g,n,Ra];g[Ra_]:= Quiet[Evaluate[First[f]]/.Select[FuncionVariable[f],ToString[#]==ToString[n]&][[1]]->Ra]];CrearFuncion[{Criterio}];FuncionAitken[n_]:=Quiet[If[n>=1,Module[{vectNiter={},vecIm={},vecOIm={},vp1,vp2,vp3,it,vp},For[it=1,it<=n,vectNiter=Append[vectNiter,it];vp1=g[it];vp2=g[it+1];vp3=g[it+2];vp=vp1-(((vp2-vp1)^2)/(vp3-2vp2+vp1));vecIm=Append[vecIm,vp];
vecOIm=Append[vecOIm,g[it]];it++];Style[Grid[{Prepend[vectNiter,"n"],Prepend[vecOIm//N,"(Subscript[p, n])"],Prepend[vecIm//N,"(Subscript[(OverTilde[p]), n])"]},Frame-> All,Alignment->Left],11]],Style["Las iteraciones deben ser mayores o iguales a 1",11]]])]],"Text"]]