How to make a circular heat map or diagram in Mathematica?

Is there any way to make a circular heat map in Mathematica?

Here is a toy example for regular heat map. Can anyone help me make it to a circular one?

data1={{9., 1., 6., 7., 6., 3., 1., 3., 10., 2., 2., 5., 2., 5., 3.,
1.}, {5., 5., 5., 4., 4., 6., 4., 6., 9., 1., 2., 10., 2., 1., 1.,
6.}, {2., 7., 6., 2., 8., 10., 8., 9., 2., 5., 3., 9., 7., 8., 7.,
5.}, {6., 6., 2., 1., 8., 2., 8., 3., 8., 5., 5., 4., 6., 2., 3.,
6.}, {8., 1., 8., 2., 5., 8., 5., 3., 5., 3., 4., 2., 2., 4., 4.,
1.}, {10., 2., 8., 10., 3., 6., 1., 9., 3., 5., 2., 5., 1., 3., 7.,
9.}};

ArrayPlot[data1, ColorFunction -> ColorData["LightTerrain"],
Frame -> True,
FrameTicks -> {{{{1, "r1"}, {2, "r2"}, {3, "r3"}, {4, "r4"}, {5,
"r5"}, {6, "r6"}}, None},
{None, {{1, "c1"}, {2, "c2"}, {3, "c3"}, {4, "c4"}, {5, "c5"}, {6,
"c6"}, {7, "c7"}, {8, "c8"}, {9, "c9"}, {10, "c10"}, {11,
"c11"}, {12, "c12"}, {13, "c13"}, {14, "c14"}, {15, "c15"}, {16,
"c16"}}}},
Epilog -> {Text["Sector1", {2, 8}], Text["Sector2", {6, 8}],
Text["Sector3", {10, 8}], Text["Sector4", {14, 8}]},
ImagePadding -> {{20, 20}, {20, 80}}, ImageSize -> Large]


I want to make a circular diagram like the following one.

Is it possible to make a one like this?

Thanks a lot!

• somewhat related: Pie Chart Annulus generation
– kglr
Mar 25, 2021 at 6:22
• @kglr Hi kglr, is there any way to plot the dendrogram shown in the 1st circular diagram example for illustrating the seven categories? The example looks very neat. I don't know how to make a similar one in Mathematica. Thanks again for your guidance. Apr 1, 2021 at 16:20
• Hi Frankie. I was afraid that question was coming:) It can be done using a custom ChartElementFunction. I will update my answer if I come up with a clean way to do it.
– kglr
Apr 1, 2021 at 16:28
• @kglr Hi kglr, thank you very much for your quick reply and look forward to your kind help! Apr 2, 2021 at 15:37

A more flexible approach: Pre-process input data to construct a data set for SectorChart. To inject an angular gap in the chart, we add a last column to input data and assign to it {}& as the ChartElementFunction (so that it is not rendered). The size of the gap is controlled by the second argument of the function preProcessData.

ClearAll[preProcessData, circularLegend, labelingFunction]

