Message Boards Message Boards

0
|
7528 Views
|
8 Replies
|
4 Total Likes
View groups...
Share
Share this post:

Create Magic Cubes, moon level ( 9x9) ?

Posted 6 years ago

Magic cube 9x9 Hello Wolfram Comunity ! My name is Serg and im wondering how it could be possibly done ? Besides that by all horizontal, vertical and diagonal rows it gives 369, it also gives 1,6,2,7,3,8,4,9,5 if you add numbers in a cell which in one step gives sequence 1,2,3,4,5 and 6,7,8,9, + if you'll look at second number in any cell, you'll see that it creates a perfect pattern that is mirors from both sides like : 7,6,7,6,7,6,7,6,7 from left side and 5,6,5,6,5,6,5,6,5 from other, and in a whole picture you may see that it is sequesialy creates a wonderfull pattern from both sides with only 1,1,1,1,1,1,1,1,1 in the central row. Also if you'll look at second numbers at the top and the bottom, you'll find out intresting mirror pattern 7,8,9,0,1,2,3,4,5 which has some meaning for shure, plus at the bottom we could find out that the pattern is the same and it applies to all vertical rows, all second numbers are the same.

So, my question is : How it is possibly be done ?

Im learning math for years and realy don't understand the key of making such beautifull constructions like this one.

I got software like HypercubeGenerator, TesseractGenerator, CubeGenerator but it gives me the results so far from this miracle.

Could you plese help me to understand how it was done ?

Thank You a lot for you attention

Here is the cube itself in the attachment

POSTED BY: Sergiy Skorin
8 Replies

See Magic_square, Magic squares in occultism, Heinrich Cornelius Agrippa, Luna=369

Posted 6 years ago

All right, let's pretend that i could build any kind of magic square based on the given formulas on this wikipedia page or any books have been written on this topic, but even than it is impossible to buld magic square with all that nuances listed above. Find me the smartest guy on the planet, guru of magic square construction and he won't be able to construct the matrix like this or even close ...

POSTED BY: Sergiy Skorin

Please see here. There is a short piece of WL code that can be used to generate Odd magic squares using a modified De LaLoubere algorithm.

z = magicSquare[9, 1, 1, 0, 2, 6, 5]

enter image description here

I believe the rules to make this matrix are outlined in the link. Manually tested start at position 6,5 place "1" then 1 step to right and 1 step down place next number "2", repeat regular steps "3", and so on. If the position is previously filled return to last filled position and step right 0 and down 2 if not previously filled then enter next number in sequence. At that position return to regular steps 1 right 1 down. The boundaries just wrap around. (positive is right or down, negative is left or up) Please see this site for further research on this oddwheel If you take the Mod[list, 9] + 1 //MatrixForm you get a Latin Square.

POSTED BY: Hans Michel

Thank you Hans, it is quite effective.I just deleted commas and comments....

magicSquare[n_, ordx_, ordy_, breakx_, breaky_, i_, j_] := 
  Module[{magicMatrix = Table[0, {n}, {n}], x = i, y = j, counter = 1,
     nextox, nextoy, nextbx, nextby}, magicMatrix[[x, y]] = 1;
   While[counter < n^2, counter++;
    nextox = x + ordy;
    If[nextox < 1, nextox = n + nextox];
    If[nextox > n, nextox = Mod[nextox, n]];
    nextoy = y + ordx;
    If[nextoy < 1, nextoy = n + nextoy];
    If[nextoy > n, nextoy = Mod[nextoy, n]];
    If[magicMatrix[[nextox, nextoy]] == 0, x = nextox; y = nextoy;
     magicMatrix[[x, y]] = counter, nextbx = x + breaky;
     If[nextbx < 1, nextbx = n + nextbx];
     If[nextbx > n, nextbx = Mod[nextbx, n]];
     nextby = y + breakx;
     If[nextby < 1, nextby = n + nextby];
     If[nextby > n, nextby = Mod[nextby, n]];
     If[magicMatrix[[nextbx, nextby]] == 0, x = nextbx;
      y = nextby;
      magicMatrix[[x, y]] = counter]]]; 
   Return[MatrixForm[magicMatrix]];];
In[4]:= z = magicSquare[9, 1, 1, 0, 2, 6, 5] // AbsoluteTiming

