0
$\begingroup$

Because of lack of data, I only have normalized data to fit. (namely the data value are divided by the max value of data and the peak value becomes unit)

The data is shown as follow:

r76 = {{542.6701856282341`, 
    0.07764989004174758`}, {626.6173842143535`, 
    0.29349832955371236`}, {656.0895281008903`, 
    0.5913314613326053`}, {728.212293943863`, 
    1.`}, {782.1313241848961`, 
    0.9743890490336464`}, {851.0031790196008`, 
    0.913194695825656`}, {902.2419705010758`, 
    0.9251181107734547`}, {925.9565995696244`, 
    0.8783386058472558`}, {1054.3921434193162`, 
    0.8614126945081949`}, {1089.1125500560115`, 
    0.7714787065217009`}, {1177.2955761199148`, 
    0.6820289616346121`}, {1256.2853554074297`, 
    0.6688860100912675`}, {1366.9471353702515`, 
    0.6517552032847401`}, {1430.506693892375`, 
    0.6350631327313485`}, {1449.10501292244`, 
    0.5724617566068132`}, {1487.1390312262042`, 
    0.5160313138756719`}, {1693.2356816458084`, 
    0.4359499374813523`}, {1726.442918377672`, 
    0.3981071705534973`}, {1760.2208884864226`, 
    0.34071744173828206`}, {1829.7137765757996`, 
    0.23848704296299775`}, {2029.69014110562`, 
    0.17927557609349742`}, {2082.6290742109622`, 
    0.12878318301060854`}, {2165.1476130003107`, 
    0.10950567327768596`}, {2325.1744775818124`, 
    0.0895597094679642`}, {2448.8431013825957`, 
    0.07324681288106921`}, {2716.647998214203`, 
    0.05990523673095968`}};

Then, I am trying to fit the data via the function given as:

Vi[n_, i_] := 
 Vi[n, i] = (-1)^(i + n/2) Sum[ 
     k^(n/2) (2 k)! /( (n/2 - k)! k! (k - 1)! (i - k)! (2 k - 
            i)! ), { k, Floor[ (i + 1)/2 ], Min[ i, n/2] } ] // N; 
Stehfest[F_, s_, t_, n_: 16] :=
 If[n > 16, Message[Stehfest::optimalterms, n];
        If[ OddQ[n], Message[Stehfest::odd, n];
                "Enter an even number of terms",
                If[n > 32, Message[Stehfest::terms, n];
                    " Try a smaller value for n. Maximum allowable n is 32 ",
                    Log[2]/t Sum[ Vi[n, i]*F /. s -> i Log[2]/t , {i, 1, n} ] ]],
        If[ OddQ[n], Message[Stehfest::odd, n];
                "Enter an even number of terms", 
    If[n > 32, Message[Stehfest::terms, n];
                    " Try a smaller value for n. Maximum allowable n is 32.",
                    Log[2]/t Sum[ 
       Vi[n, i]*F /. s -> i Log[2]/t , {i, 1, n} ] ]]]  // N; 

C1[r_, t_, al_, td_, tc_] := Re[Stehfest[E^(r/(2*al*(1 + p*tc)) + (p*r*td)/(2*al*(1 + p*tc)))*
 AiryAi[(2*2^(1/3)*((Q + 2*p*Q*td + p^2*Q*td^2)/(4*al^2*Q*(1 + p*tc)^2) + 
     (r*(8*al*b*p*Pi*R*\[Phi] + 8*al*b*p^2*Pi*R*tc*\[Phi] + 8*al*b*p^2*Pi*R*td*\[Phi] + 8*al*b*p^3*Pi*R*tc*td*\[Phi]))/
      (4*al^2*Q*(1 + p*tc)^2)))/((8*al*b*p*Pi*R*\[Phi] + 8*al*b*p^2*Pi*R*tc*\[Phi] + 8*al*b*p^2*Pi*R*td*\[Phi] + 
      8*al*b*p^3*Pi*R*tc*td*\[Phi])/(al^2*Q*(1 + p*tc)^2))^(2/3)]*
 (M/(E^(rl/(2*al*(1 + p*tc)) + (p*rl*td)/(2*al*(1 + p*tc)))*Q*
    AiryAi[(2*2^(1/3)*((Q + 2*p*Q*td + p^2*Q*td^2)/(4*al^2*Q*(1 + p*tc)^2) + 
        (rl*(8*al*b*p*Pi*R*\[Phi] + 8*al*b*p^2*Pi*R*tc*\[Phi] + 8*al*b*p^2*Pi*R*td*\[Phi] + 8*al*b*p^3*Pi*R*tc*td*\[Phi]))/
         (4*al^2*Q*(1 + p*tc)^2)))/((8*al*b*p*Pi*R*\[Phi] + 8*al*b*p^2*Pi*R*tc*\[Phi] + 8*al*b*p^2*Pi*R*td*\[Phi] + 
         8*al*b*p^3*Pi*R*tc*td*\[Phi])/(al^2*Q*(1 + p*tc)^2))^(2/3)] - 
   al*E^(rl/(2*al*(1 + p*tc)) + (p*rl*td)/(2*al*(1 + p*tc)))*Q*(1/(2*al*(1 + p*tc)) + (p*td)/(2*al*(1 + p*tc)))*
    AiryAi[(2*2^(1/3)*((Q + 2*p*Q*td + p^2*Q*td^2)/(4*al^2*Q*(1 + p*tc)^2) + 
        (rl*(8*al*b*p*Pi*R*\[Phi] + 8*al*b*p^2*Pi*R*tc*\[Phi] + 8*al*b*p^2*Pi*R*td*\[Phi] + 8*al*b*p^3*Pi*R*tc*td*\[Phi]))/
         (4*al^2*Q*(1 + p*tc)^2)))/((8*al*b*p*Pi*R*\[Phi] + 8*al*b*p^2*Pi*R*tc*\[Phi] + 8*al*b*p^2*Pi*R*td*\[Phi] + 
         8*al*b*p^3*Pi*R*tc*td*\[Phi])/(al^2*Q*(1 + p*tc)^2))^(2/3)] - 
   (E^(rl/(2*al*(1 + p*tc)) + (p*rl*td)/(2*al*(1 + p*tc)))*(8*al*b*p*Pi*R*\[Phi] + 8*al*b*p^2*Pi*R*tc*\[Phi] + 
      8*al*b*p^2*Pi*R*td*\[Phi] + 8*al*b*p^3*Pi*R*tc*td*\[Phi])*AiryAiPrime[
      (2*2^(1/3)*((Q + 2*p*Q*td + p^2*Q*td^2)/(4*al^2*Q*(1 + p*tc)^2) + (rl*(8*al*b*p*Pi*R*\[Phi] + 
            8*al*b*p^2*Pi*R*tc*\[Phi] + 8*al*b*p^2*Pi*R*td*\[Phi] + 8*al*b*p^3*Pi*R*tc*td*\[Phi]))/(4*al^2*Q*(1 + p*tc)^2)))/
       ((8*al*b*p*Pi*R*\[Phi] + 8*al*b*p^2*Pi*R*tc*\[Phi] + 8*al*b*p^2*Pi*R*td*\[Phi] + 8*al*b*p^3*Pi*R*tc*td*\[Phi])/
         (al^2*Q*(1 + p*tc)^2))^(2/3)])/(2^(2/3)*al*(1 + p*tc)^2*
     ((8*al*b*p*Pi*R*\[Phi] + 8*al*b*p^2*Pi*R*tc*\[Phi] + 8*al*b*p^2*Pi*R*td*\[Phi] + 8*al*b*p^3*Pi*R*tc*td*\[Phi])/
       (al^2*Q*(1 + p*tc)^2))^(2/3)))), p, t, 16]]

