다음 대칭 배열 작성
내 마음은 약간 흐려서 주어진 크기에 대해 다음과 같은 대칭 행렬을 만들기 위해 우아한 코드를 작성할 수있는 패턴을 여기에서 정확히 찾아 낼 수 없습니다 n.
예를 들면 다음과 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 }}
그리고 만약 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 }}
패턴이 보이십니까? 주 대각선은 0입니다. 그런 다음 하위 선행 대각선이 순서대로 채워지고 오른쪽 상단 모서리가 이어집니다. 그런 다음 하위 하위 선행 대각선이 채워지고 하위 선행 오른쪽 상단 대각선이 채워집니다.
답변
내 겸손한 시도는 다음과 같습니다.
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]]
예를 들어
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}}
첫 번째 행의 요소를 결정하면 나머지 행은 단순 회전 + 패딩 및 이전 회전 / 패딩 된 행에 1을 더하여 얻습니다.
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]&;
예 :
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]]
대각선이 모서리에서 대각선에 가깝게 전환되기 때문에 예쁜 솔루션이 없습니다 (또는 적어도 쉬운 솔루션이 없습니다). 다음 코드가 트릭을 수행합니다. 하지만 아래쪽 삼각형은 혼자서해야합니다.
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)$$
그것이하는 일 : 어떤 점에서 시작 $(x,y)$. 대각선을 따라 점을 이동하고 카운터를 사용하여 현재 개수를 추적합니다. 가장자리에 닿으면 맨 위 줄로 다시 재설정됩니다. leftOrRightToggle은 주 대각선 또는 모서리에서 시작해야하는지 추적합니다. initialxleft 및 initialxRight는 각각 주 대각선 또는 모서리에서 시작하기위한 초기 x 위치를 추적합니다. initialxleft와 initialxRight가 만나면 완료됩니다.