Create Magic Cubes, moon level ( 9x9) ?

[idon69111 (Sergiy Skorin)]

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

[trounev (Alexander Trounev)]

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

[idon69111 (Sergiy Skorin)]

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 …

[hmichel (Hans Michel)]

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]

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.

[trounev (Alexander Trounev)]

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$]]]\) }

[hmichel (Hans Michel)]

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.

[idon69111 (Sergiy Skorin)]

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

[hmichel (Hans Michel)]

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

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]

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

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

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

[idon69111 (Sergiy Skorin)]

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