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],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[{If[!ParesOrde,DifeDivi[DeleteDuplicates[VectorPreim]][[1]],DifeDiviPares[DeleteDuplicates[VectorPares]][[1]]],"",If[!ParesOrde,DifeDivi[DeleteDuplicates[VectorPreim]][[2]],DifeDiviPares[DeleteDuplicates[VectorPares]][[2]]],If[!ParesOrde,DifeDivi[DeleteDuplicates[VectorPreim]][[3]],DifeDiviPares[DeleteDuplicates[VectorPares]][[3]]]},Center],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 interpolante de Newton en diferencias divididas.",Bold,10],Spacer[{400,2}],{{Criterio,Cos[x],"f(x)="},Enabled->!ParesOrde},{{VectorPreim,{1,1.3,1.6},"Abscisas"},Enabled->!ParesOrde},Delimiter,{{ParesOrde,False,"Pares ordenados"},{True,False}},{{VectorPares,{{4,6},{4.2,7.7567},{4.4,10.1361},{4.6,13.3813},{4.8,17.8379}},"Pares ordenados"},Enabled->ParesOrde},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 diferencias divididas", Bold,14, RGBColor[0,0.33,0.33]]}},Initialization:>(Clear[VariableFuncioni,f,CrearFuncion,w,DifeDivi,DifeDiviPares];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}];DifeDivi[VectorPreim_]:=Module[{iDifeDivi,jDifeDivi,MQ,MQAux,n=Length[VectorPreim]},MQ=Join[Transpose[{N[g/@VectorPreim]}],ConstantArray[0,{n,n-1}],2];For[jDifeDivi=2,jDifeDivi<=n,For[iDifeDivi=1,iDifeDivi<=n,If[iDifeDivi>=jDifeDivi,MQ[[iDifeDivi,jDifeDivi]]=(MQ[[iDifeDivi,jDifeDivi-1]]-MQ[[iDifeDivi-1,jDifeDivi-1]])/(VectorPreim[[iDifeDivi]]-VectorPreim[[iDifeDivi-jDifeDivi+1]])];iDifeDivi++];jDifeDivi++];MQAux=MQ;
For[jDifeDivi=1,jDifeDivi<=n,For[iDifeDivi=1,iDifeDivi<=n,If[iDifeDivi==jDifeDivi,MQAux[[iDifeDivi,jDifeDivi]]=Style[MQAux[[iDifeDivi,jDifeDivi]],Bold,Red]];iDifeDivi++];jDifeDivi++];{TableForm[Join[Transpose[{VectorPreim}],MQAux,2],TableHeadings->{Range[0,n-1],Join[{"(Subscript[x, i])"},Table[StringTemplate["Q[i,<*kNeville*>]"][],{kNeville,0,n-1}]]}],Style[Row[{"P(x)=",Sum[MQ[[iDifeDiv,iDifeDiv]]Product[x-VectorPreim[[jDifeDiv]],{jDifeDiv,1,iDifeDiv-1}],{iDifeDiv,1,n}]}],10],Style[Row[{"⇒P(x)=",Expand[Sum[MQ[[iDifeDiv,iDifeDiv]]Product[x-VectorPreim[[jDifeDiv]],{jDifeDiv,1,iDifeDiv-1}],{iDifeDiv,1,n}]]}],10]}];DifeDiviPares[VectorPares_]:=Module[{iDifeDivi,jDifeDivi,MQ,MQAux,n=Length[VectorPares]},MQ=Join[Transpose[{N[VectorPares[[All,2]]]}],ConstantArray[0,{n,n-1}],2];For[jDifeDivi=2,jDifeDivi<=n,For[iDifeDivi=1,iDifeDivi<=n,If[iDifeDivi>=jDifeDivi,MQ[[iDifeDivi,jDifeDivi]]=(MQ[[iDifeDivi,jDifeDivi-1]]-MQ[[iDifeDivi-1,jDifeDivi-1]])/(VectorPares[[iDifeDivi,1]]-VectorPares[[iDifeDivi-jDifeDivi+1,1]])];iDifeDivi++];jDifeDivi++];MQAux=MQ;
For[jDifeDivi=1,jDifeDivi<=n,For[iDifeDivi=1,iDifeDivi<=n,If[iDifeDivi==jDifeDivi,MQAux[[iDifeDivi,jDifeDivi]]=Style[MQAux[[iDifeDivi,jDifeDivi]],Bold,Red]];iDifeDivi++];jDifeDivi++];{TableForm[Join[Transpose[{VectorPares[[All,1]]}],MQAux,2],TableHeadings->{Range[0,n-1],Join[{"(Subscript[x, i])"},Table[StringTemplate["Q[i,<*kNeville*>]"][],{kNeville,0,n-1}]]}],Style[Row[{"P(x)=",Sum[MQ[[iDifeDiv,iDifeDiv]]Product[x-VectorPares[[jDifeDiv,1]],{jDifeDiv,1,iDifeDiv-1}],{iDifeDiv,1,n}]}],10],Style[Row[{"⇒P(x)=",Expand[Sum[MQ[[iDifeDiv,iDifeDiv]]Product[x-VectorPares[[jDifeDiv,1]],{jDifeDiv,1,iDifeDiv-1}],{iDifeDiv,1,n}]]}],10]}])]],"Text"]]