Construa a seguinte matriz simétrica

Sep 24 2020

Minha mente está um pouco confusa e não consigo identificar o padrão aqui que me permitirá escrever um pedaço de código elegante para construir a seguinte matriz simétrica para um determinado tamanho n:

Por exemplo, se n=5:

{{0,    f[1],  f[6], f[9], f[5] }, 
 {f[1], 0,     f[2], f[7], f[10]},
 {f[6], f[2],  0,    f[3], f[8] }, 
 {f[9], f[7],  f[3], 0,    f[4] },
 {f[5], f[10], f[8], f[4], 0    }}

E se n=9,

{{0,     f[1],  f[10], f[19], f[28], f[33], f[25], f[17], f[9] },
 {f[1],  0,     f[2],  f[11], f[20], f[29], f[34], f[26], f[18]}, 
 {f[10], f[2],  0,     f[3],  f[12], f[21], f[30], f[35], f[27]}, 
 {f[19], f[11], f[3],  0,     f[4],  f[13], f[22], f[31], f[36]}, 
 {f[28], f[20], f[12], f[4],  0,     f[5],  f[14], f[23], f[32]}, 
 {f[33], f[29], f[21], f[13], f[5],  0,     f[6],  f[15], f[24]}, 
 {f[25], f[34], f[30], f[22], f[14], f[6],  0,     f[7],  f[16]}, 
 {f[17], f[26], f[35], f[31], f[23], f[15], f[7],  0,     f[8] }, 
 {f[9],  f[18], f[27], f[36], f[32], f[24], f[16], f[8],  0    }}

Você vê o padrão? A diagonal principal é zero. Em seguida, a diagonal secundária é preenchida em ordem, seguida pelo canto superior direito. Em seguida, a sub-sub-diagonal principal é preenchida, seguida pela sub-diagonal superior direita e assim por diante ...

Respostas

4 J.M.'sennui Sep 24 2020 at 07:39

Aqui está minha modesta tentativa:

qdMat[n_Integer?Positive] := Module[{id, mm},
  id = Riffle @@ Reverse[MapAt[Reverse, TakeDrop[Range[n - 1], Quotient[n - 1, 2]], -1]];
  mm = TakeList[Array[f, Binomial[n, 2]], id][[InversePermutation[id]]];
  mm = PadRight[PadLeft[Reverse[Flatten[mm, {{2}, {1}}], 2], {Automatic, n}], {n, n}];
  mm + Transpose[mm]]

Por exemplo,

qdMat[6]
   {{0, f[1], f[7], f[13], f[11], f[6]},
    {f[1], 0, f[2], f[8], f[14], f[12]},
    {f[7], f[2], 0, f[3], f[9], f[15]},
    {f[13], f[8], f[3], 0, f[4], f[10]},
    {f[11], f[14], f[9], f[4], 0, f[5]},
    {f[6], f[12], f[15], f[10], f[5], 0}}

qdMat[9]
   {{0, f[1], f[10], f[19], f[28], f[33], f[25], f[17], f[9]},
    {f[1], 0, f[2], f[11], f[20], f[29], f[34], f[26], f[18]},
    {f[10], f[2], 0, f[3], f[12], f[21], f[30], f[35], f[27]},
    {f[19], f[11], f[3], 0, f[4], f[13], f[22], f[31], f[36]},
    {f[28], f[20], f[12], f[4], 0, f[5], f[14], f[23], f[32]},
    {f[33], f[29], f[21], f[13], f[5], 0, f[6], f[15], f[24]},
    {f[25], f[34], f[30], f[22], f[14], f[6], 0, f[7], f[16]},
    {f[17], f[26], f[35], f[31], f[23], f[15], f[7], 0, f[8]},
    {f[9], f[18], f[27], f[36], f[32], f[24], f[16], f[8], 0}}
4 kglr Sep 24 2020 at 07:02

Se determinarmos os elementos na primeira linha, as linhas restantes serão obtidas por simples rotação + preenchimento e adicionando 1 à linha anterior girada / preenchida:

ClearAll[firstRow, rotatePad, spiralMat]

firstRow = Module[{rng = Range[0, Floor[(# - 1)/2]]}, 
    1 + Join[# If[OddQ @ #, Most @ rng, rng] , (# - 1) Reverse @ Rest @ rng]] &;

rotatePad = Fold[PadLeft, RotateRight[#, #2], Length[#] + {-#2, 1}] &;

spiralMat = MapIndexed[rotatePad[#, #2[[1]] - 1]&] @ NestList[#+1&, firstRow @ #, #-1]&;

Exemplos:

Row[MatrixForm[spiralMat[#]] & /@ Range[5, 9], Spacer[5]]

MatrixForm[spiralMat[9] /. x_Integer?Positive :> f[x]]

MatrixForm[# + Transpose @ # & @ spiralMat[9] /.  x_Integer?Positive :> f[x]]

3 AccidentalTaylorExpansion Sep 24 2020 at 04:35

Como as diagonais mudam do canto para perto da diagonal, não existe uma solução bonita (ou pelo menos nenhuma fácil). O código a seguir resolverá o problema. Você terá que fazer o triângulo inferior sozinho.

n=9; 
m = ConstantArray[0, {n, n}];
initialxLeft = 2;
initialxRight = n;
leftOrRightToggle = "Left";
counter = 1;
While[initialxLeft <= initialxRight,
  If[leftOrRightToggle == "Left",
   {x, y} = {initialxLeft, 1};
   initialxLeft++;
   leftOrRightToggle = "Right", 
   {x, y} = {initialxRight, 1};
   initialxRight--;
   leftOrRightToggle = "Left"];
  While[x <= n,
   m[[y, x]] = counter;
   counter++;
   x++;
   y++;
   ];
  ];
m

$$\left( \begin{array}{ccccccccc} 0 & f[1] & f[10] & f[19] & f[28] & f[33] & f[25] & f[17] & f[9] \\ 0 & 0 & f[2] & f[11] & f[20] & f[29] & f[34] & f[26] & f[18] \\ 0 & 0 & 0 & f[3] & f[12] & f[21] & f[30] & f[35] & f[27] \\ 0 & 0 & 0 & 0 & f[4] & f[13] & f[22] & f[31] & f[36] \\ 0 & 0 & 0 & 0 & 0 & f[5] & f[14] & f[23] & f[32] \\ 0 & 0 & 0 & 0 & 0 & 0 & f[6] & f[15] & f[24] \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & f[7] & f[16] \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & f[8] \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ \end{array} \right)$$

O que faz: comece com algum ponto $(x,y)$. Mova o ponto ao longo de uma diagonal e use um contador para controlar a contagem atual. Quando atingir a borda, volte para a linha superior. leftOrRightToggle mantém o controle se você deve começar da diagonal principal ou do canto. initialxleft e initialxRight rastreiam a posição x inicial para começar a partir da diagonal principal ou do canto respectivamente. Assim que initialxleft e initialxRight se encontrarem, você estará pronto.