2
$\begingroup$

I have a list of numbers and a matching list of labels. I want to plot a column of colored squares, with the color of each square matching (in some color scale) the value of the corresponding number. Moreover, each square should have its corresponding label printed on the side (left or right).

I also want to plot a row instead of a column. In this case, the labels should be printed above or below the row, and the text should be 90º degrees rotated.

How can I do this?

Improve this question
$\endgroup$
2
  • $\begingroup$ You can use Grid in both cases. In order to rotate the text you can use Rotate as in Rotate["Text", Pi/2]. For colors you can scale your number from zero to one and use Graphics[{ColorData["Rainbow"]@number,Rectangle[]}]. $\endgroup$
    – C. E.
    Aug 27, 2014 at 20:16
  • $\begingroup$ @Pickett I tried what you said. It works, but it is very ugly. The squares are too large, and I can't eliminate the white space between one square and the next. There are many graphics related options that I don't know very well. Can someone post a complete answer? $\endgroup$
    – a06e
    Aug 27, 2014 at 20:46

4 Answers 4

Reset to default
5
$\begingroup$

My answer is based upon Öska's answer here. Credits go to him.

A simple example:

legend = {"a", "b", "c"};
values = Range@3;

MatrixPlot[List /@ values,
 ColorFunction -> "DarkRainbow",
 FrameTicks -> {{True , Thread[{values, legend}]}, {False , False }}]

enter image description here

MatrixPlot[{values},
 FrameTicks -> {{False , False}, {True , Thread[{values, legend}]}}]

enter image description here

Update 1

Rotated labels:

