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,Row[{"S(x)=",If[Simplificar,Expand[Splines3[DeleteDuplicates[VectorPreim]][[1]]],Splines3[DeleteDuplicates[VectorPreim]][[1]]]}],Row[{"S(x)=",If[Simplificar,Expand[Splines3Pares[DeleteDuplicates[VectorPares]][[1]]],Splines3Pares[DeleteDuplicates[VectorPares]][[1]]]}]],"",If[!ParesOrde,Splines3[DeleteDuplicates[VectorPreim]][[2]],Splines3Pares[DeleteDuplicates[VectorPares]][[2]]]},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 de interpolación de trazadores cúbicos de frontera libre o natural.",Bold,10],Spacer[{400,2}],{{Criterio,x^4Cos[x],"f(x)="},Enabled->!ParesOrde},{{VectorPreim,{0,0.25,0.5,0.75,1},"Abscisas"},Enabled->!ParesOrde},Delimiter,{{ParesOrde,False,"Pares ordenados"},{True,False}},{{VectorPares,{{0,0},{0.25,0.00378481},{0.5,0.0548489},{0.75,0.231511},{1,0.540302}},"Pares ordenados"},Enabled->ParesOrde},Delimiter,{{Simplificar,True,"S(x) simplificada"},{True,False}},Delimiter,Button["Cambiar función",Clear[g];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 splines cúbicos: frontera libre", Bold,14, RGBColor[0,0.33,0.33]]}},Initialization:>(Clear[VariableFuncioni,f,CrearFuncion,w,Splines3,Splines3Pares,S];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}];Splines3[VectorPreim_]:=Module[{iSpli,jSpli,MA,MB,n=Length[VectorPreim],h,Vectoras,Vectorbs={},Vectorcs,Vectords={},Intervalos=Partition[VectorPreim,2,1],intervalo,Trozos={}},Vectoras=Table[g[iSpli],{iSpli,VectorPreim}];h[iSpli_]:=VectorPreim[[iSpli+1]]-VectorPreim[[iSpli]];MA=ConstantArray[0,{n,n}];MB=ConstantArray[0,{n,1}];If[n>2,For[iSpli=1,iSpli<=n,For[jSpli=1,jSpli<=n,If[iSpli==jSpli,If[(iSpli==jSpli==1)||(iSpli==jSpli==n),MA[[iSpli,jSpli]]=1,MA[[iSpli,jSpli]]=2(h[iSpli-1]+h[iSpli])],If[jSpli==iSpli+1,If[iSpli!=1||jSpli!=2,MA[[iSpli,jSpli]]=h[iSpli]],If[iSpli==jSpli+1,If[iSpli!=n||jSpli!=n-1,MA[[iSpli,jSpli]]=h[iSpli-1]]]]];jSpli++];iSpli++],MA[[1,1]]=1;MA[[2,1]]=h[1];MA[[2,2]]=1];If[n>2,For[iSpli=1,iSpli<=n,If[iSpli>=2&&iSpli<=n-1,MB[[iSpli,1]]=((3(Vectoras[[iSpli+1]]-Vectoras[[iSpli]]))/(h[iSpli]))-((3(Vectoras[[iSpli]]-Vectoras[[iSpli-1]]))/(h[iSpli-1]))];iSpli++]];Vectorcs=Flatten[LinearSolve[MA,MB]];For[iSpli=1,iSpli<=n-1,Vectorbs=Append[Vectorbs,((Vectoras[[iSpli+1]]-Vectoras[[iSpli]])/(h[iSpli]))-(1/3)h[iSpli](2Vectorcs[[iSpli]]+Vectorcs[[iSpli+1]])];Vectords=Append[Vectords,((Vectorcs[[iSpli+1]]-Vectorcs[[iSpli]])/(3h[iSpli]))];iSpli++];For[iSpli=1,iSpli<=n-1,intervalo=Intervalos[[iSpli]];Trozos=Append[Trozos,{Vectoras[[iSpli]]+Vectorbs[[iSpli]](x-VectorPreim[[iSpli]])+Vectorcs[[iSpli]](x-VectorPreim[[iSpli]])^2+Vectords[[iSpli]](x-VectorPreim[[iSpli]])^3,intervalo[[1]]<=x<=intervalo[[2]]}];iSpli++];S[x_]:=Piecewise[Trozos];{S[x]//N,Plot[{g[x],S[x]},{x,Min[VectorPreim],Max[VectorPreim]},PlotLegends->{"f(x)","S(x)"}]}];Splines3Pares[VectorPares_]:=Module[{iSpli,jSpli,MA,MB,n=Length[VectorPares],h,Vectoras,Vectorbs={},Vectorcs,Vectords={},Intervalos=Partition[VectorPares[[All,1]],2,1],intervalo,Trozos={},VectorPreim},VectorPreim=VectorPares[[All,1]];Vectoras=VectorPares[[All,2]];h[iSpli_]:=VectorPreim[[iSpli+1]]-VectorPreim[[iSpli]];MA=ConstantArray[0,{n,n}];MB=ConstantArray[0,{n,1}];If[n>2,For[iSpli=1,iSpli<=n,For[jSpli=1,jSpli<=n,If[iSpli==jSpli,If[(iSpli==jSpli==1)||(iSpli==jSpli==n),MA[[iSpli,jSpli]]=1,MA[[iSpli,jSpli]]=2(h[iSpli-1]+h[iSpli])],If[jSpli==iSpli+1,If[iSpli!=1||jSpli!=2,MA[[iSpli,jSpli]]=h[iSpli]],If[iSpli==jSpli+1,If[iSpli!=n||jSpli!=n-1,MA[[iSpli,jSpli]]=h[iSpli-1]]]]];jSpli++];iSpli++],MA[[1,1]]=1;MA[[2,1]]=h[1];MA[[2,2]]=1];If[n>2,For[iSpli=1,iSpli<=n,If[iSpli>=2&&iSpli<=n-1,MB[[iSpli,1]]=((3(Vectoras[[iSpli+1]]-Vectoras[[iSpli]]))/(h[iSpli]))-((3(Vectoras[[iSpli]]-Vectoras[[iSpli-1]]))/(h[iSpli-1]))];iSpli++]];Vectorcs=Flatten[LinearSolve[MA,MB]];For[iSpli=1,iSpli<=n-1,Vectorbs=Append[Vectorbs,((Vectoras[[iSpli+1]]-Vectoras[[iSpli]])/(h[iSpli]))-((h[iSpli](2Vectorcs[[iSpli]]+Vectorcs[[iSpli+1]]))/3)];Vectords=Append[Vectords,((Vectorcs[[iSpli+1]]-Vectorcs[[iSpli]])/(3h[iSpli]))];iSpli++];For[iSpli=1,iSpli<=n-1,intervalo=Intervalos[[iSpli]];Trozos=Append[Trozos,{Vectoras[[iSpli]]+Vectorbs[[iSpli]](x-VectorPreim[[iSpli]])+Vectorcs[[iSpli]](x-VectorPreim[[iSpli]])^2+Vectords[[iSpli]](x-VectorPreim[[iSpli]])^3,intervalo[[1]]<=x<=intervalo[[2]]}];iSpli++];S[x_]:=Piecewise[Trozos];{S[x]//N,Show[Plot[S[x],{x,Min[VectorPreim],Max[VectorPreim]}],ListPlot[VectorPares,PlotStyle->{Black,PointSize[0.025]}]]}])]],"Text"]]