# Looking for a function to norm a Polar Plot

Posted 10 years ago
8406 Views
|
23 Replies
|
1 Total Likes
|
 Hi everybody,I'm looking for a solution to normalize a polar plot diagram to 1.Therefore I need to find the maximum value over 0 up to 2Pi with respect to f and devide the function through this value.here's the code which doesn't work properly so far.The function "FindMaximum" maybe isn't the right one?!! r = 1 sp = 343.4 f = 7000  PolarPlot[Abs[ Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {0.0, 0}] + f*2*Pi*0.032/sp] + Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {0, -0.063}] + f*2*Pi*0.030/sp] / FindMaximum[Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {0.0, 0}] +f*2*Pi*0.032/sp] +Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {0, -0.063}] +f*2*Pi*0.030/sp], {phi, 0, Pi}]], {phi, 0, 2 Pi}, PlotRange -> All]Thank you for help :-)
23 Replies
Sort By:
Posted 10 years ago
 Hi,OK, there are a couple of issues here.(1) max needs to be calculated for each f. In your code, max was calculated for f = 2000 and was used for all cases of f. (2) NMaximize may sometimes find only a local maximum.The following changes will fix the problems. I removed the WorkingPrecision option since it seems unnecessary.max := Max[Table[NMaximize[Abs[rho[phi]], {phi, 0.2 i \[Pi], 0.2 (i + 1) \[Pi]}][[1]], {i, 0, 4}]];maxx = max;PolarPlot[Abs[rho[phi]/maxx], {phi, 0, 2 Pi}, PlotRange -> All]This will force recalculation of max everytime it is used. In order to find the global maximum, 0 to Pi was subdivided into 5 intervals to search for the global maximum.When generating the table, set f first, calculate max and save it as maxx and generate a list for the selected values of phi. ms = Table[maxx = max;    Table[Abs[rho[phi]/maxx], {phi, 0, 2*\[Pi],       0.04363323129985823942309226921222*2}], {f, {2000, 2060, 2120,       2180, 2240, 2300, 2360, 2430, 2500, 2580, 2650, 2720, 2800, 2900,       3000, 3070, 3150, 3250, 3350, 3450, 3550, 3650, 3750, 3870,       4000, 4120, 4250, 4370, 4500, 4620, 4750, 4870, 5000, 5150, 5300,       5450, 5600, 5800, 6000, 6150, 6300, 6500, 6700, 6900, 7100,       7300, 7500, 7750, 8000, 8250, 8500, 8750, 9000, 9250, 9500, 9750,       10000, 10300, 10600, 10900, 11200, 11500, 11800, 12200, 12500,      12800, 13200, 13600, 14000, 14500, 15000, 15500, 16000, 16500,      17000, 17500, 18000, 18500, 19000, 19500, 20000}}]You may take the Transpose of ms if necessary.I checked the max values of the lists in ms and I got: In[44]:= Max /@ ms  Out[44]= {1., 0.972359, 0.999797, 1., 0.999178, 1., 0.998816, 1., \ 0.999587, 1., 0.999707, 1., 0.99784, 1., 1., 0.995071, 1., 0.999356, \ 0.999327, 1., 0.999872, 0.997138, 1., 1., 1., 0.999881, 0.999385, \ 0.998648, 0.972954, 0.993735, 0.922472, 1., 1., 1., 1., 1., 0.999864, \ 0.99852, 1., 1., 1., 0.956176, 1., 0.997538, 0.999508, 1., 0.999849, \ 0.734313, 1., 0.999998, 0.997419, 0.994247, 1., 1., 0.999931, \ 0.664976, 1., 0.831829, 0.982719, 0.994, 0.999141, 0.968075, \0.999792, 0.863026, 0.998463, 0.999967, 0.999526, 0.970138, 0.906406, \0.999587, 0.661889, 0.999868, 0.990541, 0.999992, 0.986254, 1., \0.996389, 1., 0.914377, 1., 0.976002}They are all less than equal to 1, as expected. For those less than 1, the phi for the max is missing in the selected values of phi used for table generation. For those significantly less 1, e.g., 0.661889 at f = 15000, rho may be highly oscillatory.Youngjoo Chung
