# Using Manipulate to dynamically correct the baseline of a signal

i have data with a baseline and will correct it with a polynomial fit using Manipulate to see immediatly the changes in the resulting spectrum. It works so far, but the problem is the definition of the function fbaseline in the Manipulate Part. Mathematica keeps calculating until my RAM is full and then the computer freezes. If I leave out the "_" (fbaseline[x]=...) the code doesn't work anymore, because I can't apply the Map function. Do you have an idea, how I can avoid this?

Here is a minimal working example:

Generate Data:

datafunc = Exp[-0.2 x] + Exp[-0.1 (x - 10)^2/0.2];
data = Table[{x, datafunc + .05 RandomReal[{-1, 1}]}, {x, 0, 25, 0.05}];
ListPlot[data]

Initial values:

xi = {5, 15};

Manipulate part:

Manipulate[
baselinedata = Cases[data /. {x_, y_} /; (x > x1 && x < x2) -> 0, {x_, y_}];
fbaseline[x_] = f[x, n] /. FindFit[baselinedata, f[x, n], Array[a, {n + 1}, 0], x];
datablk = Transpose[Join[{data[[All, 1]]}, {data[[All, 2]] - Map[fbaseline, data[[All, 1]]]}]];
Show[ListPlot[{data, baselinedata, datablk}, PlotStyle -> {{Gray, PointSize[Medium]}, {Orange, PointSize[Medium]}, {Red, PointSize[Medium]}}, PlotRange -> All],Plot[fbaseline[x], {x, 0, 25}, PlotStyle -> {Black, Dashed}],
Graphics[{PointSize[Large], Point[{{x1, 0}, {x2, 0}}]}], ImageSize -> 1000],
{{n, 6}, 2, 8, 1}, {{x1, xi[[1]]}, 0, 15}, {{x2, xi[[2]]}, 5, 25}
]

Another problem is, that the axis at y=0 dissapears for some values.

Previous version (not working without the data): Here is the code i have so far:

f[x_Symbol, b_Integer] := Array[a, {b + 1}, 0].x^Range[0, b];´
(*Initial values for excluded ranges*)
xi = {441, 1151};
region1 = {{0, 4000}, {-1000, 25000}};
region2 = {{0, 4000}, {Min[data], Max[data]}};

Manipulate[
baselinedata =
Cases[data /. {x_, y_} /; (x > x1 && x < x2) -> 0, {x_, y_}];
xi = {x1, x2};
fbaseline[x_] = f[x, n] /. FindFit[baselinedata, f[x, n], Array[a, {n + 1}, 0], x];

datablk = Transpose[Join[{rawdata[[All, 1]]}, {data[[All, 2]] - Map[fbaseline, rawdata[[All, 1]]]}]];
Show[ListPlot[{data, baselinedata, datablk},
PlotStyle -> {{Gray, PointSize[Medium]}, {Orange,
PointSize[Medium]}, {Red, PointSize[Medium]}},
PlotRange -> region],
Plot[fbaseline[x], {x, 400, 4000}, PlotStyle -> {Black, Dashed}],
Graphics[{PointSize[Large], Point[{{x1, 0}, {x2, 0}}]}],
ImageSize -> 1000],
{{n, 6}, 2, 8, 1}, {{x1, xi[[1]]}, 400, 600}, {{x2, xi[[2]]}, 800, 1300}, {{region, region2, "Plotregion"}, {region1 -> "Zoom", region2 -> "All"}}

]

• Have you tried using ContinuousAction -> False as option for Manipulate? Is disables evaluation while dragging the sliders and can reduce the number of evaluations and therefore it takes at least longer until memory is full. Sep 4, 2014 at 13:54
• Try setting $HistoryLength = 0. See$HistoryLength for details. Sep 4, 2014 at 13:56
• Hi, i have added a minimal working example. Both suggestions doesn't work, the bar on the right side is "black" so Mathematica keeps calculating. Thanks so far! Sep 4, 2014 at 15:42
• Add TrackedSymbols :> {n, x1, x2} to your Manipulate. Sep 4, 2014 at 15:50

I have rewritten your code to remove function definitions from the first argument of Manipulate. It is always a bad idea to define functions in the first argument of Manipulate -- such functions get redefined every time the front end refreshes the visible contents of the Manipulate. I have also put some effort on reducing the amount of evaluation done when a slider is moved.

What I have done appears to have cured all the bad behavior you describe. The resulting Manipulate is quite responsive.

f[x_Symbol, n_Integer] := Array[a, {n + 1}, 0] . x^Range[0, n]
baselinedata[data_, u1_?NumericQ, u2_?NumericQ] := Select[data, ! (u1 < #[[1]] < u2) &]
fbaseline[x1_?NumericQ, x2_?NumericQ, n_Integer, data_] :=
Block[{x},
f[x, n] /. FindFit[baselinedata[data, x1, x2], f[x, n], Array[a, {n + 1}, 0], x]]
datablk[x1_?NumericQ, x2_?NumericQ, n_Integer, data_] :=
Block[{poly},
Function[poly[x_] := #][fbaseline[x1, x2, n, data]];
Transpose[Join[{data[[All, 1]]}, {data[[All, 2]] - Map[poly, data[[All, 1]]]}]]]

SeedRandom[1];
data = Table[
{x, Exp[-0.2 x] + Exp[-0.1 (x - 10)^2/0.2] + .05 RandomReal[{-1, 1}]},
{x, 0, 25, 0.05}];

With[{xi1 = 5, xi2 = 15},
Manipulate[
Show[
ListPlot[{data, baselinedata[data, x1, x2], datablk[x1, x2, n, data]},
PlotStyle -> {{Gray, PointSize[Medium]},
{Orange, PointSize[Medium]},
{Red, PointSize[Medium]}},
PlotRange -> All],
Plot[fbaseline[x1, x2, n, data], {x, 0, 25},
PlotStyle -> {Black, Dashed}],
Graphics[{PointSize[Large], Point[{{x1, 0}, {x2, 0}}]}],
ImageSize -> 500],
{{n, 6}, 2, 8, 1, Appearance -> "Labeled"},
{{x1, xi1}, 0, 15, Appearance -> "Labeled"},
{{x2, xi2}, 5, 25, Appearance -> "Labeled"}]]