Re: Re: Finding unknown parameters using Mathematica

*To*: mathgroup at smc.vnet.net*Subject*: [mg74985] Re: [mg74824] Re: Finding unknown parameters using Mathematica*From*: "Jean-Marc Gulliet" <jeanmarc.gulliet at gmail.com>*Date*: Fri, 13 Apr 2007 02:09:34 -0400 (EDT)*References*: <461E5A500200000B002AF50E@its-gw-inet57.its.rmit.edu.au>

[Message cross posted on MathGroup] On 4/12/07, Shafiq Ahmad <shafiq.ahmad at rmit.edu.au> wrote: > Hi Jean, > > Thanks a lot indeed for your quick help and so sorry for my delayed > response. Actually there was one week public holidays here. > > I have tried your approach and your programs runs very well. I do have > to change increment value for the r1/r2 i.e. {r1, 0.1, 1, 0.15}, {r2, > 0.1, 1, 0.15}] /. a -> r1 /. b -> r2 in the last before contour plot > command to avoid error messages for precision. > > I would like to understand few points. Pls help. > 1). When this program runs, first time it takes value for the r1/r2 > single time and get the values for LMN (ref. page 1 of attached file > pls) This is what I have understood from your original request. > 2). When it runs for next (see page 2), it takes single value of r1 and > keep on incrementing r2 value in the loop and vice versa . This way so > many values of LMN have been listed. What I was expecting, b1,b2 and p > will have same values as r1/r2 and r1/r2 should go parallel in > incrementing the values. What is ur thought ? ListCountour/DensityPlot requires a rectangular array of heights (z-values) to be plotted, and the x and y values are assumed to be evenly spaced. I just made up such an array on the fly only with the intent to illustrate how to use these functions. Do not take it as being a solution to your original problem. (The first two requirements were contradictory.) > 3.) In contour/ surface 3D plot, I was expecting a plot with 3 > components such as against Z axis -> r2, Y-axis->LMN and X-axis -> r1. > I'm not sure the graph I'm getting using list contourPlot is using same > values for these axis. No. " ListContourPlot[array] by default takes the a and a coordinate values for each data point to taken to be successive integers starting at 1. (Online Help)" > 4). Is there any option in mathematica for getting the surface 3D plots? ListPlot3D might fits your needs: "ListPlot3D[array] generates a three$B!>(Bdimensional plot of a surface representing an array of height values. (Online Help)" Regards, Jean-Marc > Many thanks for your continued help > Regards > Shafiq > > > > > >>> "Jean-Marc Gulliet" <jeanmarc.gulliet at gmail.com> 06/04/07 6:26 PM > >>> > On 4/5/07, Shafiq Ahmad <shafiq.ahmad at rmit.edu.au> wrote: > > Hi Jean-Marc, > > Thanks for your good response. I tried to run your codes but could > not. > > Could you please send me again with input formate and appreciate if > you > > could add comments with your codes. Looks to me that you have better > > idea than me to get values of all unknown parameters and also to get > the > > value of LMN from main equaition and plot result in 3D for LMN, r1 and > > r2. > > > > Really appreciate your quick response. > > Reagrds > > Shafiq > > > > > > >>> Jean-Marc Gulliet <jeanmarc.gulliet at gmail.com> 05/04/07 5:59 AM > >>> > > Shafiq Ahmad wrote: > > > Hi Danial, Andres Guzmanand and Group members, > > > > > > Thanks indeed for a good response from Danial and Andres. This is my > > > first experience to find such a cooperative group. > > > > > > I did try to solve these non-linear equations doing some > > modifications. > > > I put 2 parameters r1 and r2 equal to 1 and solved rest of the > > equations > > > for 3 parameters using FindRoot function (as mentioned by Andres). > > > > > > Below are the codes in the input form. Thanks for Danial to give me > > good > > > advice and now really easy for every one to understand codes in the > > > input formate. Next I'm trying to make these codes as generalized in > > the > > > following manner and strongly appreciate if any one can help me in > > this > > > regard. > > > > > > 1): I need to use a loop function for r1 and r2 values with an > > increment > > > of 0.1 and range for 0 to 1, it should come up with an array or list > > of > > > 10 values for b1, b2 and p. I did try it many ways, but > mathematica > > > could not accept it. > > Are you sure you want 10 values only? (This request is inconsistent > with request #3.) > > I have defined LMN as a function of 5 parameters/variables. The "loop" > is done by the function Table over the variables (r1 and r2, with r2 = > r1 according to what you stated above), which also returns a lists of > transformation rules for the unknown parameters (b1, b2, p). Join adds > the rules for the r1 and r2 to the results returned by FindRoot. The > last line (pts = ...) compute the corresponding values of LMN. > > Note that I have assumed that the undefined function L in your code is > indeed the function LMN. Moreover, the code I wrote is almost a > literal translation of what I have understood of your requirements > into Mathematica programming language. > > LMN[r1_, r2_, b1_, b2_, p_] := > Module[{n = Length[x1]}, > n*Log[p] + n*Log[p + 1] + > n*Log[b1] + n*Log[r1] + > n*Log[b2] + n*Log[r2] + > (b1 - 1)*Sum[Log[x1[[j]]], > {j, 1, n}] + (b2 - 1)* > Sum[Log[x2[[j]]], {j, 1, n}] - > (p + 2)*Sum[Log[ > 1 + r1*x1[[j]]^b1 + > r2*x2[[j]]^b2], {j, 1, n}]] > x1 = {1, 2, 3, 4}; > x2 = {1.7, 3.8, 4.9, 4.6}; > sols = Table[Block[{r2, b1, b2, p, > Eqn1, Eqn2, Eqn3}, > r2 = r1; Eqn1 = > D[LMN[r1, r2, b1, b2, p], > b1] == 0; Eqn2 = > D[LMN[r1, r2, b1, b2, p], > b2] == 0; Eqn3 = > D[LMN[r1, r2, b1, b2, p], > p] == 0; Join[{a -> r1, > b -> r2}, FindRoot[ > {Eqn1, Eqn2, Eqn3}, > {b1, 10}, {b2, 10}, > {p, 10}]]], {r1, 0.1, 1, > 0.1}] /. a -> r1 /. b -> r2 > pts = LMN[r1, r2, b1, b2, p] /. sols > > > > 2): After having values for all 5 parameters (r1,r2,b1,b2 and p), I > > need > > > to put all these values in the main equation " LMN" to get another > > list > > > or array for LMN values . Individually I used all parameter values, > I > > > got LMN value but mathematica don't accept if I give all values in > the > > > form of list or array and do it all one time. > > > > > > 3): After having LMN values, I would like plot a 3D plot or 3D > contour > > > plot / surface plot with array / or list values for r1,r2 and LMN. > > If you have a one-dimensional list of 10 values you cannot use any of > the contour/density/surface plots. Below is a version of the code > returning a square array (10 by 10) that can be used with, say, > ListContourPlot. > > LMN[r1_, r2_, b1_, b2_, p_] := > Module[{n = Length[x1]}, > n*Log[p] + n*Log[p + 1] + > n*Log[b1] + n*Log[r1] + > n*Log[b2] + n*Log[r2] + > (b1 - 1)*Sum[Log[x1[[j]]], > {j, 1, n}] + (b2 - 1)* > Sum[Log[x2[[j]]], {j, 1, n}] - > (p + 2)*Sum[Log[ > 1 + r1*x1[[j]]^b1 + > r2*x2[[j]]^b2], {j, 1, n}]] > x1 = {1, 2, 3, 4}; > x2 = {1.7, 3.8, 4.9, 4.6}; > sols = > Table[Block[{b1, b2, p, Eqn1, > Eqn2, Eqn3}, > Eqn1 = D[LMN[r1, r2, b1, b2, > p], b1] == 0; > Eqn2 = D[LMN[r1, r2, b1, > b2, p], b2] == 0; > Eqn3 = D[LMN[r1, r2, b1, > b2, p], p] == 0; > Join[{a -> r1, b -> r2}, > FindRoot[{Eqn1, Eqn2, > Eqn3}, {b1, 10}, > {b2, 10}, {p, 10}]]], > {r1, 0.1, 1, 0.1}, > {r2, 0.1, 1, 0.1}] /. > a -> r1 /. b -> r2; > pts = LMN[r1, r2, b1, b2, p] /. > sols; > ListContourPlot[pts]; > > Regards, > Jean-Marc > > > > Strongly appreciate if some one can share his/her thoughts. > > > > > > Regards > > > Shafiq > > > > > > =================================================== > > > > > > n = 4 > > > > > > x1 = {1, 2, 3, 4} > > > x2 = {1.7, 3.8, 4.9, 4.6} > > > > > > r1 = 1 > > > r2 = 1 > > > > > > LMN = n*Log[p] + n*Log[p + 1] + n*Log[b1] + n*Log[r1] + n*Log[b2] + > > > n*Log[r2] + > > > (b1 - 1)*Sum[Log[x1[[j]]], {j, 1, n}] + > > > (b2 - 1)*Sum[Log[x2[[j]]], {j, 1, n}] - > > > (p + 2)*Sum[Log[1 + r1*x1[[j]]^b1 + r2*x2[[j]]^b2], {j, 1, n}] > > > > > > Eqn1 = D[L, b1] == 0 > > > > > > Eqn2 = D[L, b2] == 0 > > > > > > Eqn3 = D[L, p] == 0 > > > > > > FindRoot[{Eqn1, Eqn2, Eqn3}, {b1, 10}, {b2, 10}, {p, 10}] > > > > > > ================================================ > > > Regards > > > Shafiq > > [snip] > > > > Please, find hereunder an example of what you could do to achieve what > > you want, assuming that I have correctly understood your request. > (Note > > that the following code is not an example of good programming > practice. > > Quick and dirty, but it works!) > > > > In[1]:= > > LMN[r1_, r2_, b1_, b2_, p_] := > > Module[{n = Length[x1]}, n*Log[p] + n*Log[p + 1] + > > n*Log[b1] + n*Log[r1] + n*Log[b2] + n*Log[r2] + > > (b1 - 1)*Sum[Log[x1[[j]]], {j, 1, n}] + > > (b2 - 1)*Sum[Log[x2[[j]]], {j, 1, n}] - > > (p + 2)*Sum[Log[1 + r1*x1[[j]]^b1 + > > r2*x2[[j]]^b2], {j, 1, n}]] > > > > In[2]:= > > x1 = {1, 2, 3, 4}; > > x2 = {1.7, 3.8, 4.9, 4.6}; > > > > In[4]:= > > sols = Table[Block[{r2, b1, b2, p, Eqn1, Eqn2, Eqn3}, > > r2 = r1; Eqn1 = D[LMN[r1, r2, b1, b2, p], b1] == > > 0; Eqn2 = D[LMN[r1, r2, b1, b2, p], b2] == 0; > > Eqn3 = D[LMN[r1, r2, b1, b2, p], p] == 0; > > Join[{a -> r1, b -> r2}, FindRoot[ > > {Eqn1, Eqn2, Eqn3}, {b1, 10}, {b2, 10}, > > {p, 10}]]], {r1, 0.1, 1, 0.1}] /. a -> r1 /. > > b -> r2 > > > > Out[4]= > > {{r1 -> 0.1, r2 -> 0.1, b1 -> 5.341935448717984, > > b2 -> 3.9436875174176804, p -> 0.3721885234758986}, > > {r1 -> 0.2, r2 -> 0.2, b1 -> 5.534042581697728, > > b2 -> 4.045832415596042, p -> 0.2940686067033152}, > > {r1 -> 0.30000000000000004, > > r2 -> 0.30000000000000004, b1 -> 5.626397092321994, > > b2 -> 4.095035940496871, p -> 0.26139996011190647}, > > {r1 -> 0.4, r2 -> 0.4, b1 -> 5.697719904063341, > > b2 -> 4.136114771126181, p -> 0.24147559059244234}, > > {r1 -> 0.5, r2 -> 0.5, b1 -> 5.7580442518190855, > > b2 -> 4.172731896134758, p -> 0.22753002319002713}, > > {r1 -> 0.6000000000000001, r2 -> 0.6000000000000001, > > b1 -> 5.810601737463024, b2 -> 4.20572325658841, > > p -> 0.2170152505036831}, > > {r1 -> 0.7000000000000001, r2 -> 0.7000000000000001, > > b1 -> 5.8571172402134515, b2 -> 4.235590112750038, > > p -> 0.20870033683174416}, {r1 -> 0.8, r2 -> 0.8, > > b1 -> 5.898742384194647, b2 -> 4.262751009402106, > > p -> 0.20190091294950313}, {r1 -> 0.9, r2 -> 0.9, > > b1 -> 5.9363209375865305, b2 -> 4.287567369366186, > > p -> 0.19619991348677382}, {r1 -> 1., r2 -> 1., > > b1 -> 5.970499008585786, b2 -> 4.310347981142145, > > p -> 0.1913259981578475}} > > > > In[5]:= > > pts = LMN[r1, r2, b1, b2, p] /. sols > > > > Out[5]= > > {-12.86601076530539, -13.020764326190708, > > -13.17718328097974, -13.311047643795543, > > -13.424702323411111, -13.522321810909304, > > -13.607333751744086, -13.682314918879541, > > -13.749187133239175, -13.809399854995021} > > > > In[6]:= > > sols = Table[Block[{b1, b2, p, Eqn1, Eqn2, Eqn3}, > > Eqn1 = D[LMN[r1, r2, b1, b2, p], b1] == 0; > > Eqn2 = D[LMN[r1, r2, b1, b2, p], b2] == 0; > > Eqn3 = D[LMN[r1, r2, b1, b2, p], p] == 0; > > Join[{a -> r1, b -> r2}, FindRoot[ > > {Eqn1, Eqn2, Eqn3}, {b1, 10}, {b2, 10}, > > {p, 10}]]], {r1, 0.1, 1, 0.1}, > > {r2, 0.1, 1, 0.1}] /. a -> r1 /. b -> r2; > > pts = LMN[r1, r2, b1, b2, p] /. sols; > > ListContourPlot[pts]; > > > > [...graphic deleted...] > > > > Hope this helps, > > Jean-Marc > > > > > > >