Posted 10 years ago
 Hi everybody :-)Today I generated a table with r = 1 sp = 3434/10 f = 2000  rho[phi_] :=   (1 Cos[f*2*Pi/sp*           Norm[{r*Cos[phi], r*Sin[phi]} - {(-207/1000), 0}] +          f*2*Pi*0/sp] +      1 Cos[       f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {(-161/1000), 0}] +         f*2*Pi*(046/1000)/sp] +     1 Cos[       f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {(-115/1000), 0}] +         f*2*Pi*(92/1000)/sp] +     1 Cos[       f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {(-69/1000), 0}] +         f*2*Pi*(138/1000)/sp] +     1 Cos[       f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {(-23/1000), 0}] +         f*2*Pi*(184/1000)/sp] +     1 Cos[       f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {(23/1000), 0}] +         f*2*Pi*(230/1000)/sp] +     1 Cos[       f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {(69/1000), 0}] +         f*2*Pi*(276/1000)/sp] +     1 Cos[       f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {(115/1000), 0}] +         f*2*Pi*(322/1000)/sp] +     1 Cos[       f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {(161/1000), 0}] +         f*2*Pi*(368/1000)/sp] +     1 Cos[       f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {(207/1000), 0}] +         f*2*Pi*(414/1000)/sp]) /. Abs[x_] -> x;max = NMaximize[{Abs[rho[phi]], 0 <= phi <= 2 \[Pi]}, phi][[1]];PolarPlot[Abs[rho[phi]/max], {phi, 0, 2 Pi}, PlotRange -> All, WorkingPrecision -> 2000];ms = Transpose[Table[   Abs[rho[phi]/max],   {phi, 0, 2*\[Pi], 0.04363323129985823942309226921222*2},   {f, {2000, 2060, 2120, 2180, 2240, 2300, 2360, 2430, 2500, 2580,      2650, 2720, 2800, 2900, 3000, 3070, 3150, 3250, 3350, 3450, 3550,      3650, 3750, 3870, 4000, 4120, 4250, 4370, 4500, 4620, 4750,      4870, 5000, 5150, 5300, 5450, 5600, 5800, 6000, 6150, 6300, 6500,      6700, 6900, 7100, 7300, 7500, 7750, 8000, 8250, 8500, 8750,      9000, 9250, 9500, 9750, 10000, 10300, 10600, 10900, 11200, 11500,      11800, 12200, 12500, 12800, 13200, 13600, 14000, 14500, 15000,      15500, 16000, 16500, 17000, 17500, 18000, 18500, 19000, 19500,      20000}}]]but there are rows where no 1 appears, even in the plot there is a part which is 1 "long"see1.    0.999342    0.995179    0.98118    0.947724    0.883826    0.780428    0.634756    0.454397    0.258858    0.0765784    0.0628819    0.138943    0.14784    0.104185    0.0353454    0.0286137    0.0649397    0.064579    0.0334508    0.0111913    0.0480898    0.0607014    0.0439163    0.00558966    0.037953    0.0699152    0.0801141    0.0677473    0.039428    0.00468889    0.0282006    0.0543983    0.072536    0.083529    0.0891306    0.0908125    0.0891306    0.083529    0.072536    0.0543983    0.0282006    0.00468889    0.039428    0.0677473    0.0801141    0.0699152    0.037953    0.00558966    0.0439163    0.0607014    0.0480898    0.0111913    0.0334508    0.064579    0.0649397    0.0286137    0.0353454    0.104185    0.14784    0.138943    0.0628819    0.0765784    0.258858    0.454397    0.634756    0.780428    0.883826    0.947724    0.98118    0.995179    0.9993420.0601086    0.0574781    0.0495886    0.0367615    0.0204773    0.00437594    0.00532022    0.000936273    0.023337    0.06661    0.117536    0.155315    0.157629    0.113211    0.0318978    0.055872    0.11266    0.114163    0.0634037    0.0107622    0.0703226    0.0891814    0.0653437    0.01785    0.0273208    0.0519441    0.0522743    0.0362558    0.0157785    0.000119514    0.00794177    0.0087091    0.0054241    0.000961914    0.00286398    0.00527419    0.00608087    0.00527419    0.00286398    0.000961914    0.0054241    0.0087091    0.00794177    0.000119514    0.0157785    0.0362558    0.0522743    0.0519441    0.0273208    0.01785    0.0653437    0.0891814    0.0703226    0.0107622    0.0634037    0.114163    0.11266    0.055872    0.0318978    0.113211    0.157629    0.155315    0.117536    0.06661    0.023337    0.000936273    0.00532022    0.00437594    0.0204773    0.0367615    0.0495886    0.05747810.970756    0.971363    0.970728    0.961576    0.932403    0.869269    0.759594    0.597994    0.392639    0.168846    0.0339885    0.173783    0.222413    0.179837    0.0771606    0.0348784    0.107439    0.114475    0.062504    0.0153353    0.077355    0.09405    0.0610443    0.00169259    0.0626465    0.095425    0.0899402    0.0533351    0.00258875    0.0451838    0.0792977    0.0970047    0.101305    0.0976213    0.0912116    0.0859177    0.0839228    0.0859177    0.0912116    0.0976213    0.101305    0.0970047    0.0792977    0.0451838    0.00258875    0.0533351    0.0899402    0.095425    0.0626465    0.00169259    0.0610443    0.09405    0.077355    0.0153353    0.062504    0.114475    0.107439    0.0348784    0.0771606    0.179837    0.222413    0.173783    0.0339885    0.168846    0.392639    0.597994    0.759594    0.869269    0.932403    0.961576    0.970728    0.971363I think the problem is that the maximum is distiguished by the value on the x-Axes and not on the actual length of the vector to the maximum.Any ideas to fix that also?
