How to plot a "main effect" plot?

Question

I'm trying to make a "main effect" type chart but I haven't found a way to do it in Mathematica. The main effect plots are the graphs plotting the means for each value of a categorical variable, ploted side by side.
Example as follows.
Dataset:
Bucket = {{24, 48}, {28, 53}}
Nozzle = {{1, 42}, {2, 58}}
NzD = {{5.5, 61}, {7, 41}}

Thanks for the replies but I apologize for forgetting to specify that I can have more than 3 datasets (for example Dt4 = {{23, 50}, {26.55}, {28, 58}}) and that they can have more that two points. My knowledge of Mathematica does not allow me to fully understand the answers to make the necessary changes. However, all graphics (frames) must be the same width and height.

MassDefect · Accepted Answer

I find the resource function PlotGrid comes in handy when you want multiple plots side-by-side.
For the most part, I specify all of the options in a list beforehand so I don't have to type them over and over again. If we only want tick marks at the specified data, I have to specify the ticks for each one separately.
pg = ResourceFunction["PlotGrid"]
bucket = {{24, .48}, {27, .53}};
nozzle = {{1, .42}, {2, .58}};
nzd = {{5.5, .61}, {7, .41}};
opts = {Axes -> False, Frame -> True, Mesh -> All, 
   MeshStyle -> AbsolutePointSize[5], 
   PlotRangePadding -> {Scaled[0.1], Automatic}};
pg[{
  ListLinePlot[#, opts, 
     FrameTicks -> {{Automatic, Automatic}, {#[[All, 1]], 
        None}}] & /@ {bucket, nozzle, nzd}
  },
 AspectRatio -> 0.5,
 ImageSize -> 500,
 FrameLabel -> {None, "Mean of Means"},
 PlotLabel -> "Main Effects Plot for Means",
 PlotLabels -> 
  Placed[{"Bucket", "Nozzle", "Nz Diameter"}, Scaled[{0.56, 1.01}]],
 PlotRange -> Max,
 Epilog -> {
   Dashed,
   Line[{{0, 0.51}, {1, 0.51}}]
   }
 ]

kglr · Answer

ClearAll[mainEffectsPlot]

Options[mainEffectsPlot] = Join[Options[ListPlot], {Spacings -> Automatic}];

