Return to Revisions

Wolfram Function Repository function

Here is a WFR candidate ParallelCoordinatesPlot :

Package

I implemented the package "ParallelCoordinatesPlot.m" for doing this kind of plots and put it in GitHub. I plan to improve it some more. It is especially interesting to have automatic selection of the axes order that produces most discernible results.

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/Misc/ParallelCoordinatesPlot.m"]

data = ExampleData[{"Statistics", "FisherIris"}];
colNames = ExampleData[{"Statistics", "FisherIris"}, "ColumnDescriptions"];

aData = GroupBy[data, #[[-1]] &, #[[All, 1 ;; -2]] &];

grs = Table[ParallelCoordinatesPlot[aData, Most[colNames], "Colors" -> Random, "AxesOrder" -> Random, Direction -> dir, ImageSize -> Medium], {dir, {"Horizontal", "Vertical"}}, {m, 3}];
Grid[grs, Alignment -> Left, Dividers -> All]

First answer

Below is given a function definition to do this. It can be improved and "productized" some more, especially with legend's colors specification. (Currently random colors are picked from a hard coded color scheme.)

Get the "Fisher Iris" data and columns names:

data = ExampleData[{"Statistics", "FisherIris"}];
colNames = ExampleData[{"Statistics", "FisherIris"}, "ColumnDescriptions"]

Group the data according to the species of iris:

aData = GroupBy[data, #[[-1]] &, #[[All, 1 ;; -2]] &];

Make the parallel plot:

ParallelListLinePlot[aData, Most[colNames]]

(Several plot evaluations might be needed in order to produce more discernible coloring.)

Definition

Clear[ParallelListLinePlot];
ParallelListLinePlot[data_?MatrixQ, opts : OptionsPattern[]] :=
  ParallelListLinePlot[data, Range[Length[data[[1]]]], MinMax /@ Transpose[data], opts];

ParallelListLinePlot[data_?MatrixQ, colNames_List, opts : OptionsPattern[]] :=  
  ParallelListLinePlot[data, colNames, MinMax /@ Transpose[data], opts];

ParallelListLinePlot[data_?MatrixQ, colNames_List, minMaxes_?MatrixQ, opts : OptionsPattern[]] :=
  Block[{divisions, data2, grBase, grid, xs, n = 5, c = 0.1},
    divisions = FindDivisions[#, n] & /@ minMaxes;
    data2 = 
     Transpose[
      MapThread[
       Rescale[#1, #2, {0, 1}] &, {Transpose[data], 
        MinMax /@ divisions}]];
    xs = Range[Length[data[[1]]]];
    grBase = 
     ListLinePlot[data2, opts, Axes -> False, 
      GridLines -> {Range[Length[data[[1]]]], None}];
    grid =
     Graphics[{
       Line[{{#, 0}, {#, 1}}] & /@ xs,
       MapThread[
        Function[{x, ds},
         MapThread[{Line[{{x - c, #2}, {x + c, #2}}], 
            Text[#1, {x - c, #2}, {2, 0}]} &, {N@ds, Rescale[ds]}]
         ],
        {xs, divisions}],
       MapThread[Text[#2, {#1, 0}, {0, 3}] &, {xs, colNames}]
       }];
    Show[grBase, grid]
    ] /; MatrixQ[data, NumberQ] && MatrixQ[minMaxes, NumberQ] && 
    Dimensions[minMaxes] == {Dimensions[data][[2]], 2};

ParallelListLinePlot[aData_Association, colNames_List, opts : OptionsPattern[]] :=
  Block[{minMaxes, cols, grs},
    minMaxes = MinMax /@ Transpose[Join @@ Values[aData]];
    cols = RandomSample[ColorData[11, "ColorList"], Length[aData]];
    grs = 
     MapThread[
      ParallelListLinePlot[#1, colNames, minMaxes, PlotStyle -> #2, 
        opts] &, {Values@aData, cols}];
    Legended[Show[grs], SwatchLegend[cols, Keys[aData]]]
    ] /; MatrixQ[Join @@ Values[aData], NumberQ];