with

b = 1; Q = 2.5/60; \[Phi] = 0.2; rl = 0.05; M = 10; R = 1;

I got some troubles here. The function value is not normalized and the peak value would change when the parameters changes; thus, I cannot use the peak value of the function to normalize during the data fitting.

Therefore, the fitting process do not work.

nlm1 = NonlinearModelFit[r76, 
   C1[7.6, t, al, td, tc], {{al, 0.1}, {td, 101}, {tc, 1}}, t];

 LogLogPlot[nlm1[t], {t, r76[[1, 1]], r76[[Length[r76], 1]]}], 
 Frame -> True]

In short, how can I use the non-normalized function to fit the normalized data?

Does anyone know how to deal with this? Thanks.

$\endgroup$
  • $\begingroup$ The process seems to be fine. It would seem that either the starting values for the parameters are far away from the desired result or the function defined simply won't fit the data. ListPlot[{r76, Transpose[{r76[[All, 1]], C1[7.6, #, 0.1, 100, 1] & /@ r76[[All, 1]]}]}, PlotRange -> All] will show the initial fit. Given the values of al and td, the parameter tc seems to have little effect (in the range of 0.1 to 10). $\endgroup$ – JimB Sep 28 '17 at 15:51
  • $\begingroup$ Because the function is non-normalized. How can I normalize the function before fitting (i.e., C/Cpeak)? $\endgroup$ – JOJO Sep 29 '17 at 1:30
  • $\begingroup$ To add more flexibility to the function you could add a multiplicative parameter (x) to allow for a wider range of heights: nlm1 = NonlinearModelFit[r76, x C1[7.6, t, al, td, tc], {{al, 0.05}, {td, 101}, {tc, -1}, {x, 2}}, t]; But that doesn't help with the poor fit with respect to shape. Your function is very complicated. Was this function generated by some theory? $\endgroup$ – JimB Sep 29 '17 at 2:41
  • $\begingroup$ The function is obtained by the diffusion equation for solute transport. I'll try your way. Thank you. $\endgroup$ – JOJO Sep 29 '17 at 3:46
2
$\begingroup$

In the neighborhoods of the starting values for the parameters, the function just doesn't fit the data. The height of the function can be made flexible by adding a multiplicative parameter x but even that doesn't get you much better fits. You either need better starting values or a different function.

Here is a set of commands that provides a structure to look at different starting values:

Manipulate[
 xy = Table[{t, x C1[7.6, t, al, td, tc]}, {t, 500, 2700, 10}];
 ListPlot[{r76, xy}, Joined -> {False, True}],
 {{al, 0.05}, 0.00001, 0.1, Appearance -> "Labeled"},
 {{td, 100}, 1, 500, Appearance -> "Labeled"},
 {{tc, 1}, 0.1, 10, Appearance -> "Labeled"},
 {{x, 1.7}, 1, 10, Appearance -> "Labeled"},
 TrackedSymbols :> {al, td, tc, x}]

Manipulate screenshot showing data and fit

$\endgroup$

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.