Posted 10 years ago
 So thank you so much so far!!! Tomorrow I will do some work on tables,may I ask you some further question if they occure?Good night!Peter
Posted 10 years ago
 ah ok :-) this is pro stuff^^what are you guys working at? are you working for Wolfram or are you math students?
Posted 10 years ago
 "/ . Abs[x_] -> x" is to replace all occurrences of the form Abs(x) to x in the function definition of rho(phi). A safer version would be "/ . Abs[x_] -> Sqrt[x^2]", but in the present case, it is ok since we have only Abs(x_)^2. This is from Norm(...)In[11]:= Norm[{r*Cos[phi], r*Sin[phi]} - {-207/1000, 0}]Out[11]= Sqrt[Abs[207/1000 + r Cos[phi]]^2 + Abs[r Sin[phi]]^2]This can make some functions like FindMaximum misbehave. Removing Abs makes it better.In[12]:= Norm[{r*Cos[phi], r*Sin[phi]} - {-207/1000, 0}] /. Abs[x_] -> xOut[12]= Sqrt[(207/1000 + r Cos[phi])^2 + r^2 Sin[phi]^2]Youngjoo Chung
Posted 10 years ago
 it works :-)I was a little bit confused after all the posts :-)but still wondering about "/ . Abs[x_] -> x;"
Posted 10 years ago
 In the last example, try max = NMaxValue[Abs[rho[phi]], phi]
Posted 10 years ago
 in this case it does't work  :-( r = 1 sp = 3434/10 f = 3000 rho[phi_] :=   Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {0, 0}] +       f*2*Pi*(32/1000)/sp] +     Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {-(63/1000), 0}] +       f*2*Pi*(30/1000)/sp] +     Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {(63/1000), 0}] +      f*2*Pi*(30/1000)/sp] +    Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {-(127/1000), 0}] +      f*2*Pi*(24/1000)/sp] +   Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {(127/1000), 0}] +      f*2*Pi*(24/1000)/sp] +    Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {-(191/1000), 0}] +      f*2*Pi*(14/1000)/sp] +    Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {(191/1000), 0}] +      f*2*Pi*(14/1000)/sp] +   Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {-(255/1000), 0}] +      f*2*Pi*0/sp] +    Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {(255/1000), 0}] +      f*2*Pi*0/sp];max = Max[Abs[FindMaximum[rho[phi], {phi, Pi}][[1]]],   Abs[FindMinimum[rho[phi], {phi, Pi}][[1]]]]PolarPlot[Abs[rho[phi]/max], {phi, 0, 2 Pi}, PlotRange -> All, WorkingPrecision -> 300]
