A box and whisker function

Getting the necessary tools

To make the function work we will need to be able to calculate the mean and quartiles of a distribution.  The functions to do that are contained in the package Statistics`DescriptiveStatistics` which we load with the following command.

<< Statistics`DescriptiveStatistics`

Some totally irrelevant data

testdata  =  {{3, 2, 5, 1, 5, 7}, {4, 3 , 8, 2, 3}, {9, 4, 8, 0, 
            2, 5, 3, 9}};

The function

All that we need to feed to our function are the data and the color of the boxes.  I tend to use Hue for color since it is easy to work with and goes from red to yellow to green to blue to purple to red as you feed it values from zero to one.

BoxWhisker[datalis_, color_, pltratio_:  1/GoldenRatio]  :=  
      Module[{incrmnt, data2, data3, grphicsprim, 
          plots}, 
incrmnt  =  
          1/(2 Length[datalis]); 
data2  =  
          Map[Sort, datalis]; 
data3  =  
          Map[{{First[#], Last[#]}, Median[#], Drop[Quartiles[#], {2, 2}]} &, 
            data2]; 
grphicsprim  =  
          If[Head[color] === List, 
            Table[{Line[{{(2 i  -  1) incrmnt, 
                      data3[[i, 1, 
                        1]]}, {(2 i  -  1) incrmnt, 
                      data3[[i, 1, 2]]}}], {First[
                    RotateLeft[color, i - 1]], 
                  Polygon[{{(2 i  -  1) incrmnt  +   .75 incrmnt, 
                        data3[[i, 
                          2]]}, {(2 i  -  1) incrmnt  +   .9  
                            incrmnt, 
                        data3[[i, 3, 
                          1]]}, {(2 i  -  
                                1) incrmnt  -   .9 incrmnt, 
                        data3[[i, 3, 
                          1]]}, {(2 i  -  
                                1) incrmnt  -   .75 incrmnt, 
                        data3[[i, 
                          2]]}, {(2 i  -  
                                1) incrmnt  -   .9 incrmnt, 
                        data3[[i, 3, 
                          2]]}, {(2 i  -  
                                1) incrmnt  +   .9 incrmnt, 
                        data3[[i, 3, 2]]}}]}, 
                Line[{{(2 i  -  1) incrmnt  +   .75 incrmnt, 
                      data3[[i, 
                        2]]}, {(2 i  -  1) incrmnt  +   .9  
                          incrmnt, 
                      data3[[i, 3, 
                        1]]}, {(2 i  -  
                              1) incrmnt  -   .9 incrmnt, 
                      data3[[i, 3, 
                        1]]}, {(2 i  -  
                              1) incrmnt  -   .75 incrmnt, 
                      data3[[i, 
                        2]]}, {(2 i  -  
                              1) incrmnt  +   .75 incrmnt, 
                      data3[[i, 
                        2]]}, {(2 i  -  
                              1) incrmnt  +   .9 incrmnt, 
                      data3[[i, 3, 
                        2]]}, {(2 i  -  
                              1) incrmnt  -   .9 incrmnt, 
                      data3[[i, 3, 
                        2]]}, {(2 i  -  
                              1) incrmnt  -   .75 incrmnt, 
                      data3[[i, 2]]}}]}, {i, Length[data3]}], 
            Table[{Line[{{(2 i  -  1) incrmnt, 
                      data3[[i, 1, 
                        1]]}, {(2 i  -  1) incrmnt, 
                      data3[[i, 1, 2]]}}], {color, 
                  Polygon[{{(2 i  -  1) incrmnt  +   .75 incrmnt, 
                        data3[[i, 
                          2]]}, {(2 i  -  1) incrmnt  +   .9  
                            incrmnt, 
                        data3[[i, 3, 
                          1]]}, {(2 i  -  
                                1) incrmnt  -   .9 incrmnt, 
                        data3[[i, 3, 
                          1]]}, {(2 i  -  
                                1) incrmnt  -   .75 incrmnt, 
                        data3[[i, 
                          2]]}, {(2 i  -  
                                1) incrmnt  -   .9 incrmnt, 
                        data3[[i, 3, 
                          2]]}, {(2 i  -  
                                1) incrmnt  +   .9 incrmnt, 
                        data3[[i, 3, 2]]}}]}, 
                Line[{{(2 i  -  1) incrmnt  +   .75 incrmnt, 
                      data3[[i, 
                        2]]}, {(2 i  -  1) incrmnt  +   .9  
                          incrmnt, 
                      data3[[i, 3, 
                        1]]}, {(2 i  -  
                              1) incrmnt  -   .9 incrmnt, 
                      data3[[i, 3, 
                        1]]}, {(2 i  -  
                              1) incrmnt  -   .75 incrmnt, 
                      data3[[i, 
                        2]]}, {(2 i  -  
                              1) incrmnt  +   .75 incrmnt, 
                      data3[[i, 
                        2]]}, {(2 i  -  
                              1) incrmnt  +   .9 incrmnt, 
                      data3[[i, 3, 
                        2]]}, {(2 i  -  
                              1) incrmnt  -   .9 incrmnt, 
                      data3[[i, 3, 
                        2]]}, {(2 i  -  
                              1) incrmnt  -   .75 incrmnt, 
                      data3[[i, 2]]}}]}, {i, 
                Length[data3]}]]; 
plots  =  
          Show[Graphics[grphicsprim], AspectRatio  ->  pltratio, 
            Axes  ->  True, 
            Ticks  ->  {None, 
                Automatic}]
]

The depth of the waist is determined by the .75 incrmnt in the function definition.  Changing the .75 to a smaller number will make the waist deeper.  The third argument here is used to change the height-width ratio of the plot.  The default is 1/GoldenRatio, so if you do not give a value that will be the ratio of the display.  It is also possible to build text into the function so that each of the box and whisker plots would have its own label.

A plot without the option

BoxWhisker[testdata, Hue[ .2]]

And now with the option changing the aspect ratio of the plot and switching the color to GrayLevel.

BoxWhisker[testdata, GrayLevel[ .8], 1/3]

Different colors for the different data sets

If we give a list of colors they will be used sequentially for each of the boxes.

data2  =  
        Table[Random[Real, {0, 10} + Random[Integer, {-6, 12}]], {i, 
            5}, {j, Random[Integer, {10, 20}]}];

BoxWhisker[data2, Hue[ .6]]

BoxWhisker[
      data2, {Hue[ .1], Hue[ .3], Hue[ .5], Hue[ .7], Hue[ .9]}]