6
$\begingroup$

Is it possible to use ProbabilityScalePlot to show different plot markers in a single dataset, such as in going from plot2 to plot3 below?

nPoints = 10;
x = RandomVariate[NormalDistribution[1, 1], nPoints];
y = RandomVariate[LogNormalDistribution[1, 1], nPoints];
z = RandomVariate[WeibullDistribution[1, 1], nPoints];

plot1 = SmoothHistogram[{x, y, z}, Filling -> Axis]
plot2 = ProbabilityScalePlot[{x, y, z}]
plot3 = ProbabilityScalePlot[Flatten[{x, y, z}]]
$\endgroup$
1
  • $\begingroup$ Welcome to Mathematica.SE! I hope you will become a regular contributor. To get started, 1) take the introductory tour now, 2) when you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge, 3) remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign, and 4) give help too, by answering questions in your areas of expertise. $\endgroup$
    – bbgodfrey
    Sep 22, 2015 at 19:21

3 Answers 3

3
$\begingroup$
s = GatherBy[First@Cases[FullForm@plot3, Point[h___] :> h, Infinity], 
             Function[{u}, MemberQ[#, u[[1]]] & /@ {x, y, z}]]

plot3 /. Point[__] :>  MapThread[{#1, Point@#2} &, {{Red, Blue, Green}, s}]

Mathematica graphics

$\endgroup$
2
  • $\begingroup$ I'll have to work on understanding the syntax, but your solution obviously works! Many thanks. $\endgroup$
    – Jim Larsen
    Sep 22, 2015 at 19:48
  • $\begingroup$ @JimLarsen Glad to help :) $\endgroup$ Sep 22, 2015 at 19:54
1
$\begingroup$

More complicated, but I thought it interesting to see how to generate the plot from first principles:

nPoints = 10;
x = RandomVariate[NormalDistribution[1, 1], nPoints];
y = RandomVariate[LogNormalDistribution[1, 1], nPoints];
z = RandomVariate[WeibullDistribution[1, 1], nPoints];
data = {x, y, z};
nn = Length@Flatten[data];
ordereddata = 
   MapIndexed[ {(First@#2 - .3)/(nn + .4), Sequence @@ #1} &, 
       Sort[Join @@ 
          MapIndexed[ Function[{dat, ind}, {#, First@ind} & /@ dat], 
           data ]]];
dataprime = 
   Table[{#[[2]], 1 - Sqrt[2] InverseErfc[2 #[[1]]]} & /@
       Select[ ordereddata , #[[3]] == k &], {k, Length@data}];
Show[ ProbabilityScalePlot[Flatten[data] ],
    ListPlot[dataprime, PlotStyle -> {Blue, Red, Green}] ]

enter image description here

Note this is drawing the color markers over top of the probabilityplot markers.ProbabiltyPlotRange for some reason does not respect PlotMarkers->None, but you can hide them with something like PlotMarkers -> Graphics@{PointSize[0], Point[{0, 0}]}

Note also this is specific to the default normal distribution assumed by ProbabilityPlotRange

$\endgroup$
1
  • $\begingroup$ This is exceptional also! What are the odds that Wolfram will add such a capability to the Options for ProbabilityScalePlot sometime in the near future? I'm surprised the need hasn't arisen before. $\endgroup$
    – Jim Larsen
    Sep 25, 2015 at 9:39
1
$\begingroup$
colorF = Piecewise[{{Red, MemberQ[x, #[[1]]]}, {Green, MemberQ[y, #[[1]]]}}, Blue] &;

Normal[ProbabilityScalePlot[Flatten[{x, y, z}]]] /. 
   Point[p_] :> ({colorF @ #, PointSize[.015], Point @ #} & /@ p)

enter image description here

$\endgroup$

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.