8
$\begingroup$

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

$\endgroup$
7
  • 3
    $\begingroup$ 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. $\endgroup$
    – MarcoB
    Commented Feb 6, 2021 at 13:19
  • $\begingroup$ 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 $\endgroup$ Commented Feb 6, 2021 at 13:21
  • 1
    $\begingroup$ Edited to highlight the remaining 'wrap around' issue. $\endgroup$ Commented Feb 6, 2021 at 13:28
  • 1
    $\begingroup$ 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. $\endgroup$
    – C. E.
    Commented Feb 6, 2021 at 13:33
  • 4
    $\begingroup$ @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. $\endgroup$
    – MarcoB
    Commented Feb 6, 2021 at 13:40

3 Answers 3

6
$\begingroup$
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]] &

enter image description here

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]] &

enter image description here

$\endgroup$
4
$\begingroup$

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

enter image description here

enter image description here

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

enter image description here

Reference link:趣味象棋 一马平川 https://demonstrations.wolfram.com/TheKnightsTour/

$\endgroup$
0
4
$\begingroup$

Adapting my answer to Imposing a Periodic Boundary Condition in Nearest Neighbour Search:

dist[a_, b_, d0_] := Norm@Mod[a - b, d0, -d0/2];
vNN[mat_, pts_] := Rest@Nearest[
     Tuples@Range@Dimensions@mat -> Flatten@mat, 
     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.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.