Revisions to Does "MeanMarker" (BoxWhiskerChart) exclude outliers?

added 128 characters in body

Source Link

edited Jul 14, 2016 at 7:57

400.5k
18
488
929

ClearAll[trimmedMeansF]
trimmedMeansF[dir_: Directive[Thick, Opacity[1, Red]]] := BoxWhiskerChart[
   ConstantArray[#, 2] & /@ TrimmedMean[Transpose@#, {0, .05}],
  {{"Fences", None}, {"Whiskers", Opacity[0]}, {"MedianMarker", 
      Opacity[0]}, {"MeanMarker", .8, dir}}] &;

Example:

SeedRandom[1]
r = RandomVariate[NormalDistribution[0, 1], 100]^2;
rr = {r, 1 + r, 2 + r};

Show[BoxWhiskerChart[rrLegended[Show[BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
                  ChartStyle -> 1, GridLines -> {None, Mean@Transpose@rr}], 
              trimmedMeansF[Directive[Thick, Cyan]]@rr], 
 LineLegend[Directive[Thick, #] & /@ {Yellow, Cyan}, {"means", "trimmed means"}]]

Mathematica graphics

Alternatively, post-process to modify the position of the mean markers:

means1 = Mean@Transpose@rr;
means2 = TrimmedMean[Transpose@rr, {0, .05}];
bwc = BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
   GridLines -> {None, means1}, PlotLabel -> TableForm[{means1, means2}, 
     TableHeadings -> {{"means", "trimmedmeans"}, {"data1", "data2", "data3"}}], 
   ChartStyle -> 1, ImageSize -> 400];

Row[{bwc, bwc /. With[{sel = Select[Cases[bwc, _LineBox, Infinity], 
       Not[FreeQ[#, Alternatives @@ means1]] &]}, 
    Thread[sel -> ( sel /. Thread[means1 -> means2])]]}]

Mathematica graphics

ClearAll[trimmedMeansF]
trimmedMeansF[dir_: Directive[Thick, Opacity[1, Red]]] := BoxWhiskerChart[
   ConstantArray[#, 2] & /@ TrimmedMean[Transpose@#, {0, .05}],
  {{"Fences", None}, {"Whiskers", Opacity[0]}, {"MedianMarker", 
      Opacity[0]}, {"MeanMarker", .8, dir}}] &;

Example:

SeedRandom[1]
r = RandomVariate[NormalDistribution[0, 1], 100]^2;
rr = {r, 1 + r, 2 + r};

Show[BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
  ChartStyle -> 1, GridLines -> {None, Mean@Transpose@rr}], 
 trimmedMeansF[Directive[Thick, Cyan]]@rr]

Mathematica graphics

Alternatively, post-process to modify the position of the mean markers:

means1 = Mean@Transpose@rr;
means2 = TrimmedMean[Transpose@rr, {0, .05}];
bwc = BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
   GridLines -> {None, means1}, PlotLabel -> TableForm[{means1, means2}, 
     TableHeadings -> {{"means", "trimmedmeans"}, {"data1", "data2", "data3"}}], 
   ChartStyle -> 1, ImageSize -> 400];

Row[{bwc, bwc /. With[{sel = Select[Cases[bwc, _LineBox, Infinity], 
       Not[FreeQ[#, Alternatives @@ means1]] &]}, 
    Thread[sel -> ( sel /. Thread[means1 -> means2])]]}]

Mathematica graphics

ClearAll[trimmedMeansF]
trimmedMeansF[dir_: Directive[Thick, Opacity[1, Red]]] := BoxWhiskerChart[
   ConstantArray[#, 2] & /@ TrimmedMean[Transpose@#, {0, .05}],
  {{"Fences", None}, {"Whiskers", Opacity[0]}, {"MedianMarker", 
      Opacity[0]}, {"MeanMarker", .8, dir}}] &;

Example:

SeedRandom[1]
r = RandomVariate[NormalDistribution[0, 1], 100]^2;
rr = {r, 1 + r, 2 + r};

Legended[Show[BoxWhiskerChart[rr,{{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
                  ChartStyle -> 1, GridLines -> {None, Mean@Transpose@rr}], 
              trimmedMeansF[Directive[Thick, Cyan]]@rr], 
 LineLegend[Directive[Thick, #] & /@ {Yellow, Cyan}, {"means", "trimmed means"}]]

Mathematica graphics

Alternatively, post-process to modify the position of the mean markers:

means1 = Mean@Transpose@rr;
means2 = TrimmedMean[Transpose@rr, {0, .05}];
bwc = BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
   GridLines -> {None, means1}, PlotLabel -> TableForm[{means1, means2}, 
     TableHeadings -> {{"means", "trimmedmeans"}, {"data1", "data2", "data3"}}], 
   ChartStyle -> 1, ImageSize -> 400];

Row[{bwc, bwc /. With[{sel = Select[Cases[bwc, _LineBox, Infinity], 
       Not[FreeQ[#, Alternatives @@ means1]] &]}, 
    Thread[sel -> ( sel /. Thread[means1 -> means2])]]}]

Mathematica graphics

deleted 64 characters in body

Source Link

edited Jul 12, 2016 at 19:33

kglr

400.5k
18
488
929

ClearAll[trimmedMeansF]
trimmedMeansF[dir_: Directive[Thick, Opacity[1, Red]]] := BoxWhiskerChart[
   ConstantArray[#, 2] & /@ TrimmedMean[Transpose@#, {0, .05}],
  {{"Fences", None}, {"Whiskers", Opacity[0]}, {"MedianMarker", 
      Opacity[0]}, {"MeanMarker", 1.8, dir}}] &;

Example:

SeedRandom[1]
rrr = {RandomVariate[NormalDistribution[0, 1], 100], 100]^2;
    RandomVariate[NormalDistribution[1,rr 1],= 100]{r, 
  1 + RandomVariate[NormalDistribution[0r, 1],2 100]+ r}^2;;

Show[BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
  ChartStyle -> 1]1, GridLines -> {None, Mean@Transpose@rr}], 
 trimmedMeansF[Directive[Thick, Cyan]]@rr]

Mathematica graphics

Alternatively, post-process to modify the position of the mean markers:

means1 = Mean@Transpose@rr;
means2 = TrimmedMean[Transpose@rr, {0, .05}];
bwc = BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
   GridLines -> {None, means1}, 
   PlotLabel -> TableForm[{means1, means2}, 
     TableHeadings -> {{"means", "trimmedmeans"}, {"data1", "data2", 
        "data3"}}], 
   ChartStyle -> 1, ImageSize -> 400];

Row[{bwc, bwc /. With[{sel = 
      Select[Cases[bwc, _LineBox, Infinity], 
       Not[FreeQ[#, Alternatives @@ means1]] &]}, 
    Thread[sel -> ( sel /. Thread[means1 -> means2])]]}]

Mathematica graphics

ClearAll[trimmedMeansF]
trimmedMeansF[dir_: Directive[Thick, Opacity[1, Red]]] := BoxWhiskerChart[
   ConstantArray[#, 2] & /@ TrimmedMean[Transpose@#, {0, .05}],
  {{"Fences", None}, {"Whiskers", Opacity[0]}, {"MedianMarker", 
      Opacity[0]}, {"MeanMarker", 1, dir}}] &;

Example:

SeedRandom[1]
rr = {RandomVariate[NormalDistribution[0, 1], 100], 
    RandomVariate[NormalDistribution[1, 1], 100], 
    RandomVariate[NormalDistribution[0, 1], 100]}^2;

Show[BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
  ChartStyle -> 1], trimmedMeansF[Directive[Thick, Cyan]]@rr]

Mathematica graphics

Alternatively, post-process to modify the position of the mean markers:

means1 = Mean@Transpose@rr;
means2 = TrimmedMean[Transpose@rr, {0, .05}];
bwc = BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
   GridLines -> {None, means1}, 
   PlotLabel -> TableForm[{means1, means2}, 
     TableHeadings -> {{"means", "trimmedmeans"}, {"data1", "data2", 
        "data3"}}], ChartStyle -> 1, ImageSize -> 400];

Row[{bwc, bwc /. With[{sel = 
      Select[Cases[bwc, _LineBox, Infinity], 
       Not[FreeQ[#, Alternatives @@ means1]] &]}, 
    Thread[sel -> ( sel /. Thread[means1 -> means2])]]}]

Mathematica graphics

ClearAll[trimmedMeansF]
trimmedMeansF[dir_: Directive[Thick, Opacity[1, Red]]] := BoxWhiskerChart[
   ConstantArray[#, 2] & /@ TrimmedMean[Transpose@#, {0, .05}],
  {{"Fences", None}, {"Whiskers", Opacity[0]}, {"MedianMarker", 
      Opacity[0]}, {"MeanMarker", .8, dir}}] &;

Example:

SeedRandom[1]
r = RandomVariate[NormalDistribution[0, 1], 100]^2;
rr = {r, 1 + r, 2 + r};

Show[BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
  ChartStyle -> 1, GridLines -> {None, Mean@Transpose@rr}], 
 trimmedMeansF[Directive[Thick, Cyan]]@rr]

Mathematica graphics

Alternatively, post-process to modify the position of the mean markers:

means1 = Mean@Transpose@rr;
means2 = TrimmedMean[Transpose@rr, {0, .05}];
bwc = BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
   GridLines -> {None, means1}, PlotLabel -> TableForm[{means1, means2}, 
     TableHeadings -> {{"means", "trimmedmeans"}, {"data1", "data2", "data3"}}], 
   ChartStyle -> 1, ImageSize -> 400];

Row[{bwc, bwc /. With[{sel = Select[Cases[bwc, _LineBox, Infinity], 
       Not[FreeQ[#, Alternatives @@ means1]] &]}, 
    Thread[sel -> ( sel /. Thread[means1 -> means2])]]}]

Mathematica graphics

added 744 characters in body

Source Link

edited Jul 12, 2016 at 19:12

kglr

400.5k
18
488
929

ClearAll[trimmedMeansF]
trimmedMeansF[dir_: Directive[Thick, Opacity[1, Red]]] := BoxWhiskerChart[
   ConstantArray[#, 2] & /@ TrimmedMean[Transpose@#, {0, .05}],
  {{"Fences", None}, {"Whiskers", Opacity[0]}, {"MedianMarker", 
      Opacity[0]}, {"MeanMarker", 1, dir}}] &;

Example:

SeedRandom[1]
rr = {RandomVariate[NormalDistribution[0, 1], 100], 
    RandomVariate[NormalDistribution[1, 1], 100], 
    RandomVariate[NormalDistribution[0, 1], 100]}^2;

Show[BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
  ChartStyle -> 1], trimmedMeansF[Directive[Thick, Cyan]]@rr]

Mathematica graphics

Alternatively, post-process to modify the position of the mean markers:

means1 = Mean@Transpose@rr;
means2 = TrimmedMean[Transpose@rr, {0, .05}];
bwc = BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
   GridLines -> {None, means1}, 
   PlotLabel -> TableForm[{means1, means2}, 
     TableHeadings -> {{"means", "trimmedmeans"}, {"data1", "data2", 
        "data3"}}], ChartStyle -> 1, ImageSize -> 400];

Row[{bwc, bwc /. With[{sel = 
      Select[Cases[bwc, _LineBox, Infinity], 
       Not[FreeQ[#, Alternatives @@ means1]] &]}, 
    Thread[sel -> ( sel /. Thread[means1 -> means2])]]}]

Mathematica graphics

ClearAll[trimmedMeansF]
trimmedMeansF[dir_: Directive[Thick, Opacity[1, Red]]] := BoxWhiskerChart[
   ConstantArray[#, 2] & /@ TrimmedMean[Transpose@#, {0, .05}],
  {{"Fences", None}, {"Whiskers", Opacity[0]}, {"MedianMarker", 
      Opacity[0]}, {"MeanMarker", 1, dir}}] &;

Example:

SeedRandom[1]
rr = {RandomVariate[NormalDistribution[0, 1], 100], 
    RandomVariate[NormalDistribution[1, 1], 100], 
    RandomVariate[NormalDistribution[0, 1], 100]}^2;

Show[BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
  ChartStyle -> 1], trimmedMeansF[Directive[Thick, Cyan]]@rr]

Mathematica graphics

ClearAll[trimmedMeansF]
trimmedMeansF[dir_: Directive[Thick, Opacity[1, Red]]] := BoxWhiskerChart[
   ConstantArray[#, 2] & /@ TrimmedMean[Transpose@#, {0, .05}],
  {{"Fences", None}, {"Whiskers", Opacity[0]}, {"MedianMarker", 
      Opacity[0]}, {"MeanMarker", 1, dir}}] &;

Example:

SeedRandom[1]
rr = {RandomVariate[NormalDistribution[0, 1], 100], 
    RandomVariate[NormalDistribution[1, 1], 100], 
    RandomVariate[NormalDistribution[0, 1], 100]}^2;

Show[BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
  ChartStyle -> 1], trimmedMeansF[Directive[Thick, Cyan]]@rr]

Mathematica graphics

Alternatively, post-process to modify the position of the mean markers:

means1 = Mean@Transpose@rr;
means2 = TrimmedMean[Transpose@rr, {0, .05}];
bwc = BoxWhiskerChart[rr, {{"Outliers"}, {"MeanMarker", Directive[Thick, Yellow]}}, 
   GridLines -> {None, means1}, 
   PlotLabel -> TableForm[{means1, means2}, 
     TableHeadings -> {{"means", "trimmedmeans"}, {"data1", "data2", 
        "data3"}}], ChartStyle -> 1, ImageSize -> 400];

Row[{bwc, bwc /. With[{sel = 
      Select[Cases[bwc, _LineBox, Infinity], 
       Not[FreeQ[#, Alternatives @@ means1]] &]}, 
    Thread[sel -> ( sel /. Thread[means1 -> means2])]]}]

Mathematica graphics

Source Link

created Jul 12, 2016 at 18:34

kglr

400.5k
18
488
929

Loading

Stack Exchange Network

Return to Answer