Defining a function which is numerical on all vectors of arguments

Question

There is an attribute NumericFunction in Mathematica that can do the following job:

Attributes[f] = {NumericFunction};
NumericQ[f[1,2,3,4]]

then returns true. However, the following return false

NumericQ[f[{1,2,3,4}]]; NumericQ[f[1,{2},3,{4}]]

which makes sense by Documentation on NumericFunction. However, I want to define a function $f$ that returns True even in above cases, how can this be achieved?

Curiously, functions like HypergeometricPFQ has Attributes NumericFunction, but NumericQ[HypergeometricPFQ[{1, Sqrt[2]}, {Pi}, 1/3]] still returns true despite having lists in its arguments, why?

My goal is to define an f such that all expressions like f[1,{2},3,{4}], 1+5*f[1,{2},3,{4}], Sin[1+5*f[1,{2},3,{4}]] returns true upon NumericQ. How can this be done?

Thank you.

---

Update: After much thoughts, I think I found a solution:

SetAttributes[f, NumericFunction]; Unprotect[NumericQ];
$numericflag = 0; 
NumericQ[expr_] /; FreeQ[expr, f] == False && $numericflag == 0 := 
 Block[{bool}, $numericflag = 1; 
  bool = NumericQ[expr /. f[x__] :> f @@ Flatten[{x}]]; $numericflag =
    0; Return[bool]]; Protect[NumericQ];

it works as expected: NumericQ[Pi + 58 + f[2, 3, {4, 4}]], NumericQ[Sin[f[2,{3,{0,0}}]]] all return true.

Answer 1

I thought @swish would incorporate my comment, but let me put it here, since it is an answer to the question. In the following, the arguments of f can be numbers or any sort of nested lists of numbers.

f /: NumericQ[f[args___]] /; VectorQ[Flatten@{args}, NumericQ] := True;

NumericQ[f[1, 2, 3, 4]]
NumericQ[f[{1, 2, 3, 4}]]
NumericQ[f[1, {2}, 3, {4}]]
NumericQ[f[x]]  (* False -- should check both cases T, F *)
NumericQ[f[]]   (* True  -- same as `NumericQ[Sin[]]` *)
(*
  True
  True
  True
  False
  True
*)

---

Update

@pisco points out that the above does not work if f[..] is nested inside other numeric expressions. There is an internal function that could be used to replace NumericQ:

ClearAll[f];
Attributes@f = {NumericFunction};

Internal`WouldBeNumericQ[2 + f[1, {2}, 3], {}]
(*  True  *)

The last list is a list a variables, the function tests whether f would be numeric if numeric values were substituted for the variables.

Answer 2

There is a slight problem with NumericQ, that prevents one to define your UpValues with it. So that would not work as expected:

f /: NumericQ[_f] := True

But manually

UpValues[f] = {HoldPattern[NumericQ[_f]] :> True};

it works as expected:

NumericQ[f[{1, 2, 3, 4}]]
NumericQ[f[1, {2}, 3, {4}]]
(* True *)
(* True *)