Creating a list of lists as a function of a list

I have a list of length n whose elements are all 1 and -1. For each -1 in the list i want to create a list with a -1 in the same spot and a 1 everywhere else.

For example: A list like {-1, -1, 1} would give me {{-1, 1, 1}, {1, -1, 1}}.

Also, if the input list is {1, 1, 1}, I want to get {{-1, 1, 1}, {1, -1, 1}, {1, 1, -1}}.

I know how to do this in other languages such as python but have no idea how to do this in mathematica.

• I can't follow your examples. I see that in Nasser's answer he uses the Position of -1 for the first and then 1 for the second. Is this what you intended? – Mr.Wizard Nov 6 '14 at 3:48
• @Mr.Wizard I understood it as 2 different problems/questions. – Nasser Nov 6 '14 at 3:50
• @Mr.Wizard , Yeah thats what I intended. To further elaborate on the example, I basically want to split a list, call it A, into multiple lists such that when you multiply those lists together component wise, you get back the original list A. The list containing all 1's is a special case though. – ra91 Nov 6 '14 at 4:01

a = {-1, -1, 1}
ones = Table[1, {Length[a]}];
ReplacePart[ones, # -> -1] & /@ Position[a, -1]

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

a = {1, 1, 1};
ones = Table[1, {Length[a]}];
ReplacePart[ones, # -> -1] & /@ Position[a, 1]

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


Update to combine into one function:

foo[a_List] := Module[{ones = Table[1, {Length[a]}], p = -1},
If[FreeQ[a, -1], p = 1]; (*assumed all 1 in this case*)
ReplacePart[ones, # -> -1] & /@ Position[a, p]
];

foo[{-1, -1, 1}]
(* {{-1, 1, 1}, {1, -1, 1}}  *)
foo[{-1, -1, 1, -1}]
(* {{-1, 1, 1, 1}, {1, -1, 1, 1}, {1, 1, 1, -1}} *)

foo[{1, 1, 1}]
(* {{-1, 1, 1}, {1, -1, 1}, {1, 1, -1}} *)


If you prefer a stronger test for all ones in a list (in the above I assumed if it has no -1, then it must be all ones case), then use the following:

foo[a_List] := Module[{ones = Table[1, {Length[a]}], p = -1},
If[And @@ (# == 1 & /@ a), p = 1]; (*checks that all elements are 1*)
ReplacePart[ones, # -> -1] & /@ Position[a, p]
]

• Cool, thanks. Is there a way to turn this into a single function that just takes in the original list as an argument. I feel like Would have to use if statements in a procedural way but I have no idea how to do that in mathematica. – ra91 Nov 6 '14 at 3:56
• @ra91 yes. Will update to one function. – Nasser Nov 6 '14 at 4:00

Just another way (if I have interpreted correctly):

fun[m_] := With[{p = Position[m, -1], w = 1 - 2 IdentityMatrix[Length@m]},
If[p == {}, w, Extract[w, p]]]


So,

Column[# -> fun@# & /@ Tuples[{-1, 1}, 3]]


f[a:_List] := Pick[1 + 2 DiagonalMatrix[a], a, -1]
f[a:{1..}] := f[-a]


Test:

f @ {-1, -1, 1}
f @ {1, 1, 1}

{{-1, 1, 1}, {1, -1, 1}}

{{-1, 1, 1}, {1, -1, 1}, {1, 1, -1}}

• it is very nice to think I could 'inspire' you...and I really like the terseness of the answer:) – ubpdqn Nov 6 '14 at 7:29
• @ubpdqn In that case I'll try to always mention it as this surely isn't the first time. :-) You often have a rather nice and sometimes unconventional approach to a problem. I hope I have mentioned this before. By the way your code used to be a little rough and I would sometimes edit it but I only bothered to do so because I liked your ideas. – Mr.Wizard Nov 6 '14 at 7:30
• @Mr.Wizard...amateur's luck...but sincerely appreciate the words of encouragement...the variety that springs forth from Mathematica and this user group is a wonderful environment to learn in :) – ubpdqn Nov 6 '14 at 8:10