1
$\begingroup$

I have some 2D data (a load of random walks) that I would like to show using a bivariate line plot with marginals attached (I would like the output to look similar to that in this question.)

The twist here, is that I need to plot the bivariate data above another plot, that happens to be 3D. To do this I am using Graphics3D to draw the data:

n = 50;
lRand = Table[RandomVariate[MultinormalDistribution[{0, 0}, {{1, 0}, {0, 1}}], {10}],
        {i, 1, n, 1}];
lRW = Accumulate /@ lRand;
lRWAugmented = Table[{#[[1]], #[[2]], 0.1} & /@ lRW[[i]], {i, 1, n}];
Show[Plot3D[0.1, {x, -10, 10}, {y, -10, 10}, PlotStyle -> Opacity[0.2, Gray]], 
Graphics3D[Line[lRWAugmented]]]

Which results in a plot like the one below:

enter image description here

Note I have omitted the plot below the top line graph, since it doesn't affect the answer to this question.

Does anyone know how I could add marginals to the top line plot? I don't really know where to begin to be honest!

Improve this question
$\endgroup$
1

1 Answer 1

Reset to default
1
$\begingroup$ 
Manipulate[Module[{x, y},

  mysoln = Solve[{x, y}.Inverse[( {
          {a[[1]] a[[1]],  ρ a[[1]] a[[2]]},
          { ρ a[[1]] a[[2]], a[[2]] a[[2]]}
         } )].{x, y} == 1, x, Reals] // Quiet;

  Show[{

    ParametricPlot3D[{{x /. mysoln[[1]], y, -.2}, {x /. mysoln[[2]], 
       y, -.2}}, {y, -5, 5}, 
     PlotRange -> {{-5, 5}, {-5, 5}, {-.2, .3}}, 
     ImageSize -> 700,
     PlotStyle -> {{Thick, Green}, {Thick, Green}},    
     Ticks -> {{{xx, 
         Text[Style[
           "\!\(\*OverscriptBox[SubscriptBox[\(x\), \(1\)], \
\(^\)]\)", 18, Italic, Red]]}}, None, None}, 
     TicksStyle -> { Red, None, None}, 
     BoxRatios -> {1, 1, 1}, 
     AxesLabel -> {Text[
        Style["\!\(\*SubscriptBox[\(x\), \(1\)]\)", Italic, 14]], 
       Text[Style["\!\(\*SubscriptBox[\(x\), \(2\)]\)", Italic, 14]], 
       Text[Style["p(x)", Italic, 16]]}],

    Plot3D[PDF[MultinormalDistribution[{0, 0}, ( {
         {a[[1]] a[[1]],  ρ a[[1]] a[[2]]},
         { ρ a[[1]] a[[2]], a[[2]] a[[2]]}
        } )], {x, y}], {x, -5, 5}, {y, -5, 5}, 
     PlotStyle -> Opacity[0.7],
     PlotPoints -> 20,
     PlotRange -> {{-5, 5}, {-5, 5}, {-.2, .3}}, Mesh -> {{0}}, 
     MeshFunctions -> {#1 - xx &}, MeshStyle -> {Thick, Red}, 
     ImageSize -> 700,
     Ticks -> {{{xx, 
         Text[Style[
           "\!\(\*OverscriptBox[SubscriptBox[\(x\), \(1\)], \
\(^\)]\)", 18, Italic, Red]]}}, None, None}, 
     TicksStyle -> { Red, None, None}, BoxRatios -> {1, 1, 1}, 
     AxesLabel -> {Text[
        Style["\!\(\*SubscriptBox[\(x\), \(1\)]\)", Italic, 14]], 
       Text[Style["\!\(\*SubscriptBox[\(x\), \(2\)]\)", Italic, 14]], 
       Text[Style["p(x)", Italic, 16]]}],

    Graphics3D[{Opacity[0.5], 
      Polygon[{{xx, -5, 0}, {xx, -5, .3}, {xx, 5, .3}, {xx, 5, 
         0}, {xx, -5, 0}}]}, 
     PlotRange -> {{-5, 5}, {-5, 5}, {-.2, .3}}, 
     Ticks -> {{{xx, 
         Text[Style[
           "\!\(\*OverscriptBox[SubscriptBox[\(x\), \(1\)], \
\(^\)]\)", 18, Italic, Red]]}}, None, None}, 
     TicksStyle -> { Red, None, None}, BoxRatios -> {1, 1, 1}, 
     AxesLabel -> {Text[
        Style["\!\(\*SubscriptBox[\(x\), \(1\)]\)", Italic, 14]], 
       Text[Style["\!\(\*SubscriptBox[\(x\), \(2\)]\)", Italic, 14]], 
       Text[Style["p(x)", Italic, 16]]}],

    ParametricPlot3D[{-5, y, 
      PDF[NormalDistribution[ρ xx a[[2]]/a[[1]], 
        a[[2]] Sqrt[1 - ρ^2]], y]}, {y, -5, 5},
     PlotRange -> {{-5, 5}, {-5, 5}, {-.2, .3}}, 
     PlotStyle -> {Thick, Red}, 
     Ticks -> {{{xx, 
         Text[Style[
           "\!\(\*OverscriptBox[SubscriptBox[\(x\), \(1\)], \
\(^\)]\)", 18, Italic, Red]]}}, None, None},
     ImageSize -> 700, TicksStyle -> { Red, None, None}, 
     BoxRatios -> {1, 1, 1}, 
     AxesLabel -> {Text[
        Style["\!\(\*SubscriptBox[\(x\), \(1\)]\)", Italic, 14]], 
       Text[Style["\!\(\*SubscriptBox[\(x\), \(2\)]\)", Italic, 14]], 
       Text[Style["p(x)", Italic, 16]]}]

    }]], 
 {{a, {1, 1}, 
   "\!\(\*SubscriptBox[\(σ\), \(1\)]\) , \!\(\*SubscriptBox[\(\
σ\), \(2\)]\)"}, {1, 1}, {2, 2}}, {{ρ, 
   0}, -.85, .85, .05}, {{xx, 0, 
   Text[Style[
     "\!\(\*OverscriptBox[SubscriptBox[\(x\), \(1\)], \(^\)]\)", 14, 
     Italic, Red]]}, -5, 5, .2},
 AutoAction -> False]
Improve this answer
$\endgroup$
1
  • $\begingroup$ Thanks for your answer, although it is not quite what I was looking for (did you see the question that I linked to in my original question?) Sorry, it's my fault - I wasn't clear. I am looking to show both marginals in the same plane as the top line plot. The marginals should be reconstructed from the data, not from the PDF I used to make them - the above example is not exactly the same as my real question. Apologies for not being clear. Best, Ben $\endgroup$
    – ben18785
    Commented Apr 9, 2016 at 12:43

Not the answer you're looking for? Browse other questions tagged or ask your own question.