14
$\begingroup$

A homogeneous function of degree $k$ is defined as a function that observes the following specification rule:

$f(a x_1, a x_2, ..., a x_n) = a^k f(x_1, x_2, ..., x_n)$

(see Wikipedia entry, Positive homogeneity)

Also, it satisfies the Euler homogeneous function theorem; i.e

$k f= x_1f_{x_1}+x_2f_{x_2}+...+x_nf_{x_n}$

where $f_{(.)}$ denotes a partial derivative.

Finally, the derivative of a homogeneous function is also a homogeneous function with a degree of homogeneity equal to the degree of homogeneity of the initial function minus one.

What is a proper idiomatic way to define homogeneous functions that allows seamless symbolic as well as numeric manipulation?

(some) Examples of desired behavior (assume $g(y, z)$ is homogeneous of degree $k$)

 In[1]: g[b y, b z]
Out[1]: b^k g[y, z]

,

In[2]: g[y b, b z]/.b->1/z
Out[2]: (1/z)^k g[y/z, 1]

,

 In[3]: D[g[y b, z b], b]
Out[3]: k g[y, z]
$\endgroup$
  • $\begingroup$ This will replicate the behavior, but i don't know if this is what you are looking for: Attributes[f]=HoldAll; f[x_*a_:1,x_*b_:1]:=x^k f[a,b]; f/:k*f[a_,b_]:=a*Derivative[1,0,0,0][f][a,b]+b*Derivative[0,1,0,0][f][a,b]; $\endgroup$ – ruddi02 Aug 27 '16 at 10:59
  • 1
    $\begingroup$ Take a look at upvalues in Mathematica. This should explain what you can do with custom assignments in Mathematica, even if certain symbols like D are protected. $\endgroup$ – Wizard Aug 27 '16 at 12:40
  • $\begingroup$ @ruddi02: yep, HoldAll does the trick in order to achieve the definition of a homogeneous function i.e $f(a x, a y)=a^k f(x,y)$ but In[1]: f[x,x] spits out a RecursionLimit error. Also, defining the upvalue wrt f certainty produces the desired result as far as Euler's theorem is concerned but In[2]: D[g[y b, z b], b] still doesn't evaluate to k g[y, z] as it should. Thanks for the input! $\endgroup$ – user42582 Aug 27 '16 at 13:10
  • $\begingroup$ @Wizard: I have looked at upvalues (I even used the tag for it) and the reason I posted is that I cannot seem to make it work. Will have another go at it later... . Thanks. $\endgroup$ – user42582 Aug 27 '16 at 13:18
8
$\begingroup$

Update 1: Answer restructured and code modified to address OP's comments.

Update 2: Code extended to account for the cases mentioned in OP's comments (see Definition 2 in commented line in the code).

Update 3: Code extended to account for cases with powers, such as g[x^2, x^3].


This only addresses the first property of OP's question:

$f(a x_1, a x_2, ..., a x_n) = a^k f(x_1, x_2, ..., x_n)$


Introduction

makeHomogeneous[f, k] defines for a symbol f a downvalue that encodes the homogeneity of degree k. Some particular features of the code are:

1) The homogeneity property applies for any number of arguments passed to f.

2) The downvalue for homogeneity always fires first, even if other downvalues were defined previously.

3) The degree k needs to be given as a symbol or a positive integer.

4) Exponents of powers must be nonnegative integers or symbols for the homogeneity property to fire.

Code

makeHomogeneous[fun_Symbol, k : (_Integer?NonNegative | _Symbol)] :=
    Module[{downvalues = DownValues[fun]},

        DownValues[fun] = {};

        (** Definition 1 **)

        fun[args : HoldPattern[Times[__]] ..] := Module[
            {list = {args}, fact, x, res, temp, hold},

            temp = Replace[list, 
               Power[a_, expn_] /; MatchQ[expn, _Integer?NonNegative | _Symbol] :> 
                      a hold[Power[a, expn - 1]], {2}];

            fact = MaximalBy[GatherBy[Join @@ List @@@ temp, Identity], Length];
            If[Length[fact[[1]]] == Length[list],
                 fact = Times @@ fact;
                 x = Divide[list, fact];
                 res = (First@ fact)^k fun @@ x /. hold -> Identity,
                 res = $Failed
            ];

            res /; res =!= $Failed

        ];

        (** Definition 2 **)

        fun[args___] := Block[{$tried = True}, 
            Module[{list = {args}, a, temp, hold},

                temp = Replace[list,
                   Power[x_, expn_] /; MatchQ[expn, _Integer?NonNegative | _Symbol] :> 
                   x hold[Power[x, expn - 1]],
                   {1}
                ];

                fun[Sequence @@ (a temp)] /. {a -> 1, hold -> Identity}
            ]

        ] /; ! TrueQ[$tried];


        AppendTo[DownValues[fun], downvalues];

    ];

Usage

makeHomogeneous[g, k]

g[a x, a y]
(* a^k g[x, y] *)

g[a x, x y]
(* x^k g[a, y] *)

g[a x, a x]
(* (a x)^k g[1, 1] *)

g[a x, a y b]
(* a^k g[x, b y] *)

