DensityPlot with text
I don't think that a density plot is ideal for achieving the image above. I'd us a different approach in this case.
Let's start generating the data:
max = 50;
entries = RandomReal[{0, max}, {24, 7}];
dim = Dimensions@entries;
We can now create the final table:
head = {"", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday",
"Saturday", "Sunday"};
temp = Transpose[{Range[0, 23]}~Join~Transpose@entries];
table = Prepend[temp, head];
And we can assign a background color to each cell:
background =
Join[{Lighter@Blue, None},
{Flatten[Table[
{i, j} -> ColorData["WatermelonColors"][table[[i, j]]/max]
, {i, 2, 1 + dim[[1]]}, {j, 2, 1 + dim[[2]]}
], 1]}
];
of course, you can use any other color scheme other than WatermelonColors, or create a new one as described in other posts here.
Finally, let's generate the table (the frame settings are a bit verbose, but I couldn't find a more clever way to do it):
frame = {None,
None, {{{1, -1}, {1, -1}} -> True}~
Join~(({1, #} -> True) & /@ Range[8])~
Join~(({#, 1} -> True) & /@ Range[25])};
Grid[table, Frame -> frame, Background -> background,
ItemStyle -> {{Directive[White, Bold],
Automatic}, {Directive[White, Bold], Automatic}}]
Here is an approach similar to @Fraccalo's, but using Item
to specify the styles, and ArrayFlatten
to attach the headers. I usually find Item
to be more readable in cases like this, since the style is attached directly to each item and doesn't need to be matched up with several other matrices.
max = 50;
entries = RandomReal[{0, max}, {24, 7}];
dim = Dimensions@entries;
styledEntries = Map[
Item[#, Background -> ColorData["WatermelonColors"][#/max]] &,
entries,
{2}
];
head = {"", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"};
rowHead = Range[0, 23];
{styledHead, styledRowHead} = Map[
Item[#, Background -> Lighter@Blue, Frame -> True, BaseStyle -> Directive[White, Bold]] &,
{head, rowHead},
{2}
];
table = ArrayFlatten[{List /@ TakeDrop[styledHead, 1], {List /@ styledRowHead, styledEntries}}];
Grid[table]
As you can see, it is very apparent which style is applied to which item and how they are computed.
SeedRandom[1]
data = RandomReal[100, {24, 7}];
days = {"", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"};
MatrixPlot
An alternative approach using MatrixPlot
with labels added with the option Epilog
:
table = Prepend[MapIndexed[Prepend[#, ToString[#2[[1]] - 1]] &, data], days];
scaled = PadLeft[Rescale[data], 1 + Dimensions[data], Blue];
epilog = MapIndexed[Text[Style[# /. x_?NumericQ -> Round[x, 0.01], 12,
If[NumericQ[#] && .25 < Rescale[#, MinMax@data, {0, 1}] < .75, Black, White]], #2 - .5]&,
Reverse /@ Transpose@table, {2}];
mp = MatrixPlot[scaled,
ColorFunction -> "RedGreenSplit",
ColorFunctionScaling -> False,
ImageSize -> 1 -> {80, 20},
Mesh -> All,
Epilog -> epilog,
Frame -> False]
Add a legend:
legend = BarLegend[{"RedGreenSplit", MinMax @ data}, LegendMarkerSize -> {20, 400}];
Legended[mp, legend]
Use ColorFunction -> (Opacity[.5,ColorData["RedGreenSplit"]@#]&)
and change epilog
to
epilog = MapIndexed[Text[Style[# /. x_?NumericQ -> Round[x, 0.01], 12,
If[StringQ @ #, White, Black]], #2 - .5] &,
Reverse /@ Transpose@table, {2}];
to get
DensityHistogram + WeightedData
If it is ok to have row and column headers as plain text labels, you can also use DensityHistogram
after constructing a WeightedData
object from data
:
wd = WeightedData[Join @@ MapIndexed[Reverse@#2 &, data, {2}], Join @@ Reverse[data]];
{leftticks, topticks} = {MapIndexed[{#2[[1]],
Style[24 - #, 14, Bold, FontOpacity -> 1, FontColor -> Blue]} &, Range[24]],
MapIndexed[{#2[[1]] - 1,
Style[#, 14, Bold, FontOpacity -> 1, FontColor -> Blue]} &, days]};
Using a custom ChartElementFunction
assoc = AssociationThread[N@wd["InputData"], wd["Weights"]];
cEF = {ChartElementData["Rectangle"][##],
Text[Style[#, 12, If[.25 <= Rescale[#, MinMax@data, {0, 1}] <= .75, Black,
White]] & @ assoc[Mean @ Transpose[#]], Mean @ Transpose[#]]} &;
dp1 = DensityHistogram[wd, Reverse[Dimensions@data] - 1,
ColorFunction -> "RedGreenSplit",
FrameTicksStyle -> Directive["LineOpacity" -> 0],
FrameTicks -> {{leftticks, False}, {False, topticks}},
FrameStyle -> Directive["LineColor" -> White], Frame -> True,
BaseStyle -> EdgeForm[Gray],
PlotRangePadding -> Scaled[.01],
PlotRangeClipping -> False,
ImageSize -> 600,
ChartElementFunction -> cEF];
Legended[dp1, legend]
Post-processing DensityHistogram
output:
Alternatively, we can post-process DensityHistogram
output to replace tooltips with Text
labels:
dp2 = DensityHistogram[wd, Reverse[Dimensions@data] - 1,
ColorFunction -> "RedGreenSplit",
FrameTicksStyle -> Directive["LineOpacity" -> 0],
FrameTicks -> {{leftticks, False}, {False, topticks}},
FrameStyle -> Directive["LineColor" -> White], Frame -> True,
BaseStyle -> EdgeForm[Gray], PlotRangePadding -> Scaled[.01],
ImageSize -> 600];
labels = dp2 /. Tooltip[c_, t_, ___] :> Text[Style[Round[t, 0.01], 12,
If[.25 <= Rescale[t, MinMax @ data, {0, 1}] <= .75, Black, White]],
Cases[c, Rectangle[a_, b_, ___] :> (a + b)/2, All][[1]], {Center, Center}]
Legended[Show[dp2, labels], legend]