Control evaluation for functional constraints

Question

I'm trying to understand how to use Mathematica to find a solution subject to constraints, where one of the constraints is specified as a predicate function. But I don't know how to control evaluation in order to use the predicate function as a condition.

Here's the problem. I want to find three integers, $a$, $b$, and $c$, subject to these constraints:

1. They sum to 70
2. Each of the integer is greater than or equal to 15 and less than 30
3. No digits from 1-9 appears twice if you consider all the digits in the squares of the integers.

So how do I approach this with Mathematica? I expect I can use FindInstance to find values under a set of constraints.

I can express constraints 1 and 2 by setting variables equal to equations and inequalities:

eq = (a + b + c == 70);
cs = 15 <= a <= 30 && 15 <= b <= 30 && 15 <= c <= 30;

In order to express the third constraint, I have defined this predicate function, which takes a list of numbers and returns true when they do not re-use digits:

UniqueDigitsQ[xss_] := With[
  {nonzeros = Select[Flatten[Map[IntegerDigits,xss]] ,#1!=0&]},
  SortBy[Tally[nonzeros],Last][[-1,-1]] <2];

So I would like to be able to express the third constraint by saying:

cs2 = UniqueDigitsQ[ {a^2,b^2,c^2} ];

But this fails, because the predicate function cannot handle symbolic argument.

Is there a way to fix this problem by defining the function in such a way that it does not evaluate until the arguments are numeric? Or else, what is the right approach?

Answer 1

Clear["Global`*"]

Find all solutions for the first two criteria then select from those the ones that meet the third criteria.

sol = Select[
  Solve[{a + b + c == 70, 15 <= a < 30, 15 <= b < 30, 
    15 <= c < 30}, {a, b, c}, Integers],
  (digits = Flatten[IntegerDigits[{a^2, b^2, c^2}] /. #];
    Length[digits] == Length[Union@digits]) &]

(* {{a -> 19, b -> 23, c -> 28}, {a -> 19, b -> 28, c -> 23}, {a -> 23, 
  b -> 19, c -> 28}, {a -> 23, b -> 28, c -> 19}, {a -> 28, b -> 19, 
  c -> 23}, {a -> 28, b -> 23, c -> 19}} *)

These are just permutations of {19, 23, 28}

EDIT: A user-defined function must be used in an equation or an inequality. Consequently, modify your function to return a numeric value.

UniqueDigitsQ[xss_?(VectorQ[#, NumericQ] &)] := With[
  {nonzeros = Select[Flatten[Map[IntegerDigits, xss]], #1 != 0 &]}, 
   Boole[SortBy[Tally[nonzeros], Last][[-1, -1]] < 2]];

Solve[{a + b + c == 70, 15 <= a < 30, 15 <= b < 30, 15 <= c < 30,
  UniqueDigitsQ[{a^2, b^2, c^2}] == 1}, {a, b, c}, Integers]

(* {{a -> 19, b -> 23, c -> 28}, {a -> 19, b -> 28, c -> 23}, {a -> 23, b -> 19, 
  c -> 28}, {a -> 23, b -> 28, c -> 19}, {a -> 28, b -> 19, 
  c -> 23}, {a -> 28, b -> 23, c -> 19}} *)