14
$\begingroup$

I have the following lists representing energy spectra that need to be subtracted from each other to produce a difference spectrum.

data1 = ToExpression@Import["http://pastebin.com/raw.php?i=VfBcE9L5", "Data"][[1]]

data2 = ToExpression@Import["http://pastebin.com/raw.php?i=dFcxfJ4j", "Data"][[1]]

This is how all the spectra look before the necessary shift (I threw a spline fit through the arrays):

enter image description here

The problem is that I need to preform an energy shift to the black spectrum before the subtraction so that the first peaks line up. I usually construct my difference spectrum array like this:

diffdata = Transpose[{data1[[1,;;,1]], data1[[1,;;,2]] - data2[[1,;;,2]]}]

Where the first column is energy and the second column is intensity. I want to energy shift data2 to line up with data1 (it's about a -0.35 shift), then subtract the intensity of data1 from the intensity of data2

Since the subtraction occurs based on the position of the elements within the list, any shifting I do to column 1 of data2 (the energy) will not matter to my difference array. Furthermore, the data point spacing is not homogenous within the spectrum i.e. the data points are more dense in the peak regions than in other regions; however, the point spacing between data1 and data2 are identical. Is there any way I can get around this?

My immediate attempt was to do something with Interpolation, but I do not know how to subtract the y-values of two interpolated functions from each other. I would then input the energies of data1 (i.e. data1[[1,;;,1]] into the interpolated difference spectrum to get the interpolated intensities of with the corresponding energies.

Any help is appreciated.

$\endgroup$
20
$\begingroup$

I always use TimeSeries for these kinds of problems, since it avoids having to worry about indices too much, gives you good control over resampling and you have a whole load of useful functions

dt = 0.05;
{ts1, ts2} = 
 TimeSeries[TimeSeriesResample[#, dt,
  ResamplingMethod -> {"Interpolation", InterpolationOrder -> 1}]] & /@ {data1, data2};

ListLinePlot[{Quiet@
 TimeSeriesThread[First[#] - Last[#] &, {TimeSeriesShift[ts2, -0.35], ts1}],
 ts1, ts2}, PlotStyle -> {Blue, Green, Black}]

final

The function TimeSeriesShift performs your shift/alignment:

ListLinePlot[{TimeSeriesShift[ts2, -0.35], ts1}, PlotStyle -> {Green, Black}]

aligned

TimeSeriesThread is used to do shifted data2 minus data1. If you want it the other way around, change First[#]-Last[#] to Last[#]-First[#].

$\endgroup$
  • 1
    $\begingroup$ thank you for this very instructive answer +1 :) $\endgroup$ – ubpdqn Jun 8 '15 at 3:05
  • 1
    $\begingroup$ Brilliant! I used TimeSeriesThread[ Last[#] - First[#] &, {TimeSeriesShift[ts2, -0.35], ts1}] and threw my data1 energies in there to get the interpolated intensities as an array. $\endgroup$ – W. Heisenberg Jun 8 '15 at 3:47
10
$\begingroup$

Because data1 and data2 have an extra set of curly brackets, it is necessary to remove the extra set before generating interpolating functions.

int1 = Interpolation[Flatten[data1, 1]];
int2 = Interpolation[Flatten[data2, 1]];

The difference then can be computed and plotted:

Plot[{int1[t], int2[t + .35], int1[t] - int2[t + .35]}, {t, 1105, 1134}]

enter image description here

The difference alone is

enter image description here

Addendum

In answer to the OP's question below, the difference between the two curves can be converted into an interpolation function itself, if desired, by

diffdata = FunctionInterpolation[int1[t] - int2[t + .35], {t, 1105, 1133.65}, 
  InterpolationOrder -> 1, InterpolationPoints -> 5 Length[Flatten[data1, 1]]]

enter image description here

$\endgroup$
  • 2
    $\begingroup$ Can the difference between the two interpolations be an interpolation itself i.e. throw a list into the interpolation to get values? I still need a difference array with the energies in data1 for further processing. $\endgroup$ – W. Heisenberg Jun 8 '15 at 3:00
  • 1
    $\begingroup$ Procedure for doing so added to Answer. $\endgroup$ – bbgodfrey Jun 8 '15 at 5:24
  • 1
    $\begingroup$ Great info for future reference +1 $\endgroup$ – W. Heisenberg Jun 8 '15 at 15:26
9
$\begingroup$

Using the same variable names. The separation can be approximated using FindPeaks. I have used on the distinctive three middle peaks.

lp1 = ListPlot[data1, 
   Epilog -> {Red, PointSize[0.03], 
     Point@(p1 = 
        Extract[data1[[1]], 
         List /@ FindPeaks[data1[[1, All, 2]]][[All, 1]]])}, 
   Frame -> True, ImageSize -> 400];
lp2 = ListPlot[data2, 
   Epilog -> {Red, PointSize[0.03], 
     Point@(p2 = 
        Extract[data2[[1]], 
         List /@ FindPeaks[data2[[1, All, 2]]][[All, 1]]])}, 
   Frame -> True, ImageSize -> 400];
diff = Drop[p1, 3] - Drop[p2, 2];
md = Mean[diff[[1 ;; 3]]]
i1 = Interpolation[data1[[1]]];
i2 = Interpolation[data2[[1]]];
pld = Plot[{i1[t], i2[t - md[[1]]], i1[t] - i2[t - md[[1]]]}, {t, 
    1105, 1130}, Frame -> True, ImageSize -> 400];
Column[{lp1, lp2, pld}]

The mean difference in 3 peak locations: {-0.309621, 0.0253712}

enter image description here

$\endgroup$
  • 1
    $\begingroup$ Nice, though what I really need is for the onset and the tail of the peaks to be roughly aligned. $\endgroup$ – W. Heisenberg Jun 8 '15 at 2:58
  • 1
    $\begingroup$ @W.Heisenberg perhaps this will facilitate you achieving that desired goal $\endgroup$ – ubpdqn Jun 8 '15 at 3:03

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.