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[VectorQ[{a,b,n,vtolerancia},NumericQ],If[!tolerancia,PuntoFijo[a,b,n],PuntoFijoTolerancia[a,b,vtolerancia,valorkdec]],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 el método de los puntos fijos.",Bold,10],Spacer[{400,2}],{{Criterio,((5x^2+5)^(1/4)),"g(x)="}},Delimiter,{{a,2,"Valor de a"}},{{b,3,"Valor de b"}},{{n,6,"Iteraciones"},Enabled->!tolerancia},Delimiter,{{tolerancia,False,"Tolerancia"},{True,False}},{{vtolerancia,(10^(-3)),"Valor de precisión"},Enabled->tolerancia},{{valorkdec,False,"k con decimales"},{True,False},Enabled->tolerancia},Delimiter,Button["Cambiar funció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["Método de los puntos fijos", Bold,14, RGBColor[0,0.33,0.33]]}},Initialization:>(Clear[VariableFuncioni,f,CrearFuncion,w,PuntoFijo,PuntoFijoTolerancia];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,x,Ra];g[Ra_]:= Quiet[Evaluate[First[f]]/.Select[FuncionVariable[f],ToString[#]==ToString[x]&][[1]]->Ra]];CrearFuncion[{Criterio}];PuntoFijo[a_,b_,n_]:=If[a<b,If[n>=0,Module[{p=(a+b)/2,vectNiter={0},vecPreIm,vecIm,PuntFi},If[TrueQ[Quiet[(g[a]-a)*(g[b]-b)<=0]],vecPreIm={p};vecIm={g[p]};For[PuntFi=1,PuntFi<=n,vectNiter=Append[vectNiter,PuntFi];p=g[p];vecPreIm=Append[vecPreIm,p];vecIm=Append[vecIm,g[p]];PuntFi++];Style[Grid[{Prepend[vectNiter,"n"],Prepend[vecPreIm//N,"(Subscript[p, n])"],Prepend[vecIm//N,"g((Subscript[p, n]))"]},Frame-> All,Alignment->Left],11],Style["No se satisface (g(a)-a)*(g(b)-b)<= 0 (teorema de Bolzano)",11]]],Style["NaD",11]],Style["NaD",11]];PuntoFijoTolerancia[a_,b_,tolerancia_,kdec_:False]:=If[tolerancia>0,If[TrueQ[Quiet[(g[a]-a)*(g[b]-b)<=0]],Module[{iteraciones,k=Quiet[Maximize[Abs[D[g[x],x]],{a<=x<=b},x][[1]]],p0=(a+b)/2},If[0<k<1,iteraciones=Min[Ceiling[Log[k,((tolerancia(1-k))/(Abs[g[p0]-p0]))]],Ceiling[Log[k,(tolerancia/(((b-a)/2)))]]];If[iteraciones>=0,Column[{Row[{Style["k = ",11],Style[If[!kdec,k,N[k]],11]}],Row[{Style["iteraciones = ",11], Style[iteraciones,11]}],TimeConstrained[PuntoFijo[a,b,iteraciones],10]}],Style["NaD",11]],Style["Cambie g(x) no hay unicidad del punto fijo (no es posible usar la tolerancia)",11]]],Style["No se satisface (g(a)-a)*(g(b)-b)<= 0 (teorema de Bolzano)",11]],Style["NaD",11]])]],"Text"]]