Out[4]= {0.000499306,\!\(
TagBox[
RowBox[{"(", "", GridBox[{
{"37", "78", "29", "70", "21", "62", "13", "54", "5"},
{"6", "38", "79", "30", "71", "22", "63", "14", "46"},
{"47", "7", "39", "80", "31", "72", "23", "55", "15"},
{"16", "48", "8", "40", "81", "32", "64", "24", "56"},
{"57", "17", "49", "9", "41", "73", "33", "65", "25"},
{"26", "58", "18", "50", "1", "42", "74", "34", "66"},
{"67", "27", "59", "10", "51", "2", "43", "75", "35"},
{"36", "68", "19", "60", "11", "52", "3", "44", "76"},
{"77", "28", "69", "20", "61", "12", "53", "4", "45"}
},
GridBoxAlignment->{
      "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, 
       "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
GridBoxSpacings->{"Columns" -> {
Offset[0.27999999999999997`], {
Offset[0.7]}, 
Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {
Offset[0.2], {
Offset[0.4]}, 
Offset[0.2]}, "RowsIndexed" -> {}}], "", ")"}],
Function[BoxForm`e$, 
MatrixForm[BoxForm`e$]]]\) }

Alexander Trounev:

Thanks for thinking this is effective (code?). As I wrote this code ~28 years ago in an early version of Mathematica and translated from a Pascal college computer science class assignment I wrote -- I consider as Ed Pegg calls some code "Bad but short..." It isn't just the style "commas and comments" I believe that the code could be shorter and possibly use SparseArrays. Even though this code works well for odd squares, I recall using it or some modification to find all 880 4X4 magic squares. As much as I like recreational math, I did not want to go down the rabbit whole of magic squares, so I have not modified this code much. Here is another piece of code "Bad but short.." that will generate Latin square order 3,4,... But I would not go above order 4 as depending on memory and amount of time one has it quickly blows up.

LatinSquare[n_Integer?Positive] := Module[{s, ss},
   s = Table[j, {i, 1, n}, {j, 1, n}];
   ss = Table[{}, {i, 1, n}];
   Choose[ro_, cl_] := Module[{e1, e2, i},
        e1 = s[[ro, cl]];
        For[i = cl, i <= n, i++,
         e2 = s[[ro, i]];
         If[ ! MemberQ[ss[[cl]], e2],
               s[[ro, cl]] = e2; s[[ro, i]] = e1; AppendTo[ss[[cl]], e2];
                 If[cl != n, Choose[ro, cl + 1],
                      If[ro != n, Choose[ro + 1, 1], Print[MatrixForm[s]] ];
                    ];
               s[[ro, i]] = e2; ss[[cl]] = DeleteCases[ss[[cl]], e2];
              ]; 
            ]; 
        s[[ro, cl]] = e1;
     ];
   Choose[1, 1];
   ];

Code is a translation from JS Rohl. Recursion via Pascal. Cambridge Computer Science Text 19. Cambridge University Press, Cambridge; 1984:162--165. Again for another computer science class taken ~28 years ago, same professor.

Fell free to improve these codes to more modern standards hopefully better WL code.

POSTED BY: Hans Michel
Posted 6 years ago

Thank you for explanation. Could you please try to generate somethings like this but with another numbers ?

POSTED BY: Sergiy Skorin

Still using the code from above, we borrow a magic matrix tester from here

magicQ[mat_?MatrixQ] /; Equal @@ Dimensions@mat := 
 Module[{n = Length@mat, row, col, diagonal}, row = Total[mat, {2}]; 
  col = Total[mat, {1}]; diagonal = {Tr@mat, Tr@Transpose@mat}; 
  Union[row, col, diagonal] == {(n^3 + n)/2}]

The following are 3 order 9 magic squares

Row[{   magicSquare[9, 1, -1, -1, 0, 2, 3], 
    magicSquare[9, 2, -1, 1, 0, 2, 1],
    magicSquare[9, -2, 1, 0, 2, 3, 2]}]

enter image description here

So we can test

{magicQ[First[magicSquare[9, 1, -1, -1, 0, 2, 3]]],
magicQ[First[magicSquare[9, 2, -1, 1, 0, 2, 1]]],
magicQ[First[magicSquare[9, -2, 1, 0, 2, 3, 2]]]}
(* {True, True, True} *)

A good pull-out quote from this article quoting Pickover regarding seeking the "holy grail" of generating magic squares. The code here is not the "holy grail" of magic square generation.

The magic square I originally wrote the code for is

magicSquare[5, 1, 2, 0, -1, 1, 3]

enter image description here

I would not begin to start to explore that space for 9X9 the parameters are -9,9 for parameter {2,3,4,5} and 1,9 for parameter {6,7}.

The same algorithm can be extended to solve for example the method from here:

z = magicSquare[3, 1, 2, 0, 1, 1, 2];
(First[z]  - 1) // MatrixForm

enter image description here

Partition[Map[Plus[(First[z]  - 1), #] &, (Flatten[(First[z] - 1)]*9)], 3] // MatrixForm

enter image description here

I believe you can explore these areas yourself. Currently, I don't wish to go down that rabbit hole .

POSTED BY: Hans Michel
Posted 6 years ago

Thanks a lot ! I got what i was looking for ...

POSTED BY: Sergiy Skorin
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract