Helio chart for canonical correlation

Question

I'm trying to create a chart usually called "Helio chart". It's a chart type very suited for canonical correlation analysis involving several dependent and independent variables.

However, it is a little bit difficult to find good examples of for this chart on the web and the best example I have can be found on the 6th page of this paper on the NASA website:

http://ti.arc.nasa.gov/m/profile/adegani/Canonical%20Correlation.pdf

It is possible to create such a chart in Mathematica?

Answer 1

Here's some code that could help you to start:

sample data:

data = RandomReal[{-1, 1}, 30];

plot:

angleBar[max_, length_: .1][{{t0_, t1_}, {r0_, r1_}}, v_, meta_] :=
    Block[{angle, coords, x, y},
        angle = t0 + (t1 - t0)/2;
        coords = {Cos[angle], Sin[angle]};
        x = r0 coords;
        y = r1 coords;
        {{Gray, Dashed, Line[{x, y}]}, 
        {Black, If[meta[[1]] > 0, EdgeForm[],FaceForm[White]], 
          Translate[
            Rotate[Scale[
              Rectangle[{0, -.5}, {1, .5}], { meta[[1]]/max, length}, {0, 
          0}], angle, {0, 0}], x]} }
];

newdata = 1 -> # & /@ data;
max = Max[Abs[data]];
PieChart[newdata, ChartElementFunction -> angleBar[1.3 max, .1], 
   SectorOrigin -> {Automatic, 1.5}, 
   PolarGridLines -> {None, {0, 1.5}}, PerformanceGoal -> "Speed"]

I added names and grouping.

angleBarName[max_, length_: .1][{{t0_, t1_}, {r0_, r1_}}, v_, meta_] :=
     Block[{angle, coords, x, y, tangle, offset},
         angle = t0 + (t1 - t0)/2;
         coords = {Cos[angle], Sin[angle]};
         x = r0 coords;
         y = r1 coords;
         If[Pi/2 <= Mod[angle, 2 Pi] <= 3/2 Pi, tangle = angle + Pi; 
            offset = {1, 0}, tangle = angle; offset = {-1, 0}];
         {{Gray, Dashed, Line[{x, 1.2 y}]}, {Black, 
          If[meta[[1, 1]] > 0, EdgeForm[], FaceForm[White]], 
          Translate[
            Rotate[Scale[
               Rectangle[{0, -.5}, {1, .5}], {meta[[1, 1]]/max, length}, {0, 
               0}], angle, {0, 0}], x]},
               Translate[
               Rotate[Text[Style[meta[[1, 2]], "Title", 10, Black], {0, 0}, 
               offset], tangle, {0, 0}], 2.1 x]}];

angleBarName[max_, length_: .1][{{t0_, t1_}, {r0_, r1_}},v_, {{"Group", msize_}}] :=
       Block[{angle, end, start, offset},
          If[v == msize, {},
           offset = (t1 - t0)/(v/msize *2);
           start = {Cos[t0 + offset], Sin[t0 + offset]};
           end = {Cos[t1 - offset], Sin[t1 - offset]};
           {Black, Thick, Line[{2.7 start, 3 start}], 
           Line[{2.7 end, 3 end}], 
           Circle[{0, 0}, 2.7, {t0 + offset, t1 - offset}]}]];

angleBarName[max_, length_: .1][{{t0_, t1_}, {r0_, r1_}}, v_, {"LineBreaker"}]:= {}

Sample data with names and grouping:

data = Transpose[{RandomReal[{-2, 2}, 30], ChemicalData[][[;; 30]]}];
max = Max[Abs[data[[All, 1]]]];
getherdata = GatherBy[data, StringTake[#[[2]], 1] &];
gdata = Length[#] -> {"Group",1} & /@ getherdata;
newdata = 1 -> # & /@ Flatten[getherdata, 1];

Chart:

PieChart[{newdata, gdata}, 
  ChartElementFunction -> angleBarName[1.1 max, .1], 
  SectorOrigin -> {{Pi/2, "Clockwise"}, 1.5}, 
  PolarGridLines -> {None, {1.5}}, PerformanceGoal -> "Speed", 
  PlotRange -> All]

I edited code to give space in the middle. To do that, I assumed the given data already separated into two part.

filterData[data_] :=
  Block[{fdata, size},
    fdata = Flatten[data, 1];
    size = 1/Length[fdata];
    {Join[{.005 -> "LineBreaker"}, 
           size -> # & /@ fdata, {.005 -> "LineBreaker"}], 
     Join[{.005 -> 
         "LineBreaker"}, (size Length[#]) -> {"Group", size} & /@ 
     data, {.005 -> "LineBreaker"}]}
]

sample data:

data = Transpose[{RandomReal[{-2, 2}, 22], ChemicalData[][[;; 22]]}];
ldata = GatherBy[data[[;; 7]], StringTake[#[[2]], 1] &];
rdata = GatherBy[data[[8 ;;]], StringTake[#[[2]], 1] &];

draw chart:

max = Max[Abs[ldata[[All, 1, 1]]], Abs[rdata[[All, 1, 1]]]];
newdata = MapThread[Join, {filterData[rdata], filterData[ldata]}];
PieChart[newdata, ChartElementFunction -> angleBarName[1.2 max, .1], 
   SectorOrigin -> {{Pi/2, "Clockwise"}, 1.5}, 
   PolarGridLines -> {None, {1.5}}, PerformanceGoal -> "Speed", 
   PlotRange -> All, 
   Epilog -> {Orange, Thick, Line[{{0, -4.5}, {0, 4.5}}]}]

Answer 2

Here is a start:

out = Table[{i, RandomReal[{-1, 1}]}, {i, 0, 2 Pi - 2 Pi/20, 2 Pi/20}];
Graphics[{White, EdgeForm[Directive[Black]], Disk[],
  {If[#[[2]] > 0, White, Black], 
     GeometricTransformation[ Rectangle[{0, 0}, {#[[2]] .5, .1}], 
                         {RotationMatrix[#[[1]]], {Cos[#[[1]]], Sin[#][[1]]}}]} & /@ out}]