# Is there a way to specify custom domains?

I want to solve for all solutions to the system of equations $a_1 a_2 a_3 b_4 + a_1 a_2 b_3 + a_1 b_2 + b_1 = 0$ and $a_1 a_2 a_3 a_4 = 1$ where the $a_i$'s and $b_i$'s take on values from $\{-1,1\}$. Is there a way to efficiently solve this besides exhaustive casework?

Also, is there a way to specify a custom domain for $\{-1,1\}$ in Mathematica so I can just do this on my computer?

-

## migrated from math.stackexchange.comMay 9 '14 at 7:59

This question came from our site for people studying math at any level and professionals in related fields.

Not sure if you'd consider this exhaustive casework :

dom = {1, -1};
vars = {a1, a2, a3, a4, b1, b2, b3, b4};
cond = And @@ (# == -1 || # == 1 & /@ vars);

Solve[Join[{a1*a2*a3*b4 + a1*a2*b3 + a1*b2 + b1 == 0, a1*a2*a3*a4 == 1}, {cond}], vars]
-
By defining cond as And @@ (# == -1/k || # == k & /@ vars), you can get a more general answer: {{a1 -> -(1/k), a2 -> -(1/k), a3 -> k, a4 -> k, b1 -> -(1/k), b2 -> k, b3 -> k, b4 -> k}, ... }. All the other solution sets are permutations of the first. – m_goldberg May 9 '14 at 12:23
@m_goldberg Nice ! – b.gatessucks May 9 '14 at 12:27
Oops. I need to retract that remark about "All the other solution sets are permutations of the first". The symmetry of the equations is not complete, so while the solutions sets are very similar, they are not all permutations of the first. – m_goldberg May 9 '14 at 12:33

This is the fastest I could come up with. Instead of putting the constraint {1, -1} on the variables at the outset, I let Reduce work over all reals but modify the equations to contain only the Sign of all the variables.

This yields a lot of logical conditions, but they are produced very fast. At the end, ToRules helps convert the conditions into a form that can be used by Simplify to get a list of allowed Sign values for the list of variables var. WIthout the initial constraints, I get zeros in the result, too, which can easily by weeded out by Select:

vars = {a1, a2, a3, a4, b1, b2, b3, b4};
solutions = Select[
Simplify[Sign /@ vars, #] & @@@ {ToRules[
Reduce[{Sign /@ (a1*a2*a3*b4 + a1*a2*b3 + a1*b2 + b1) == 0,
Sign[a1*a2*a3*a4] == 1}, vars, Reals]]}, FreeQ[#, 0] &]

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

The problem is small enough for brute force and solution space reduced by considering the 8 (of 16) cases where there are an even number of 1 (or -1).

red = Select[Tuples[{-1, 1}, 4], Times @@ # == 1 &];
v = {b4, b3, b2, b1};
sols = {Thread[{a1, a2, a3, a4} -> #],
Solve[{#.v == 0, And @@ (# == -1 || # == 1 & /@ v)}, v]} & /@test;
vissol =
Column[{Grid[{({a1, a2, a3, a4} /. #[[1]]) /. rul}, Frame -> All],
Grid[{b4, b3, b2, b1} /. #[[2]]]}, Frame -> True] & /@ sols;
Grid[Partition[vissol, 4]]

The solutions (the top row: {a1,a2,a3,a4},then each row below {b4,b3,b2,b1}_:

You can also quickly get them:

Map[Function[u, (u /. rul) -> Select[Tuples[{-1, 1}, 4], #.u == 0 &]], test]

yielding:

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