Check if rows and columns of matrices have more than one non-zero element?

Question

I am given a list of square matrices (with non numeric entries but abstract symbols which are assumed to take real values) and I want to write a function that returns True if the following condition is satisfied:

• All rows and columns of each matrix have at most one nonzero element.

In other words, a row or column can either have all elements zero, or all but one. Otherwise, the function should return False.

I could of course write a triple loop that goes through each matrix in the list, then each row and column, and counts non-zero elements, but I am wondering what would be the most clever and efficient way to do it.

Note that even if only one matrix in that list has a row or column with more than one non-zero elements, then there would be no need to check for the rest.

Answer 1

ClearAll[f]
f[mat_?(MatrixQ[#, NumericQ]&)] :=
 FreeQ[
  Through[{Total, Map[Total]} @ Unitize[mat]], 
  _?(# > 1 &)
 ]

The code uses Unitize to turn any non-zero number into 1. Total sums the columns of the unitized matrix; Map[Total] sums the rows. The sums are therefore counts of non-zero elements in each column vs. row. FreeQ checks whether any of those counts is higher than 1, which indicates that there was more than one non-zero element in that column vs. row.

Let's make some matrices to test:

SeedRandom[4563]
MatrixForm /@ 
 (list = 
   RandomChoice[{200, 10, 10, 10} -> {0, 1, 2, 3}, {10, 5, 5}])

and apply our test function f to each:

f /@ list

(* Out: {False, True, False, False, False, False, False, True, False, True} *)

---

Following the comment and edit mentioning the presence of symbols rather than numbers, here is an alternative function:

ClearAll[fSym]
fSym[mat_] :=
 FreeQ[
   Through[{Total, Map[Total]}@mat],
   _Plus,
   -1
 ]

Same test, but with symbolic variables:

SeedRandom[4563]
MatrixForm /@ (listSym = 
   RandomChoice[{200, 10, 10, 10} -> {0, a, b, c}, {10, 5, 5}])

fSym /@ listSym

(* Out: {False, True, False, False, False, False, False, True, False, True} *)

Answer 2

m = {{0, a, 0}, {b, 0, 0}, {0, 0, c}};
f[m_] := AllTrue[
  Count[#, 0] & /@ Join[m, Transpose[m]], # >= Length@m - 1 &]

True

Original

f[m_] := Nor @@ (AllTrue[#, EqualTo[0]] & /@ Join[m, Transpose[m]]);
m = {{0, 0, 1}, {1, 0, 1}, {2, 0, 0}};
n = {{1, 1, 1}, {0, 0, 1}, {0, 1, 0}};
f[m]
f[n]

False

True