2
$\begingroup$

So, I'm having a bit of an issue with this code that I'm trying to write. I've written (and working) a part that does the quadratic spline from a list of points. In this case I'm trying to show the accuracy of such a spline from uniform points along the Cos[6*Pi*x] function by changing the number of sample points.

ClearAll[data, a, b, c, d, x, y, S, Sp, eqns]
xdata = Table [i, {i, 0, 1, .20}];
ydata = Table[Cos[6*Pi*i], {i, 0, 1, .20}];
data = Transpose[{xdata, ydata}];

dataplot = ListPlot[data, PlotStyle -> Black];

S[i_][x_] = a[i] + b[i]*x + c[i]*x^2;
Do[x[i_] := data[[i, 1]], {i, 1, Length[data]}];
Do[y[i_] := data[[i, 2]], {i, 1, Length[data]}];
eqns = Table[S[i][x[i]] == y[i], {i, 1, Length[data] - 1}];
Do[AppendTo[eqns, S[i][x[i + 1]] == y[i + 1]], {i, 1, 
   Length[data] - 1}];
Do[AppendTo[eqns, S[i]'[x[i + 1]] == S[i + 1]'[x[i + 1]]], {i, 1, 
   Length[data] - 2}];
AppendTo[eqns, S[1]'[x[1]] == 0];
coeffs = Solve[eqns];
Do[Sp[i][x_] = S[i][x] /. coeffs;

  Print[Sp[i][x]], {i, 1, Length[data] - 1}];
s1plot = Plot[Sp[1][x], {x, 0, .2}, PlotStyle -> Red];
s2plot = Plot[Sp[2][x], {x, .2, .4}, PlotStyle -> Green];
s3plot = Plot[Sp[3][x], {x, .4, .6}, PlotStyle -> Red];
s4plot = Plot[Sp[4][x], {x, .6, .8}, PlotStyle -> Green];
s5plot = Plot[Sp[5][x], {x, .8, 1.0}, PlotStyle -> Red];
splot = Plot[Cos[6*Pi*x], {x, 0, 1}, PlotStyle -> Black];
dataplot = ListPlot[data, PlotStyle -> Black];
Show[splot, dataplot, s1plot, s2plot, s3plot, s4plot, s5plot, 
 PlotRange -> All]

As you can see, that once I have enough points it will become tedious. I'm just not sure how to automate the plotting of all the functions in Sp[i][x] and plot them over their respective domains.

$\endgroup$
  • 1
    $\begingroup$ Table[Plot[Sp[i][x], {x,.2 (i-1),.2 i} ] , {i,5}] $\endgroup$ – george2079 Nov 15 '17 at 19:22
  • $\begingroup$ @george2079 Perfect! Thank you! $\endgroup$ – xCanaan Nov 15 '17 at 19:48
2
$\begingroup$

This part repeats the part of your code that I didn't change much.

data = Table[{i, Cos[6*Pi*i]}, {i, 0, 1, .20}];
dataplot = ListPlot[data, PlotStyle -> {Black, AbsolutePointSize[8]}];
splot = Plot[Cos[6*Pi*x], {x, 0, 1}, PlotStyle -> Black];
S[i_][x_] = a[i] + b[i]*x + c[i]*x^2;
Do[x[i_] := data[[i, 1]], {i, 1, Length[data]}];
Do[y[i_] := data[[i, 2]], {i, 1, Length[data]}];
eqns = Table[S[i][x[i]] == y[i], {i, 1, Length[data] - 1}];
Do[AppendTo[eqns, S[i][x[i + 1]] == y[i + 1]], {i, 1, Length[data] - 1}];
Do[AppendTo[eqns, S[i]'[x[i + 1]] == S[i + 1]'[x[i + 1]]], {i, 1, Length[data] - 2}];
AppendTo[eqns, S[1]'[x[1]] == 0];
coeffs = Solve[eqns];
Do[Sp[i][x_] = S[i][x] /. coeffs, {i, 1, Length[data] - 1}]

Preparing the arguments that are needed to do multiple plots of Sp[i][x]

args =
  With[{max = 5},
   {Table[Sp[i][x], {i, max}],
    {x, Sequence @@ #} & /@ Partition[Subdivide[1., max], 2, 1],
    PadRight[{}, max, PlotStyle -> # & /@ {Red, Green}]}];

Combining the plots.

Show[splot, dataplot, MapThread[Plot[#1, #2, #3] &, args], PlotRange -> All]

plot

$\endgroup$
0
$\begingroup$

For setting up the equations, you might also dispense with the Table and Do expressions and more tersely do this:

x = 0.2 Range[0, 5];
y = Cos[6 Pi x];
data = Transpose[{x, y}];
n = Length[x];

s[i_][x_] := a[i] + b[i] x + c[i] x^2

eq0[i_] := s[i][x[[i]]] == y[[i]]
eq1[i_] := s[i][x[[i + 1]]] == y[[i + 1]]
eq2[i_] := s[i]'[x[[i + 1]]] == s[i + 1]'[x[[i + 1]]]
eq3 := s[1]'[x[[1]]] == 0;
eqns = Join[eq0 /@ Range[n - 1], eq1 /@ Range[n - 1], eq2 /@ Range[n - 2], {eq3}]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.