4
$\begingroup$

I have the following data:

data = {{493, 416}, {1330, 1586, 1579, 1424, 1667, 1023, 665}, {1963, 
    428, 1797, 1832, 1697, 549, 526}, {1742, 2040, 1767, 1876, 1680, 
    668, 531}, {1751, 1565, 1577, 1693, 1691, 584, 523}, {1356}};

days = {{Saturday, Sunday}, {Monday, Tuesday, Wednesday, Thursday, 
    Friday, Saturday, Sunday}, {Monday, Tuesday, Wednesday, Thursday, 
    Friday, Saturday, Sunday}, {Monday, Tuesday, Wednesday, Thursday, 
    Friday, Saturday, Sunday}, {Monday, Tuesday, Wednesday, Thursday, 
    Friday, Saturday, Sunday}, {Monday}};

daysnum = {{1, 2}, {3, 4, 5, 6, 7, 8, 9}, {10, 11, 12, 13, 14, 15, 
    16}, {17, 18, 19, 20, 21, 22, 23}, {24, 25, 26, 27, 28, 29, 
    30}, {31}};

I want to plot a BarChart and to use more than one ChartLabel. I have created a handmade picture so that you can know what I mean.

enter image description here

How can I create a ChartLabel at the x-axis and at the center and the top of the BarChart?
Is it possible to color a ChartLabel according to the Bars colors?

$\endgroup$
0

4 Answers 4

4
$\begingroup$

The problem with the following is that you are loosing the depth of the initial list data since I only found a way to do it thanks to Flatten.

data = {{493, 416}, {1330, 1586, 1579, 1424, 1667, 1023, 665}, {1963, 
    428, 1797, 1832, 1697, 549, 526}, {1742, 2040, 1767, 1876, 1680, 
    668, 531}, {1751, 1565, 1577, 1693, 1691, 584, 523}, {1356}};

(* version 8 *)
col = Cases[BarChart@data, RGBColor[__], Infinity][[2 ;;]];
(* version 9 *)
(* col = Cases[BarChart@data, RGBColor[__], Infinity]; *)

days = {{Saturday, Sunday}, {Monday, Tuesday, Wednesday, Thursday, 
    Friday, Saturday, Sunday}, {Monday, Tuesday, Wednesday, Thursday, 
    Friday, Saturday, Sunday}, {Monday, Tuesday, Wednesday, Thursday, 
    Friday, Saturday, Sunday}, {Monday, Tuesday, Wednesday, Thursday, 
    Friday, Saturday, Sunday}, {Monday}};
