2

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

Ateq Alsaadi
  • 13
  • 4

2 Answers2

4

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}]
Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
  • Thank you for your answer but it is not what I want. – Ateq Alsaadi Feb 17 '17 at 12:05
  • @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. – Mr.Wizard Feb 17 '17 at 12:06
  • I did a full example to explain what I want – Ateq Alsaadi Feb 17 '17 at 13:05
  • 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

     – Ateq Alsaadi Feb 17 '17 at 13:37
  • @AteqAlsaadi I gave an example of applying Solve. – Mr.Wizard Feb 17 '17 at 13:45
  • @AteqAlsaadi Glad I could help, finally. Please include an example like the one you gave in future questions; it really helps. – Mr.Wizard Feb 17 '17 at 13:51
0
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
Alan
  • 13,686
  • 19
  • 38