Extract four (von Neumann) neighbors of a matrix entry
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}
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[10]]
SeedRandom[333]
mat = RandomInteger[10, {10, 15}];
poslist = RandomSample[Tuples @ Range @ Dimensions @ mat, 7];
Legended[MatrixPlot[ReplacePart[mat,
Join[Thread[poslist -> (ColorData[97] /@ Range[Length@poslist])],
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[97] /@ Range[Length @ poslist]),
Style[#, 14] & /@ ({Defer @ #, vNNeighbors[mat, #]} & /@ poslist),
LegendMarkerSize -> 20, LegendLabel -> "positions & neighbors"], Right]]
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]], {1, nrows}] && Between[#[[2]], {1, ncols}] &];
Extract[mat, pts]
]