3
$\begingroup$

Suppose I have the following Association,

f=<|"a:b" -> (2.888888888888889` x + 158.5679012345679` x^2 + 
      972.4261545496113` x^3 + 2782.574803223688` x^4 + 
      4689.153835062141` x^5 + 6158.852000788219` x^6 + 
      6193.345446598874` x^7 + 4759.487380195244` x^8 + 
      2828.1047688854555` x^9 + 1262.2623444432436` x^10 + 
      396.8075199523231` x^11 + 87.10349331793769` x^12 + 
      15.918345899682585` x^13 + 2.358273466619642` x^14)/(2 x + 
      142 x^2 + 994 x^3 + 3068 x^4 + 5440 x^5 + 7516 x^6 + 8061 x^7 + 
      6591 x^8 + 4215 x^9 + 2029 x^10 + 694 x^11 + 181 x^12 + 
      33 x^13 + 4 x^14), 
  "a:c" -> (1.9259259259259258` x + 154.85871056241427` x^2 + 
      1000.1077071584616` x^3 + 2910.6970670309593` x^4 + 
      4824.123299147454` x^5 + 6433.145771926378` x^6 + 
      6287.788973741406` x^7 + 4729.911569226189` x^8 + 
      2616.6377204567093` x^9 + 1072.3401991902406` x^10 + 
      300.41168315858073` x^11 + 66.12235989098919` x^12 + 
      9.795905169035438` x^13 + 1.179136733309821` x^14)/(2 x + 
      142 x^2 + 994 x^3 + 3068 x^4 + 5440 x^5 + 7516 x^6 + 8061 x^7 + 
      6591 x^8 + 4215 x^9 + 2029 x^10 + 694 x^11 + 181 x^12 + 
      33 x^13 + 4 x^14), 
  "a:d" -> (4.814814814814815` x + 154.85871056241427` x^2 + 
      992.0711273687954` x^3 + 2876.30182842498` x^4 + 
      4856.41660650529` x^5 + 6212.275496911057` x^6 + 
      6143.436265588593` x^7 + 4685.547852772606` x^8 + 
      2780.4000811927754` x^9 + 1173.8148471954553` x^10 + 
      376.33991077009017` x^11 + 87.73928523996643` x^12 + 
      12.244881461294296` x^13 + 1.7687050999647316` x^14)/(2 x + 
      142 x^2 + 994 x^3 + 3068 x^4 + 5440 x^5 + 7516 x^6 + 8061 x^7 + 
      6591 x^8 + 4215 x^9 + 2029 x^10 + 694 x^11 + 181 x^12 + 
      33 x^13 + 4 x^14), 
  "a:e" -> (1.9259259259259258` x + 154.85871056241427` x^2 + 
      1177.8054158410812` x^3 + 3305.3824300345664` x^4 + 
      5174.381478951672` x^5 + 6568.697926267911` x^6 + 
      6234.040624961103` x^7 + 4385.353371436694` x^8 + 
      2365.2980972400514` x^9 + 900.9303208030539` x^10 + 
      255.51499204916647` x^11 + 41.96226685389699` x^12 + 
      6.122440730647148` x^13 + 1.179136733309821` x^14)/(2 x + 
      142 x^2 + 994 x^3 + 3068 x^4 + 5440 x^5 + 7516 x^6 + 8061 x^7 + 
      6591 x^8 + 4215 x^9 + 2029 x^10 + 694 x^11 + 181 x^12 + 
      33 x^13 + 4 x^14), 
  "a:f" -> (2.888888888888889` x + 143.73113854595337` x^2 + 
      946.5305085606869` x^3 + 2706.9052782905346` x^4 + 
      4601.382281730587` x^5 + 6048.018180473671` x^6 + 
      6250.932963149198` x^7 + 4803.8510966488275` x^8 + 
      2905.7138876690697` x^9 + 1305.4576337968147` x^10 + 
      423.87758370946995` x^11 + 103.63408329068498` x^12 + 
      18.97956626500616` x^13 + 1.7687050999647316` x^14)/(2 x + 
      142 x^2 + 994 x^3 + 3068 x^4 + 5440 x^5 + 7516 x^6 + 8061 x^7 + 
      6591 x^8 + 4215 x^9 + 2029 x^10 + 694 x^11 + 181 x^12 + 
      33 x^13 + 4 x^14)|>;