Posted 10 years ago
 Hi,I made some changes to your code, and the following works fine. NMaximize, as suggested by Ilian, gives no warnings. Seems to work ok without the WorkingPrecision option, though.r = 1sp = 3434/10;f = 6000;rho[phi_] := Cos[f*2*Pi/sp*Norm[{r*Cos[phi], r*Sin[phi]} - {-207/1000, 0}] + f*2*Pi*0/sp] +     Cos[f*2*Pi/sp*Norm[{r*Cos[phi], r*Sin[phi]} - {-161/1000, 0}] + f*2*Pi*(046/1000)/sp] /. Abs[x_] -> x;max = NMaximize[{Abs[rho[phi]], 0 <= phi <= 2 \[Pi]}, phi][[1]]PolarPlot[Abs[rho[phi]/max], {phi, 0, 2 Pi}, PlotRange -> All, WorkingPrecision -> 200]Youngjoo Chung
Posted 10 years ago
 for what is. Abs[x_] -> x;standing for?
Posted 10 years ago
 Hey you are brilliant!so this would be the result of the discussion? r = 1 sp = 3434/10 f = 6000  rho[phi_] :=    1 Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {-207/1000, 0}] +        f*2*Pi*0/sp] +    1 Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {-161/1000, 0}] +        f*2*Pi*(046/1000)/sp];max = Max[Abs[FindMaximum[rho[phi], {phi, 0}][[1]]],   Abs[FindMinimum[rho[phi], {phi, 0}][[1]]]]PolarPlot[Abs[rho[phi]/max], {phi, 0, 2 Pi}, PlotRange -> All, WorkingPrecision -> 200]there is still the pricision warning but the 1 thing is solved
Posted 10 years ago
 Right, so we just need to maximize Abs[rho[ phi ]]. I corrected my last post.
Posted 10 years ago
 Hi,I noticed that rho(phi) can become negative, and at certain frequencies, the max of rho can have smaller magnitude than the min. I did some analytical calculation and I found that if max is between 0 and 1 we need to divide with the minimum (<0) rather than the maximum since in this case Abs(minimum) > Abs(maximum). For example, at f = 3494, the max is 1.95243*10^-6 while the min is -2.A quick fix ismax = Max[Abs[FindMaximum[rho[phi], {phi, 0}][[1]]], Abs[FindMinimum[rho[phi], {phi, 0}][[1]]]]PolarPlot[Abs[rho[phi]/max], {phi, 0, 2 Pi}, PlotRange -> All]Please note that rho(phi) is divided with max rather than max[[1]]. Or we can trymax = FindMaximum[Abs[rho[phi]], {phi, 0}][[1]]PolarPlot[Abs[rho[phi]/max], {phi, 0, 2 Pi}, PlotRange -> All]and use NMaximize instead as Ilian suggested. Some experimentation may be necessary, though, since FindMaximum may not  like Abs[...] as seen before.Youngjoo Chung
Posted 10 years ago
 On second thought, it is probably safer to use NMaximize which is less likely to return a local instead of a global maximum. For example, here is the same list of maximum values as above (I did not modify the original rho): Table[NMaximize[{Abs[rho[phi]], 0 <= phi <= 2 Pi}, phi], {f, 2000, 20000, 2000}]  (*  Out[4]=   {1.99783, {phi -> 6.25486}}  {1.99134, {phi -> 6.25486}}  {1.98054, {phi -> 4.28723}}  {1.96549, {phi -> 6.25486}}  {1.94625, {phi -> 6.25486}} {1.92291, {phi -> 6.25486}} {1.89557, {phi -> 2.26335}} {1.86434, {phi -> 6.25486}} {1.82937, {phi -> 0.281135}} {1.79079, {phi -> 5.31289}} *)
Posted 10 years ago
 Hi,The Norm function in the Cos[...] generates Abs[...] since Norm assumes that its argument is complex. This causes the FindMaximum::lstol messages to appear. You can remove Abs since everything is real. Then the rho function can be changed to:rho[phi_] := Cos[f*2*Pi/sp*Norm[{r*Cos[phi], r*Sin[phi]} - {0.0, 0}] + f*2*Pi*0.032/sp] +     Cos[f*2*Pi/sp*Norm[{r*Cos[phi], r*Sin[phi]} - {0, -0.063}] + f*2*Pi*0.030/sp] /. Abs[x_] -> x;I observed that the maximum always occurs at phi slightly less than zero. Try setting the starting point to zero:max = FindMaximum[rho[phi], {phi, 0}]The phi value found is negative, but this is ok. You can add 2 Pi if you want. With these changes, I got the table of max values as follows with no warning messages:In[63]:= Table[FindMaximum[rho[phi], {phi, 0}], {f, 2000, 20000, 2000}]Out[63]= {{1.99783, {phi -> -0.0283289}}, {1.99134, {phi -> -0.0283289}}, {1.98054, {phi -> -0.0283289}}, {1.96549, {phi -> -0.0283289}}, {1.94625, {phi -> -0.0283289}}, {1.92291, {phi -> -0.496271}}, {1.89557, {phi -> -0.0283289}}, {1.86434, {phi -> -0.0283289}}, {1.82937, {phi -> -0.0283289}}, {1.79079, {phi -> -0.0283289}}}Youngjoo Chung
Posted 10 years ago
 Hey Ilian, thank you for your thoughts!!!so I typed in all values in "exact numbers" which was a good idea ;-) and included the precision option.So I works better but still not in every case which is still a problem since I wanted to generate a list and do further comparisions...just for the plots I can deal with this problem now but not for generating a list from 2000-20kHz...
Posted 10 years ago
 Try giving FindMaximum a different starting point, for example max = FindMaximum[rho[phi], {phi, 0.5}]If that does not help in all cases, it might be a good idea to use only exact numbers in the input (32/1000 instead of 0.032 etc.) and/or increase the precision (by adding an option such as WorkingPrecision -> 100).
Posted 10 years ago
 Oh, I am sorry, I made a mistake. Ilian is right. I meant to put max[[1]] outside Abs[...].In retrospect, since the same expression is used twice, it would be better to define a function, and a cleaner code would ber = 1sp = 343.4f = 7000rho[phi_] := Cos[f*2*Pi/sp*Norm[{r*Cos[phi], r*Sin[phi]} - {0.0, 0}] + f*2*Pi*0.032/sp] +    Cos[f*2*Pi/sp*Norm[{r*Cos[phi], r*Sin[phi]} - {0, -0.063}] + f*2*Pi*0.030/sp];max = FindMaximum[rho[phi], phi]PolarPlot[Abs[rho[phi]/max[[1]]], {phi, 0, 2 Pi}, PlotRange -> All]Youngjoo Chung
Posted 10 years ago
 Hi Ilian, hi Youngjoo and thx for your replys,it looks fine so far, but for example at f=10000 the maximum on the x-axes reaches approximately 1.4 because ofFindMaximum::lstol: The line search decreased the step size to within the tolerance specified by AccuracyGoal and PrecisionGoal but was unable to find a sufficient increase in the function. You may need more than MachinePrecision digits of working precision to meet these tolerances. >>Since I'd like to go up to 20kHz this would mix up the results...How could I reach higher precision???Any ideas? I think you have them also ;-)
Posted 10 years ago
 Try adding parentheses so that the expression plotted has the form Abs[ (x + y) / max ] instead of Abs[ x + y / max ].PolarPlot[Abs[(Cos[f*2*Pi/sp*Norm[{r*Cos[phi], r*Sin[phi]} - {0.0, 0}] + f*2*Pi*0.032/sp] +         Cos[f*2*Pi/sp*Norm[{r*Cos[phi], r*Sin[phi]} - {0, -0.063}] + f*2*Pi*0.030/sp])/max[[1]]],         {phi, 0, 2 Pi}, PlotRange -> All]
Posted 10 years ago
 Hi,Since you need to calculate the max value only once, you can take out FindMaximum out of PolarPlot. In addition, FindMaximum returns the location where the maximum occurs as well, so you need to take the first element for division. Try: r = 1 sp = 343.4 f = 7000 max = FindMaximum[ Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {0.0, 0}] + f*2*Pi*0.032/sp] + Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {0, -0.063}] + f*2*Pi*0.030/sp], phi]   PolarPlot[Abs[  Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {0.0, 0}] + f*2*Pi*0.032/sp] + Cos[f*2*Pi/sp* Norm[{r*Cos[phi], r*Sin[phi]} - {0, -0.063}] + f*2*Pi*0.030/sp] / max[[1]]], {phi, 0, 2 Pi}, PlotRange -> All]Youngjoo Chung
Posted 10 years ago
 Hi Youngjoo,thank you for the quick reply. But the outcome of the plot is always at 1.5 maximum, which can't be the case if the the max value is devided by itsself. It should be 1...Why isn't that the case?Greetings Peter
Posted 10 years ago
 Looking forward for your solutions :-)