1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
| nextright[x_] :=
Block[{n = Length@x},
Table[{x[[i]], x[[If[i + 1 > n, 1, i + 1]]]}, {i, n}]]
nextleft[x_] :=
Table[{x[[i]], x[[If[i - 1 <= 0, -1, i - 1]]]}, {i, Length@x}]
nextup[x_, y_] := MapThread[List, {x, y}]
nextdown[x_, y_] := MapThread[List, {y, x}]
next[L_] :=
Block[{M = ArrayReshape[Range[L*L], {L, L}], n = L*L},
Flatten[{nextup[Sequence @@ #] & /@ nextleft[M], nextright /@ M}, 2]]
nextall[L_] :=
Block[{M = ArrayReshape[Range[L*L], {L, L}], n = L*L},
Sort[Flatten[{nextup[Sequence @@ #] & /@ nextleft[M],
nextup[Sequence @@ #] & /@ nextright[M], nextleft /@ M,
nextright /@ M}, 2]]]
nextall2[L_] :=
Block[{M = ArrayReshape[Range[L*L], {L, L}], n = L*L},
Partition[
Sort[Flatten[{nextup[Sequence @@ #] & /@ nextleft[M],
nextup[Sequence @@ #] & /@ nextright[M], nextleft /@ M,
nextright /@ M}, 2]], L]]
|