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?

Improve this question
$\endgroup$
4
  • $\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.'s eventual burnout ♦
    Jul 31, 2017 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, 2017 at 16:14
  • $\begingroup$ Somewhat related: (140099) $\endgroup$
    – Mr.Wizard
    Jul 31, 2017 at 21:26
  • $\begingroup$ As noted, please include data that can be easily copied the next time. $\endgroup$
    – J. M.'s eventual burnout ♦
    Aug 1, 2017 at 2:34

4 Answers 4

Reset to default
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) $

Improve this answer
$\endgroup$
1
  • $\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$
    – TheSeparatrix
    Aug 2, 2017 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.

Improve this answer
$\endgroup$
2
  • $\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, 2017 at 10:12
  • $\begingroup$ @Carl, thank you. The bug is fixed now. $\endgroup$
    – kglr
    Aug 1, 2017 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)$

Improve this answer
$\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)$

Improve this answer
$\endgroup$

Your Answer

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

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