Quick way to use conditioned patterns when defining multi-argument function?

Question

I have a simple function that is supposed to only accept numeric values (i.e. complex/real numbers and constant symbols e.g. Pi, E).

$$f(a,b,c)=a+b+c$$

Edit: I should have chosen a less simple function for this question as there might be approaches that will work for this simple function but not for functions in general (1-see end of question). Please think of a more complicated function, such as $$f(a,b,c)=a^2 \sin(b) \log(c)$$ when you're thinking of an answer.

I know that one can use _?NumericQ for each parameter such that only numeric values of that parameters are entered into the function (click here for more information on putting constrains on patterns).

Clear[f1]
f1[a_?NumericQ, b_?NumericQ, c_?NumericQ] := a + b + c

f1 @@@ {{1, 2, 3}, {x, y, z}, {1, y, z}, {x, 2, z}, {x, y, 3}}
(* {6, f[x, y, z], f[1, y, z], f[x, 2, z], f[x, y, 3]} *)

However, for functions with more than 1 variables, I'm way too lazy to add NumericQ after each parameter. Using /; at the end of the function definition works, but I feel it's still too long and I have to retype the name of the parameters (a,b,c) at the end.

Clear[f2, f3]
f2[a_, b_, c_] := a + b + c /; And @@ (NumericQ[#] & /@ {a, b, c})
f3[a_, b_, c_] := a + b + c /; VectorQ[{a, b, c}, NumericQ]

Is there any way to express the condition only once, and without having to type the list of parameters one more time? I know that this is a frivolous question borne out of sheer laziness but I'd love to hear your ideas.

(1) such as using the double underscore (BlankSequence) to apply NumericQ to any number of arguments passed to Plus (per Kuba's helpful suggestion). This is because these arguments have identical hierarchy in the function--thus having no need for parameters with different names to represent them--and because Plus can take any number of arguments.

Clear[f4]
f4[a__?NumericQ] := Plus[a]

f4 @@@ {{1, 2, 3}, {x, y, z}, {1, y, z}, {x, 2, z}, {x, y, 3}}    
(* {6,f4[x,y,z],f4[1,y,z],f4[x,2,z],f4[x,y,3]} *)

Answer 1

Ramblings

Arguments of the left-hand-side head are evaluated in the course of function definition, therefore you can use a utility function that constructs the patterns that you want. For example:

SetAttributes[nq, HoldFirst]
Quiet[
 nq[s_Symbol] := s_?NumericQ
]

Now:

ClearAll[f]

f[nq @ a, nq @ b, nq @ c] := a + b + c

Definition[f]

f[a_?NumericQ, b_?NumericQ, c_?NumericQ] := a + b + c

Doing this you lose the nice syntax highlighting shown in the original.

If you Block all Symbols you could even Map the utility function, e.g.:

Block[{f, a, b, c},
  Evaluate[nq /@ f[a, b, c]] := a + b + c
]

This hardly feels like a clean solution however. Perhaps you merely want something shorter than verbatim NumericQ? At risk of a tautology you could always do something like:

ClearAll[f]

q = NumericQ;
f[a_?q, b_?q, c_?q] := a + b + c

But this requires you to keep the Global definition q or it will break as it is not expanded to NumericQ in the definition itself:

Definition[f]

f[a_?q, b_?q, c_?q] := a + b + c

Metaprogramming approach

Another approach would be to write a function to modify all Pattern objects on the left-hand-side at the time of assignment. Something like:

SetAttributes[defWithTest, HoldFirst]

defWithTest[(s : Set | SetDelayed)[LHS_, RHS_], test_] := 
  s @@ Join[Hold[LHS] /. p_Pattern :> p?test, Hold[RHS]]

Now:

ClearAll[f]

defWithTest[
  f[a_, b_, c_] := a + b + c,
  NumericQ
]

Definition[f]

f[a_?NumericQ, b_?NumericQ, c_?NumericQ] := a + b + c

---

Proposed solution

As Kuba and rasher show in the comments you could also use clever alternatives to the explicit form f[a_?NumericQ, b_?NumericQ, c_?NumericQ]. Inspired by those comments I propose:

SetAttributes[numArgsQ, HoldFirst]
numArgsQ[_[___?NumericQ]] := True

Now:

ClearAll[f]

f[a_, b_, c_]?numArgsQ := a + b + c

Test:

f[1, 2, 3]
f["a", 2, 3]

6

f["a", 2, 3]

For examples of advanced argument testing with an emphasis on messages please see:

• How to check the style and number of arguments like the built-in functions?

Note how (some) internal functions pass additional argument checking (and message generation) to an auxiliary function, e.g. ChartArgCheck, much as I did in the minimal application of numArgsQ above.

Answer 2

Update

I was reading the comments to the question, and found that @Kuba had already provided the following answer. I think it's the cleanest solution, so it deserves to be an answer, but please credit him with the idea.

Another idea is to use PatternSequence:

ClearAll[f]

f[PatternSequence[a_,b_,c_]?NumericQ] := a+b+c

Examples:

f[1,2,3]
f["a",2,3]

6

f["a", 2, 3]

Generalization

We can generalize the idea behind this answer as follows:

SequencedPattern[a_] := PatternSequence[##]?a&

Then, we can use SequencedPattern as follows:

f[SequencedPattern[NumericQ][a_, b_, c_]] := a + b + c

The previous examples still work:

f[1, 2, 3]
f["a", 2, 3]

6

f["a", 2, 3]

Here is another example using SequencedPattern:

f[SequencedPattern[PrimeQ][a_, b_, c_], d_] := (a+b+c)/d

f[2,3,4,10]
f[2,3,7,11]

f[2, 3, 4, 10]

12/11

Answer 3

I think there is another way to do that:

f[s : (PatternSequence[_?NumericQ] ..)] /; Length[{s}] == 3 :=
 Function[{a, b, c}, a^2 Sin[b] Log[c]][s]

It's suitable for the cases that conditions are the same.

Answer 4

A Slightly More Complex Case Where Level-1 Heads Can Vary

1. My way by defining a short alias for a long pattern because I don't know any better. However this works!

However before we start how can I add the following condition: /;x!=y preferably to cpat or inside the definition zinfy1[(x:cpat,y:cpat)/;x!=y] (does this look correct?) and not in the inside or at the end of the function body?

(* cpat for common pattern *)
(* all arguments Integers >= 0 or +Infinity *)
cpat = _Integer?(# >= 0 &) | Infinity;

zinfy1[x : cpat, y : cpat] := Style[#, 20, Bold, Green] & /@ {x, y};
zinfy1[x_, y_] := Style[#, 20, Bold, Red] & /@ {x, y};

(* should pass - all args Greeen *)
{zinfy1[1, 2], zinfy1[3, 2 + 3], zinfy1[Infinity, 1], zinfy1[0, 0]}

(* should fail- all args Red *)
{zinfy1[Infinity, -9], zinfy1[3, 2 - 3], zinfy1[-1 Infinity, 0], 
 zinfy1[-1, 1]}

2. An Attempt to Implement `SequencePattern` on same function and test cases completely fails.

And I don't know why. Anyone here feeling a little adventurous up for the challenge? I could sure use a little help solving this.

SequencedPattern[a_] := PatternSequence[##]?a &;
zinfy2[SequencedPattern[cpat][x_, y_]] := 
  Style[#, 20, Bold, Green] & /@ {x, y};
zinfy2[x_, y_] := Style[#, 20, Bold, Red] & /@ {x, y};

(* should pass - all args Greeen *)
{zinfy2[1, 2], zinfy2[3, 2 + 3], zinfy2[Infinity, 1], zinfy2[0, 0]}

(* should fail- all args Red *)
{zinfy2[Infinity, -9], zinfy2[3, 2 - 3], zinfy2[-1 Infinity, 0], 
 zinfy2[-1, 1]}