# Constructing a grid from a matrix

I would like to construct a grid from a matrix. For example, one possible matrix is $M1$.

$$M1= \begin{pmatrix} c2 & a1 & a1 & a1 & a1 & a1\\ a2 & b1 & c2 & a1 & a1 & a1\\ a2 & c2 & b2 & a1 & a1 & a1\\ b2 & b2 & c1 & b1 & c2 & a1\\ b2 & c1 & b1 & c2 & b2 & a1\\ a2 & b1 & b1 & a2 & a2 & c2\\ \end{pmatrix}$$

Each element $a1, a2, \dots, c2$ is represented graphically as the following: So I want to represent $M1$ as: Here, how an element, $c2$ fits in the grid is shown as an example.
Is this possible in Mathematica? Currently, I have no idea even where to begin. Any help will be appreciated!

• I see that you have already Accepted an answer but I hope you will give consideration to my code as well. I feel that it is ultimately a cleaner approach with less code duplication. – Mr.Wizard May 16 '15 at 6:47

You could define $a_1,a_2$,.. as graphic primitives (Line) and use Translate:

a1 = {Thickness[.01], Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]};
a2 = {Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]};
b1 = {Line[{{0, 0}, {1, 0}}], Thickness[.01], Line[{{1/2, -1/2}, {1/2, 1/2}}]};
b2 = {Line[{{1/2, -1/2}, {1/2, 1/2}}], Thickness[.01], Line[{{0, 0}, {1, 0}}]};
c1 = {Line[{{{1/2, 0}, {1, 0}}, {{1/2, 0}, {1/2, 1/2}}}],
Thickness[.01],
Line[{{{0, 0}, {1/2, 0}}, {{1/2, 0}, {1/2, -1/2}}}]};
c2 = {Line[{{{0, 0}, {1/2, 0}}, {{1/2, 0}, {1/2, -1/2}}}],
Thickness[.01],
Line[{{{1/2, 0}, {1, 0}}, {{1/2, 0}, {1/2, 1/2}}}]};

m =
{{c2, a1, a1, a1, a1, a1}, {a2, b1, c2, a1, a1, a1},
{a2, c2, b2, a1, a1, a1}, {b2, b2, c1, b1, c2, a1},
{b2, c1, b1, c2, b2, a1}, {a2, b1, b1, a2, a2, c2}};

Graphics[
MapIndexed[
Translate[#1, Reverse[#2]] &, Reverse[m], {2}]
] • beat me to it; +1 – Mr.Wizard May 16 '15 at 3:32

One way of doing that is create an image for each element and then use GraphicsGrid

With the definition about line of @halmir

a1 = {Thickness[.03], Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]};
a2 = {Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]};
b1 = {Line[{{0, 0}, {1, 0}}], Thickness[.03], Line[{{1/2, -1/2}, {1/2, 1/2}}]};
b2 = {Line[{{1/2, -1/2}, {1/2, 1/2}}], Thickness[.03], Line[{{0, 0}, {1, 0}}]};
c1 = {Line[{{{1/2, 0}, {1, 0}}, {{1/2, 0}, {1/2, 1/2}}}],
Thickness[.03],
Line[{{{0, 0}, {1/2, 0}}, {{1/2, 0}, {1/2, -1/2}}}]};
c2 = {Line[{{{0, 0}, {1/2, 0}}, {{1/2, 0}, {1/2, -1/2}}}],
Thickness[.03],
Line[{{{1/2, 0}, {1, 0}}, {{1/2, 0}, {1/2, 1/2}}}]};

