2
$\begingroup$

To add Arrow connecting the red point across two Show[] function result as below, Could I know how to modify my code?

trialSet = {1, 4, 5};
sampleMean = Mean[trialSet];
Column[
 {(*Upper Graph *)
  Show[ListPlot[{Transpose[{trialSet, 
       ConstantArray[0, 3]}], {Style[{Mean[trialSet], 0}, Red, 
       PointSize @ .06]} } , PlotMarkers -> {Automatic, 0.04}    , 
    PlotRange -> {{-6, 6}, Automatic}, Axes -> {True, True}],
   Plot[PDF[NormalDistribution[0, 1], x], {x, -6, 6}, 
    PlotRange -> Full]],
  (*Lower Graph*)
  Show[Histogram[{sampleMean}, PlotRange -> {{-6, 6}, Automatic}], 
   NumberLinePlot[Style[sampleMean, Red], {x, -6, 6}, Spacings -> 0], 
   Axes -> {True, False}]}
 ]

enter image description here

$\endgroup$

1 Answer 1

6
$\begingroup$

Easier way is to use single graphics canvas (combining various graphics objects with Show and/or adding desired primitives as Epilog or Prolog):

 nlp = NumberLinePlot[
    {Style[sampleMean, Red], 
     {trialSet, Style[sampleMean, Red]}},
   {x, -6, 6},
   Spacings -> {0, 1.05}]

enter image description here

Histogram[{sampleMean}, 
  PlotRange -> {{-6, 6}, Automatic}, 
  Epilog -> 
   {First @ nlp,
    Red, Thick, Arrowheads @ Medium, 
    Arrow[{{sampleMean, 1.05}, {sampleMean, 0}}, .025]}, 
 Frame -> {{False, False}, {True, True}}, 
 FrameTicks -> All]

enter image description here

Update:

ug = Show[
   ListPlot[{Transpose[{trialSet, ConstantArray[0, 3]}], 
       {{Mean[trialSet], 0}}},
     PlotStyle -> {Automatic, Red}, 
     PlotMarkers -> {{Automatic, 0.2}, {Automatic, .3}}, 
     PlotRange -> {{-6, 6}, {0, 1/2}}, 
     Axes -> True], 
   Plot[PDF[NormalDistribution[0, 1], x], {x, -6, 6}], 
   PlotRangeClipping -> False, 
   PlotRangePadding -> {{.1, .1}, {0, 0}},
   ImagePadding -> {{0, 0}, {20, 2}}, 
   AspectRatio -> 1/6];

Histogram[{sampleMean}, 
 PlotRange -> {{-6, 6}, Automatic}, 
 Epilog -> 
   {Inset[ug, Scaled @ {0, 1.1}, Scaled @ {0, 0}, Scaled[1]], 
    Red, Thick, Arrowheads @ Medium, PointSize @ Large, 
    Point @ {sampleMean, 0}
    Arrow[{{sampleMean, 1.1}, {sampleMean, 0}}, .025]}, 
 Axes -> {True, False}, 
 PlotRangePadding -> {{.1, .1}, {0, 0}}, 
 ImagePadding -> {{0, 0}, {50, 100}}]

enter image description here

$\endgroup$
2
  • $\begingroup$ Thank you for your reply!! Could I have additional question? If there is a more combined graph at upper area as picture above,-I've just edited original question-,how to fix my code? $\endgroup$
    – Soon
    Nov 14, 2023 at 13:27
  • 1
    $\begingroup$ @Soon, please see the update. $\endgroup$
    – kglr
    Nov 14, 2023 at 14:06

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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