6
$\begingroup$

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: 6vertex

So I want to represent $M1$ as:

grid representation

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!

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Mr.Wizard May 16 '15 at 6:47
5
$\begingroup$

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}]
]

enter image description here

$\endgroup$
  • $\begingroup$ beat me to it; +1 $\endgroup$ – Mr.Wizard May 16 '15 at 3:32
4
$\begingroup$

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)

enter image description here

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}]

enter image description here

Or:

ImageAssemble[M1]

same result

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Mr.Wizard May 16 '15 at 3:28
  • $\begingroup$ @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 $\endgroup$ – Algohi May 16 '15 at 3:30
  • $\begingroup$ I know; you cannot simply copy it as-is. But perhaps what I was proposing is too much work. You still have my vote. $\endgroup$ – Mr.Wizard May 16 '15 at 3:31
  • $\begingroup$ @Mr.Wizard, Please see my edit:-) $\endgroup$ – xyz May 16 '15 at 4:27
4
$\begingroup$

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]
   }];

Your input:

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

the grid

If you do not have CirclePoints simply use:

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

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]

grid picture

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.