cmlboot.src

没有说明

/*
** cmlboot.src   CMLboot - Bootstrapped Maximum Likelihood
**
**
** (C) Copyright 1994-1996  Aptech Systems, Inc.
** All Rights Reserved.
**
** This Software Product is PROPRIETARY SOURCE CODE OF APTECH
** SYSTEMS, INC.    This File Header must accompany all files using
** any portion, in whole or in part, of this Source Code.   In
** addition, the right to create such files is strictly limited by
** Section 2.A. of the GAUSS Applications License Agreement
** accompanying this Software Product.
**
** If you wish to distribute any portion of the proprietary Source
** Code, in whole or in part, you must first obtain written
** permission from Aptech Systems.
**
**-------------------**------------------**-------------------**-----------**
**-------------------**------------------**-------------------**-----------**
**
**   PROC CMLboot
**
**   FORMAT
**          { x,f,g,cov,retcode } = CMLboot(dataset,vars,&fct,start)
**
**   INPUT
**
**    dataset - string containing name of GAUSS data set, or
**              name of data matrix stored in memory
**
**       vars - character vector of labels selected for analysis, or
**              numeric vector of column numbers in data set
**              of variables selected for analysis
**
**        fct - the name of a procedure that returns either
**              the log-likelihood for one observation or a vector of
**              log-likelihoods for a matrix of observations
**
**      start - a Kx1 vector of start values
**
**   OUTPUT
**          x - Kx1 vector, bootstrapped estimates
**          f - scalar, bootstrapped function at minimum (mean log-likelihood)
**          g - Kx1 vector, bootstrapped gradient evaluated at x
**        cov - KxK matrix, covariance matrix of the bootstrapped parameters
**    retcode - return code:
**
**           0   normal convergence
**           1   forced exit
**           2   maximum number of iterations exceeded
**           3   function calculation failed
**           4   gradient calculation failed
**           5   Hessian calculation failed
**           6   step length calculation failed
**           7   function cannot be evaluated at initial parameter values
**           8   error with gradient
**           9   error with constraints
**          10   secant update failed
**          11   maximum time exceeded
**          12   error with weights
**          13   quadratic program failed
**          20   Hessian failed to invert
**          34   data set could not be opened
**          99   termination condition unknown
**
**-------------------**------------------**-------------------**-----------**
**-------------------**------------------**-------------------**-----------**
**
**   GLOBAL VARIABLES                                                     LINE
**
**    _cml_BootFname - string, file name of GAUSS dataset (do not include
**                        the .DAT extension) containing bootstrapped
**                        parameter estimates.  If not specified, CMLBOOT
**                        will select the file name, BOOTxxxx where xxxx is
**                        0000 incremented by 1 until a name is found that
**                        doesn't exist on the current directory.
**
**    _cml_NumSample - scalar, sets number of re-samples for the bootstrap.
**                        Default = 100.
**
**    _cml_MaxTime - scalar, maximum time in bootstrap.
**                      Default = 1e5 minutes.
**
**   see CML.SRC for description of additional global variables
*/

#include cml.ext

proc (5) = CMLboot(dataset,var,lfct,start);
    local x,f,g,h,retcode,ofname;
    local nobs,wgt,ttime,tt0,ff,l1,fhandle,fout,g0,ncase, itdta,
        mm,mn,incr,tme,iter,xv,title0,it0,yv,zv,i,j,k,l;

    if type(dataset) == 13 and dataset $/= "";
        open fhandle = ^dataset;
        if fhandle == -1;
            if not trapchk(4);
                errorlog dataset $+ " could not be opened";
            endif;
            retp(start,error(0),error(0),error(0),error(34));
        endif;
        nobs = rowsf(fhandle);
        fhandle = close(fhandle);
    else;
        nobs = rows(dataset);
    endif;

    if _cml_BootFname $== "";
        ofname = tempname("","boot",".dat");
        if ofname $== "";
            errorlog "ERROR:  file name selection for bootstrap dataset fai"\
                "led";
            retp(start,error(0),error(0),error(0),error(99));
        endif;
        _cml_BootFname = ofname;
    else;
        ofname = _cml_BootFname;
    endif;

    if _cml_ParNames $== "";
        create fout = ^ofname with PAR_,rows(start),8;
    else;
        create fout = ^ofname with ^_cml_ParNames,0,8;
    endif;

    tme = 0;
    iter = 1;
    ttime = date;
    tt0 = ftos(_cml_NumSample,"%0*.*lf",1,0);
    clear ncase,mn,mm,ff,g0,itdta;
    do until iter > _cml_NumSample or tme > _cml_MaxTime;

        if __weight == 0;
            wgt = _cmlboot_rnd3(nobs);
        else;
            wgt = __weight .* _cmlboot_rnd3(nobs);
        endif;

        title0 = __title $+ " - " $+ ftos(iter,"%0*.*lf",1,0) $+ " of " $+
            tt0 $+ " -";

        { x,f,g,L1,retcode,L1,it0,L1,L1,L1,L1 } = _cml(dataset,var,lfct,
            start, _cml_Algorithm, 0, _cml_Delta, _cml_Extrap,
            _cml_GradMethod, _cml_GradProc, _cml_DirTol, _cml_HessProc,
            _cml_Interp, _cml_Key, _cml_Lag, _cml_MaxIters, _cml_MaxTime,
            _cml_MaxTry, _cml_NumObs, _cml_ParNames,
            _cml_LineSearch, _cml_Options, _cml_UserSearch,
            _cml_UserNumGrad, _cml_UserNumHess, _cml_Active, _cml_GradStep,
            _cml_GradCheckTol, __altnam, 0, __row, title0, wgt );

        if retcode == 0;
            ncase = ncase + 1;
            mn = mn + x;
            mm = mm + x * x';
            ff = ff + f;
            g0 = g0 + g;
            itdta = itdta + it0;
            call writer(fout,x');
            start = mn / ncase;
        endif;

        tme = ethsec(ttime,date)/6000;
        iter = iter + 1;
    endo;

    fout = close(fout);
    if ncase > 0;
        mn = mn / ncase;
        mm = mm / ncase - mn * mn';
        ff = ff / ncase;
        g0 = g0 / ncase;
        itdta[1:2] = itdta[1:2] / iter;
        itdta[3] = "BOOT";
        _cml_IterData = itdta;
        if tme >= _cml_MaxTime;
            retcode = 11;
        else;
            retcode = 0;
        endif;
    else;
        mn = error(0);
        ff = error(0);
        g0 = error(0);
        mm = error(0);
        _cml_IterData = itdta;
        _cml_IterData[3] = "";
        retcode = 99;
    endif;
    _cml_NumObs = ncase;

    if __output;
        cls;
        print "bootstrapped coefficients stored in "$+ofname;
    endif;

    retp(mn,ff,g0,mm,retcode);

endp;

proc _cmlboot_rnd3(n);
    local ff;

    ff = { 0.367879441171442, 0.735758882342884, 0.919698602928604,
        0.981011843123844, 0.996340153172654, 0.999405815182418,
        0.999916758850708, 0.999989750803323, 0.999998874797402,
        0.999999888574521, 0.999999989952236, 0.999999999168391,
        0.999999999936404, 0.999999999995483, 0.999999999999697,
        0.999999999999984, 1.000000000000000 };

    retp(sumc(rndu(n,1)'.>ff));
endp;