Help with some code

Question

I got stuck solving the following problem:

Table[Table[
  Table[
   g1Size = x; g2Size = y;
   vals = 
    FindInstance[(a1 - a2) - (b1 - b2) == z && a1 + b1 == g1Size && 
      a2 + b2 == g2Size && a1 + a2 == g1Size && b1 + b2 == g2Size && 
      a1 > 0 && a2 > 0 && b1 > 0 && b2 > 0, {a1, a2, b1, b2}, 
     Integers, 3];
   aa1 = a1 /. vals; aa2 = a2 /. vals; bb1 = b1 /. vals; 
   bb2 = b2 /. vals;
   {g1Size, g2Size, z, Flatten@{aa1, aa2, bb1, bb2}}
   , {z, 0, 10}], {x, 1, 10}], {y, 1, 10}]

I want to loop through different values of g1Size, g2Size and z and find the first solution to the system of equations. As soon as a solution for a combination of g1Size,g2size and z was found, I want to extract the values for a1,a2,b1,b2 and continue with the next loop. In other words, only print the values when vals is not empty and then stop the z-loop and switch to the next values of x and y.

But my output is like this:

{{{{1, 1, 0, {a1, a2, b1, b2}}, {1, 1, 1, {a1, a2, b1, b2}}, {1, 1, 
    2, {a1, a2, b1, b2}}, {1, 1, 3, {a1, a2, b1, b2}}, {1, 1, 
    4, {a1, a2, b1, b2}}, {1, 1, 5, {a1, a2, b1, b2}}, {1, 1, 
    6, {a1, a2, b1, b2}}, {1, 1, 7, {a1, a2, b1, b2}}, {1, 1, 
    8, {a1, a2, b1, b2}}, {1, 1, 9, {a1, a2, b1, b2}}, {1, 1, 
    10, {a1, a2, b1, b2}}}

plotting the names for a1,a2,b1,b2 when no solution was found.

My mathematica coding is a bit rust and this code seems far from elegant. And I hope it is clear what I mean :).

Answer 1

Two points:

1. If you don't know how many results a piece of code will give, you can use Reap and Sow to collect the results you want.

2. If you want to break from the loop over z, simply use Break[] within an appropriate If test.

I would do the following:

ans = Reap[
   Do[
    Do[
     instances = 
      FindInstance[(a1 - a2) - (b1 - b2) == z && a1 + b1 == g1Size && 
        a2 + b2 == g2Size && a1 + a2 == g1Size && b1 + b2 == g2Size &&
         a1 > 0 && a2 > 0 && b1 > 0 && b2 > 0, {a1, a2, b1, b2}, 
       Integers];
     If[instances =!= {},
      Sow[{g1Size, g2Size, z, {a1, a2, b1, b2} /. instances}]; 
      Break[]
      ]
     , {z, 0, 10}]
    , {g1Size, 1, 10}, {g2Size, 1, 10}]
    ];

The results are found with ans[[2,1]], which gives a list that's a bit too long to reproduce here :)

Answer 2

This may me done a bit faster (speed increases by factor 4; there may be potential for more increase) by doing it the functional way:

rangeX = rangeY = Range[10];

(* the function fz will find exactly on solution given z ∈ [0,10] if it exists *)
fz = Function[ {g1Size, g2Size},
    With[
      {
        sol = FindInstance[
          (a1 - a2) - (b1 - b2) == z
          && a1 + b1 == g1Size
          && a2 + b2 == g2Size
          && a1 + a2 == g1Size
          && b1 + b2 == g2Size
          && a1 > 0 && a2 > 0 && b1 > 0 && b2 > 0 &&  0 <= z <= 10,
          {z, a1, a2, b1, b2},
          Integers
        ]
      },
      If[ sol === {},
          (* then *)
          Nothing,
          (* else *)
          { g1Size, g2Size, z, {a1, a2, b1, b2}} /. sol 
      ]
    ]
];

solList = Outer[ fz[ #1, #2]&, rangeX, rangeY] // Flatten[ #, 2 ]&;

Short@solList

{{2,2,0,{1,1,1,1}},{2,3,1,{1,1,1,2}},<<77>>,{10,9,3,{6,4,4,5}},{10,10,0,{5,5,5,5}}}

References:

• FindInstance
• Outer
• Nothing
• ReplaceAll
• Flatten