2
$\begingroup$

For example if n = 4,

row = {1,5,6,7}

Construct the matrix

 mat = {{1,5,6,7},{5,1,7,6},{6,7,1,5},{7,6,5,1}}

$\left( \begin{array}{cccc} 1 & 5 & 6 & 7 \\ 5 & 1 & 7 & 6 \\ 6 & 7 & 1 & 5 \\ 7 & 6 & 5 & 1 \\ \end{array} \right)$

Test for symmetry

mat == Transpose[mat] (* True *)

Test for persymmetry

mat == Reverse/@Transpose[Reverse/@mat] (* True *)

I need a method for arbitrary even n lengths.

Improve this question
$\endgroup$
3
  • 1
    $\begingroup$ Why this particular matrix mat when there are infinitely many that satisfy both of your equations and have the same first row? $\endgroup$
    – azerbajdzan
    Commented Nov 12 at 22:50
  • $\begingroup$ @azerbajdzan All rows must some permutation of the same values. $\endgroup$
    – Phillip Dukes
    Commented Nov 12 at 23:08
  • 1
    $\begingroup$ You did not mention it in your question. But even if it is permutation of the first row there are still few possibilities. $\endgroup$
    – azerbajdzan
    Commented Nov 13 at 7:45

3 Answers 3

Reset to default
4
$\begingroup$

Not as nice as @lericr's answer, but here's a version that avoids SubsetMap, and should work in 11.3

MakeSymAndPersym[list_] := 
 Module[{len, subMatrix, oneBlockRow, halfMat, indexMat},
   len = Length[list]/2;
   
   subMatrix = len*IdentityMatrix[len] - 1;
   oneBlockRow = Most /@ {-Reverse[subMatrix], subMatrix};
   
   halfMat = 
    Accumulate@
     ArrayFlatten[{List /@ Partition[Range[2 len], len], oneBlockRow}];
   indexMat = 
    ArrayFlatten[{{halfMat}, {Reverse /@ (Reverse@halfMat)}}];
   
   Map[Part[list, #] &, indexMat, {-1}]
   
   ] /; EvenQ[Length[list]]

This probably can still be optimized a lot.

Improve this answer
$\endgroup$
2
  • $\begingroup$ Perfect, thank you. $\endgroup$
    – Phillip Dukes
    Commented Nov 13 at 4:31
  • $\begingroup$ Your large n image result is very interesting! $\endgroup$
    – Phillip Dukes
    Commented Nov 13 at 4:33
4
$\begingroup$

This can probably be made more elegant:

MakeSymAndPersym[list_] :=
  With[
  {len = Length[list]/2},
  MapAt[Reverse, List /@ Range[-len, -1]]@*
  SubsetMap[Reverse, -len ;;]@*
  NestList[SubsetMap[RotateRight, -len ;;]@*SubsetMap[RotateLeft, ;; len], Length[list] - 1]@
   list] /; EvenQ[Length[list]]

MakeSymAndPersym[list]
(* {{1, 5, 6, 7}, 
    {5, 1, 7, 6}, 
    {6, 7, 1, 5}, 
    {7, 6, 5, 1}} *)

Update

I think this is compatible with version 11:

MakeSymAndPersym2[list_] :=
  With[
    {halfLength = Length[list]/2},
    With[
      {seed = TakeDrop[list, halfLength]},
      With[
        {quad1 = NestList[RotateLeft, seed[[1]], halfLength - 1],
         quad2 = NestList[RotateRight, seed[[-1]], halfLength - 1]},
        With[
          {quad3 = Map[Reverse, quad2, {0, 1}],
           quad4 = Map[Reverse, quad1, {0, 1}]},
          Flatten[{{quad1, quad2}, {quad3, quad4}}, {{1, 3}, {2, 4}}]]]]] /; EvenQ[Length[list]]
Improve this answer
$\endgroup$
4
  • $\begingroup$ I have Mathematica 11.3, I get the error "NestList::argrx: NestList called with 2 arguments; 3 arguments are expected." $\endgroup$
    – Phillip Dukes
    Commented Nov 13 at 0:30
  • $\begingroup$ Oh, and 11.3 does not know SubsetMap, can you provide a definition or an alternative, please? $\endgroup$
    – Phillip Dukes
    Commented Nov 13 at 0:40
  • $\begingroup$ Completely unrelated, but the image made by this using Range[n] for large n as the starting row looks really cool! (MakeSymAndPersym@Range[1000]) // Rescale // Image $\endgroup$
    – ydd
    Commented Nov 13 at 0:44
  • $\begingroup$ @PhillipDukes Please see update. $\endgroup$
    – lericr
    Commented Nov 13 at 5:15
1
$\begingroup$

Using GroupMultiplicationTable :

row = {1, 5, 6, 7};
len = Length@row;
perm = 
  Cycles@
   Apply[{RotateRight@Reverse@#, #2} &, Partition[Range@len, len/2]];
gmt = 
  GroupMultiplicationTable@
   PermutationGroup@
    {perm, PermutationCycles[Reverse@Range@len], InversePermutation@perm};
mat = Map[row[[#]] &, gmt, {2}] ;
mat // TeXForm

$ \left( \begin{array}{cccc} 1 & 5 & 6 & 7 \\ 5 & 1 & 7 & 6 \\ 6 & 7 & 1 & 5 \\ 7 & 6 & 5 & 1 \\ \end{array} \right) $

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.