# Periodic von Neumann neighbours

From Carl Woll's answer here, I have this code for pulling the von Neumann neighbors:

vNN[mat_, pts_] :=
Nearest[Tuples@Range@Dimensions@mat ->Flatten@mat][pts, {All, 1}][[2 ;;]]


How do I make it so that this function wraps around (i.e, that it always pulls four values)?

Thanks

• There are two good approaches in Extract four (von Neumann) neighbors of a matrix entry. What exactly doesn’t work for you in the code presented there? It seems that what you are asking would be a relatively small modification of that code. What have you tried, and what issue are you facing, so we can point you in the right direction? Otherwise your question is actually likely to be closed as a duplicate of one of those. Commented Feb 6, 2021 at 13:19
• Hi, thanks for the comment. On closer inspection, I agree with you. I have found that vNN[mat_, pts_] := Nearest[Tuples@Range@Dimensions@mat -> Flatten[mat]][ pts, {All, 1}][[2 ;;]] from another question suits my needs. I don't know how to wrap around so that I always have 4 values showing though, so any advice on this before this gets closed would be appreciated. Thanks Commented Feb 6, 2021 at 13:21
• Edited to highlight the remaining 'wrap around' issue. Commented Feb 6, 2021 at 13:28
• I edited your post to emphasize that you are asking about the same for periodic boundaries. Note that you have to give credit when you take code from other users' answers. Commented Feb 6, 2021 at 13:33
• @TubularHell you could use ArrayPad[m, {1,1},"Periodic"] to generate a version of your array with wraparound padding, then extract the neighbors in that matrix. Remember to adjust the indices inside your function. Commented Feb 6, 2021 at 13:40

ClearAll[vNNPos, vNNVals]
vNNPos[mat_, pos_] := Transpose[Mod[pos + {{1, 0, -1, 0}, {0, 1, 0, -1}},
Dimensions @ mat, 1]]

vNNVals[mat_, pos_] := Extract[vNNPos[mat, pos]] @ mat


Examples:

mat1 = {{3, 6, 9}, {12, 15, 18}, {21, 24, 27}};
mat2 = {{4, 8, 12, 16}, {20, 24, 28, 32}, {36, 40, 44, 48}, {52, 56,  60, 64}};

vNNVals[#, {2, 2}] & /@ {mat1, mat2}

 {{24, 18, 6, 12}, {40, 28, 8, 20}}

MatrixForm[MapAt[Highlighted[#, Background -> Red] &,
MapAt[Highlighted, #, {2, 2}], vNNPos[#, {2, 2}]]] & /@
{mat1, mat2} // Row[#, Spacer[10]] &


vNNVals[#, {2, 1}] & /@ {mat1, mat2}

 {{21, 15, 3, 18}, {36, 24, 4, 32}}

MatrixForm[MapAt[Highlighted[#, Background -> Red] &,
MapAt[Highlighted, #, {2, 1}], vNNPos[#, {2, 1}]]] & /@
{mat1, mat2} // Row[#, Spacer[10]] &


I wrote the following code using the method of finding where the horse can go in the chess board:

matrix = {{3, 6, 9}, {12, 15, 18}, {21, 24,
27}};
value = 15;(*The value of the central element*)
{m, n} = Dimensions[matrix];
Board = Table[0, {m + 1}, {n + 1}];
Moves0 = {{0, 1}, {0, -1}, {1, 0}, {-1, 0}};
Moves = Nest[
DeleteDuplicates[Flatten[Outer[Plus, #, Moves0, 1], 1]] &, {{0,
0}}, 1(*step number*)];
InRangeAndEmpty[{x_, y_}] := (1 <= x <= m && 1 <= y <= n &&
Board[[x, y]] == 0);
Accessibility[{x_, y_}] :=
Module[{accessibility = 0, a = 1},
While[a <= 8,
If[InRangeAndEmpty[{x + Moves[[a, 1]], y + Moves[[a, 2]]}],
accessibility++]; a++];
accessibility];

GetNextMove[{x_, y_}] :=
MapIndexed[{First[#2], #1} &,
SortBy[Select[
Table[{x + Moves[[i, 1]], y + Moves[[i, 2]]}, {i,
Length[Moves]}], InRangeAndEmpty],
N@Arg[#[[2]] - x + (#[[1]] - y) I] &]];

matrix[[#1, #2]] & @@@ (GetNextMove[
Position[matrix, value] // First][[All, 2]])
MatrixForm[
MapAt[Highlighted[#, Background -> Red] &,
MapAt[Highlighted, #, First[Position[matrix, value]]],
GetNextMove[
Position[#, value(*The value of the central element*)] //
First][[All, 2]]]] &@matrix


If you need periodic filling, you only need to increase some feasible ways of moves:

Moves0 = {{0, 1}, {0, -1}, {1, 0}, {-1, 0}, {m - 1, 0}, {-(m - 1),
0}, {0, -(n - 1)}, {0, n - 1}};

Moves0 = {{0, 1}, {0, -1}, {1, 0}, {-1, 0}, {m - 1, 0}, {-(m - 1),
0}, {0, -(n - 1)}, {0, n - 1}};
matrix = {{4, 8, 12, 16}, {20, 24, 28, 32}, {36, 40, 44, 48}, {52, 56,
60, 64}};
position = {1, 1};(*The position of the central element*)
{m, n} = Dimensions[matrix];
Board = Table[0, {m + 1}, {n + 1}];
Moves0 = {{0, 1}, {0, -1}, {1, 0}, {-1, 0}, {m - 1, 0}, {-(m - 1),
0}, {0, -(n - 1)}, {0, n - 1}};
Moves = Nest[
DeleteDuplicates[Flatten[Outer[Plus, #, Moves0, 1], 1]] &, {{0,
0}}, 1(*step number*)];
InRangeAndEmpty[{x_, y_}] := (1 <= x <= m && 1 <= y <= n &&
Board[[x, y]] == 0);
Accessibility[{x_, y_}] :=
Module[{accessibility = 0, a = 1},
While[a <= 8,
If[InRangeAndEmpty[{x + Moves[[a, 1]], y + Moves[[a, 2]]}],
accessibility++]; a++];
accessibility];

GetNextMove[{x_, y_}] :=
MapIndexed[{First[#2], #1} &,
SortBy[Select[
Table[{x + Moves[[i, 1]], y + Moves[[i, 2]]}, {i,
Length[Moves]}], InRangeAndEmpty],
N@Arg[#[[2]] - x + (#[[1]] - y) I] &]];

matrix[[#1, #2]] & @@@ (GetNextMove[position][[All, 2]])

MatrixForm[
MapAt[Highlighted[#, Background -> Red] &,
MapAt[Highlighted, #,
position(*The position of the central element*)],
GetNextMove[position][[All, 2]]]] &@matrix


dist[a_, b_, d0_] := Norm@Mod[a - b, d0, -d0/2];
pts, {All, 1 + $MachineEpsilon}, DistanceFunction -> (dist[##, Dimensions@mat] &)];  Example: mat = Table[10 i + j, {i, 4}, {j, 6}]; mat // MatrixForm vNN[mat, {2, 2}] vNN[mat, {1, 1}] vNN[mat, {4, 5}]  For some reason the radius 1 needs to be replaced with something slightly greater, for instance 1 +$MachineEpsilon.