-1
$\begingroup$

Maybe someone has code of linear least squares?

https://en.wikipedia.org/wiki/Linear_least_squares_(mathematics)#Example

$\endgroup$

closed as off-topic by m_goldberg, Edmund, Quantum_Oli, Sascha, LLlAMnYP Jun 20 '17 at 10:23

This question appears to be off-topic. The users who voted to close gave this specific reason:

  • "This question arises due to a simple mistake such as a trivial syntax error, incorrect capitalization, spelling mistake, or other typographical error and is unlikely to help any future visitors, or else it is easily found in the documentation." – m_goldberg, Edmund, Quantum_Oli, Sascha, LLlAMnYP
If this question can be reworded to fit the rules in the help center, please edit the question.

2
$\begingroup$

Linear least squares is provided in Mathematica by the built-in function LinearModelFit.

pts =
  {{0, 2.38224}, {0.2, 3.26463}, {0.4, 3.73676}, 
   {0.6, 4.12454}, {0.8, 4.72272}, {1, 5.5135}};

lm = LinearModelFit[pts, x, x]

lmf

Show[ListPlot[pts, PlotStyle -> Red], Plot[lm[x], {x, 0, 1}]]

plot

$\endgroup$
1
$\begingroup$

I have found approximation. Is this code right?

points = {{0, 2.38224}, {0.2, 3.26463}, {0.4, 3.73676}, {0.6, 
    4.12454}, {0.8, 4.72272}, {1, 5.5135}};

FindFit[points, k x + d, {k, d}, x];
(*Plot[k x+d/.%,{x,0,1},*)

S = Sum[((points[[i, 2]] - k points[[i, 1]] - d))^2, {i, 1, 6}];

D[S, d];
D[S, k];
NSolve[{%% == 0, % == 0}, {k, d}, Reals]
Show[ListPlot[points], Plot[k x + d /. %[[1]], {x, 0, 1}]]

enter image description here

$\endgroup$
  • $\begingroup$ Your answer looks good, but see my answer for an easier way. $\endgroup$ – m_goldberg Jun 20 '17 at 8:56
1
$\begingroup$

Code for linear least squares

pts = {{0, 2.38224}, {0.2, 3.26463}, {0.4, 3.73676},
   {0.6, 4.12454}, {0.8, 4.72272}, {1, 5.5135}};

{x, y} = Transpose[pts];
MapIndexed[(X@#2[[1]] = #1) &, x];
MapIndexed[(Y@#2[[1]] = #1) &, y];

n = Length[pts];
ΣX = Sum[X[i], {i, n}];
ΣY = Sum[Y[i], {i, n}];
ΣXY = Sum[X[i] Y[i], {i, n}];
ΣX2 = Sum[X[i]^2, {i, n}];
Clear[a, b];
{{a, b}} = {a, b} /. Solve[{
     (*Normal equations for straight line*)
     ΣY == n a + b ΣX,
     ΣXY == a ΣX + b ΣX2}, {a, b}];

Show[Plot[a + b x, {x, 0, 1}], ListPlot[pts]]

enter image description here

$\endgroup$
0
$\begingroup$

Just to illustrate the "anatomy":

$A x=b$

$x=(A^TA)^{-1}A^T b$

(omitting various complications: singularity, weighting, etc)

You can do, e.g.

pts = {{0, 2.38224}, {0.2, 3.26463}, {0.4, 3.73676}, {0.6, 
    4.12454}, {0.8, 4.72272}, {1, 5.5135}};
{v, b} = Transpose[pts];
a = Transpose[{ConstantArray[1, Length[v]], v}];
ata = Transpose[a].a;
betas = Inverse[ata].Transpose[a].b;
Plot[betas.{1, x}, {x, 0, 1}, Epilog -> Point[pts], 
 PlotLabel -> (betas.{1, x} == y)]
ss = (b - a.betas).(b - a.betas)

enter image description here

$\endgroup$

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