Model Definition for Tweedie Distribution with Mean Parameter

/*--------------------------------------------------------------

                    SAS Sample Library

        Name: svrttwdy.sas
 Description: Example Program from SAS/ETS User's Guide,
              The SEVERITY Procedure
       Title: Model Definition for Tweedie Distribution with Mean Parameter
     Product: SAS/ETS Software
        Keys: fitting continuous distributions
        PROC: SEVERITY
       Notes: If you run this sample program without any modification, then
              the Sasuser.Svrtdist library contains functions and subroutines
              that are identical to those in the Sashelp.Svrtdist library.
              Further, if you run this sample without any modification to the
              names of functions and subroutines, then PROC FCMP writes
              warnings of the following nature to the SAS log:
              WARNING: Function <name> was defined in a previous package.
                       Function <name> as defined in the current program will
                       be used as default when the package is not specified.
              You can ignore such warnings; they appear because the functions
              defined in this sample are already defined in the input library
              Sashelp.Svrtdist.

--------------------------------------------------------------*/
proc fcmp library=sashelp.svrtdist outlib=sasuser.svrtdist.models;
    function TWEEDIE_DESCRIPTION() $48;
        return ("Tweedie Distribution with Mean Parameter");
    endsub;

    function TWEEDIE_PARMCOUNT();
        return (3);
    endsub;

    function TWEEDIE_LOGPDF(x, p, mu, phi);
        _delta_ = 1.0e-3;
        return (logpdf('TWEEDIE', x, p, mu, phi));
    endsub;
    function TWEEDIE_PDF(x, p, mu, phi);
        _delta_ = 1.0e-3;
        return (pdf('TWEEDIE', x, p, mu, phi));
    endsub;
    function TWEEDIE_LOGCDF(x, p, mu, phi);
        _delta_ = 1.0e-3;
        return (logcdf('TWEEDIE', x, p, mu, phi));
    endsub;
    function TWEEDIE_CDF(x, p, mu, phi);
        _delta_ = 1.0e-3;
        return (cdf('TWEEDIE', x, p, mu, phi));
    endsub;
    function TWEEDIE_LOGSDF(x, p, mu, phi);
        _delta_ = 1.0e-3;
        return (logsdf('TWEEDIE', x, p, mu, phi));
    endsub;
    function TWEEDIE_SDF(x, p, mu, phi);
        _delta_ = 1.0e-3;
        return (sdf('TWEEDIE', x, p, mu, phi));
    endsub;

    subroutine TWEEDIE_LOWERBOUNDS(p, mu, phi);
        outargs p, mu, phi;
        /* Tweedie is undefined for 0 < p < 1 and is not much useful for p < 0;
           hence set lower limit to 1 */
        p = 1;
        mu = 0;
        phi = 0;
    endsub;

    subroutine TWEEDIE_PARMINIT(dim, x[*], nx[*], F[*], Ftype, p, mu, phi);
        outargs p, mu, phi;
        array m[2] / nosymbols;

        /* initialize p */
        gscale = .;
        gshape = .;
        call gamma_parminit(dim, x, nx, F, Ftype, gscale, gshape);
        if (not(missing(gshape))) then do;
            /* use approximation in 1<p<2 range of gshape = (2-p)/(p-1) */
            p = (gshape+2)/(gshape+1);
        end;
        else
            p = 1.5;

        /* initialize mu and phi */
        call svrtutil_rawmoments(dim, x, nx, 2, m);
        mu = m[1]; /* sample mean */
        v = m[2] - m[1]*m[1]; /* sample variance */
        phi = v/(mu**p); /* use variance = phi*mu**p property of Tweedie */
    endsub;

    function TWEEDIE_QUANTILE(prob, p, mu, phi);
        return (quantile('TWEEDIE', prob, p, mu, phi));
    endsub;

    function TWEEDIE_MEAN(x, P, Mu, Phi);
        return (Mu);
    endsub;
quit;