6
$\begingroup$

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"}}

]

enter image description here

$\endgroup$
4
  • 1
    $\begingroup$ 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. $\endgroup$ Sep 4, 2014 at 13:54
  • 1
    $\begingroup$ Try setting $HistoryLength = 0. See $HistoryLength for details. $\endgroup$
    – Karsten7
    Sep 4, 2014 at 13:56
  • $\begingroup$ 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! $\endgroup$
    – new_user
    Sep 4, 2014 at 15:42
  • 1
    $\begingroup$ Add TrackedSymbols :> {n, x1, x2} to your Manipulate. $\endgroup$
    – Karsten7
    Sep 4, 2014 at 15:50

1 Answer 1

3
$\begingroup$

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"}]]

manipulate

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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