# Replace non-zero elements with symbol

I have a very large matrix (tensor) in Mathematica with some zero and non-zero elements. I am interested in replacing the non-zero elements with some symbol or a 1 so that it is easier to view the entire object.

I would include my code but there is a lot of preamble so here is an analogue of what I would like to work on:

{{{{0, -a Sqrt[a^2 + c^2], -c Sqrt[a^2 + c^2]}, {-a Sqrt[a^2 + c^2],
0, 0}, {-c Sqrt[a^2 + c^2], 0, 0}}}, {{{0, 0,
0}, {0, -2 a^2, -2 a c}, {0, -2 a c, -2 c^2}}}, {{{0, 0, 0}, {0,
0, 0}, {0, 0, 0}}}}


and I would like to output something like:

{{{{0, 1, 1}, {1, 0, 0}, {1, 0, 0}}}, {{{0, 0, 0}, {0, 1, 1}, {0, 1,
1}}}, {{{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}}}

• Try SparseArray[array]["PatternArray"] // Normal. – J. M.'s ennui May 20 '16 at 15:22
• @J.M. it replaces non-zeros with blanks... And it looks like black magic – BlacKow May 20 '16 at 15:52
• @BlacKow, well, you can always do Verbatim[_] -> 1 if need be. :) – J. M.'s ennui May 20 '16 at 15:56
• Map[Boole@*PossibleZeroQ, array, {4}] – BlacKow May 20 '16 at 16:13
• – user1066 May 20 '16 at 19:33

## 4 Answers

I propose the use of ArrayComponents and Unitize:

array = {{{{0, -a Sqrt[a^2 + c^2], -c Sqrt[a^2 + c^2]},
{-a Sqrt[a^2 + c^2], 0, 0}, {-c Sqrt[a^2 + c^2], 0, 0}}},
{{{0, 0, 0}, {0, -2 a^2, -2 a c}, {0, -2 a c, -2 c^2}}},
{{{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}}};

array // ArrayComponents // Unitize

{{{{0, 1, 1}, {1, 0, 0}, {1, 0, 0}}},
{{{0, 0, 0}, {0, 1, 1}, {0, 1, 1}}},
{{{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}}}


For the purpose of visualization you may also be interested to know that MatrixPlot and ArrayPlot will handle symbolic element in the following way:

{{0, 0, 0}, {0, -2 a^2, -2 a c}, {0, -2 a c, -2 c^2}} // ArrayPlot Therefore you could visualize your complete array with something like:

array /. m_?MatrixQ :> ArrayPlot[m] // Grid Other possibilities exist if you have different needs.

mat = {{{{0, -a Sqrt[a^2 + c^2], -c Sqrt[a^2 + c^2]}, {-a Sqrt[a^2 + c^2], 0, 0},
{-c Sqrt[a^2 + c^2], 0, 0}}},
{{{0, 0, 0}, {0, -2 a^2, -2 a c}, {0, -2 a c, -2 c^2}}},
{{{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}}}


You can use

f1 = Replace[#, Except[0 | _List] -> 1, Infinity] &;
f2 = SparseArray[SparseArray[#]["NonzeroPositions"] -> 1, Dimensions[#]] &;
f3 = Block[{f}, SetAttributes[f, Listable]; f = 0; f[_] := 1; f@#] &;

f1 @ mat Equal @@ (Through[{f1, f2, f3}@mat])


True

I used the following code for almost a similar purpose. Hope it also helps you out:

mtx = {{{{0, -a Sqrt[a^2 + c^2], -c Sqrt[a^2 + c^2]}, {-a Sqrt[
a^2 + c^2], 0, 0}, {-c Sqrt[a^2 + c^2], 0, 0}}}, {{{0, 0,
0}, {0, -2 a^2, -2 a c}, {0, -2 a c, -2 c^2}}}, {{{0, 0, 0}, {0,
0, 0}, {0, 0, 0}}}};

{Rw, Cl, rw, cl} = Dimensions[mtx];

Do[
If[
mtx[[k, 1, i, j]] =!= 0,
mtx[[k, 1, i, j]] = 1
],
{k, Rw},
{i, rw},
{j, cl}
];


You could also use a Replace that only works at one level instead of all of them (as in @kglr's answer):

Replace[mat, Except->1, {ArrayDepth[mat]}] //TeXForm


$\left( \begin{array}{c} \left( \begin{array}{ccc} 0 & 1 & 1 \\ 1 & 0 & 0 \\ 1 & 0 & 0 \\ \end{array} \right) \\ \left( \begin{array}{ccc} 0 & 0 & 0 \\ 0 & 1 & 1 \\ 0 & 1 & 1 \\ \end{array} \right) \\ \left( \begin{array}{ccc} 0 & 0 & 0 \\ 0 & 0 & 0 \\ 0 & 0 & 0 \\ \end{array} \right) \\ \end{array} \right)$