imgs = Graphics /@ {a1, b1, c1, a2, b2, c2};
{a1, b1, c1, a2, b2, c2} =
ImageResize[#, {100, 100}] & /@ (ImageCrop[#] & /@ imgs) M1 =
{{c2, a1, a1, a1, a1, a1}, {a2, b1, c2, a1, a1, a1},
{a2, c2, b2, a1, a1, a1}, {b2, b2, c1, b1, c2, a1},
{b2, c1, b1, c2, b2, a1}, {a2, b1, b1, a2, a2, c2}};

GraphicsGrid[M1, Spacings -> {0, 0}] Or:

ImageAssemble[M1]


same result

• It would be great if you could make this code executable; you could insert the needed images into your post, then add code with Import to bring them into Mathematica. – Mr.Wizard May 16 '15 at 3:28
• @Mr.Wizard, I don't how to copy this code. when I do it returns a lot of things in low level coding because of the pictures – Algohi May 16 '15 at 3:30
• I know; you cannot simply copy it as-is. But perhaps what I was proposing is too much work. You still have my vote. – Mr.Wizard May 16 '15 at 3:31
• @Mr.Wizard, Please see my edit:-) – xyz May 16 '15 at 4:27

I like the existing answers, but I cannot resist posting my own formulation. I shall make use of the new-in-10.1 CirclePoints though I shall also provide an alternative without it.

First, here are Rules that specify the thickness of each radial line, counterclockwise from 3 o'clock:

rls =
{"a1" -> {3, 3, 3, 3}, "b1" -> {1, 3, 1, 3}, "c1" -> {1, 1, 3, 3},
"a2" -> {1, 1, 1, 1}, "b2" -> {3, 1, 3, 1}, "c2" -> {3, 3, 1, 1}};


And a function that takes a mark and a position:

fn[mk_, {r_, c_}] := Thread[{
AbsoluteThickness /@ (mk /. rls),
Line[{{c, -r}, #}] & /@ CirclePoints[{c, -r}, {1, 0}, 4]
}];


m =
{{"c2", "a1", "a1", "a1", "a1", "a1"},
{"a2", "b1", "c2", "a1", "a1", "a1"},
{"a2", "c2", "b2", "a1", "a1", "a1"},
{"b2", "b2", "c1", "b1", "c2", "a1"},
{"b2", "c1", "b1", "c2", "b2", "a1"},
{"a2", "b1", "b1", "a2", "a2", "c2"}};


The operation using MapIndexed:

MapIndexed[fn, m, {2}] // Graphics If you do not have CirclePoints simply use:

fn[mk_, {r_, c_}] :=
AbsoluteThickness /@ (mk /. rls),
Line[{{c, -r}, #}] & /@ {{1 + c, -r}, {c, 1 - r}, {c - 1, -r}, {c, -1 - r}}
}];


Here's a somewhat different approach:

With[{s = 101, (* resolution *) w = 2 (* thickness *)},
Block[{h = (s + 1)/2},
rules = {a1 -> Image[SparseArray[{{j_, k_} /;
h - w <= j <= h + w || h - w <= k <= h + w :> 0},
{s, s}, 1]],
a2 -> Image[SparseArray[{{j_, k_} /; j == h || k == h :> 0},
{s, s}, 1]],
b1 -> Image[SparseArray[{{j_, k_} /; j == h ||
h - w <= k <= h + w :> 0},
{s, s}, 1]],
b2 -> Image[SparseArray[{{j_, k_} /; h - w <= j <= h + w ||
k == h :> 0},
{s, s}, 1]],
c1 -> Image[SparseArray[{{j_, k_} /; (h - w <= j <= h + w &&
k < h) || (j == h && h <= k) ||
(j <= h && k == h) ||
(h < j && h - w <= k <= h + w) :> 0},
{s, s}, 1]],
c2 -> Image[SparseArray[{{j_, k_} /; (j == h && k < h) ||
(h - w <= j <= h + w && h <= k) ||
(j <= h && h - w <= k <= h + w) ||
(h < j && k == h) :> 0},
{s, s}, 1]]}]]


We can now do this:

ImageAssemble[{{c2, a1, a1, a1, a1, a1},
{a2, b1, c2, a1, a1, a1},
{a2, c2, b2, a1, a1, a1},
{b2, b2, c1, b1, c2, a1},
{b2, c1, b1, c2, b2, a1},
{a2, b1, b1, a2, a2, c2}} /. rules] 