values = Range[30];
legend = Map[Rotate[#, Pi/2] &, "Box " <> # & /@ ToString /@ values];

MatrixPlot[{values},
 FrameTicks -> {{False, False}, {True, Thread[{values, legend}]}},
 ColorFunction -> "Rainbow",
 Mesh -> All,
 ImageSize -> 600]

enter image description here

Update 2

Based upon Becko's comment:

(a) You can control the size of the legend bar by replacing it with an ArrayPlot

(b) You can control the size of the squares by varying AspectRatio and ImageSize

For example:

p1 =
  ArrayPlot[{dat},
   FrameTicks -> {{False, False}, {Thread[{Range@Length@labels, Rotate[#, Pi/2] & /@ labels}], False}},
   Frame -> {{False, False}, {True, False}},
   PlotRangePadding -> None,
   AspectRatio -> 0.25,
   ImageSize -> 200];

p2 =
 ArrayPlot[{Range[Min[dat], Max[dat]]},
  AspectRatio -> 1/10,
  FrameTicks -> {{False, False}, {True, False}},
  ImageSize -> 200];

Grid[{{p1}, {p2}}]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ The squares are too large. My list of numbers has about 100 elements, so I need small squares. Also, in your horizontal plot, the labels should be rotated. $\endgroup$
    – a06e
    Aug 28, 2014 at 13:15
  • $\begingroup$ @becko see update $\endgroup$
    – eldo
    Aug 28, 2014 at 17:01
2
$\begingroup$

Here's another example.

horizontal[pairs_] := Grid[pairs]
vertical[pairs_] := Grid[MapAt[Rotate[#, Pi/2] &, Transpose@pairs, {2, All}]]


SwatchLegend[{Red, Green, Blue}, {"red", "green", "blue"}, LegendLayout -> horizontal]
SwatchLegend[{Red, Green, Blue}, {"red", "green", "blue"}, LegendLayout -> vertical]

Example 1

Example 2

Example of my first suggestion, in the comment:

colors = Table[ImageCrop@Graphics[{ColorData["Rainbow"]@RandomReal[], Rectangle[]}, ImageSize -> {16, 16}], {10}];
labels = Range[10];
Grid[
 Transpose[{colors, labels}],
 Spacings -> {1, 0}
 ]

enter image description here

Improve this answer
$\endgroup$
3
  • $\begingroup$ I like this, but how can I remove the spacing between elements? The squares should be adjacent. $\endgroup$
    – a06e
    Aug 28, 2014 at 13:15
  • $\begingroup$ @becko I would prefer to do this the way I suggested at first. I suspect you haven't played with it enough to give it a fair chance. I also have to tell you that I am not happy with how you wrote this question, it was very much "give me tha codez" and the description was so vague it's impossible to say what you are looking for. You should have drawn a picture, and you should have attempted to do it yourself first and your attempt should have been a part of the question. I'm saying this not to be rude but as feedback so that you can write better questions in the future. $\endgroup$
    – C. E.
    Aug 28, 2014 at 15:43
  • 1
    $\begingroup$ That's ok. I attempted to do it myself at first, but it was too ugly and I thought it wasn't worth it to add it to the question. Now, in part thanks to ideas in the answers here, I have a better code that better displays what I want. I'm posting an answer with my latest code. I will not accept my own answer, but leave it there so that what I want is better understood. $\endgroup$
    – a06e
    Aug 28, 2014 at 18:07
2
$\begingroup$

I have something like this in mind: I am posting this answer so that others can see what I have done. I have no intention of accepting this. Surely others will come up with better ideas.

dat = {1, 4, 3, 7, 8, 9, 10};
labels = {"john", "mary", "rusty", "pi", "euler", "leonard", "rupert"};

ArrayPlot[{dat}, 
  FrameTicks -> {{False, False}, {Thread[{Range@Length@labels, 
    Rotate[#, Pi/2] & /@ labels}], False}}, 
  Frame -> {{False, False}, {True, False}}, 
  PlotRangePadding -> None, 
  PlotLegends -> Placed[Automatic, Below]]����

enter image description here

Improve this answer
$\endgroup$
6
  • 1
    $\begingroup$ I got a flag that this is "not an answer"... I understand that you did not intend for it to be one and I agree that it's good to share your incomplete progress/thoughts so far if it'll be of help to others. So, how about making it an edit to the question? :) $\endgroup$
    – rm -rf ♦
    Aug 28, 2014 at 20:22
  • $\begingroup$ @becko Maybe you should delete your question before misusing our time. But yes ! Please accept your own answer :) $\endgroup$
    – eldo
    Aug 28, 2014 at 20:22
  • $\begingroup$ @rm-rf sure. I'll edit it into the question. But tomorrow, now I have to go home. $\endgroup$
    – a06e
    Aug 28, 2014 at 20:27
  • 2
    $\begingroup$ @eldo I hope I didn't misuse your time. All I wanted was to show what I wanted to get. I'm not satisfied with my own approach yet, I think it is still ugly. Your answer was very helpful to me. In fact, what I had before reading the answers here was even worse, that's why I didn't post it. :) $\endgroup$
    – a06e
    Aug 28, 2014 at 20:29
  • $\begingroup$ @becko I don't feel that your solution is "ugly". Why should it be so ??? $\endgroup$
    – eldo
    Aug 28, 2014 at 20:39
1
$\begingroup$

Using ConstantImage:

SeedRandom[1];
n = 10;
labels = StringJoin@Riffle[Characters@#, "\[ThinSpace]"] & /@ 
   RandomWord["Noun", n];
nums = RandomReal[{1, 10}, n];

Transpose[{ConstantImage[
      ColorData["Rainbow"][Rescale[#, MinMax[nums]]], {40, 40}] & /@ 
    nums , labels}] // 
 Grid[#, Alignment -> Left, Spacings -> {1, 0}] &

enter image description here

{ConstantImage[
     ColorData["Rainbow"][Rescale[#, MinMax[nums]]], {40, 40}] & /@ 
   nums, Rotate[#, -π/2] & /@ labels} // 
 Grid[#, Alignment -> Top, Spacings -> {0, 1}] &

enter image description here

Improve this answer
$\endgroup$

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.