Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I have a set of 3 lifetime datasets in lists called values1, values2 and values3.

values1 = {53377., 16542., 31418., 5629., 17654., 7365., 15797., 862., 76906., 10073.};

values2 = {74412., 15620., 29650., 96951., 9252., 14257., 11684., 84461., 49724., 14903.};

values3 = {69174., 77036., 115837., 105497., 103195., 55433., 90053., 45861., 57840., 33875.};

The plot of this raw data is shown below.

enter image description here

I now use EstimatedDistribution to fit the data to individual Weibull distributions and plot their PDFs.

enter image description here

enter image description here

enter image description here

What I would like to do now is to locate and align the individual PDF curves on top of the raw data plot close to their corresponding data points. The PDFs would be rotated 90 degrees clockwise thereby ending up in a vertical orientation in the final plot. At this point I don’t necessarily need the frames and labels associated with the PDF plots to be included. What is most important is that the Age to Failure axes of the Raw Data plot be aligned with that of the PDF plots so that the resulting composite plot is a true mathematically accurate representation of the information in all 4 plots. Below is a depiction of the formatting I’m after (minus the inclusion of the boxes and whiskers]. I don’t know what software tool created this plot.

enter image description here

The closest I’ve seen to this is in Mathematica is the BoxWhiskerChart but that apparently is unable to show the PDF. Below is my code. Thanks for any help.

values1 = {53377., 16542., 31418., 5629., 17654., 7365., 15797., 862.,
76906., 10073.};

values2 = {74412., 15620., 29650., 96951., 9252., 14257., 11684., 
84461., 49724., 14903.};

values3 = {69174., 77036., 115837., 105497., 103195., 55433., 90053., 
45861., 57840., 33875.};

category1 = Table[1, {10}];
category2 = Table[2, {10}];
category3 = Table[3, {10}];
data1 = Transpose[{category1, values1}];
data2 = Transpose[{category2, values2}];
data3 = Transpose[{category3, values3}];

plot1 = ListPlot[{data1, data2, data3}, Frame -> True, 
PlotRange -> {{0, 4}, {0, 150000}}, 
FrameLabel -> {"Category", "Age to Failure"}, 
FrameTicks -> {{1, 2, 3}, {0, 25000, 50000, 75000, 100000, 125000, 
 150000}, None, None}, PlotLabel -> "Raw Data"]

dist1 = EstimatedDistribution[values1, 
WeibullDistribution[\[Alpha], \[Beta]]]

dist2 = EstimatedDistribution[values2, 
WeibullDistribution[\[Alpha], \[Beta]]]

dist3 = EstimatedDistribution[values3, 
WeibullDistribution[\[Alpha], \[Beta]]]

plotrange = {0, 5*10^-5};

plot2 = Plot[PDF[dist1, t], {t, 0, 75000}, Frame -> True, 
FrameLabel -> {"Age to Failure", "PDF"}, 
PlotLabel -> "Distribution 1 PDF", PlotRange -> plotrange]

plot3 = Plot[PDF[dist2, t], {t, 0, 100000}, Frame -> True, 
FrameLabel -> {"Age to Failure", "PDF"}, 
PlotLabel -> "Distribution 2 PDF", PlotRange -> plotrange]

plot4 = Plot[PDF[dist3, t], {t, 0, 150000}, Frame -> True, 
FrameLabel -> {"Age to Failure", "PDF"}, 
PlotLabel -> "Distribution 3 PDF", PlotRange -> plotrange]

Edit 1: I also looked at DistributionChart which appears to return teardrop-like objects but not the actual PDF (probability density function) plot that I am seeking.

DistributionChart draws a representation of the distribution of values in each Subscript[data, i].

Edit 2: Here is another example showing “vertical PDFs”, this time on a semi-log plot. I believe one of the ReliaSoft products produced this. See here.

enter image description here

Edit 3: Here is George's solution

enter image description here

share|improve this question
    
See if DistributionChart does what you need –  Verbeia Jan 16 at 19:43

1 Answer 1

up vote 1 down vote accepted

Here is one somewhat brute force approach:

 dist = {NormalDistribution[.5, .1], BetaDistribution[2, 4]}; 
 peak = First@Maximize[PDF[#, z], z] & /@ dist;
 Show[{ListPlot[{1, #} & /@ RandomVariate[dist[[1]], 50]],
      ListPlot[{2, #} & /@ RandomVariate[dist[[2]], 30]],
      ParametricPlot[{PDF[dist[[1]], x]/peak[[1]]/2 + 1, x }, {x, 0, 1}],
      ParametricPlot[{PDF[dist[[2]], x]/peak[[2]]/2 + 2, x }, {x, 0, 1}]},
      PlotRange -> {{0, 3}, {0, 1}}]

Another way if you want it filled:

 Show[Table[ 
     ListPlot[{k, #} & /@ RandomVariate[dist[[k]], 50]] , {k, 1, 2}], 
  Prolog -> 
     Table[{GrayLevel[.7], 
        Polygon[Table[ {PDF[dist[[k]], x]/peak[[k]]/2 + k, x } , {x, 0, 
           1, .01}]]}, {k, 1, 2}], PlotRange -> {{0, 3}, {0, 1}}]

(Much obliged if somone could post up the figures for me..)

share|improve this answer
    
very clever solution, thank you. This is what I needed but my Mathematica skills are not sufficient to have produced this. I will need to "unpack" this to fully understand it but it is what I'm after. Hopefully WR will add this kind of functionality in a future version to make Mathematica more "Engineer friendly".Thanks again. –  Steve Jan 17 at 15:46

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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