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[VectorPreim,NumericQ]&&VectorQ[InterExt,NumericQ],If[MatrixQ[VectorPares,NumericQ],If[Dimensions[DeleteDuplicates[VectorPares]][[2]]==2,If[(Length[DeleteDuplicates[VectorPreim]]>=2&&ParesOrde==False)||(Length[DeleteDuplicates[VectorPares]]>=2&&ParesOrde==True),Style[Column[{Row[{"P(x)=",If[!ParesOrde,Lagrange[DeleteDuplicates[VectorPreim],InterExt,Calcular,CotaError][[1]],LagrangePares[DeleteDuplicates[VectorPares],InterExt,Calcular][[1]]]}],If[!ParesOrde,Row[{"Aproximaciones: ",Lagrange[DeleteDuplicates[VectorPreim],InterExt,Calcular,CotaError][[2]]}],Row[{"Aproximaciones: ",LagrangePares[DeleteDuplicates[VectorPares],InterExt,Calcular][[2]]}]],If[!ParesOrde,Row[{"|f(x)-P(x)|≤ ",Lagrange[DeleteDuplicates[VectorPreim],InterExt,Calcular,CotaError][[3]]," ∀x, x∈[",Min[VectorPreim],",",Max[VectorPreim],"]"}],""]},Left],10],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]]],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 Lagrange (aproximación polinomial).",Bold,10],Spacer[{400,2}],{{Criterio,E^x,"f(x)="},Enabled->!ParesOrde},{{VectorPreim,{1,2,3,4,5,6},"Abscisas"},Enabled->!ParesOrde},{{CotaError,False,"Cota de error"},{True,False},Enabled->!ParesOrde},Delimiter,{{ParesOrde,False,"Pares ordenados"},{True,False}},{{VectorPares,{{1,2.71828},{2,7.389056},{3,20.08553},{4,54.59815},{5,148.41315},{6,403.42879}},"Pares ordenados"},Enabled->ParesOrde},Delimiter,{{Calcular,False,"Calcular"},{True,False}},{{InterExt,{1.5,5.5},"Interpolaciones o Extrapolaciones"},Enabled->Calcular},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 Lagrange", Bold,14, RGBColor[0,0.33,0.33]]}},Initialization:>(Clear[VariableFuncioni,f,CrearFuncion,w,Lagrange,Lk,LagrangePares];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}];Lk[VectorPrei_,vk_]:=Module[{xi},Product[((x-xi)/(VectorPrei[[vk]]-xi)),{xi,Select[VectorPrei,#!=VectorPrei[[vk]]&]}]];Lagrange[VectorPreim_,InterExt_,Logico1_,Logico2_]:=Module[{iSum,Poli,CotaError},CotaError[VectorPrei_]:=Module[{n=Length[VectorPrei],a=Min[VectorPrei],b=Max[VectorPrei],v1,v2},v1=TimeConstrained[Quiet[Abs[D[g[x],{x,n}]]/.Maximize[Abs[D[g[x],{x,n}]],a<=x<=b,x][[2]]],5];If[NumericQ[v1],v2=TimeConstrained[Quiet[Abs[Product[x-xi,{xi,VectorPrei}]]/.Maximize[Abs[Product[x-xi,{xi,VectorPrei}]],a<=x<=b,x][[2]]],5]];If[NumericQ[v2],If[v2<=0,v2=TimeConstrained[Quiet[Product[x-xi,{xi,VectorPrei}]/.Maximize[Product[x-xi,{xi,VectorPrei}],a<=x<=b,x][[2]]],5]]];If[NumericQ[v1]&&NumericQ[v2],N[v1*(1/(n!))*v2],"NaD"]];Poli=Sum[Lk[VectorPreim,iSum]*g[VectorPreim[[iSum]]],{iSum,Length[VectorPreim]}];{Expand[Poli]//N,If[Logico1,N[Expand[Poli]]/.x->InterExt,"sin cálculo"],If[Logico2,CotaError[VectorPreim],"sin cota de error"]}];LagrangePares[VectorPares_,InterExt_,Logico_]:=Module[{iSum,Poli},Poli=Sum[Lk[VectorPares[[All,1]],iSum]*VectorPares[[iSum,2]],{iSum,Length[VectorPares]}];{Expand[Poli]//N,If[Logico,N[Expand[Poli]]/.x->InterExt,"sin cálculo"]}])]],"Text"]]