5
$\begingroup$

In the Generalized Linear Model, a Link function maps an arbitrary density function to an underlying Normal Distribution.

Consider the LogNormal distribution, which is a continuous probability distribution of a random variable whose logarithm is normally distributed. It's link function is simply the natural logarithm.

To explain this concept, one may visualise the mapping from the normally distributed space to the original distribution using the following combined graphic:

LogNormalMap

I would like to reproduce this graphic in Mathematica. In particular, I would like this to become Dynamic using Manipulate.

So far, I have created the following sub-parts:

normalDistribution =
  Function[{},
    ParametricPlot[{PDF[NormalDistribution[], x], x},{x, -3, 3},
    PlotRange -> {{0, -0. 4}, {-3, 3}},
    AspectRatio -> 1,
    Frame -> True,
    Axes -> False,
    ScalingFunctions -> {"Reverse", "Reverse"}]];

logNormalDistribution = 
  Function[{a, b},
    Plot[PDF[LogNormalDistribution[a, b], x], {x, -1, 15}, 
      PlotRange -> {{-1, 15}, All},
      AspectRatio -> 1, 
      Frame -> True, 
      Axes -> False, 
      ScalingFunctions -> {Automatic, Automatic}]];

transformation = 
  Function[{a, b}, 
    Plot[Log[(x - a)/b], {x, -1, 15},
      PlotRange -> {{-1, 15}, {-3, 3}},
      AspectRatio -> 1, 
      Frame -> True,  
      Axes -> False,  
      ScalingFunctions -> {Automatic, "Reverse"}]]

Finally, I attempted to combine these using:

Manipulate[
  Graphics[
    {Inset[normalDistribution[], {0,0},{0,3}],
     Inset[logNormalDistribution[a,b], {0,0}, {-1,0}],
     Inset[transformation[a,b], {0,0}, {-1,3}], 
     Dashed, Darker[Green], Line[{{-0.4,-1},{1,-1},{1,0.6}}]}], 
  {{a,0}, -1,15,0.1},
  {{b,1}, 0.1,3,0.1}]

Which resulted in:

MyAttempt

Visualisation and plotting questions:

  • Is Inset the right way to go?
    • If so, how can I position and scale correctly?
    • Is not, what would also work?
  • How can I draw lines across plots (the dashed green ones in the original image)?
    • How do I know what ${x,y}$ coordinates in my Graphic correspond to the coordinated in one of the three Plots?
  • How can I deal with the Ticks in my plots? They cause the remainder of the plot to be rescaled so that they don't line up.
  • Could you provide some general advise when dealing with Plots and Graphics?
$\endgroup$
4
$\begingroup$

I have slightly changed your input functions because we need to extract plot ranges when combining plots:

normalDistribution = Function[{}, 
   ParametricPlot[{PDF[NormalDistribution[], x], x}, {x, -3, 3}, 
    PlotRange -> {{0, 0.41}, {-3, 3}}, AspectRatio -> 1, Frame -> True, Axes -> False]];

logNormalDistribution = Function[{a, b}, Module[
    {max = E^(-a+b^2-(a+Log[E^(-a+b^2)])^2/(2 b^2))/(b Sqrt[2Pi])}, 
    Plot[PDF[LogNormalDistribution[a, b], x], {x, -1, 15}, 
       PlotRange -> {{-1, 15}, {-0.01, 1.1 max}}, AspectRatio -> 0.5, Frame -> True, Axes -> False]
    ]];

transformation = Function[{a, b}, 
   Plot[Log[(x - a)/b], {x, -1, 15}, PlotRange -> {{-1, 15}, {-3, 3}},
     AspectRatio -> 1, Frame -> True, Axes -> False]];

Then we want to define the function CompositePlot[main, left, top] that will draw the plot. The complexity of this function arises from fact that ImagePadding property of the graphics (where all the ticks and labels go) can be set only in absolute (printer) units. Thus, we need to define functions mtf, ltf and ttf that will help us to transform the coordinate of corresponding plots to the coordinates of the resulting plot.

GetPlotRange[plot_] := First@Cases[plot, (PlotRange -> x_) :> x, \[Infinity]];
Options[CompositePlot] = {AspectRatio -> 0.6, ImageSize -> 500, 
   ImagePadding -> {{20, 6}, {15, 7}}, Inset -> {0.7, 0.5}};
