2
$\begingroup$

Well the title actually says it all. Is there a function that finds the best fit for data points without any user-inputed information about the form the formula might have?

Here is the data I want to find a fit for: data={8, 11.2, 10.3, 8.1, 13.6, 2.8, 3.2, 1.3, 1.8, 1, 0.3, 0.2, 0, 2.1} It is the annual sales of DVD-A from 2001 to 2014 (this is the whole dataset). In 2003, a direct competitor to the DVD-A appeared, the SA-CD. So I would like to graphically illustrate the fact that the trend in the sales of the DVD-A change drastically from the moment the SA-CD made it's appearance. Obviously, there are only two observations before 2003, so a linear fit is obvious... But I'm having trouble finding a continuous function that illustrates the sales trend from 2003 to 2014.

So the predictor variable is simply {3,4,...,14}.

Here is a graph of the data, the linear trend for the years 2001 and 2002 and the chopped-up function for the 2003-2014 period provided by the FindFormula described below:

Code for the graph:

Show[ListLinePlot[data,(*DVD-A*) PlotStyle ->Directive[CMYKColor[0.37,0.,0.44,0.48] ,Thickness[.008],Opacity[.5]] ,Frame -> True ,PlotRange -> All ,FrameTicks-> {Automatic, {Table[{i, 2000 + i}, {i, 0, 14}], None}} ,PlotLabel -> "Sales evolution of DVD-A" ,FrameLabel -> {None, "Sales\n(Millions, 2013 USD)"}] ,Plot[Evaluate@LinearModelFit[data[[{1,2}]], t, t][t], {t, 0.75, 2.5}] ,Plot[Evaluate@FindFormula[data[[3;;]], t, 5,SpecificityGoal -> 3][[4]], {t,4, 14}] ]

Until now, I have tried this: FindFormula[data[[3;;]], t, 5, SpecificityGoal -> 3], which gives a chopped-up fonction with different chunks. I would like to find a continuous function that fits the data (I already tried with NonlinearFit with different orders polynomials and did not get a visually good estimation of the data from 2003 to 2014).

Thanks,

$\endgroup$
  • 1
    $\begingroup$ You might try FindFormula if you have version 10.2 or above. But you still need to examine the fit afterwords. $\endgroup$ – JimB Nov 25 '16 at 22:23
  • $\begingroup$ If all the output I get is a real number, I guess this means that the software can't find a better fit than a straight line? $\endgroup$ – EBassal Nov 25 '16 at 22:37
  • $\begingroup$ I posted a method here that should work. mathematica.stackexchange.com/a/72037/12558 can you give us some data? $\endgroup$ – Hugh Nov 25 '16 at 23:10
  • $\begingroup$ It might just be that there is no relationship which would explain why the result is just the mean of the dependent variable as the predictor. It's hard to say more than that unless you share a specific example (data AND code). $\endgroup$ – JimB Nov 25 '16 at 23:52
  • 1
    $\begingroup$ I don't think there is any answer to this question, and there certainly is no answer with out seeing the data. $\endgroup$ – m_goldberg Nov 26 '16 at 0:23
3
$\begingroup$

Using Quantile regression might produce results you would want.

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/QuantileRegression.m"]

data = {8, 11.2, 10.3, 8.1, 13.6, 2.8, 3.2, 1.3, 1.8, 1, 0.3, 0.2, 0, 2.1};
ts = Transpose[{Range[2001, 2014], data}];

qfunc = QuantileRegression[ts, 4, {0.5}][[1]];

