# Extract four (von Neumann) neighbors of a matrix entry

Assume I have a $$m\times n$$ matrix and I would like to extract four neighbors of randomly selected entry of a matrix. I have handled if location is not on the boundary. Any suggestion how to handle it if entry is on the boundary or handle it all in once? Thanks.

Here is an example.

SeedRandom;
{n, m} = {4, 6};
mat = RandomInteger[{1, 5}, {n, m}];
MatrixForm@mat


$$\text{mat}= \left( \begin{array}{cccccc} 4 & 2 & 3 & 1 & 1 & 3 \\ 4 & 2 & 2 & 5 & 1 & 2 \\ 5 & 4 & 3 & 3 & 5 & 5 \\ 3 & 5 & 2 & 2 & 5 & 3 \\ \end{array} \right)$$

loc = {RandomInteger[{2, n - 1}], RandomInteger[{2, m - 1}]}
fourNeighbor = (Extract[mat, # + loc] &) /@ {{0, -1}, {0, 1}, {-1, 0}, {1, 0}}


Edit:

Here is Moore Neighbors

nf = Nearest[Tuples@Range@Dimensions@mat -> Flatten[mat],
DistanceFunction -> ChessboardDistance];

neighbors[pt_] := nf[pt, {All, 1}][[1 ;;]]


Or

   mooreNeighborPositions =  AdjacencyList[NearestNeighborGraph[Tuples@Range@Dimensions@#,
DistanceFunction -> ChessboardDistance], #2] &;

mooreNeighbors = Extract[#, mooreNeighborPositions@##] &;  mooreNeighbors[mat, {1, 1}]

• How do you want to handle boundary cases? Wrap around (periodic) or include <4 neighbors or ? Dec 21, 2017 at 15:24

You could use Nearest for this.

nf = Nearest[Tuples @ Range @ Dimensions @ mat -> Flatten[mat]];

neighbors[pt_] := nf[pt, {All, 1}][[2;;]]


Some examples:

neighbors[{3, 3}]
neighbors[{1, 1}]
neighbors[{4, 6}]


{2, 4, 3, 2}

{2, 4}

{5, 5}

• something is wrong: {2,4} is not a neighbor to {1,1}... Dec 22, 2017 at 9:04
• ...sorry my fault! Every thing is ok! Dec 22, 2017 at 9:14
vNNeighborPositions = AdjacencyList[
NearestNeighborGraph @ Tuples @ Range @ Dimensions @ #, #2] &;

vNNeighbors = Extract[#, vNNeighborPositions @ ##] &;


Examples:

Row[Labeled[Style[#, 20] & @ MatrixForm @
MapAt[Highlighted[#, Background -> Red] &,
MapAt[Highlighted, mat, vNNeighborPositions[mat, #]], #],
Grid[{{"pos:", #}, {"neighbors:", vNNeighbors[mat, #]}}], Top] & /@
{{1, 1}, {1, 4}, {3, 1}, {4, 6}, {3, 5}},
Spacer] SeedRandom
mat = RandomInteger[10, {10, 15}];
poslist = RandomSample[Tuples @ Range @ Dimensions @ mat, 7];

Legended[MatrixPlot[ReplacePart[mat,
Thread[vNNeighborPositions[mat, #] & /@ poslist -> Yellow],
{{_, _} :> White}]], ImageSize -> 1 -> 40, Mesh -> All,
Epilog ->  MapIndexed[Text[Style[#, 16, Black], #2 - .5] &,
Reverse /@ Transpose @ mat, {2}]],
Placed[SwatchLegend[(ColorData /@ Range[Length @ poslist]),
Style[#, 14] & /@ ({Defer @ #, vNNeighbors[mat, #]} & /@ poslist),
LegendMarkerSize -> 20, LegendLabel -> "positions & neighbors"], Right]] The four neighbors are

ij=Map[loc + # &, {{0, -1}, {0, 1}, {-1, 0}, {1, 0}}]


Now you must check the index range:

DeleteCases[Map[{Max[1,Min[n,#[] ]],Max[1,Min[m,#[] ]]}& ,ij],loc] (* index pairs*)
Extract[mat,%] (* neighbors  *)

nbrs[loc_?VectorQ, m_?MatrixQ] := Module[{nrows, ncols, pts},
{nrows, ncols} = Dimensions[m];
pts = Select[(loc + # &) /@ {{0, -1}, {0, 1}, {-1, 0}, {1, 0}},
Between[#[], {1, nrows}] && Between[#[], {1, ncols}] &];
Extract[mat, pts]
]