TABLE OF CONTENTS

CcurveUpdate/PopulateLocalCurve [ Functions ]

NAME

    PopulateLocalCurve --- populate a CCurve structure from an RCurve

FUNCTION

At initialization of the SplineSurvMainLoop, this routine populates a local curve that is easier to work with in C. Much of this just consists of creating a set of pointers that point to the appropriate locations in R memory.

SYNOPSIS

697 void PopulateLocalCurve( curveP theCurve, SEXP Rcurve)

INPUTS

    theCurve  a CCurve to be populated
    Rcurve    the RCurve that contains the current values

SOURCE

701 {
702     // has a parametric component?
703     theCurve->hasPar = asInteger(getListElement(Rcurve,"haspar"));
704     // has a spline component?
705     theCurve->hasSpline = asInteger(getListElement(Rcurve,"hasspline"));
706     // does it use adaptive knot selection?
707     theCurve->SplineAdaptive = asInteger(getListElement(Rcurve,"spline.adaptive"));
708     // length of observations (times/frailties)
709     theCurve->nx = (int) (length(getListElement(Rcurve,"x")));
710     // minimum spline parameter value
711     theCurve->SplineMin = REAL(getListElement(Rcurve,"spline.min"));
712     // spline prior varianc3
713     theCurve->SplinePriorvar =  REAL(getListElement(Rcurve,"spline.priorvar"));
714     // spline hyperparameters
715     theCurve->SplineHyper =  REAL(getListElement(Rcurve,"spline.hyper"));
716     // spline tuning parameters
717     theCurve->SplineTun =  REAL(getListElement(Rcurve,"spline.tun"));
718     // spline accept/reject of the last step
719     theCurve->SplineAccept =  REAL(getListElement(Rcurve,"spline.accept"));
720     // parameter prior variance
721     theCurve->ParamPriorvar = REAL(getListElement(Rcurve,"param.priorvar"));
722     // parametric tuning parameter
723     theCurve->ParamTun = REAL(getListElement(Rcurve,"param.tun"));
724     // parametric hyperparameters
725     theCurve->ParamHyper = REAL(getListElement(Rcurve,"param.hyper"));
726     // parametric accept/reject of last step
727     theCurve->ParamAccept = REAL(getListElement(Rcurve,"param.accept"));
728     // weight of spline component
729     theCurve->Weight = REAL(getListElement(Rcurve,"weight"));
730     // prior variance of weight
731     theCurve->WeightPriorvar = REAL(getListElement(Rcurve,"weight.priorvar"));
732     // hyperparameters of weight
733     theCurve->WeightHyper = REAL(getListElement(Rcurve,"weight.hyper"));
734     // tuning parameter of weight
735     theCurve->WeightTun = REAL(getListElement(Rcurve,"weight.tun"));
736     // accept/reject for last step of weight
737     theCurve->WeightAccept = REAL(getListElement(Rcurve,"weight.accept"));
738     // vector of observations
739     theCurve->X = REAL(getListElement(Rcurve,"x"));
740     // vector of the curve evaluated at X
741     theCurve->Y = REAL(getListElement(Rcurve,"y"));
742     // hazard curves also need a vector of cumulative hazard integrals
743     if(theCurve->isHazard) theCurve->Ycum =REAL(getListElement(Rcurve,"ycum"));
744     // frailty curve needs to keep track of acceptance of the frailties themselves
745     if(!theCurve->isHazard) theCurve->Accept =REAL(getListElement(Rcurve,"accept"));
746     // tuning parameter for the frailties
747     if(!theCurve->isHazard) theCurve->tun = REAL(getListElement(Rcurve,"tun"));
748 
749     // special terms for spline components
750     if(theCurve->hasSpline){  
751         // order of the spline
752         theCurve->SplineOrd=asInteger(getListElement(Rcurve,"spline.ord"));
753         // number of knots of the spline
754         theCurve->SplineNknots = asInteger(getListElement(Rcurve,"spline.nknots"));
755         // max number of knots
756         theCurve->SplineNknotsMax = asInteger(getListElement(Rcurve,"spline.maxoccknots"));
757         // hyperparameters for the number of knots
758         theCurve->SplineNknotsHyper = REAL(getListElement(Rcurve,"spline.nknots.hyper"));
759         // number of candidate knots
760         theCurve->SplineNCandKnots = asInteger(getListElement(Rcurve,"spline.ncandknots"));
761         // vector of candidate knot positions
762         theCurve->SplineCandKnots = REAL(getListElement(Rcurve,"spline.candknots"));
763         // vector of occupancies of candidate knots
764         theCurve->SplineCandOcc = REAL(getListElement(Rcurve,"spline.candocc"));
765         // constant used for birth-death-move step
766         theCurve->SplineBDMConst = REAL(getListElement(Rcurve,"spline.bdmconst"));
767         // number of spline basis functions
768         theCurve->nj = theCurve->SplineNknots + theCurve->SplineOrd;
769         // get the type of prior on the number of knots
770         const char * charNknotsPrior = 
771             CHAR(STRING_ELT(getListElement(Rcurve,"spline.nknots.prior"),0));
772         nknotsprior iNknotsPrior;
773         if(strcmp(charNknotsPrior,"poisson")==0) iNknotsPrior=PrPoisson;
774         if(strcmp(charNknotsPrior,"geometric")==0) iNknotsPrior=PrGeometric;
775         if(strcmp(charNknotsPrior,"poissonmix")==0) iNknotsPrior=PrPoissonMix;
776         if(strcmp(charNknotsPrior,"negbin")==0) iNknotsPrior=PrNegBin;
777         if(strcmp(charNknotsPrior,"power")==0) iNknotsPrior=PrPower;
778         theCurve->SplineNknotsPrior = iNknotsPrior;
779 
780         // get the type of smoothness penalty
781         const char * charPenaltyType = 
782             CHAR(STRING_ELT(getListElement(Rcurve,"spline.penalty"),0));
783         penalty iPenaltyType;
784         if (strcmp(charPenaltyType,"2diff") ==0) { iPenaltyType=pdiff; }
785         else if (strcmp(charPenaltyType,"2deriv") ==0) { iPenaltyType=pderiv; }
786         else if (strcmp(charPenaltyType,"log2deriv") ==0) { iPenaltyType=plogderiv;}
787         else { iPenaltyType=pnone;}
788         theCurve->SplinePenaltyType = iPenaltyType;
789         if(iPenaltyType != pnone) // if there is a penalty matrix, get it
790             theCurve->SplinePenaltyMatrix = 
791                 REAL(getListElement(Rcurve, "spline.penaltymatrix"));
792         // scaling factor for penalty
793         theCurve->SplinePenaltyFactor = REAL(getListElement(Rcurve,"spline.penaltyfactor"));
794         // vector of spline knots
795         theCurve->SplineKnots =  REAL(getListElement(Rcurve,"spline.knots"));
796         // spline basis matrix
797         theCurve->SplineBasis =  REAL(getListElement(Rcurve,"spline.basis"));
798         // vector of integrals of each basis function
799         theCurve->SplineBasisInt =  REAL(getListElement(Rcurve,"spline.basisint"));
800         // spline parameters
801         theCurve->SplinePar =  REAL(getListElement(Rcurve,"spline.par"));
802         // exponentials of spline parameters
803         theCurve->SplineEPar = (double *) malloc( 
804                 (theCurve->SplineNknotsMax + theCurve->SplineOrd) * sizeof(double));
805         for(int j=0; j< theCurve->nj; j++)
806             theCurve->SplineEPar[j] = exp(theCurve->SplinePar[j]);
807         // covariance matrix for candidate generation
808         theCurve->SplineCandCov =  REAL(getListElement(Rcurve,"spline.candcov"));
809         // cholesky factorization of the covariance matrix
810         theCurve->SplineCholCov =  REAL(getListElement(Rcurve,"spline.cholcandcov"));
811         // standard deviations for candidate generation
812         theCurve->SplineCandSD = REAL(getListElement(Rcurve,"spline.candsd"));
813         // spline component evaluated at X
814         theCurve->SplineY =  REAL(getListElement(Rcurve,"spline.y"));
815         if(theCurve->isHazard){
816             // hazards additionally need cumulative basis functions and cumulative
817             // spline component integrals
818             theCurve->SplineBasisCum =  REAL(getListElement(Rcurve,"spline.basiscum"));
819             theCurve->SplineYcum =  REAL(getListElement(Rcurve,"spline.ycum"));
820         }
821         if(!theCurve->isHazard){
822             // frailties need integrals of each basis function
823             theCurve->SplineBasisInt =  REAL(getListElement(Rcurve,"spline.basisint"));
824             // 1-expected value of each basis function
825             theCurve->SplineBasisExp =  REAL(getListElement(Rcurve,"spline.basisexp"));
826             // sum of exponentials of spline parameters
827             theCurve->SplineEParSum = 0;
828             for(int j=0; j< theCurve->nj; j++) 
829                 theCurve->SplineEParSum += theCurve->SplineEPar[j];
830             // variance of spline component of frailty
831             theCurve->SplineFvar = FrailtySplineVar(theCurve);
832             // penalty on the distance of the mean from 1
833             theCurve->SplineMeanPenalty = REAL(getListElement(Rcurve,"spline.meanpenalty"));
834             // which of the spline parameters is held fixed
835             theCurve->SplineFixedInd = 
836                 asInteger(getListElement(Rcurve, "spline.fixedind")) - 1;
837         }
838     }
839 
840     // parametric component only
841     if(theCurve->hasPar){
842         // parametric component parameters
843         theCurve->ParamPar = REAL(getListElement(Rcurve,"param.par"));
844         // parametric component evaluated at X
845         theCurve->ParamY = REAL(getListElement(Rcurve,"param.y"));
846         // cumulative integral for hazard
847         if(theCurve->isHazard)
848             theCurve->ParamYcum = REAL(getListElement(Rcurve,"param.ycum"));
849         // get parametric distribution
850         const char * charParamDist = CHAR(STRING_ELT(getListElement(Rcurve,"param.dist"),0));
851         distribution iParamDist;
852         if(strcmp(charParamDist,"exponential") == 0) { iParamDist = Dexponential; } 
853         else if(strcmp(charParamDist,"weibull") == 0) { iParamDist = Dweibull; } 
854         else if(strcmp(charParamDist,"gamma") == 0) { iParamDist = Dgamma; } 
855         else if(strcmp(charParamDist,"lognormal") == 0) { iParamDist = Dlognormal; } 
856         else { iParamDist = Dnone; } 
857         theCurve->ParDist = iParamDist;
858         // number of parametric component parameters
859         theCurve->np = (int) (length(getListElement(Rcurve,"param.par")));
860         // candidate generation for parametric component parameters
861         theCurve->ParamCandCov =  REAL(getListElement(Rcurve,"param.candcov"));
862         theCurve->ParamCholCov =  REAL(getListElement(Rcurve,"param.cholcandcov"));
863     }
864 }