mainEffectsPlot[data_, labels_, opts : OptionsPattern[]] := 
 Module[{xcoords, means = Flatten@data[[All, All, -1]], 
    levels = Flatten@data[[All, All, 1]], 
    gap = OptionValue[Spacings] /. Automatic -> 1}, 
  xcoords = Accumulate @ Flatten[Prepend[gap]@
        Differences @ Subdivide[1, Max[Length /@ data], Length@# - 1] & /@ data]; 
  ListPlot[TakeList[Transpose[{xcoords, means}], Length /@ data], 
   Frame -> True, 
   GridLines -> {gap/2 + Most[Last /@ TakeList[xcoords, Length /@ data]], 
      {{Mean @ means,  Dashed}}}, 
   PlotRange -> All, 
   FilterRules[{opts}, Options[ListPlot]], 
   PlotRangePadding -> {{gap, gap}/2, {Automatic, Automatic}}, 
   FrameTicksStyle -> {{Automatic, Automatic}, {Automatic, FontColor -> Black}}, 
   FrameTicks -> {{Automatic, All}, {Transpose[{xcoords, levels}], 
      Transpose[{Mean /@ TakeList[xcoords, Length /@ data], labels}]}}, 
   PlotMarkers -> {Graphics[{Disk[]}], .05}, 
   Joined -> True]]

Examples:
data = {Bucket, Nozzle, NzD};

labels = Style[#, 16] & /@ {"Bucket", "Nozzle", "NzD"};

mainEffectsPlot[data, labels, 
 ImageSize -> Large, 
 FrameLabel -> {None, Style["Mean of means", 16]}, 
 PlotLabel -> Style[ "Main Effects Plot", 20]]

SeedRandom[1]
data2 = SortBy[First] @ RandomInteger[100, {#, 2}] & /@ {2, 3, 2, 4};
labels2 = Style[#, 16] & /@ RandomWord["Noun", 4];

mainEffectsPlot[data2, labels2, 
 ImageSize -> Large, 
 FrameLabel -> {None, Style["Mean of means", 16]}, 
 PlotLabel -> Style[ "Main Effects Plot", 20],
 PlotMarkers -> Thread[{ChartElementData["CenterMarkers"][[All, 1]], .06}],
 PlotLegends -> LineLegend[labels2, BaseStyle -> EdgeForm[]]]

SeedRandom[1]
data3 = SortBy[First]@RandomInteger[100, {#, 2}] & /@ {3, 3, 5, 2, 4};
labels3 = Style[#, 16] & /@ RandomWord["Noun", 5];

mainEffectsPlot[data3, labels3, 
 ImageSize -> Large, 
 FrameLabel -> {None, Style["Mean of means", 16]}, 
 PlotLabel -> Style["Main Effects Plot", 20], 
 PlotMarkers -> Thread[{ChartElementData["CenterMarkers"][[All, 1]], .04}], 
 PlotLegends -> LineLegend[labels3, BaseStyle -> EdgeForm[]]]

Add the options Spacings -> 3 and AspectRatio -> 1/2 to get

kglr · Answer

Using RectangleChart with a custom ChartElementFunction:
ClearAll[mainEffectsChart, cEF, preProcess]

cEF = {AbsolutePointSize[10], Point[{Mean @ #[[1]], #[[2, 2]]}], GrayLevel[.4],
    Text[Style[#3[[1, 1]], 11], Offset[{0, -5}, {Mean[#[[1]]], #3[[1, 2]]}], {0, 1}], 
    Line[Table[ Offset[{0, i}, {Mean[#[[1]]], #3[[1, 2]]}], {i, 0, 7}]]} &;

preProcess = Module[{min = Min@# - .1 Abs[Subtract@@#] & @ MinMax[#[[All, All, -1]]]},
    Module[{ll = Length @ #}, Rule[{1/ll, #2}, {#, min}] & @@@ #] & /@ #] &;

mainEffectsChart = Module[{data = preProcess @ #,
     colors = ColorData[97] /@ Range[Length @ #],
     labels = #2,
     means = #[[All, All, -1]],
     gl = 3/2 Range[Length@# - 1], 
     yrange = (# + {-.1, .1} Abs[Subtract @@ #]) & @ MinMax @ #[[All, All, -1]]},
   ReplaceAll[l_Line :> {Thick, Last[colors = RotateLeft[colors]], l}]@
     RectangleChart[data,
      Joined -> {{Mean@#[[1]], #[[2, 2]]} &}, 
      Frame -> True, 
      ChartStyle -> {colors, None},
      GridLines -> {gl, {{Mean@Flatten@means, Dashed}}},
      BarSpacing -> {0, .5}, 
      PlotRange -> {{0, 3/2 Length@data}, yrange},
      ImagePadding -> {{Automatic, Automatic}, {Scaled[.05], Automatic}},
      PlotRangePadding -> 0,
      FrameTicks -> {{Automatic, All},
        {Automatic, Thread[{3/4 + Prepend[gl, 0], labels, 0}]}},
      ChartElementFunction -> cEF, ##3]] &;

Examples:
data = {Bucket, Nozzle, NzD};

labels = Style[#, 16] & /@ {"Bucket", "Nozzle", "NzD"};

mainEffectsChart[data, labels, ImageSize -> Large, 
 FrameLabel -> {None, Style["Mean of means", 16]}, 
 PlotLabel -> Style["Main Effects Plot", 20]]

SeedRandom[1]
data3 = SortBy[First]@RandomInteger[100, {#, 2}] & /@ {3, 3, 5, 2, 4};
labels3 = Style[#, 16] & /@ RandomWord["Noun", 5];

mainEffectsChart[data3, labels3, ImageSize -> Large, 
 FrameLabel -> {None, Style["Mean of means", 16]}, 
 PlotLabel -> Style["Main Effects Plot", 20], 
 ChartLegends -> LineLegend[labels3, LegendMarkers -> {"●", 12}]]

How to plot a "main effect" plot?

3 Answers

Add your own answers!

Ask a Question