6
$\begingroup$

I have a matrix where I would like to look for all elements around element x (in this example -2) and replace all the ones that are 0 with the number 1. My matrix (matrix0) looks as follows:

\begin{array}{cccccccccc} -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -2 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ \end{array}

matrix0 = {{-1, -1, -1, -1, -1, -1, -1, -1, -1, -1},
           {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
           {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
           {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
           {-1, 0, 0, 0, 0, 0, 0, 0, 0, -2},
           {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
           {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
           {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
           {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
           {-1, -1, -1, -1, -1, -1, -1, -1, -1, -1}};

I wrote a module, which gives me the positions of the elements around my x like this:

Clear[around] (* The following module gives a list of all positions next to that of x0
in matrix mat0 *)

around[x0_, mat0_] :=
 Module[{x, mat, pos},
  x = x0;
  mat = mat0;
  pos[x_] := Flatten[Position[mat, x]];
  Cases[Tuples[Range[Dimensions[mat][[1]]], 
    2], {a_, 
     b_} /; (a == pos[x][[1]] && 
       b == pos[x][[2]] - 1) || (a == pos[x][[1]] - 1 && 
       b == pos[x][[2]]) || (a == pos[x][[1]] - 1 && 
       b == pos[x][[2]] - 1) || (a == pos[x][[1]] + 1 && 
       b == pos[x][[2]] - 1) || (a == pos[x][[1]] - 1 && 
       b == pos[x][[2]] + 1) || (a == pos[x][[1]] && 
       b == pos[x][[2]] + 1) || (a == pos[x][[1]] + 1 && 
       b == pos[x][[2]]) || (a == pos[x][[1]] + 1 && 
       b == pos[x][[2]] + 1)]
  ]

For -2 this yields the result:

around[-2, matrix0]
{{4,9},{4,10},{5,9},{6,9},{6,10}}

I now tried to let all of these elements which are 0 be replaced by 1, however Mathematica is only giving me a Null output. Any ideas why this doesn't work?

For[i=1,i<=Length[around[-2,matrix0]],i++,
If[Part[matrix0,around[-2,matrix0][[i,1]],around[-2,matrix0][[i,2]]]==0,
ReplacePart[matrix0,around[-2,matrix0][[i]]->1],Null]]

EDIT: These answers are already helping me learn new functions thank you. However my question mainly was why my version does not work seeing as I can't find an illogical step in it. The reason my version is so unnecessarily complicated is partly because I am a Mathematica beginner but also because I want to generalise this method to build up my matrix. After having changed the 0s around -2 to 1s, I would like to change the 0s around all 1s to 2s and the 0s around all 2s to 3s and so on. Any suggestion what I should look into to solve this on my own? Or is my approach just fundamentally doomed to failure?

$\endgroup$
  • $\begingroup$ Try {m, n} = Dimensions[mat0]; ReplacePart[mat0, Cases[First[Position[mat0, x0]] + # & /@ DeleteCases[Tuples[{-1, 0, 1}, 2], {0, 0}], {j_, k_} /; 1 <= j <= m && 1 <= k <= n] -> 1]. $\endgroup$ – J. M. is away Jul 31 '17 at 15:28
  • 1
    $\begingroup$ It would be very helpful if you could share your matrix as Mathematica code rather than as TeX. $\endgroup$ – MarcoB Jul 31 '17 at 16:14
  • $\begingroup$ Somewhat related: (140099) $\endgroup$ – Mr.Wizard Jul 31 '17 at 21:26
  • $\begingroup$ As noted, please include data that can be easily copied the next time. $\endgroup$ – J. M. is away Aug 1 '17 at 2:34
7
$\begingroup$

Update: Re: why my version does not work

Documentation >> ReplacePart:

  • ReplacePart[expr, i -> new] yields an expression in which the i'th part of expr is replaced by new.

that is, it does not replace expr with the expression it yields.

So, with a small change, namely assigning the value of ReplacePart[...] to matrix0 in each step of the For loop, your version also works:

For[i = 1, i <= Length[around[-2, matrix0]], i++, 
 If[Part[matrix0, around[-2, matrix0][[i, 1]], around[-2, matrix0][[i, 2]]] == 0, 
 matrix0 = ReplacePart[matrix0, around[-2, matrix0][[i]] -> 1], Null]]

matrix0 // TeXForm

$\left( \begin{array}{cccccccccc} -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -2 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ \end{array} \right)$

By the way, since

  • ReplacePart[expr, {i, j, ...} -> new] replaces the part at position {i, j, ...}

you can use much simpler

 matrix0 = ReplacePart[matrix0, around[-2, matrix0] -> 1]

instead of using a For loop.

Original answer - updated:

ClearAll[aroundF, replaceF]
aroundF[m_, t_] := DeleteDuplicates[Join @@ Function[{k}, 
 Clip[#, {1, #2}] & @@@ Transpose[{k + #, Dimensions[m]}] & /@ 
 Tuples[{-1, 0, 1}, {2}]] /@ Position[m, t]]



replaceF[old_: 0, new_: 1][m_, t_] := MapAt[If[#===old, new, #] &, m, aroundF[m,t]]

replaceF[][matrix0, -2]  // TeXForm

$\left( \begin{array}{cccccccccc} -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -2 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ \end{array} \right)$

replaceF[0, aa][matrix0, -2]  // TeXForm

$ \left( \begin{array}{cccccccccc} -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & \text{aa} & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & \text{aa} & -2 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & \text{aa} & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ \end{array} \right) $

$\endgroup$
  • $\begingroup$ To the RE: Using only ReplacePart would be a good trick but that does not include that I only want parts that are 0 to be replaced does it? $\endgroup$ – ThatEpicDude Aug 2 '17 at 8:11
5
$\begingroup$

Here is a version that is pretty fast:

Clear[setNeighbors]

setNeighbors[m_, n_, foo_Rule:(0->1)] := Module[{nmatrix,omatrix,old,new},
    {old,new} = List @@ foo;
    nmatrix=Unitize @ ListCorrelate[
        {{1,1,1}, {1,0,1}, {1,1,1}},
        Unitize @ Clip[m, {n, n}, {0, 0}],
        {2, -2},
        0
    ];
    omatrix = 1 - Unitize[m - old];
    m + omatrix nmatrix (new-old)
]

For your example:

m = {{-1, -1, -1, -1, -1, -1, -1, -1, -1, -1},
{-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
{-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
{-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
{-1, 0, 0, 0, 0, 0, 0, 0, 0, -2},
{-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
{-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
{-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
{-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
{-1, -1, -1, -1, -1, -1, -1, -1, -1, -1}};

setNeighbors[m, -2] //TeXForm

$\left( \begin{array}{cccccccccc} -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -2 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ \end{array} \right)$

Here is the timing for a much larger matrix:

data = RandomInteger[100, {1000, 1000}];

setNeighbors[data, 3, 1->3]; //AbsoluteTiming

{0.051501, Null}

Finally, it seems that @klgr's solution might have a bug. Compare:

SeedRandom[2];
m = RandomInteger[10, {5, 5}];
m //TeXForm

$\left( \begin{array}{ccccc} 8 & 4 & 5 & 4 & 7 \\ 4 & 0 & 1 & 0 & 4 \\ 3 & 7 & 3 & 0 & 2 \\ 7 & 8 & 7 & 9 & 3 \\ 6 & 2 & 3 & 8 & 9 \\ \end{array} \right)$

r1 = setNeighbors[m, 3, 1->3];
r1 //TeXForm

$\left( \begin{array}{ccccc} 8 & 4 & 5 & 4 & 7 \\ 4 & 0 & 3 & 0 & 4 \\ 3 & 7 & 3 & 0 & 2 \\ 7 & 8 & 7 & 9 & 3 \\ 6 & 2 & 3 & 8 & 9 \\ \end{array} \right)$

r2 = setNeighborValues[1,3][m,3];
r2 //TeXForm

$\left( \begin{array}{ccccc} 8 & 4 & 5 & 4 & 7 \\ 4 & 0 & 1 & 0 & 4 \\ 3 & 7 & 3 & 0 & 2 \\ 7 & 8 & 7 & 9 & 3 \\ 6 & 2 & 3 & 8 & 9 \\ \end{array} \right)$

r1 === r2

False

I think the $m_{2, 3}$ entry should be a 3.

$\endgroup$
  • $\begingroup$ Very nice! I wanted to apply ListCorrelate too but I ran out of time yesterday so I just left a link in the comments. $\endgroup$ – Mr.Wizard Aug 1 '17 at 10:12
  • $\begingroup$ @Carl, thank you. The bug is fixed now. $\endgroup$ – kglr Aug 1 '17 at 11:57
4
$\begingroup$

Here is a cleaner approach using Developer`PartitionMap.

(m as defined in my first answer.)

fn[b_] := If[# != 0, #, Total[1 - Unitize[b + 2], 2]] & @ b[[2, 2]]

Developer`PartitionMap[fn, m, {3, 3}, 1, 2] // MatrixForm

$\left( \begin{array}{cccccccccc} -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -2 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ \end{array} \right)$

$\endgroup$
4
$\begingroup$

A related post:

I'll try to apply the same method here.

Your data

I'll start by assigning your data to m:

m = {{-1, -1, -1, -1, -1, -1, -1, -1, -1, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -2},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, -1, -1, -1, -1, -1, -1, -1, -1, -1}};

Two-dimensional replacement rules

Using CellularAutomaton:

p = Partition[#, 3] & /@ Permutations[Table[_, {8}]~Append~-2];
p[[All, 2, 2]] = 0;

rules = Append[Thread[(Delete[p, 5]) -> 1], ArrayPad[{{x_}}, 1, _] :> x];

CellularAutomaton[rules, m, 1][[2]] // MatrixForm

$\left( \begin{array}{cccccccccc} -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -2 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & -1 \\ -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 & -1 \\ \end{array} \right)$

$\endgroup$
0
$\begingroup$
m = {{-1, -1, -1, -1, -1, -1, -1, -1, -1, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -2},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, 0, 0, 0, 0, 0, 0, 0, 0, -1},
   {-1, -1, -1, -1, -1, -1, -1, -1, -1, -1}};

rep[m_, v_] :=
 Module[{a, r, c, p},
  p = {-1, 0, 1};
  a = ArrayPad[m, 1];
  {r, c} = FirstPosition[a, v];
  a[[r + p, c + p]] = a[[r + p, c + p]] /. (0) -> 1;
  a[[2 ;; -2, 2 ;; -2]]]

rep[m, -2] // MatrixForm

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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