Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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?

share|improve this question

migrated from math.stackexchange.com May 9 at 7:59

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

3 Answers 3

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]
share|improve this answer
1  
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 at 12:23
    
@m_goldberg Nice ! –  b.gatessucks May 9 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 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}}
*)
share|improve this answer

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}}}
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.