Search code examples
wolfram-mathematicapuzzle

Mathematica's Minimize function


Is it true that Mathematica's Minimize function does not allow constraints like Mod[x,2]==0? I am trying to solve a MinuteMath puzzle with Mathematica:

What is the smallest possible average of four distinct positive even integers?

My "solution" looks like this:

vars = Subscript[x, #] & /@ Range[4];
cond = Apply[And, Mod[#, 2] == 0 & /@ vars] && 
   (0 < Subscript[x, 1]) &&
   Apply[And, Table[Subscript[x, i] < Subscript[x, i + 1], {i, 1, 3}]];
Minimize[{Mean[vars], cond}, vars, Integers] 

but Minimize returns unevaluated. Additional question: Can I use EvenQ for defining the constraints? Problem is, EvenQ[x] returns False for undefined expressions x.


Solution

  • A clear overkill for this problem, but useful to show some tricks.

    Note that:

     Exists[x, Element[x, Integers] && n x == y]
    

    can be used as an alternative to

      Mod[y,n] == 0
    

    So:

    Minimize[{(x1 + x2 + x3 + x4)/4, 0 < x1 < x2 < x3 < x4 && 
       Exists[x, Element[x, Integers] && 2 x == x1] &&
       Exists[x, Element[x, Integers] && 2 x == x2] &&
       Exists[x, Element[x, Integers] && 2 x == x3] &&
       Exists[x, Element[x, Integers] && 2 x == x4]
      },
     {x1, x2, x3, x4}, Integers]  
    
    -> {5, {x1 -> 2, x2 -> 4, x3 -> 6, x4 -> 8}}  
    

    Or perhaps more elegant:

    s = Array[x, 4];  
    Minimize[{  
      Total@s,  
      Less @@ ({0} \[Union] s) &&  
       And @@ (Exists[y, Element[y, Integers] && 2 y == #] & /@ s)},
    s, Integers]
    
    --> {20, {x[1] -> 2, x[2] -> 4, x[3] -> 6, x[4] -> 8}}