g[5 x, 5 x y, 5 x y z]
(* 5^k x^k g[1, y, y z] *)

(* Update 2 *)

g[x, x]
(* x^k g[1, 1] *)

g[x, x y]
(* x^k g[1, y] *)

g[x, a x, x y, x y z]
(* x^k g[1, a, y, y z] *)

(* Update 3 *)

g[x, x^2]
(* x^k g[1, x] *)

g[a x, a x^p, a x^q]
(* (a x)^k g[1, x^(-1 + p), x^(-1 + q)] *)

g[x^l y^m, x^p y^q]
(* (x y)^k g[x^(-1 + l) y^(-1 + m), x^(-1 + p) y^(-1 + q)] *)

Comments

1) The homogeneity property applies for any number of arguments passed to f.

In case it is preferable to avoid this flexibility, the syntax of makeHomogeneous and its code could be modified as follows:

makeHomogeneous[{fun_Symbol, nbArgs_Integer?NonNegative}, 
                 k : (_Integer?NonNegative | _Symbol)] :=
    Module[{downvalues = DownValues[fun]},

        DownValues[fun] = {};

        With[{n = nbArgs},
          fun[args : Repeated[HoldPattern[Times[__]], {n}]] := ....
        ];

        With[{n = nbArgs},
          fun[args : Repeated[_, {n}]] := ...
        ];

        AppendTo[DownValues[fun], downvalues];

    ];

2) The downvalue for homogeneity always fires first, even if other downvalues were defined previously.

Here is an example:

g[x_, y_, z_, u_] := x y z u (* new downvalue after homogeneity definition above *)
g[5 x, 5 y, 5 z, 5 u]
(* 5^k u x y z *) (* homogeneity fires first *)
(* alternative would result in: 625 x y z *)

h[x_, y_] := x^6 y (* downvalue before homogeneity definition *)
h[x_, y_, z_] := x y^3 z^3 (* downvalue for three arguments *)

makeHomogeneous[h, p]

h[a x, a y]
(* a^p x^6 y *) (* homogeneity fires first *)
(* alternative would result in: a^7 x^6 y *)

h[2 x, 2 y, 2 z]
(* 2^p x y^3 z^3 *) (* homogeneity fires first *)
(* alternative would result in: 128 x y z *)

In case this behavior is not needed, the AppendTo in the code could be changed to PrependTo. This would modify the evaluations of h only.

3) The degree k needs to be given as a symbol or a positive integer.

The pattern test (_Integer?NonNegative | _Symbol) can be removed for complete flexibility. In case constraints are needed with more working cases, one could define a function degreeQ and test it on k with k_?degreeQ. Simple definitions for this symbol could be for instance:

degreeQ[_?Internal`RealValuedNumericQ] := True;
degreeQ[_Symbol] := True;
degreeQ[args: HoldPattern[Times[__]]] := And @@ degreeQ /@ List @@ args;
(* ... other definitions ... *)
degreeQ[_] := False;

4) Exponents of powers must be nonnegative integers or symbols for the homogeneity property to fire.

Here also, the pattern MatchQ[expn, _Integer?NonNegative | _Symbol] can be removed for more flexibility, and a function be added if necessary. This modification may yield recursion errors, which can be avoided by using the Block trick of the second definition on the first one as well.

| improve this answer | |
$\endgroup$
  • $\begingroup$ stuff that don't work: 1. In[1]:= g[x,x] returns Out[1]:= g[x,x] instead of the correct Out[1']:= x^k g[1,1] 2. In[2]:= D[g[a x, a x], a] returns Out[2]:= k (a x)^(k-1) g[1,1] instead of the correct Out[2']:= k g[x,y]. I guess that (1) is trivial to resolve and I understand that you have not tackled the issues with D[]. In any case, I'll consider the answer as correct and try to address the remaining shortcomings of the code myself. Thanx @Xavier $\endgroup$ – user42582 Aug 31 '16 at 19:44
  • $\begingroup$ just for history's sake, a fast solution to issue (1) above is to interject this: fun[args : HoldPattern[_] ..] := Module[{list = {args}, union, bool, seq, res, a}, union = Union[list]; bool = ((union =!= {1}) && (Length[union] == 1) && (Length[list] > 1)); If[bool === True, seq = Sequence @@ (a list); res = fun[seq]; res = res /. a -> 1, res = $Failed ]; res /; res =!= $Failed ]; between the original def of fun[] and the AppendTo[] in makeHomogeneous[] $\endgroup$ – user42582 Aug 31 '16 at 20:18
  • 1
    $\begingroup$ @user42582 Thanks for the accept. I have updated the code to account for case (1) and related. Inputs like g[x, x] and g[x, a x] now works. Note that the code is not yet complete, as the homogeneity property will not apply for things like g[x, x^2]. This should probably require a third definition in the code, or perhaps it could be mixed with definition 2 with additional checks and processing on args. $\endgroup$ – user31159 Aug 31 '16 at 23:45
  • 1
    $\begingroup$ @user42582 I've updated my answer to account for the above-mentioned missing cases. $\endgroup$ – user31159 Sep 5 '16 at 15:38

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.