I would like to propose a different way of doing the non-linear fitting using Quantile regression with B-splines. The advantages of the approach are that it does not need guessing of the fit functions and it requires less experimentation.
Load the package QuantileRegression (explained here Quantile regression through linear programming ).
After several experiments with the number of knots we can find a regression quantile using 3d order B-splines of 18 knots that approximates the data well.
qfunc = Simplify[QuantileRegression[data, 18, {0.5}, InterpolationOrder -> 2][[1]]];
qfGr = Plot[qfunc[x], {x, Min[data[[All, 1]]], Max[data[[All, 1]]]}, PlotPoints -> 700];
Show[{dGr, qfGr}, Frame -> True, ImageSize -> 700]
Here are the relative errors:
ListPlot[Map[{#[[1]], (qfunc[#[[1]]] - #[[2]])/#[[2]]} &, data],
Filling -> Axis, Frame -> True, ImageSize -> 500]
If we select a non-uniform grid of knots according to gradients of the data we get a good approximation with one attempt.
knots =
Join[
Rescale[Range[0, 1, 0.2], {0, 1}, {Min[data[[All, 1]]], Max[data[[All, 1]]] 3/4}],
Rescale[Range[0, 1, 0.1], {0, 1}, {Max[data[[All, 1]]] 3/4, Max[data[[All, 1]]]}]
]
qfunc = QuantileRegression[data, knots, {0.5}][[1]];
The grid lines in the plot below are made with knots.
qfGr = Plot[qfunc[x], {x, Min[data[[All, 1]]], Max[data[[All, 1]]]}];
Show[{dGr, qfGr}, GridLines -> {knots, None}, GridLinesStyle -> Directive[GrayLevel[0.8], Dashed],
Frame -> True, ImageSize -> 700]
Here are the relative errors:
ListPlot[Map[{#[[1]], (qfunc[#[[1]]] - #[[2]])/#[[2]]} &, data],
Filling -> Axis, Frame -> True, ImageSize -> 500]
Here is the approximation function after using PiecewiseExpand and Simplify:
qfunc = Evaluate[Simplify[PiecewiseExpand[qfunc[[1]]]]] &;
qfunc
