Flip the bits on the diagonal of a binary matrix

Question

The following code flips the bits of a binary-valued matrix.

I realise that the positions of diagonal elements (form {i,i}) can be easily generated with Table or another Mathematica function. I don't want to use this fact. I aim to learn about applying functions to elements in specific positions, using patterns to identify the positions.

The following code for flipping the bits on diagonal positions of a matrix has been written in that spirit:

Test to identify diagonal positions:

diagonalPositionTest[p_] := MatchQ[p, {i_, i_}]

Determining the positions of diagonal elements using MapIndexed:

helpMapIndexed[f_, m_] := MapIndexed[{#1, f[#2]} &, m, {2}]

matrixAnnotated = helpMapIndexed[diagonalPositionTest, M]

Flipping the diagonal-bits

matrixAnnotated /. {{x_, True} -> 1 - x, {x_, False} -> x}

The code can be tested on a binary-valued matrix:

M = IdentityMatrix[4] /. {0 :> RandomInteger[{0, 1}], 
   1 :> RandomInteger[{0, 1}]}

Can the above solution be coded in a different way?

I don't mean using the fact that diagonal positions are of a trivial form (eliminating the pattern-test).

I mean: is there a more direct route (or more efficient code) to produce the same result using a Mathematica command that

• makes use a pattern to identify particular positions
• with the aim to replace the elements in those selected positions with new elements
• (where these new elements are computed via a function application).

Or is MapIndexed the "right" approach (given the above aims)?

Answer 1

The following seems reasonably clean:

M = RandomInteger[{0, 1}, {4, 4}]
(* {{0, 1, 1, 1}, {0, 1, 1, 0}, {1, 0, 0, 0}, {0, 0, 0, 0}} *)

ReplacePart[M, {i_, i_} :> 1 - M[[i, i]]]
(* {{1, 1, 1, 1}, {0, 0, 1, 0}, {1, 0, 1, 0}, {0, 0, 0, 1}} *)

My main issue with this is that ReplacePart doesn't give you access to the previous value at the affected position, so we have to extract it manually from M. (On the other side of the spectrum there is MapAt, which gets the previous value, but doesn't support pattern positions, so ReplacePart is definitely more suited)

Answer 2

This is another way to do it

SetAttributes[flip, Listable]
flip[x_, 0] := x
flip[x_, 1] := 1 - x
flipDiagonal[m_?SquareMatrixQ] := flip[m, IdentityMatrix[Length[m]]]

to test

M = RandomInteger[{0, 1}, {6, 6}];
MatrixForm /@ {M, flipDiagonal[M]}

Answer 3

And yet another method using BitXor[]:

SeedRandom[1234];
m = RandomInteger[{0, 1}, {8, 8}];
Imn = IdentityMatrix[Length[m]];

which gives:

m // MatrixForm
BitXor[m, Imn] // MatrixForm

Also here's a quick time comparison of the various methods for large matrices (apologies as my Mathematica v11.2 doesn't support all the commands shown by other users). Note the timings are in secs and the runs were made on Windows 10.

SeedRandom[1234];
m = RandomInteger[{0, 1}, {200, 200}];
Imn = IdentityMatrix[Length[m]];

BitXor[m, Imn] // RepeatedTiming // First
(* 0.000051 *)

Abs[m - Imn] // RepeatedTiming // First
(* 0.00011 *)

LinearAlgebra`Private`SetMatrixDiagonal[m, 1 - Diagonal@m] // RepeatedTiming // First
(* 2.56*10^-6 *)

ReplacePart[m, {i_, i_} :> 1 - m[[i, i]]]//RepeatedTiming//First
(* 0.0091 *)

SetAttributes[flip, Listable]
flip[x_, 0] := x
flip[x_, 1] := 1 - x
flipDiagonal[m_?SquareMatrixQ] := flip[m,IdentityMatrix[Length[m]]]
flipDiagonal[m] // RepeatedTiming // First
(* 0.013 *)

(Set[m[[#, #]], Abs@(1 - #) &@m[[#, #]]] & /@ 
    Range@First@Dimensions@m) // RepeatedTiming // First
(* 0.00046 *)

m - Imn (2 m - 1) // RepeatedTiming // First
(* 0.00019 *)

From the methods tested, naively I'd say the LinearAlgebra[] method by @MichaelE2 and then BitXor[] are by far the fastest (albeit with the caveat that I didn't test a few of the methods as mentioned).

Answer 4

Another way is by using a mask, which conveniently is now the IdentityMatrix:

SeedRandom[1234];
m = RandomInteger[{0, 1}, {8, 8}];
MatrixForm[m]
id = IdentityMatrix[Length[m]];
MatrixForm[m - id (2 m - 1)]

Answer 5

LinearAlgebra`Private`SetMatrixDiagonal does an in-place, non-functional-programming change (like a lot of LAPACK functions) and is quite speedy. Using @SHuisman's example:

SeedRandom[1234];
m = RandomInteger[{0, 1}, {8, 8}];

m // MatrixForm

LinearAlgebra`Private`SetMatrixDiagonal[m, 1 - Diagonal@m];
m // MatrixForm

In particular, it does not unpack the matrix, which Listable functions, ReplacePart, and SubsetMap† do (†SubsetMap is complicated: it unpacks something but perhaps not the whole matrix, and returns a packed matrix). Keeping the matrix packed can be an important factor in the performance of linear algebra applications; however, in small, short computations, it is not important.

Answer 6

You can use SubsetMap to apply a function to the diagonal only.

n = 6;
SeedRandom[1];
M = RandomInteger[{0, 1}, {n, n}];
f1 = SubsetMap[Abs@(# - 1) &, M, {#, #} & /@ Range[n]]
MatrixForm /@ {M, f1}

$$\left( \begin{array}{cccccc} 1 & 1 & 0 & 1 & 0 & 0 \\ 0 & 1 & 0 & 1 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 1 \\ 1 & 1 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 1 & 0 \\ 0 & 0 & 0 & 1 & 1 & 0 \\ \end{array} \right), \left( \begin{array}{cccccc} 0 & 1 & 0 & 1 & 0 & 0 \\ 0 & 0 & 0 & 1 & 0 & 0 \\ 0 & 0 & 1 & 0 & 0 & 1 \\ 1 & 1 & 0 & 1 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 1 & 1 & 1 \\ \end{array} \right) $$

---

EDIT

With M as defined above, evaluate to see the in-place change:

Dynamic[M // MatrixForm]

Set[M[[#, #]], Abs@(1 - #) & @M[[#, #]]] & /@ 
  Range@First@Dimensions@M;

Answer 7

This might be too simple for SE mathematica, but I would just use subtraction and absolute value:

m1 = RandomInteger[{0, 1}, {6, 6}];
m2 = m1 - IdentityMatrix[6];
m3 = Abs[m2];

m1 // MatrixForm
m2 // MatrixForm
m3 // MatrixForm

Here's the output: