# How to draw a bar-in-bar chart using Mathematica? or align two bar/rectangle charts at the center of the bar rather than the left alignment?

I would like to create a bar-in-bar chart similar to the online example provided below.

I have attempted to create it using the "RectangleChart" function to generate two bars. However, when I combine the two bars, the "Show" function produces a result with incorrect positioning, as shown here. Could you please guide me on how to resolve this alignment issue?

• Please give us data to work with and include Mathematica code that you have tried so far.
– Syed
Sep 5, 2023 at 7:31
• @Syed Thanks for your comment. This is a toy example for illustration of the problem. The admin has gave me a viable solution. Thanks! Sep 5, 2023 at 9:25
• In that case, let me try with some fake data.
– Syed
Sep 5, 2023 at 9:27

SeedRandom[1];
alist = RandomInteger[{20000, 45 10^3}, 4];
blist = RandomInteger[{20000, 45 10^3}, 4];

legend = SwatchLegend[{
Opacity[1, Lighter@Red]
, Opacity[1, Blend[{Lighter@Cyan, Gray}]]}
, {"Profit 2016", "Profit 2017"}
, LegendLabel -> Style["Year", Bold, 12]
];

b1 = BarChart[{{2, 1, 3}, {1, 3, 2}}, BarOrigin -> Left,
Ticks -> None,
ChartStyle -> {Lighter@Red, Blend[{Lighter@Cyan, Gray}]
, Blend[{Lighter@Cyan, Gray}]}
, BarSpacing -> {0.2, 0.5}
, ImageSize -> 30
];

xlabel = Row[{"Profitability", "   ", b1}];

xTicks = Transpose@{Range[0, 45000, 5000],
Table[ToString@i <> "k", {i, 0, 45, 5}]};

Legended[
BarChart[
#1
, BarOrigin -> Left
, BarSpacing -> #2
, ChartStyle -> #3
, Axes -> {True, True}
, Ticks -> {True, None}
, ChartLabels -> #4
, PlotRangePadding -> 0.5
, GridLines -> {Range[0, 45000, 5000], None}
, GridLinesStyle -> {{Dotted, Gray}, None}
, Frame -> {{False, False}, {True, False}}
, FrameTicks -> {{None, None}, {xTicks, None}}
, FrameLabel -> #5
, ImageSize -> 500
, PlotRange -> {{-10000, 50000}, Automatic}
] &,
{{alist, blist}
, {0.4, 1.4}
, {Directive[EdgeForm[None], Opacity[1, Lighter@Red]]
, Directive[EdgeForm[None],
Opacity[1, Blend[{Lighter@Cyan, Gray}]]]
}
, {None,
Style[# <> "      ", Bold, Black, 12,
FontFamily -> "Calibri"] & /@ {"South", "Central", "East",
"West"}}
, {{None, xlabel}, None}
}
]
, Placed[legend, {0.9, 0.2}]
]


• Many thanks again for your solution. I'm trying to learn from both solutions. Many thanks again! Sep 5, 2023 at 9:56
• Finally, I notice the key of this problem. The Barchart function works automatically with a centered position when overlapping two plots. We can use barspacing to control the width of the bars. However, I tried to use the RectangleChart function to generate a bar-in-bar chart, but it doesn't support the automatically centered function. Sep 5, 2023 at 10:24
• Mathematica has more mystery locks than users have keys for. I learn new stuff everyday.
– Syed
Sep 5, 2023 at 10:26
SeedRandom[1];
data = RandomInteger[{5, 40}, {10, 2}];


First, a helper function to pre-process input data to add metadata to be used for scaling bar widths:

preProcess = Map[Thread[# -> 1/Range[Length@#]/2] &];


and a custom ChartElementFunction that modifies the box coordinates using attached metadata:

cEF[cedf_ : "Rectangle"] := ChartElementData[cedf][{#[[1]],
Mean[#[[2]]] + {-1, 1} #3[[1]]}, ##2] &;


We can then use BarChart with the options BarSpacing, BarOrigin and the custom function cEF as the setting for the option ChartElementFunction

BarChart[preProcess @ data,
BarSpacing -> {-1, .5},
BarOrigin -> Left,
ChartStyle -> {Lighter @ Red, Darker @ Cyan},
ChartElementFunction -> cEF[],
ChartLabels -> {ToUpperCase@Alphabet[], None},
ChartLegends ->
Placed[SwatchLegend[{"2021", "2022"},
LegendLabel -> Placed["legend:", Before], LegendLayout -> "Row"],
Above],
LabelStyle -> 14,
ImageSize -> 500]


Use ChartElementFunction -> cEF["GlassRectangle"] to get

Use ChartElementFunction -> cEF["ArrowRectangle"] to get

SeedRandom[1];
data2 = RandomInteger[{5, 40}, {4, 5}];

BarChart[preProcess @ data2,
BarSpacing -> {-1, .25},
BarOrigin -> Left,
ChartStyle -> "Rainbow",
ChartElementFunction -> cEF[],
ChartBaseStyle -> EdgeForm[],
ChartLabels -> {{"SOUTH", "CENTRAL", "EAST", "WEST"}, None},
ChartLegends ->
Placed[SwatchLegend[{"2019", "2020", "2021", "2022", "2023"},
LegendLabel -> Placed["legend:", Before],
LegendLayout -> "Row"], Above],
LabelStyle -> 14, ImageSize -> 500]


• Thanks again for your prompt response for my questions. The customized function works perfect for this issue. Thanks again kglr! Sep 5, 2023 at 9:30

We can also use a custom DisplayFunction that post-processes BarChart output to rescale rectangle groups:

centerRectangleGroups = Replace[#,
p : {{_Directive, _[_[_Rectangle, ___], ___]} ..} :>
MapIndexed[Scale[#, {1, 1/#2[[1]]}] &, p], All] &;


Examples:

SeedRandom[1];

data = RandomInteger[{5, 40}, {4, 2}];

chartstyle = {Lighter @ Red, Darker @ Cyan};

legendlabels = Range[2021, 2022];

options = {
DisplayFunction -> centerRectangleGroups,
BarSpacing -> {-1, .25},
BarOrigin -> Left,
ChartStyle -> chartstyle,
ChartBaseStyle -> EdgeForm[],
ChartLabels -> {{"SOUTH", "CENTRAL", "EAST", "WEST"}, None},
ChartLegends -> Placed[SwatchLegend[legendlabels,
LegendLabel -> Placed["Year:", Before], LegendLayout -> "Row"],
Above],
LabelStyle -> 14, ImageSize -> 500
};

BarChart[data, options]


Replace data = RandomInteger[{5, 40}, {4, 2}]; with data = RandomInteger[{5, 40}, {4, 5}];, chartstyle = {Lighter@Red, Darker@Cyan}; with chartstyle = "Rainbow" and legendlabels = Range[2021, 2022]; with legendlabels = Range[2019, 2023]; above to get