Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I have six square matrices of the same dimensions in a list, for example:

n = 4; (*Matrix dimension*)
cubedata = Table[ConstantArray[i, {n, n}], {i, 1, 6}] (*Matrices 1 to 6*)

I would like to make a visualization of the cube that is formed when you put said matrices as its faces. This should be the orientation of the faces.

This should be the orientation of the faces

I want to see the numbers and, if possible, the cube colored (like a Rubik's cube).

I don't even know where to start. I think I should use Graphics3D but I'm not familiar with it, at all.

I would greatly appreciate it if you could help me.

share|improve this question

3 Answers 3

up vote 12 down vote accepted

So you need two thing. Six matrices and and a cube with each side painted with a matrix. In such wall painting Texture is the most handy option. Let me show an example.

n = 3; (*Matrix Dimension*)
color = {Red, Blue, Green, Yellow, Orange, White};
Table[mat[k] = 
  Grid[Table[RandomInteger[{1, n^2}], {i, 1, n}, {j, 1, n}], 
    Frame -> All, 
    ItemStyle -> Directive[FontSize -> 20, Bold], 
    Background -> Table[RandomChoice[color], {i, 1, n}, {j, 1, n}]],
  {k, 1, 6}];

You can choose your matrix and style as you wish. Now I am going to make a cube using Polygon and I will use these matrices as wallpaper.

vtc = {{0, 0}, {1, 0}, {1, 1}, {0, 1}}; (*VertexTextureCoordinates*)
coords = {{{0, 0, 0}, {0, 1, 0}, {1, 1, 0}, {1, 0, 0}}, 
         {{0, 0,0}, {1, 0, 0}, {1, 0,1},{0, 0, 1}}, 
         {{1, 0, 0}, {1, 1, 0}, {1,1, 1}, {1, 0, 1}}, 
         {{1, 1, 0}, {0, 1, 0}, {0, 1, 1},{1, 1,1}}, 
         {{0, 1, 0}, {0, 0, 0}, {0, 0, 1}, {0, 1, 1}}, 
         {{0, 0,1}, {1, 0, 1}, {1, 1, 1},{0, 1, 1}}};

Graphics3D[Table[{Texture[mat[k]],Polygon[coords[[k]], VertexTextureCoordinates -> vtc]},{k, 1, 6}], Boxed -> False]

Tada, your cube is served.

Answer for modified question

You just make the job simpler.

n = 3;(*Matrix Dimension*)
color = {Red, Blue, Green, Yellow, Orange, Black};
Table[mat[k] = Grid[Table[RandomInteger[{1, n^2}], {i, 1, n}, {j, 1, n}], ItemStyle ->     Table[{FontSize -> 20, Bold, RandomChoice[color]}, {i, 1, n}, {j,1, n}], Frame -> All], {k, 1, 6}];
(*For 2D visual*)   
Grid[{{, mat[6], ,}, {mat[4], mat[1], mat[2], mat[3]}, {, mat[5], ,}},Frame -> None, Spacings -> {0.1, 0.1}]
(*For 3D visual*)
Graphics3D[Table[{Texture[mat[k]],Polygon[coords[[k]], VertexTextureCoordinates -> vtc]},{k, 1, 6}], Boxed -> False]
(*use the same coords and vtc as before*)

This time instead of using Graphics3D with that large coordinate set, I'm simply using a Grid to create the output in a order you suggested.

Anyway I put both the outputs (just in case you want to play in higher dimension :) ).

cube

share|improve this answer
    
we must have posted a few seconds apart! –  cormullion Jun 25 '13 at 7:02
    
Thanks @cormullion. But your method is more elegant. And I overlook the colouring part. I'm going to fix that. –  Sumit Jun 25 '13 at 10:54
    
@cormullion and Sumit, none of You took care about "orientation of faces" which is described by OP. I do not want to spam another post so please, fix Your codes so they can be worth accepting and another upvotes :) –  Kuba Jun 25 '13 at 11:10
    
@kuba Yes, you're right. But we must leave something for the OP to do?! :) (And it might be a bit more difficult...) –  cormullion Jun 25 '13 at 11:20
    
Perhaps for the darker colors, Lighting->"Neutral" might enhance readability. –  Yves Klett Jun 25 '13 at 12:07

My first version had to be repaired because I didn't think about the orientation of the faces, and I cheated...

