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!

Improve this question
$\endgroup$
1
  • $\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, 2015 at 6:47

4 Answers 4

Reset to default
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

Improve this answer
$\endgroup$
1
  • $\begingroup$ beat me to it; +1 $\endgroup$
    – Mr.Wizard
    May 16, 2015 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

Improve this answer
$\endgroup$
4
  • $\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, 2015 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$
    – Basheer Algohi
    May 16, 2015 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, 2015 at 3:31
  • $\begingroup$ @Mr.Wizard, Please see my edit:-) $\endgroup$
    – xyz
    May 16, 2015 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}}
  }];
Improve this answer
$\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

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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