2
$\begingroup$

Problem statement

I have some experimental data of measurement values vs. temperature. Now, I want to find the spectrum which causes the measured temperature dependence.

The measurement values are the integrals of

enter image description here

The forward calculation

I will now illustrate the problem with an example. There is an yet unknown sensitivity spectrum.

spectrum[lam_] := Exp[-((lam - 5)/2)^4];
Plot[spectrum[lam], {lam, 0, 10}, AxesLabel -> {"wavelength", "sensitivity"}]

enter image description here

And there is a known spectral intensity

intensity[lam_, T_] := 1/(T^4 lam^5) 1/(Exp[1/(lam *T)] - 1)
Plot[Table[intensity[lam, T], {T, 0.03, 0.1, 0.01}] // Evaluate, {lam, 0, 10}, 
  AxesLabel -> {"wavelength", "intensity"}] // Quiet

enter image description here

The measured signals are the areas under these curves

Plot[Table[spectrum[lam]*intensity[lam, T], {T, 0.03, 0.1, 0.01}] // Evaluate, {lam, 0, 10}, 
  AxesLabel -> {"wavelength", "intensity"}] // Quiet

data = Table[{T,NIntegrate[spectrum[lam]*intensity[lam, T], {lam, 1, 10}]}, {T, 0.03, 0.1, 0.01}];
ListPlot[data, AxesLabel -> {"temperature", "signal"}]

enter image description here enter image description here

What's the solution?

I thought of nonlinear curve fitting for the control points of an interpolation function as was proposed in this question by Hugh and Alexey Popkov. Using the sample data, the result should look like the spectrum[lam] from above.

But how to make this code work?

nOfControlPoints = 5;
controlPoints = Subdivide[1, 10, nOfControlPoints - 1]

model[y : {__Real}] := Interpolation[Transpose[{controlPoints, y}]]
fctn = NIntegrate[model[Array[y, nOfControlPoints]][lam]*intensity[lam, T], {lam, 1, 10}];

nlm = NonlinearModelFit[data, fctn, Array[y, nOfControlPoints], T]
$\endgroup$

1 Answer 1

2
$\begingroup$

Fixing obvious mistakes and slightly redesinging the code in order to avoid NIntegrate error messages, we get:

nOfControlPoints = 5;
controlPoints = Subdivide[1, 10, nOfControlPoints - 1];

Clear[fctn, model];
model[y__Real] := Interpolation[Transpose[{controlPoints, {y}}]]
fctn[{y__Real}][T_Real] := 
  NIntegrate[model[y][lam]*intensity[lam, T], {lam, 1, 10}, 
   Method -> {Automatic, "SymbolicProcessing" -> 0}];

nlm = NonlinearModelFit[data, fctn[Array[y, nOfControlPoints]][T], 
  Array[y, nOfControlPoints], T]

screenshot

Now we can plot the model along with the data:

Show[ListPlot[data], Plot[nlm["Function"][T], {T, 0.03, 0.1}], Frame -> True]

output

We see that NonlinearModelFit has done its job well.

But the fitted model doesn't reproduce the original spectrum well:

Show[Plot[spectrum[lam], {lam, 0, 10}, 
  AxesLabel -> {"wavelength", "sensitivity"}], 
 Plot[Evaluate[model @@ Values@nlm["BestFitParameters"]][lam], {lam, 1, 10}, 
   PlotStyle -> Directive[{Dashed, Red}]], PlotRange -> All]

output2

So you can try to increase the number of sample points, try other interpolation method, try to add constraints, better starting values, etc…

$\endgroup$
0

Your Answer

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

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