2
$\begingroup$

Suppose I have five quantities:

A1 = 4; A2 = 2 + 4b; A3 = a + 6 b; A4 = 10 b; A5 = 4 a

I want to make as many systems of equations as I can from these five quantities without repeat the system.

For example:

If I have 5 equation A1,A2,A3, A4 and A5: I will have 10 systems (no more):

Start with A1:

    Solve[A1 == A2 && A2 == A3, {a, b}]     (Here A1=A2=A3)
    Solve[A1 == A2 && A2 == A4, {a, b}]     (Here A1=A2=A4)
    Solve[A1 == A2 && A2 == A5, {a, b}]     (Here A1=A2=A5)
    Solve[A1 == A3 && A3 == A4, {a, b}]     (Here A1=A3=A4)
    Solve[A1 == A3 && A3 == A5, {a, b}]     (Here A1=A3=A5)
    Solve[A1 == A4 && A4 == A5, {a, b}]     (Here A1=A4=A5)

Start with A2:
    Solve[A2 == A3 && A3 == A4, {a, b}]
    Solve[A2 == A3 && A3 == A5, {a, b}]
    Solve[A2 == A4 && A4 == A5, {a, b}]

Start with A3:
    Solve[A3 == A4 && A4 == A5, {a, b}]

If n=6 for example I will have 20 systems. If n=7 I will have 35 systems. and so on.

Note that If I start with A4=A5=A6 the number of A must get bigger and not smaller this A4=A3=A1 is wrong choice here because I started with A4 the one after must be A5 and so on.

What is the best code to find all the systems if I know (n). I think I need like a loop for that.

Thank you

$\endgroup$
0
4
$\begingroup$

For your clarified question I believe this does what you want using loops:

eqs = {A1, A2, A3, A4, A5};
n = Length[eqs];

Table[eqs[[i]] == eqs[[j]] && eqs[[j]] == eqs[[k]],
   {i, n - 2}, {j, i + 1, n - 1}, {k, j + 1, n}] ~Flatten~ 3 // Column

Or more idiomatically to Mathematica:

sys = ReplaceList[eqs, {___, a_, ___, b_, ___, c_, ___} :> a == b && b == c];

sys // Column
A1 == A2 && A2 == A3
A1 == A2 && A2 == A4
A1 == A2 && A2 == A5
A1 == A3 && A3 == A4
A1 == A3 && A3 == A5
A1 == A4 && A4 == A5
A2 == A3 && A3 == A4
A2 == A3 && A3 == A5
A2 == A4 && A4 == A5
A3 == A4 && A4 == A5

Applying Solve:

A1 = 4; A2 = 2 + 4 b; A3 = a + 6 b; A4 = 10 b; A5 = 4 a;

Solve[#, {a, b}] & /@ sys   // Column
{{a -> 1, b -> 1/2}}
{}
{{a -> 1, b -> 1/2}}
{{a -> 8/5, b -> 2/5}}
{{a -> 1, b -> 1/2}}
{{a -> 1, b -> 2/5}}
{{a -> 4/3, b -> 1/3}}
{{a -> 1, b -> 1/2}}
{{a -> 5/6, b -> 1/3}}
{{a -> 0, b -> 0}}

Old reply before the question was clarified, in case it's of use to somebody.

Is this what you want?

Equal @@@ Subsets[{A1, A2, A3, A4, A5}, {2}];

And @@@ Subsets[%, {2}]
{A1 == A2 && A1 == A3, A1 == A2 && A1 == A4, A1 == A2 && A1 == A5, 
 A1 == A2 && A2 == A3, A1 == A2 && A2 == A4, A1 == A2 && A2 == A5, 
 A1 == A2 && A3 == A4, A1 == A2 && A3 == A5, A1 == A2 && A4 == A5, 
 A1 == A3 && A1 == A4, A1 == A3 && A1 == A5, A1 == A3 && A2 == A3, 
 A1 == A3 && A2 == A4, A1 == A3 && A2 == A5, A1 == A3 && A3 == A4, 
 A1 == A3 && A3 == A5, A1 == A3 && A4 == A5, A1 == A4 && A1 == A5, 
 A1 == A4 && A2 == A3, A1 == A4 && A2 == A4, A1 == A4 && A2 == A5, 
 A1 == A4 && A3 == A4, A1 == A4 && A3 == A5, A1 == A4 && A4 == A5, 
 A1 == A5 && A2 == A3, A1 == A5 && A2 == A4, A1 == A5 && A2 == A5, 
 A1 == A5 && A3 == A4, A1 == A5 && A3 == A5, A1 == A5 && A4 == A5, 
 A2 == A3 && A2 == A4, A2 == A3 && A2 == A5, A2 == A3 && A3 == A4, 
 A2 == A3 && A3 == A5, A2 == A3 && A4 == A5, A2 == A4 && A2 == A5, 
 A2 == A4 && A3 == A4, A2 == A4 && A3 == A5, A2 == A4 && A4 == A5, 
 A2 == A5 && A3 == A4, A2 == A5 && A3 == A5, A2 == A5 && A4 == A5, 
 A3 == A4 && A3 == A5, A3 == A4 && A4 == A5, A3 == A5 && A4 == A5}

Equivalent one-liners:

Fold[#2 @@@ Subsets[#, {2}] &, {A1, A2, A3, A4, A5}, {Equal, And}]

Fold[Subsets[#2 @@ #, {2}] &, {A1, A2, A3, A4, A5}, {Equal, And}]

Subsets[And @@ Subsets[A1 == A2 == A3 == A4 == A5, {2}], {2}]
$\endgroup$
6
  • $\begingroup$ Thank you for your answer but it is not what I want. $\endgroup$ – Ateq Alsaadi Feb 17 '17 at 12:05
  • $\begingroup$ @AteqAlsaadi Please edit your question to explain then what it is that you do want. I'll close it for now to prevent any more incorrect answers. $\endgroup$ – Mr.Wizard Feb 17 '17 at 12:06
  • $\begingroup$ I did a full example to explain what I want $\endgroup$ – Ateq Alsaadi Feb 17 '17 at 13:05
  • $\begingroup$ Thank you Mr.Wizard, I need it to give me the solution of the systems can I use: eqs = {A1, A2, A3, A4, A5}; n = Length[eqs]; Solve[eqs[[i]] == eqs[[j]] && eqs[[j]] == eqs[[k]], {i, n - 2}, {j, i + 1, n - 1}, {k, j + 1, n}] ~Flatten~ 3 // Column $\endgroup$ – Ateq Alsaadi Feb 17 '17 at 13:37
  • $\begingroup$ @AteqAlsaadi I gave an example of applying Solve. $\endgroup$ – Mr.Wizard Feb 17 '17 at 13:45
0
$\begingroup$
Clear[A1, A2, A3, A4, A5]
As = {A1, A2, A3, A4, A5}
pairs = Subsets[As, {2}]
eqns = Equal @@@ pairs
eqnPairs = And @@@ Subsets[eqns, {2}]
A1 = 4; A2 = 2 + 4 b; A3 = a + 6 b; A4 = 10 b; A5 = 4 a;
Solve[#, {a, b}] & /@ eqnPairs
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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