preProcessData[data_, gap_: Automatic, clr_: "Rainbow"] :=
Module[{del = gap /. Automatic -> 1/16,
slices = ConstantArray[1/#[[2]], #] & @ Dimensions[data]},
Append[del -> {Null, 0}] /@
{Rescale[slices, {0, 1}, {0, 1 - del}], Rescale @ data, data}] /.
Rule[a_, {b1_, b2_}] :> Style[Labeled[{a, 1}, b2, Tooltip], ColorData[clr] @ b1]]

circularLegend[min_, max_, colorscheme_: "Rainbow"] :=
AngularGauge[min, {min, max}, ScaleOrigin -> {{Pi/2, 2 Pi}, 1.1},
ScaleRanges -> ({#, .3} & /@ Partition[Subdivide[min, max, 50], 2, 1]),
"TickSide" -> Left, "LabelSide" -> Left,
"TickLength" -> {Scaled[.04], Scaled[0.02]},
TicksStyle -> FontSize -> Scaled[.07], GaugeMarkers -> None,
ScaleRangeStyle -> colorscheme, GaugeFrameStyle -> None]

labelingFunction[nrows_, collabels_] := If[#2[[1]] == nrows,
Placed[collabels[[#2[[2]]]], {1/2, 1.1}]] &


Examples:

columnlabels = Append[Style["c" <> ToString@#, 14] & /@
Range[Last@Dimensions[data1]], ""];

rowlabels = Style[2010 + #, 16] & /@ Range[First @ Dimensions @ data1];

gap = 1/16;

SectorChart[preProcessData[data1],
SectorOrigin -> {{Pi/2 + gap Pi, "Counterclockwise"}, radialorigin},
ChartBaseStyle -> Directive[EdgeForm[{Opacity[1], White}]],
LabelingFunction -> labelingFunction[First@Dimensions@data1, columnlabels],
ChartElementFunction -> Append[ConstantArray["Sector", Length@First@data1], {} &],
ChartLegends -> Placed[circularLegend[Min@data1, Max@data1], Center],
ImageSize -> 700, SectorSpacing -> {0, 0},
Epilog -> {Text[Style["Legend", Black, 16], {0, 0}],
MapIndexed[Text[#, {0, radialorigin - 1/2 + #2[[1]]}] &, rowlabels]}]


Use preProcessData[data1, gap, "LightTerrain"] and circularLegend[Min@data1, Max@data1, "LightTerrain"] to get

To have a gap in the positive quadrant, use

SectorChart[preProcessData[data1, 1/4, "LightTerrain"],
ChartBaseStyle -> Directive[EdgeForm[{Opacity[1], White}]],
LabelingFunction -> labelingFunction[First@Dimensions@data1, columnlabels],
ChartElementFunction -> Append[ConstantArray["Sector", Length@First@data1], {} &],
ChartLegends -> Placed[circularLegend[Min@data1, Max@data1,  "LightTerrain"],  Center],
ImageSize -> 700, SectorSpacing -> {0, 0},
Epilog -> {Text[Style["Legend", Black, 16], {0, 0}],
MapIndexed[Text[#, Offset[{30, 0}, {0, radialorigin - 1/2 + #2[[1]]}]] &,
rowlabels]}]


Using other built-in ChartElementFunctions:

Multicolumn[SectorChart[preProcessData[data1, 1/4],
ChartBaseStyle -> Directive[EdgeForm[{Opacity[1], White}]],
LabelingFunction -> labelingFunction[First@Dimensions@data1, columnlabels],
ChartElementFunction ->
Append[ConstantArray[
ChartElementDataFunction[#, "AngularFrequency" -> 50,
"RadialAmplitude" -> 0.2], Length@First@data1], {} &],
ImageSize -> Medium, SectorSpacing -> {0, 0},
Epilog -> {Text[Style[#, 16], {0, 0}, {-1, -3}],
MapIndexed[Text[#, Offset[{30, 0}, {0, radialorigin - 1/2 + #2[[1]]}]] &,
rowlabels]}] & /@
{"TriangleWaveSector", "SquareWaveSector", "OscillatingSector", "NoiseSector"}, 2]


Multiple data sets:

SeedRandom[1]
data2 = RandomReal[{25, 100}, {8, Last@Dimensions@data1}];
data3 = RandomInteger[{10, 30}, {4, Last@Dimensions@data1}];

{rowlabels1, rowlabels2, rowlabels3} = Style[2010 + #, 16] & /@
Range[First@Dimensions@#] & /@ {data1, data2, data3};

colors = {"LightTerrain", "Rainbow", "SolarColors"};

SectorChart[preProcessData[#, 1/4, #2],
SectorOrigin -> {{Pi/2, "Counterclockwise"}, #3},
ChartBaseStyle -> Directive[EdgeForm[{Opacity[1], White}]],
LabelingFunction -> #4,
ChartElementFunction -> Append[ConstantArray["Sector", Length@First@#], {} &],
ImageSize -> 1 -> 15, SectorSpacing -> {0, 0}] &,
{None, None, labelingFunction[First @ Dimensions @ data3, columnlabels]}}];

legends = MapThread[Inset[circularLegend[Min @ #, Max @ #,  #2],
{radialorigin + First[Dimensions @ data1]/2, #3 +
First[Dimensions @ #]/2}, Center, Scaled[{.12, .12}]] &,


Combine the three charts using Show and add legends as Epilog:

Show[charts,
Epilog -> {legends,
{0, # - 1/2 + y[[1]]}]]], #2] &,
MapThread[Text[#2, Offset[{0, 20}, {#, 0}]] &,
{radialorigins + (Dimensions[#][[1]]/2 & /@ {data1, data2, data3}),
Style["group " <> ToString@#, 16] & /@ Range[3]}]},
PlotRange -> All]


ClearAll[barLegendRow]
barLegendRow = BarLegend[{#2, #}, LegendLabel -> #3, LegendLayout -> "Row",
LegendMarkerSize -> {250, 30}] &;

{MinMax /@ {data1, data2, data3}, colors,
Style["group " <> ToString@#, 14] & /@ Range[3]}];

First[Dimensions@#]/2}, {-1, 0}, Scaled[{1, 1}]] &,

Show[charts,
Epilog -> {legends2,
Text[x, Offset[{30, 0}, {0, # - 1/2 + y[[1]]}]]], #2] &,
MapThread[Text[#2, Offset[{0, 20}, {#, 0}]] &,
{radialorigins + (Dimensions[#][[1]]/2 & /@ {data1, data2, data3}),
Style["group " <> ToString@#, 16] & /@ Range[3]}]},
PlotRange -> All]


ClearAll[histogramLegend]
histogramLegend = SmoothHistogram[Flatten@#, MaxExtraBandwidths -> 0,
PlotRange -> {MinMax @ #, Automatic}, PlotLabel -> #3,
ColorFunction -> Function[{x, y}, ColorData[#2][x]],
Filling -> Axis, Axes -> {True, False}, AspectRatio -> 1/8,
PlotStyle -> LineOpacity -> 0] &;

{{data1, data2, data3}, colors,
Style["group " <> ToString @ #, 14] & /@ Range[3]}];

First[Dimensions@#]/2}, Left, Scaled[{.3, .2}]] &,

Show[charts,
Epilog -> {legends3,
Text[x, Offset[{30, 0}, {0, # - 1/2 + y[[1]]}]]], #2] &,
MapThread[Text[#2, Offset[{0, 20}, {#, 0}]] &,
{radialorigins + (Dimensions[#][[1]]/2 & /@ {data1, data2, data3}),
Style["group " <> ToString@#, 16] & /@ Range[3]}]},
PlotRange -> All]


• Impressive work! should be submitted as a ResourceFunction. Mar 25, 2021 at 22:27
• @sunt05 I agree. Many of kglr's MSE posts could become fine WFR entries. Mar 26, 2021 at 6:41
• Thanks for your kind help! Really appreciate! Mar 26, 2021 at 12:02
• @sunt05 I agree too. Many of kglr's quick responses are far more useful than the online manual of Mathematica. I really appreciate kglr's contribution to the community! Mar 26, 2021 at 12:07
• @sunt05, anton, Frankie, thank you for the kind words. This is a great question. A ResourceFunction is a great idea. I will look into it. Given so many moving parts (input data structure with possibly many layers, layout/labeling/legending choices) it looks like a non-trivial task to put together something clean and robust .
– kglr
Mar 26, 2021 at 20:00

For starters:

ClearAll[styledData]

styledData[data_, sectorlengths_, colorscheme_: "LightTerrain"] :=
Fold[Function[{x, y}, Insert[#, .1 -> White, y] & /@ x],
Map[Tooltip[1, #] -> ColorData[colorscheme][Rescale[#, MinMax@data, {0, 1}]] &,
data, {-1}], 1 + Reverse @ Most @ Accumulate @ sectorlengths];

sectorlengths = {3, 4, 5, 4};

styleddata1 = styledData[data1, sectorlengths];

PieChart[MapIndexed[Labeled[#, Rotate[Style[Row[{"row ", #2[[1]]}], 16], -90 Degree],
{{1/2, 1/2}, {.5, -1/5}}] &, styleddata1],
SectorOrigin -> {Automatic, 5},
ChartElementFunction ->
(ChartElementData["Sector"][{Rescale[#[[1]],
{-Pi, Pi}, {Pi/2, 2 Pi}], #[[2]]}, ##2] &),
ChartLegends -> Placed[BarLegend[{ColorData["LightTerrain"], MinMax @ data1},
LegendMarkerSize -> {30, 200}], {.8, .75}],
ImageSize -> Large]


Use

ChartLegends -> Placed[BarLegend[{ColorData["LightTerrain"], MinMax@data1},
LegendLayout -> "Row", LegendMarkerSize -> {200, 30}], {.8, .8}]


to get

• Thank you very much for your kind help and quick reply! I really appreciate your great contribution to the freshman's community! Mar 26, 2021 at 12:10