ListLinePlot[{ts, {#, qfunc[#]} & /@ ts[[All, 1]]}, 
 PlotLegends -> {"data", "QR fit"}, PlotTheme -> "Detailed"]

enter image description here

qfunc[x] // Simplify

enter image description here

$\endgroup$
  • 1
    $\begingroup$ Would you add in confidence bands for the curve to help assess the "confidence" in the fit? I suspect those bands will be so wide as to make the predictions useless. There just isn't enough data here to put nonparametric quantile regression to work. $\endgroup$ – JimB Nov 27 '16 at 13:53
  • 1
    $\begingroup$ Thank you, this is precisely what I wanted but wasn't able to obtain. For this particular usage I don't need the confidence bands. $\endgroup$ – EBassal Nov 27 '16 at 14:18
  • $\begingroup$ @EBassal You might not want confidence bands but you do need them. Any estimate without some measure of precision is at best of unknown value. Here with just 14 data points and probably 8 parameters estimated is a case of way overfitting. This is not an indictment of quantile regression or the great package that Anton has put together. It is simply a case of overfitting confounded by the ignoring of the cost of not knowing what model might be appropriate. $\endgroup$ – JimB Nov 27 '16 at 15:26
  • 1
    $\begingroup$ @JimBaldwin My answer is for question's request "[...] I'm having trouble finding a continuous function that illustrates the sales trend from 2003 to 2014." In this case using QR I am not starting with a model or trying to find one. Also, theoretically speaking QR is much more ad hoc -- to verify that QR worked I just have to count the points above and below the found curve. (In this case of 14 points for the 0.5 quantile QR worked perfectly: with Tally[(qfunc[#[[1]]] > #[[2]]) & /@ ts] we get {{False, 7}, {True, 7}}.) $\endgroup$ – Anton Antonov Nov 27 '16 at 15:44
  • 1
    $\begingroup$ Anton: I understand. This site is about the use of Mathematica software and not a statistics, physics, chemistry, astronomy, or engineering site. However, if someone had a model and data and grammatically correct Mathematica code and they predicted that the mass of an electron was twice as big as currently accepted, I would hope that folks would jump all over that prediction. I'm simply attempting to do the same for statistics when I see the need. Here quantile regression provides a predicted curve but with huge confidence bands rendering the prediction useless. $\endgroup$ – JimB Nov 27 '16 at 17:22
4
$\begingroup$

I think that @m_goldberg had the right answer in his comment: "I don't think there is any answer to this question..."

Why do I say this? Mainly because of the subjective tone you've used. In other words, when a good curve appears, you'll know it when you see it. That is not to say that such an approach is wrong. It's only to say that maybe the rest of us can't help you because of that.

In addition, there are some statements for which there is not much statistical validity:

(1) "Obviously, there are only two observations before 2003, so a linear fit is obvious..." No, it not obvious but it is inappropriate.

(2) Both DVD-A and SA-CD have had low sales, have never caught on (few musicians recording in such formats), and finding a smooth curve to fit 12 data points won't help you with assigning cause-and-effect. You mention difference-in-difference techniques which are popular among certain disciplines but the restrictive assumptions are rarely checked and maybe rarely met.

(3) You've given a good rationale for why the sales are negative in one year (because of returns) but no rationale for why converting that to a zero would be appropriate as other years have returns also.

(4) FindFormula does not give "a chopped-up fonction with different chunks". It gives you the top 5 models that you requested.

I'd still recommend first addressing the question at CrossValidated and then using Mathematica for implementation.

Update: Why you need confidence bands

At some point adding in more parameters loses effectiveness in fitting and soon one starts to overfit giving you false confidence in the result. Two ways of assessing the models being considered is to use confidence bands and ranking models by their AICc statistic. (Overfitting especially applies to good but data hungry techniques such as quantile regression and generalized additive models when one doesn't have many data points to estimate the multiple and "hidden" parameters.)

Here is a summary of fits if you restrict yourself to polynomials of order up to 6 for predicting the values for the years 2003 through 2014.

data = {8, 11.2, 10.3, 8.1, 13.6, 2.8, 3.2, 1.3, 1.8, 1, 0.3, 0.2, 0, 2.1};
ts = Transpose[{Range[2001, 2014], data}];
ts2 = Transpose[{Range[3, 14], data[[Range[3, 14]]]}];

fit[order_] := Module[{x, z, i, lm},
  lm = LinearModelFit[ts2, Table[x^i, {i, order}], x];
  Show[Plot[{lm[z - 2000], lm["MeanPredictionBands"] /. x -> z - 2000}, {z, 2003, 2014}],
   ListPlot[ts], AxesOrigin -> {2000, 0}, 
   PlotRange -> {{2001, 2014}, {-5, 20}}, ImageSize -> Medium,
   Frame -> True, 
   FrameLabel -> {{"Sales", ""}, {"Year", 
      "Polynomial order = " <> ToString[order]}}]
  ]

Grid[{{fit[1], fit[2]}, {fit[3], fit[4]}, {fit[5], fit[6]}}]

Polynomial fits

One can see that as the order of the polynomial increases, there is closer agreement to the observed data. However, a price is paid in that the confidence bands start to get wider and wider.

If one computes the AICc statistic, the 2nd order polynomial has the smallest AICc statistic with the linear model (1st order polynomial) coming in second. So if you restrict yourself to these polynomials the 2nd order polynomial is best. Whether or not the confidence bands are small enough to meet your objective is a subject matter issue. But ignoring the confidence bands is not justifiable.

$\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.