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,Biseccion[a,b,n],BiseccionTolerancia[a,b,vtolerancia]],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 bisección.",Bold,10],Spacer[{400,2}],{{Criterio,27x^3-45x^2-3x+5,"f(x)="}},Delimiter,{{a,1,"Valor de a"}},{{b,2,"Valor de b"}},{{n,6,"Iteraciones"},Enabled->!tolerancia},Delimiter,{{tolerancia,False,"Tolerancia"},{True,False}},{{vtolerancia,(10^(-2)),"Valor de precisión"},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 bisección", Bold,14, RGBColor[0,0.33,0.33]]}},Initialization:>(Clear[VariableFuncioni,f,CrearFuncion,w,Biseccion,BiseccionTolerancia];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}];Biseccion[a_,b_,n_]:=If[a<b,If[n>=1,Module[{aaux=a,baux=b,p=((a+b)/2),vectNiter={1},vecPreIm,vecIm,Biseci},If[Quiet[TrueQ[g[aaux]*g[baux]<=0]],vecPreIm={p};vecIm={g[p]};For[Biseci=2,Biseci<=n,vectNiter=Append[vectNiter,Biseci];If[g[aaux]*g[p]<=0,baux=p,aaux=p];p=((aaux+baux)/2);vecPreIm=Append[vecPreIm,p];vecIm=Append[vecIm,g[p]];Biseci++];Style[Grid[{Prepend[vectNiter,"n"],Prepend[vecPreIm//N,"(Subscript[p, n])"],Prepend[vecIm//N,"f((Subscript[p, n]))"]},Frame-> All,Alignment->Left],11],Style["No se satisface f(a)*f(b)<= 0 (teorema de Bolzano)",11]]],Style["NaD",11]],Style["NaD",11]];BiseccionTolerancia[a_,b_,tolerancia_]:=If[tolerancia>0,Module[{iteraciones=If[Log[2,(b-a)/tolerancia]==Ceiling[Log[2,(b-a)/tolerancia]],Ceiling[Log[2,(b-a)/tolerancia]]+1,Ceiling[Log[2,(b-a)/tolerancia]]]},If[IntegerQ[iteraciones],If[iteraciones>=1,Biseccion[a,b,iteraciones],Style["NaD",11]],Style["NaD",11]]],Style["NaD",11]])]],"Text"]]