0
$\begingroup$

I have a parameter vectors pars, par1, and a matrix data1 together with a vector result values[[All,1]] and vector weight values[[All,2]].

pars = ToExpression["a" <> ToString[#]] & /@ Range[20]

data1 = {{0., 0., 0., 0., 0., 0., 0., 1., 2., 0., 0., 0., 0., 0., 3.,
0., 0., 
  0., 0., 0.}, {1., 0., 0., 0., 0., 0., 0., 0., 2., 0., 0., 0., 0., 
  0., 5., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 2., 
  0., 0., 0., 0., 0., 7., 0., 1., 0., 1., 0.}, {0., 0., 4., 0., 0., 
  0., 0., 0., 2., 0., 0., 0., 0., 0., 7., 0., 0., 0., 0., 0.}, {0., 
  0., 0., 0., 0., 0., 0., 0., 2., 0., 0., 0., 0., 0., 9., 1., 0., 0., 
  0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 2., 0., 0., 0., 0., 0., 
  9., 0., 1., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 2., 0., 
  0., 0., 0., 0., 9., 0., 0., 0., 1., 0.}, {0., 0., 0., 0., 0., 0., 
  0., 0., 2., 0., 0., 0., 0., 0., 17., 0., 0., 0., 0., 0.}, {0., 0., 
  0., 0., 0., 1., 0., 0., 1., 0., 0., 0., 0., 0., 6., 0., 0., 0., 0., 
  0.}, {0., 0., 0., 0., 0., 0., 0., 0., 1., 0., 0., 0., 0., 0., 10., 
  1., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 1., 0., 0., 
  0., 0., 0., 10., 0., 0., 1., 0., 0.}, {0., 0., 0., 0., 0., 1., 0., 
  0., 1., 0., 0., 0., 0., 0., 14., 0., 0., 0., 0., 0.}, {0., 0., 0., 
  0., 0., 0., 0., 0., 1., 0., 1., 0., 0., 0., 14., 0., 0., 0., 0., 
  0.}, {2., 0., 0., 0., 0., 0., 1., 0., 1., 0., 0., 0., 0., 0., 18., 
  0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 1., 0., 0., 
  0., 0., 0., 18., 0., 0., 1., 0., 0.}, {0., 0., 0., 0., 0., 0., 1., 
  0., 0., 0., 0., 0., 0., 0., 9., 0., 0., 0., 0., 0.}, {0., 0., 0., 
  0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 15., 0., 1., 0., 0., 
  0.}, {0., 2., 0., 0., 0., 0., 0., 0., 4., 0., 0., 0., 0., 0., 4., 
  0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 1., 0., 0., 4., 0., 0., 
  0., 0., 0., 6., 0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 
  0., 4., 0., 0., 0., 1., 0., 8., 0., 0., 0., 0., 0.}, {0., 0., 0., 
  0., 9., 0., 0., 0., 4., 0., 0., 0., 0., 0., 12., 0., 0., 0., 0., 
  0.}, {0., 0., 0., 0., 0., 0., 0., 0., 4., 0., 0., 1., 0., 0., 16., 
  0., 0., 0., 0., 0.}, {0., 0., 0., 0., 0., 0., 0., 0., 4., 0., 0., 
  0., 0., 0., 18., 0., 1., 1., 0., 0.}, {0., 5., 0., 0., 0., 0., 0., 
  0., 4., 0., 0., 0., 0., 0., 20., 0., 0., 0., 0., 0.}, {0., 0., 0., 
  0., 0., 0., 0., 0., 4., 0., 1., 0., 0., 0., 24., 0., 0., 0., 0., 
  0.}} 

values ={{428., 1.}, {456.6, 1.}, {497., 1.}, {471.8, 0.8}, {531.9, 
      0.9}, {514.3, 0.95}, {483.7, 1.}, {6441., 1.}, {436., 1.}, {493.2, 
      1.}, {550.2, 1.}, {550., 1.1}, {523.1, 1.}, {607.5, 1.}, {584.4, 
      1.}, {433.3, 1.}, {532., 1.}, {613.1, 1.}, {632., 1.}, {651., 
      1.}, {685., 0.9}, {712., 0.95}, {726., 1.}, {736., 1.}, {767., 1.}}

I want to find parameters for the function: a21 + a22 * Total[weight*Abs[(Total[pars * data1] - values[1])/values[1]]] + a23 * Total[weight * Abs[((Total[pars * data1] - value[1])/value[1])]^a24] with the following code:

pars1 = Append[Append[Append[Append[pars, a21], a22], a23], a24]

sum2 = 0;

For[i = 1, i < Length[values[[All, 2]]], i++, 
  sum2 = sum2 + 
    values[[i, 2]]*
     Abs[((a21 + a22*Total[pars*data1[[i, All]]] + 
           a23*Total[pars*data1[[i, All]]]^a24) - values[[i, 1]])/
       values[[i, 1]]]];

sum2;

NMinimize[sum2, pars1]

The found parameters seem to be wrong because a10 and a20 should be zero for this case.

I also want to eliminate (to drop) the case i and re-find the parameters when the difference between the function value with the found parameters and values[i,1] is too large, e.g., the relative difference is more than 10%. I don't know how to solve these problems.

Could you please advice me how to solve these problems. Thank you in advance for your support.

Improve this question
$\endgroup$
3
  • $\begingroup$ Parameters a1, a10, a14, a20 do not appear in sum2. Therefore they could have any value. But to get a reasonable result you should not specify these variables in NMinimize. E.g.: NMinimize[sum2, Complement[pars1, {a10 , a20, a4, a14}]] gives a result of: 2.945 $\endgroup$
    – Daniel Huber
    Sep 18, 2021 at 19:29
  • $\begingroup$ @DanielHuber : Thank you for your comments. NMinimize for this case gives the strange results. Lets see: NMinimize[sum2, pars1]; NMinimize[sum2, Complement[pars1, {a10, a20}]]; NMinimize[sum2, Complement[pars1, {a10, a20, a4, a14}]] gives strange results. Furthermore, let see simplest case: sum1 = 0; For[i = 1, i < Length[values[[All, 1]]], i++, sum1 = sum1 + values[[i, 2]]* Abs[(Total[pars*data1[[i, All]]] - values[[i, 1]])/ values[[i, 1]]]]; sum1; NMinimize[sum1, pars] --> best results. What is the problems of the NMinimize? $\endgroup$
    – Anh
    Sep 19, 2021 at 9:01
  • $\begingroup$ You must understand that for a non-convex problems without constrains there is no method that will find the global minimum with 100% accuracy. You would have to sample at infinite many points. It is always possible that a local minimum is found. The lowest minimum I can find is 1.17524 using the method "RandomSearch". $\endgroup$
    – Daniel Huber
    Sep 19, 2021 at 9:23

0

Reset to default

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.