CompositePlot[main_, left_, top_, OptionsPattern[]] := 
 Module[{mrange = GetPlotRange[main], trange = GetPlotRange[top], 
   lrange = GetPlotRange[left], height, width, ipl, ipr, ipb, ipt,
   f2x, f2y, f1x, f1y, h1, h2, w1, w2, xp, yp, mtf, ltf, ttf, g, x, y,ar},
  ar = OptionValue[AspectRatio];
  {{ipl, ipr}, {ipb, ipt}} = OptionValue[ImagePadding];
  {xp, yp} = OptionValue[Inset];
  xp = 1 - xp;
  Assert[mrange[[1]] == trange[[1]]];
  Assert[mrange[[2]] == lrange[[2]]];

  If[MatchQ[OptionValue[ImageSize], {_, _}],
   {width, height} = OptionValue[ImageSize],
   {width, height} = 
    OptionValue[ImageSize] {1, ar}
   ];

  w2 = (1 - xp) - (ipl + ipr)/width; h2 = (yp) - (ipb + ipt)/height;
  f2x[x_] = xp + ipl/width + w2 (x - mrange[[1, 1]])/(mrange[[1, 2]] - mrange[[1, 1]]);
  f1y[y_] = ipb/height + h2 (y - mrange[[2, 1]])/(mrange[[2, 2]] - mrange[[2, 1]]);
  w1 = (xp) - (ipl + ipr)/width;
  f1x[x_] = ipl/width + w1 (x - lrange[[1, 1]])/(lrange[[1, 2]] - lrange[[1, 1]]);
  h1 = (1 - yp) - (ipb + ipt)/height;
  f2y[y_] = yp + ipb/height + h2 (y - trange[[2, 1]])/(trange[[2, 2]] - trange[[2, 1]]);
  mtf[{x_, y_}] = {f2x[x], f1y[y]};
  ltf[{x_, y_}] = {f1x[x], f1y[y]};
  ttf[{x_, y_}] = {f2x[x], f2y[y]};

  g = Graphics[{
     Inset[
      Show[main, ImagePadding -> OptionValue[ImagePadding], AspectRatio -> ar h2/w2 ], 
      mtf@mrange[[All, 1]], mrange[[All, 1]], {1 - xp, yp}],
     Inset[
      Show[left, ImagePadding -> OptionValue[ImagePadding], AspectRatio -> ar h2/w1 ], 
      ltf@lrange[[All, 1]], lrange[[All, 1]], {xp, yp}],
     Inset[
      Show[top, ImagePadding -> OptionValue[ImagePadding], AspectRatio -> ar h1/w2 ],
      ttf@trange[[All, 1]], trange[[All, 1]], {1 - xp, 1 - yp}]
     }, PlotRange -> {{0, 1}, {0, 1}}, ImageSize -> {width, height}, AspectRatio -> ar];
  {g, {mtf, ltf, ttf}}
  ]

Here we return both the graphics and the coordinate transformation functions, so we can use them to draw something later.

Manipulate[
    {g, {mtf, ltf, ttf}} = CompositePlot[
        transformation[a, b],
        normalDistribution[], 
        logNormalDistribution[a, b]];

    Show[g, Graphics[{Dashed, Red, 
        Line[{ltf[{0.4, 0}], mtf[{a + b, 0}], 
           ttf[{a + b, PDF[LogNormalDistribution[a, b], a + b]}]}]}]]),
 {{a, 0}, -1, 15, 0.1}, {{b, 1}, 0.1, 3, 0.1}]

enter image description here

You can also play with the defined options of CompositePlot: AspectRatio, ImageSize, ImagePadding and Inset. First 2 are self-explanatory. ImagePadding option relates to the padding of insets (not the output graphic). And Inset option defines the size of main inset: Inset->{0.75,0.5} means 75% of width and 50% of height.

|improve this answer|||||
$\endgroup$
  • $\begingroup$ Great, and a very generic solution. This can easily be applied to other mappings from function to function or distribution to distribution. It's unfortunate about the Ticks and ImagePadding, otherwise this could have been a lot cleaner/simpler. Impressive you figured it out. $\endgroup$ – LBogaardt Nov 20 '19 at 14:43

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.