Generating all matrices with 1 (possibly) replaced by -1

Question

I have a matrix $M$, whose dimension I am unsure of, which has only $\lbrace0,1\rbrace$ entries. I would like to generate all the possible matrices that result from changing (some subset) of the $1$'s to $-1$'s. For example, if $M=\lbrace\lbrace0,1\rbrace,\lbrace 1,0\rbrace\rbrace$, then I would like to generate the list: $$ \lbrace\lbrace\lbrace0,1\rbrace,\lbrace 1,0\rbrace\rbrace,\lbrace\lbrace0,-1\rbrace,\lbrace 1,0\rbrace\rbrace,\lbrace\lbrace0,1\rbrace,\lbrace -1,0\rbrace\rbrace,\lbrace\lbrace0,-1\rbrace,\lbrace -1,0\rbrace\rbrace\rbrace.$$

I am trying to use ReplaceList to do this, but it is not working out exactly as I would want. For example, here is an example for a 2x2 matrix:

ReplaceList[{1, 1, 1, 1}, 
{{x___, 1, y___} -> {x, -1, y},
{z___, 1, x___, 1, y___} -> {z, -1, x, -1, y},
{t___, 1, z___, 1, x___, 1, y___} -> {t, -1, z, -1, x, -1, y},
{1, 1, 1, 1} -> {-1, -1, -1, -1}}]

Not exactly extensible (nor very pretty). Is there a nice way to do this? Again, I would like to have code that works regardless of dimension, and also accepts as input a matrix (you might notice I Flattened my 2x2 above), and returns a list of matrices.

Thanks!

Answer 1

You can do it by generating all possible subsets of the positions of the ones:

m = {{0, 1}, {1, 0}}
ReplacePart[m, # -> -1] & /@ Subsets[Position[m, 1]]
(* {{{0,1},{1,0}},{{0,-1},{1,0}},{{0,1},{-1,0}},{{0,-1},{-1,0}}} *)

I guess you can't go around the problem of it being inefficient since getting all combinations of something always is.

Answer 2

For example

m = {{0, 1}, {1, 0}};

ReplacePart[m, #] & /@ Thread[Rest[Subsets@Position[m, 1]] -> -1]

(* {{{0, -1}, {1, 0}}, {{0, 1}, {-1, 0}}, {{0, -1}, {-1, 0}}} *)

Answer 3

Find the posituions of the 1s. Then create a list of all tuples of that length, but with either 1 or -1. Last use that as replacements for the 1s in the original matrix.

Your example:

mat = {{0, 1}, {1, 0}};
pos1 = Position[mat, 1];
lposn = Length[pos1];
vallists = IntegerDigits[Range[0, 2^lposn - 1], 2, lposn] /. 0 -> -1

(* Out[17]= {{-1, -1}, {-1, 1}, {1, -1}, {1, 1}} *)

Map[ReplacePart[mat, Thread[pos1 -> #]] &, vallists]

(* Out[21]= {{{0, -1}, {-1, 0}}, {{0, -1}, {1, 0}}, {{0, 1}, {-1, 
   0}}, {{0, 1}, {1, 0}}} *)

Answer 4

 mat = {{0, 1}, {1, 0}};
 spar = SparseArray[mat];
 pos = Rest@Subsets@spar["NonzeroPositions"];
 MapAt[-1 &, spar, #] & /@ pos
 (* or *)
 MapAt[#/. (1)-> -1 &, spar, #] & /@ pos
 (* {{{0, -1}, {1, 0}}, {{0, 1}, {-1, 0}}, {{0, -1}, {-1, 0}}} *)