4
$\begingroup$

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?

Improve this question
$\endgroup$

4 Answers 4

Reset to default
5
$\begingroup$

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]
Improve this answer
$\endgroup$
3
  • 2
    $\begingroup$ 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. $\endgroup$
    – m_goldberg
    Commented May 9, 2014 at 12:23
  • $\begingroup$ @m_goldberg Nice ! $\endgroup$
    – b.gates.you.know.what
    Commented May 9, 2014 at 12:27
  • $\begingroup$ 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. $\endgroup$
    – m_goldberg
    Commented May 9, 2014 at 12:33
2
$\begingroup$

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}}
*)
Improve this answer
$\endgroup$
2
$\begingroup$

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\}\}\}$

Improve this answer
$\endgroup$
1
$\begingroup$

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}_: enter image description here

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}}}
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.