What is an elegant way to find where a row of 0's and a column of 0's in a matrix intersect?

Question

I am working on a Mathematica program to construct unitary matrices satisfying specified properties. To complete this construction I need to find where a row of 0's and a column of 0's intersect and place a 1 there. Any ideas on an elegant way to do this?

As an example, consider

{{0,0,-(1/Sqrt[2]),1/Sqrt[2]},{0,0,1/Sqrt[2],1/Sqrt[2]},{0,0,0,0},{0,0,0,0}}

and making it unitary like

{{0,0,-(1/Sqrt[2]),1/Sqrt[2]},{0,0,1/Sqrt[2],1/Sqrt[2]},{1,0,0,0},{0,1,0,0}}

Answer 1

MatrixForm[mat = {
   {0, 0, -(1/Sqrt[2]), 1/Sqrt[2]},
   {0, 0, 1/Sqrt[2], 1/Sqrt[2]},
   {0, 0, 0, 0},
   {0, 0, 0, 0}}]

MapIndexed[(row[First[#2]] = Union[#1] == {0}) &, mat];
MapIndexed[(col[First[#2]] = Union[#1] == {0}) &, Transpose[mat]];
f[r_, c_] := If[row[r] && col[c], Sow[{r, c}]];
pos = Reap[Outer[f, Sequence @@ Range /@ Dimensions[mat]]][[-1, 1]];
MatrixForm[ReplacePart[mat, pos -> 1]]

{{0, 0, -(1/Sqrt[2]), Sqrt[2]}, 
 {0, 0, 1/Sqrt[2], 1/Sqrt[2]}, 
 {1, 1, 0, 0}, 
 {1, 1, 0, 0}}

not quite the desired result

version 2

MatrixForm[mat = {
   {0, 0, -(1/Sqrt[2]), 1/Sqrt[2]},
   {0, 0, 1/Sqrt[2], 1/Sqrt[2]},
   {0, 0, 0, 0},
   {0, 0, 0, 0}}]

MapIndexed[(row[First[#2]] = Union[#1] == {0}) &, mat];
MapIndexed[(col[First[#2]] = Union[#1] == {0}) &, Transpose[mat]];

f[r_, c_] := If[row[r] && col[c],
   mat = ReplacePart[mat, {r, c} -> 1];
   row[r] = col[c] = False];

Outer[f, Sequence @@ Range /@ Dimensions[mat]];
MatrixForm[mat]

{{0, 0, -(1/Sqrt[2]), Sqrt[2]}, 
 {0, 0, 1/Sqrt[2], 1/Sqrt[2]}, 
 {1, 0, 0, 0}, 
 {0, 1, 0, 0}}

as a function

place[$mat_] := Module[{row, col, f, mat = $mat},

  MapIndexed[(row[First[#2]] = Union[#1] == {0}) &, mat];
  MapIndexed[(col[First[#2]] = Union[#1] == {0}) &, Transpose[mat]];

  f[r_, c_] := If[row[r] && col[c],
    mat = ReplacePart[mat, {r, c} -> 1];
    row[r] = col[c] = False];

  Outer[f, Sequence @@ Range /@ Dimensions[mat]];
  mat]

place[{
  {0, 0, -(1/Sqrt[2]), 1/Sqrt[2]},
  {0, 0, 1/Sqrt[2], 1/Sqrt[2]},
  {0, 0, 0, 0},
  {0, 0, 0, 0}}] // MatrixForm

{{0, 0, -(1/Sqrt[2]), Sqrt[2]}, 
 {0, 0, 1/Sqrt[2], 1/Sqrt[2]}, 
 {1, 0, 0, 0}, 
 {0, 1, 0, 0}}

Answer 2

(mat = {{0, 0, -(1/Sqrt[2]), 1/Sqrt[2]}, {0, 0, 1/Sqrt[2], 
     1/Sqrt[2]}, {0, 0, 0, 0}, {0, 0, 0, 0}}) // MatrixForm

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

---

umat[mat_?MatrixQ] := Module[{
   tr = DiscreteDelta @@@ mat
   , tc = DiscreteDelta @@@ Transpose@mat, pr, pc, ml},
  pr = Flatten@Position[tr, 1];
  pc = Flatten@Position[tc, 1];
  ml = Min@(Length /@ {pr, pc});
  idx = Thread[{pr[[1 ;; ml]], pc[[1 ;; ml]]}];
  SubsetMap[# + 1 &, mat, idx]
  ]

umat[mat] // MatrixForm

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

Answer 3

mat = {
       {0, 0, -(1/Sqrt[2]), 1/Sqrt[2]},
       {0, 0, 1/Sqrt[2], 1/Sqrt[2]},
       {0, 0, 0, 0}, 
       {0, 0, 0, 0}
      };

TeXForm@mat

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

---

I was inquiring about the possibilities you have for constructing the unitary matrix because it’s clear that the answer is not unique, given, of course, what you're asking for—that is, to keep adding ones at the intersections between rows and columns of zeros. My attempt is as follows:

Umatrices[mat_] := Module[{zeroRows, zeroCols, positions, allSubsets, matrices},
  matrices = {};
  zeroRows = Flatten[Position[Total[Abs[mat], {2}], 0]];
  zeroCols = Flatten[Position[Total[Abs[mat], {1}], 0]];
  positions = Tuples[{zeroRows, zeroCols}];
  allSubsets = Subsets[positions];
  Do[Module[{result = mat, det}, 
    Scan[(result[[#[[1]], #[[2]]]] = 1) &, subset];
    det = Det[result];
    If[det != 0, AppendTo[matrices, result]]], {subset, allSubsets}];
  Pick[#, UnitaryMatrixQ /@ #] &@matrices];

Testing Umatrices:

Row[Map[MatrixForm]@Umatrices[mat], " "] // TeXForm

$\left( \begin{array}{cccc} 0 & 0 & -\frac{1}{\sqrt{2}} & \frac{1}{\sqrt{2}} \\ 0 & 0 & \frac{1}{\sqrt{2}} & \frac{1}{\sqrt{2}} \\ 1 & 0 & 0 & 0 \\ 0 & 1 & 0 & 0 \\ \end{array} \right)\, \left( \begin{array}{cccc} 0 & 0 & -\frac{1}{\sqrt{2}} & \frac{1}{\sqrt{2}} \\ 0 & 0 & \frac{1}{\sqrt{2}} & \frac{1}{\sqrt{2}} \\ 0 & 1 & 0 & 0 \\ 1 & 0 & 0 & 0 \\ \end{array} \right)$

In this way, you obtain the possible unitary matrices that result from adding ones at the intersections between rows and columns of zeros. You then select the one that best matches your requirements; for instance, the first matrix in the output of Umatrices is the one you provided as an example.

Answer 4

mat = {{0, 0, 0}, {0, 2, 2}, {0, 0, 0}}

We want a 1 to be placed where the norm of the row and column is 0. In other words, the row norm + column norm is 0. We can then use Unitize to replace any numerical values other and 0 with 1, and subtract 1 from it to get a matrix that is 1 where the row and column norm are 0, and 0 everywhere else. We then add this to the original mat:

mat +=  1 - 
  Unitize@Outer[Plus, Norm /@ mat, Norm /@ (mat\[Transpose])]

Note this matrix is not unitary, so I'm guessing that this is just a part of a bigger algorithm for making unitary matrices.

Answer 5

Assuming we "mark" one intersection at a time recursively, we could do something like this:

MarkFirstIntersection[matrix_?MatrixQ] :=
  With[
    {intersection = Flatten[FirstPosition[0] /@ {Total[matrix, {2}], Total[matrix, {1}]}]},
    If[FreeQ[intersection, _Missing], ReplacePart[matrix, intersection -> 1], matrix]];

list = {{0, 0, -(1/Sqrt[2]), 2/Sqrt[2]}, 
        {0, 0, 1/Sqrt[2], 1/Sqrt[2]}, 
        {0, 0, 0, 0}, 
        {0, 0, 0, 0}};

FixedPoint[MarkFirstIntersection, list]
(* {{0, 0, -(1/Sqrt[2]), Sqrt[2]}, 
    {0, 0, 1/Sqrt[2], 1/Sqrt[2]}, 
    {1, 0, 0, 0}, 
    {0, 1, 0, 0}} *)

Answer 6

This method is more like brute force:

(mat = {{0, 0, -(1/Sqrt[2]), 1/Sqrt[2]}, {0, 0, 1/Sqrt[2], 
     1/Sqrt[2]}, {0,0,0, 0}, {0,0, 0, 0}}) // MatrixForm

Clear[unitize]
unitize[m_] := m + SparseArray[
    With[{n = Count[m, ConstantArray[0, Length[m]]]},
          Transpose[{OrderingBy[m, Max@*Abs][[;;n]],
                     OrderingBy[Transpose[m], Max@*Abs][[;;n]]}]
    ] -> 1, Dimensions[m]]
   
unitize[mat] // UnitaryMatrixQ   (* True *)

An explanation of the various phrases --

Count[m, ConstantArray[0, Length[m]]] counts the number of zero rows in the matrix $m$. This count, which is 2 in the example, is stored the variable $n$.

OrderingBy[m, Max@*Abs][[;;n] finds the row numbers of the first $n$ zero rows. In the example, this expression returns {3,4}, since rows 3 and 4 are all zeroes.

OrderingBy[Transpose[m], Max@*Abs][[;;n]] finds the column numbers of the first $n$ zero columns. In the example, this expression returns {1,2}, since columns 1 and 2 are all zeroes.

The With expression returns the transpose of {{3,4}, {1,2}}, which gives the subscripts of the matrix elements that must change to ones.

SparseArray[{{3,1}, {4,2}} -> 1, Dimensions[m] gives the matrix $S$ with the same dimensions as $m$, and having element $S_{3\,1} = 1$ and element $S_{4\,2} = 1$ and zeros elsewhere.

Adding the sparse array to the original array gives the completed unitary matrix.