I want to plot this for x between 2/26 and 1 can plot this as follow:

Plot[f // Values, {x, 2/26, 1}, PlotRange -> All]

For which I get:

enter image description here

Now question is how to sorts the opacity of the lines in the plot based on their y value? so that the line with highest value of y has the higher opacity and the line with lowest value of y has the lowest opacity, bear in mind that in reality my f has more number of polynomials and thus the opacity range should be such that it would work for any number of lines.

Update: To plot the curve with corresponding transparency we can use C. E.'s code as follow:

funcs = f // Values;
g = f // Keys;
getOpacities[values_] := 
 Range[Length[values]] /. 
  MapThread[Rule, {Ordering[values], Rest@Subdivide[Length[values]]}]

values = Table[funcs, {x, 2/26, 1, 0.01}];
opacities = Transpose[getOpacities /@ values];
interp = ListInterpolation[#, {{0, 1}}, InterpolationOrder -> 1] & /@ 
   opacities;

colorf[opacityf_, x_] := 
 RGBColor[0.368417, 0.506779, 0.709798, opacityf[x]]

Show@MapThread[
  Function[{f, opacityf}, 
   Plot[f, {x, 2/26, 1}, PlotRange -> All, 
    PlotLabels -> Placed[g, Before], Axes -> False, 
    ColorFunction -> (colorf[opacityf, #] &)]], {funcs, interp}]

where I made g as key list and used it later to label the curves according to their associations. However it seems the labels are getting messed up? Is there a fix for this?

Secondly I know to plot with different curve colours one can use

Plot[Evaluate[f // Values], {x, 2/26, 1}, 
 PlotLabels -> Placed[f // Keys, Before], Axes -> False] 

I wonder if we can put this into C. E.'s code so essentially to have colours too and each curve would have different opacity with respect to its y value?

$\endgroup$
4
$\begingroup$

Paint over parts with white RankedMax functions with varying opacities:

funclist = Function /@ BesselJ[Range @ 4, #];
whiteouts = Function[x, #] & /@ (Style[RankedMax[Through[funclist @ x], #], 
   Opacity[Sqrt @ (( # - 1)/(1 + Length@funclist)), White]] & /@ Range[Length @ funclist]);

Plot[Evaluate[Join[Through[funclist @ x], Through[whiteouts @ x]]], {x, 0, 10}, 
 PlotStyle -> AbsoluteThickness[5], 
 PlotLabels -> Placed[TraditionalForm /@ Through[funclist@x], Above]]

enter image description here

funclist = Function[x, #] & /@ Values[f];
whiteouts = Function[x, #] & /@ (Style[RankedMax[Through[funclist @ x], #], 
  Opacity[Sqrt @ (( # - 1)/(1 + Length@funclist)), White]] & /@ Range[Length @ funclist]);

Plot[Evaluate[Join[Through[funclist @ x], Through[whiteouts @ x]]], {x, 0, 10}, 
  PlotStyle -> AbsoluteThickness[3], PlotRange -> {{0, .5}, {0.8, 1.3}}]

enter image description here

$\endgroup$
  • 1
    $\begingroup$ Clever! I like this very much! $\endgroup$ – C. E. Jun 21 at 18:30
  • $\begingroup$ Thank you @C.E. $\endgroup$ – kglr Jun 23 at 2:14
4
$\begingroup$

You can use ColorFunction and the four-argument form of RGBColor to specify the opacity given x. All that's left, then, is to figure out what opacity to give for each function at each x. This can be done numerically.

funcs = {Sin[x], Sin[2 x], Sin[3 x]};

getOpacities[values_] := Range[Length[values]] /. MapThread[Rule, {
    Ordering[values],
    Rest@Subdivide[Length[values]]
    }]

values = Table[funcs, {x, 0, 2 Pi, 0.01}];
opacities = Transpose[getOpacities /@ values];
interp = ListInterpolation[#, {{0, 1}}, InterpolationOrder -> 1] & /@ opacities;

colorf[opacityf_, x_] := RGBColor[0.368417, 0.506779, 0.709798, opacityf[x]]

Show@MapThread[Function[{f, opacityf},
   Plot[f, {x, 0, 2 Pi}, ColorFunction -> (colorf[opacityf, #] &)]
   ], {funcs, interp}]

Mathematica graphics

Here is the code changes as described in the comments & corresponding plot for your functions, after setting PlotRange and the starting x appropriately:

funcs = fValues;

getOpacities[values_] := 
 Range[Length[values]] /. 
  MapThread[Rule, {Ordering[values], Rest@Subdivide[Length[values]]}]

values = Table[funcs, {x, 2/26, 1, 0.01}];
opacities = Transpose[getOpacities /@ values];
interp = ListInterpolation[#, {{2/26, 1}}, 
     InterpolationOrder -> 1] & /@ opacities;

colorf[opacityf_, x_] := 
 RGBColor[0.368417, 0.506779, 0.709798, opacityf[x]]

Show@MapThread[
  Function[{f, opacityf},
   Plot[f, {x, 2/26, 1},
    ColorFunction -> (colorf[opacityf, #] &),
    PlotRange -> All]
   ], {funcs, interp}]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Thanks, so to run the code I made funcs=f // Values and commented out the values but don't get the plot as yours. Am I doing something wrong? $\endgroup$ – William Jun 21 at 13:44
  • $\begingroup$ @William You have to specify PlotRange -> All and you also have to change 2 Pi to 1 in two places. You also have to change 0 to 2/26 in the same two places. $\endgroup$ – C. E. Jun 21 at 13:52
  • $\begingroup$ Thanks this works can you see the update on this question, I am trying to change your code a little to include labels and colours. Any help on that is appreciated. $\endgroup$ – William Jun 21 at 14:54
  • $\begingroup$ @William Thread over {funcs, interp, colors} instead of {funcs, interp}, where colors is your desired list of colors. Then pass the color colorf and make the suitable adjustment in RGBColor. $\endgroup$ – C. E. Jun 21 at 18:28
2
$\begingroup$

I think this works too...

fPlot[f_] := Module[{fValues, fValuesSorted},
  fValues = Values[f];
  fValuesSorted = Sort[fValues];

  Plot[fValuesSorted, {x, 2/26, 1},
   PlotRange -> All,
   PlotStyle -> (Lighter[Black, #] & /@ 
      Table[1 - 1/i, {i, Length[fValues]}])]
  ]

fPlot[f]

Version 2 addressing @Williams comment...

fPlot2[f_] := Module[{fValues, fValuesSorted},
  fValues = Values[f];
  fValuesSorted = 
   Sort[fValues, FindMaximum[#, {x, 2/26, 1}] & /@ fValues];

  Plot[fValuesSorted, {x, 2/26, 1},
   PlotRange -> All,
   PlotStyle -> (Lighter[Black, #] & /@ 
      Table[1 - 1/i, {i, Length[fValues]}])]
  ]

fPlot2[f]

Version 1

Mathematica graphics

Version 2

Version 2

Hmmm...? Not certain this looks quite right. May need to Sort by something else.

Open to suggestions.

$\endgroup$
  • $\begingroup$ This is what I am looking for indeed however, if you look at the plot the highest opacity is not the line with the highest y-axis value, why is that? $\endgroup$ – William Jun 21 at 12:42
  • $\begingroup$ Do you want to do this by identifying the curves by the single highest y value? $\endgroup$ – Jagra Jun 21 at 12:45
  • $\begingroup$ @C.E. -- Thanks for adding the plot. $\endgroup$ – Jagra Jun 21 at 12:46
  • $\begingroup$ yes as I mentioned in the question I want the lines to be sorted with respect to y-value from high to low and so their corresponding opacity. The curve with highest value of y should have the highest opacity and the curve with lowest value of y should have the lowest opacity $\endgroup$ – William Jun 21 at 13:02
  • $\begingroup$ @William -- I need to give this some thought. While I do, you might try Sorting the curves by using something lite FindMaximum $\endgroup$ – Jagra Jun 21 at 13:13

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.