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?

Improve this question
$\endgroup$
0

4 Answers 4

Reset to default
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.

Improve this answer
$\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$
    – Basheer Algohi
    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$
    – Basheer Algohi
    Jun 17, 2014 at 18:40
  • $\begingroup$ very string, when I find col = Cases[BarChart@data, RGBColor[__], Infinity]; Length@col it returns 31. $\endgroup$
    – Basheer Algohi
    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

Improve this answer
$\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

Improve this answer
$\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

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

Your Answer

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

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