days = ToString /@ days[[#]] & /@ Range@Length@days;
days = Style[#, #2] & @@@ Thread[{Flatten@days, col}];

daysnum = {{1, 2}, {3, 4, 5, 6, 7, 8, 9}, {10, 11, 12, 13, 14, 15, 
    16}, {17, 18, 19, 20, 21, 22, 23}, {24, 25, 26, 27, 28, 29, 
    30}, {31}};
daysnum = ToString /@ daysnum[[#]] & /@ Range@Length@daysnum;

BarChart[Labeled[#, #2, Above] & @@@ 
    Thread[{Flatten[data, 1], Flatten[daysnum, 1]}],
  ChartLabels -> {Placed[Flatten@days, Axis, Rotate[#, Pi/2] &]}, 
  LabelingFunction -> (Placed[#, Center, Rotate[#, Pi/2] &] &),
  ImageSize -> 500, ChartStyle -> col, BarSpacing -> .2]

Mathematica graphics


About the version issue with col:

In version 8

Cases[BarChart[{{1, 2, 3}}], RGBColor[__], Infinity] // Length

4

while it apparently returns 3 in version 9.

$\endgroup$
13
  • $\begingroup$ Perfect. I want to just mention one thing, I think you need to change col = Cases[BarChart@data, RGBColor[], Infinity][[2 ;;]] to col = Cases[BarChart@data, RGBColor[], Infinity][[1 ;;]], otherwise the Thread will not work of unequal lengths list. $\endgroup$ Jun 17, 2014 at 18:33
  • $\begingroup$ The length of Cases[BarChart@data, RGBColor[], Infinity] is 32, Length@Flatten@data is 31. You need the 2;; or it's not the same length. See this. Plus, the right first colour is the second one $\endgroup$
    – Öskå
    Jun 17, 2014 at 18:37
  • $\begingroup$ if I copy paste the code you wrote, it will give error unless I remove the [[2;;]] from end of col. $\endgroup$ Jun 17, 2014 at 18:40
  • $\begingroup$ very string, when I find col = Cases[BarChart@data, RGBColor[__], Infinity]; Length@col it returns 31. $\endgroup$ Jun 17, 2014 at 18:42
  • $\begingroup$ @Algohi, what version are you using? $\endgroup$
    – Öskå
    Jun 17, 2014 at 18:43
4
$\begingroup$
data = {{493, 416}, {1330, 1586, 1579, 1424, 1667, 1023, 665},
   {1963, 428, 1797, 1832, 1697, 549, 526},
   {1742, 2040, 1767, 1876, 1680, 668, 531},
   {1751, 1565, 1577, 1693, 1691, 584, 523}, {1356}};

 days = {{Saturday, Sunday},
   {Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday},
   {Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday},
   {Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday},
   {Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, 
    Sunday}, {Monday}};

 daysnum = {{1, 2}, {3, 4, 5, 6, 7, 8, 9}, {10, 11, 12, 13, 14, 15, 16},
   {17, 18, 19, 20, 21, 22, 23}, {24, 25, 26, 27, 28, 29, 30}, {31}};

Restructuring data into a more easily used form:

 data2 = Partition[Thread[Flatten /@ {data, days, daysnum}], 7, 7, 1, {}];

I believe that this is what you asked for

EDIT : Corrected colors

Module[{len = Length[data2], colors}, 
 colors = Table[ColorData["Rainbow"][(n - 1)/6], {n, 7}];
 BarChart[Map[
   Labeled[#[[1]], {Rotate[#[[1]], Pi/2], 
      Style[#[[3]], colors[[Mod[#[[3]] - 1, 7] + 1]]]}, {Center, Above}] &, 
   data2, {2}], ChartStyle -> "Rainbow", ChartLabels -> (n = 1;
    Rotate[Style[#, colors[[n++]]], Pi/2] & /@ data2[[1, All, 2]])]]

enter image description here

However, you might want to consider using ChartLegends rather than ChartLabels

 Module[{len = Length[data2], colors}, 
 colors = Table[ColorData["Rainbow"][(n - 1)/6], {n, 7}];
 BarChart[
  Map[Labeled[#[[1]], {Rotate[#[[1]], Pi/2], 
      Style[#[[3]], colors[[Mod[#[[3]] - 1, 7] + 1]]]}, {Center, 
      Above}] &, data2, {2}], ChartStyle -> "Rainbow", 
  ChartLegends -> (n = 1;
    Style[#, colors[[n++]]] & /@ data2[[1, All, 2]])]]

enter image description here

$\endgroup$
1
  • $\begingroup$ Corrected colors for labels $\endgroup$
    – Bob Hanlon
    Jun 18, 2014 at 5:39
3
$\begingroup$
d = ToString /@ Flatten@days;
n = # <> "  " & /@ ToString /@ Range@Length@d;
nd = StringJoin[n[[#]], d[[#]]] & /@ Range@Length@d;

BarChart[Flatten@data,
 ColorFunction -> "DarkTerrain",
 ImageSize -> 600,
 LabelingFunction -> (Placed[Rotate[#, Pi/4], Above] &),
 ChartElementFunction -> "SegmentScaleRectangle",
 ChartLabels -> Map[Rotate[#, Pi/2] &, nd]]

enter image description here

d = StringTake[#, 3] & /@ ToString /@ Flatten@days;
d = StringJoin[d[[#]], Table["  ", {Length@d}][[#]]] & /@ Range@Length@d;
n = # <> "  " & /@ ToString /@ Range@Length@d;
nd = StringJoin[n[[#]], d[[#]]] & /@ Range@Length@d;

BarChart[Reverse@Flatten@data,
 BarOrigin -> Left,
 ColorFunction -> "DarkTerrain",
 ImageSize -> 600,
 LabelingFunction -> (Placed[#, Right] &),
 ChartElementFunction -> "SegmentScaleRectangle",
 ChartLabels -> Reverse@nd]

enter image description here

$\endgroup$
2
$\begingroup$
rule = Thread[days[[2]] -> Range[7]];
cdF = ColorData[63];
(* for Gradient schemes use, e.g., cdF = ColorData[{"Rainbow", {1, 7}}] *)

BarChart[Apply[
               Labeled[Style[#1, cdF[Mod[(#3 /. rule), 7, 1]]],
                       {Rotate[Style[#1, 12], 90 Degree],
                       Style[#2, 14, cdF[Mod[(#3 /. rule), 7, 1]]], 
                       Rotate[Style[#3, 14, cdF[Mod[(#3 /. rule), 7, 1]]], 90 Degree]},
                     {Center, Above, Below}] &,
              Thread /@ Thread[{data, daysnum, days}], {2}],
        ImageSize -> 600]

enter image description here

$\endgroup$
1
  • $\begingroup$ This is exactly the answer that I am looking for. great thanks. $\endgroup$ Jun 18, 2014 at 15:29

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.