# 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?

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. Commented May 9, 2014 at 12:23
• @m_goldberg Nice ! Commented May 9, 2014 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. Commented May 9, 2014 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}}
*)


You can use region functionality to create a custom domain. For instance:

iteratedPointLattice[p_, dim_] := RegionProduct @@ Table[Point[List/@p], dim]


A region that consists of 4-dimensional points with coordinates ±1:

custom = iteratedPointLattice[{-1,1}, 4]


RegionProduct[Point[{{-1}, {1}}], Point[{{-1}, {1}}], Point[{{-1}, {1}}], Point[{{-1}, {1}}]]

Check:

{-1, 1, -1, 1} ∈ custom
{-1, 0, 1, 1} ∈ custom


True

False

Using this custom domain for your problem:

{a1, a2, a3, a4} = Thread[Indexed[a, Range[4]]];
{b1, b2, b3, b4} = Thread[Indexed[b, Range[4]]];
eqns = a1 a2 a3 b4 + a1 a2 b3 + a1 b2 + b1 == 0 && a1 a2 a3 a4 == 1;

Solve[eqns && (a|b) ∈ custom, {a, b}] //TeXForm


$$\{\{a\to \{-1,-1,-1,-1\},b\to \{-1,-1,-1,-1\}\},\{a\to \{-1,-1,-1,-1\},b\to \{-1,-1,1,1\}\},\{a\to \{-1,-1,-1,-1\},b\to \{-1,1,1,-1\}\},\{a\to \{-1,-1,-1,-1\},b\to \{1,-1,-1,1\}\},\{a\to \{-1,-1,-1,-1\},b\to \{1,1,-1,-1\}\},\{a\to \{-1,-1,-1,-1\},b\to \{1,1,1,1\}\},\{a\to \{-1,-1,1,1\},b\to \{-1,-1,-1,1\}\},\{a\to \{-1,-1,1,1\},b\to \{-1,-1,1,-1\}\},\{a\to \{-1,-1,1,1\},b\to \{-1,1,1,1\}\},\{a\to \{-1,-1,1,1\},b\to \{1,-1,-1,-1\}\},\{a\to \{-1,-1,1,1\},b\to \{1,1,-1,1\}\},\{a\to \{-1,-1,1,1\},b\to \{1,1,1,-1\}\},\{a\to \{-1,1,-1,1\},b\to \{-1,-1,-1,-1\}\},\{a\to \{-1,1,-1,1\},b\to \{-1,-1,1,1\}\},\{a\to \{-1,1,-1,1\},b\to \{-1,1,-1,1\}\},\{a\to \{-1,1,-1,1\},b\to \{1,-1,1,-1\}\},\{a\to \{-1,1,-1,1\},b\to \{1,1,-1,-1\}\},\{a\to \{-1,1,-1,1\},b\to \{1,1,1,1\}\},\{a\to \{-1,1,1,-1\},b\to \{-1,-1,-1,1\}\},\{a\to \{-1,1,1,-1\},b\to \{-1,-1,1,-1\}\},\{a\to \{-1,1,1,-1\},b\to \{-1,1,-1,-1\}\},\{a\to \{-1,1,1,-1\},b\to \{1,-1,1,1\}\},\{a\to \{-1,1,1,-1\},b\to \{1,1,-1,1\}\},\{a\to \{-1,1,1,-1\},b\to \{1,1,1,-1\}\},\{a\to \{1,-1,-1,1\},b\to \{-1,-1,-1,1\}\},\{a\to \{1,-1,-1,1\},b\to \{-1,1,-1,-1\}\},\{a\to \{1,-1,-1,1\},b\to \{-1,1,1,1\}\},\{a\to \{1,-1,-1,1\},b\to \{1,-1,-1,-1\}\},\{a\to \{1,-1,-1,1\},b\to \{1,-1,1,1\}\},\{a\to \{1,-1,-1,1\},b\to \{1,1,1,-1\}\},\{a\to \{1,-1,1,-1\},b\to \{-1,-1,-1,-1\}\},\{a\to \{1,-1,1,-1\},b\to \{-1,1,-1,1\}\},\{a\to \{1,-1,1,-1\},b\to \{-1,1,1,-1\}\},\{a\to \{1,-1,1,-1\},b\to \{1,-1,-1,1\}\},\{a\to \{1,-1,1,-1\},b\to \{1,-1,1,-1\}\},\{a\to \{1,-1,1,-1\},b\to \{1,1,1,1\}\},\{a\to \{1,1,-1,-1\},b\to \{-1,-1,1,-1\}\},\{a\to \{1,1,-1,-1\},b\to \{-1,1,-1,-1\}\},\{a\to \{1,1,-1,-1\},b\to \{-1,1,1,1\}\},\{a\to \{1,1,-1,-1\},b\to \{1,-1,-1,-1\}\},\{a\to \{1,1,-1,-1\},b\to \{1,-1,1,1\}\},\{a\to \{1,1,-1,-1\},b\to \{1,1,-1,1\}\},\{a\to \{1,1,1,1\},b\to \{-1,-1,1,1\}\},\{a\to \{1,1,1,1\},b\to \{-1,1,-1,1\}\},\{a\to \{1,1,1,1\},b\to \{-1,1,1,-1\}\},\{a\to \{1,1,1,1\},b\to \{1,-1,-1,1\}\},\{a\to \{1,1,1,1\},b\to \{1,-1,1,-1\}\},\{a\to \{1,1,1,1\},b\to \{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}}}