faces = First@Normal[PolyhedronData["Cube", "Faces"]];
grids = ImagePad[
     Rasterize[#, ImageSize -> 400],
     10,
     Padding -> White] & /@ Table[
    Grid[
     ConstantArray[i, {4, 4}],
     ItemStyle -> {Automatic, 
       Automatic, {{1, 1} -> Red, {3, 3} -> Green}}, 
     Background -> 
      RandomChoice[{LightRed, LightBlue, LightYellow, LightGreen}]],
    {i, {5, 1, 4, 3, 6, 2}}];
textures = MapThread[ImageRotate[#1, #2] &,
   { grids, {Right -> Top, 0, Left -> Top, Left -> Top, Right -> Left,
      Left -> Top}}];
cube = Graphics3D[
   Table[{Texture[textures[[n]]],
     faces[[n]]}, {n, 1, 6}],
   Lighting -> "Neutral",
   Background -> None,
   Boxed -> False,
   ViewPoint -> {2, -2, -1},
   ViewAngle -> .6,
   ViewVertical -> {0, 0, -1}] /. Polygon[l_] :>
   Polygon[l,
    VertexTextureCoordinates -> {{0, 0, 0}, {1, 0, 0}, {1, 1, 0}, 
     {0, 1, 0}}]

By the way, you'll find a complete Rubik's cube implementation on the Wolfram demonstration site.

cube

I don't think this page can afford any more animated spinning business, because Kuba has pursued that to a logical - if not absurd - conclusion. But, to check that the back face of the cube is correct, hold it up to a mirror:

cube 2

reflection = Graphics3D[
    Table[{Texture[textures[[n]]],
      faces[[n]]}, {n, 1, 6}],
    Lighting -> "Neutral",
    Background -> Gray,
    Boxed -> False, 
    ViewVertical -> {0, 0, -1},
    ViewAngle -> .8,
    ViewPoint -> {-1.5, 1.5, -1}] /. Polygon[l_] :>
    Polygon[l,
     VertexTextureCoordinates -> {{0, 0, 0}, {1, 0, 0}, {1, 1, 0}, 
       {0, 1, 0}}];
Show[
 ImageAdjust[
  ImagePad[
   Blur@ImageResize[
     ImageReflect[reflection, Right -> Left], 450],
   {{-30, -30}, {30, 30}}, 
   Padding -> Gray],
   {-.2, -.2}],
  Image[cube]
 ]

I'm starting to regret writing a quick answer to this question this morning... :)

share|improve this answer

Do not go further if You have epileptic-seizures/migraines related health problems.

I know You have meant what my followers showed but this is fun:

n = 6;
cubedata = Table[i + j + k, {k, 6}, {i, n}, {j, n}] ;
da = Table[{
             cubedata[[ k, i, j]], 
             Insert[1/(2 n) + {(i - 1)/n, (j - 1)/n}, If[OddQ@k, 0, 1], Ceiling[k/2]]
           }
         , {k, 6}, {i, n}, {j, n}];
Graphics3D[Text[Style[#1, Bold], Scaled[#2]] & @@@ Flatten[da, 2]]

.

.

.

.

.

.


enter image description here

And one clearer version:

cubedata = Table[i + j + k, {k, 6}, {i, n}, {j, n}] ;
da =Table[{cubedata[[ k, i, j]],Insert[1/(2 n) + {(i - 1)/n,(j - 1)/n},
           If[OddQ@k, 0, 1], 
           Ceiling[k/2]], k/6}, {k, 6}, {i, n}, {j, n}];
Graphics3D[{Orange, Cuboid[], 
Inset[Style[#1, Bold, 18, Hue@#3], Scaled[#2]] & @@@ Flatten[da, 2]}]

enter image description here

Notice the difference if Inset->Text. Then Text can be seen through walls :)

share|improve this answer
1  
my brain is hurting from that! :) –  cormullion Jun 25 '13 at 7:20
    
yup, you should post a warning on possible epileptic seizures and migraines. –  Yves Klett Jun 25 '13 at 10:25
    
I hope this does not come across as mocking of people with such problems - no intention of that! If it does, I´ll be happy to remove the comment. –  Yves Klett Jun 25 '13 at 10:48
1  
@YvesKlett I think it will not. In fact, I should have add this warrning while first posting. –  Kuba Jun 25 '13 at 10:57

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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