local RS real scalar local RM real matrix program define survsim_user_core version 14.2 syntax , stime(varname) /// maxtime(string) /// logu(varname) /// expxb(varlist) /// tdexb(varlist) /// [ /// ltruncated(varname) /// CHazard /// MARGinal /// ] // mata: survsim_user($overallsyntax2) end mata: void survsim_user($overallsyntax1) { N = st_nobs() ismarginal = st_local("marginal")!="" st_view(time = .,.,st_local("stime")) st_view(maxt = .,.,st_local("maxtime")) st_view(expxb = .,.,st_local("expxb")) st_view(tdexb = .,.,st_local("tdexb")) st_view(rc = .,.,"_survsim_rc") st_view(logu = .,.,st_local("logu")) if (st_local("ltruncated")!="") { st_view(lt=.,.,st_local("ltruncated")) } else lt = J(N,1,smallestdouble()) hazard = st_local("chazard")=="" if (hazard) { nodes = st_matrix("r(nodes)")' weights = st_matrix("r(weights)") } maxit = 1000 tol = 0 if (hazard) { if (ismarginal) { for (i=1;i<=N;i++){ rc[i] = mm_root( /// t=.,&survsim_user_hazard_marg(),lt[i],maxt[i],tol,maxit, /// logu[i],nodes,weights,i,expxb,lt[i],tdexb,N /// ${mmrootsyntax1} /// ) // time[i] = t } } else { for (i=1;i<=N;i++){ rc[i] = mm_root( /// t=.,&survsim_user_hazard(),lt[i],maxt[i],tol,maxit, /// logu[i],nodes,weights,i,expxb[i,],lt[i],tdexb[i,] /// ${mmrootsyntax1} /// ) // time[i] = t } } } else { for (i=1;i<=N;i++){ rc[i] = mm_root( /// t=.,&survsim_user_chazard(),lt[i],maxt[i],tol,maxit, /// logu[i],i,expxb[i,],lt[i],tdexb[i,] /// ${mmrootsyntax1} /// ) // time[i] = t } } } function survsim_user_hazard( `RS' t, /// `RS' logu, /// `RM' nodes, /// `RM' weights, /// `RS' i, /// `RM' expxb, /// `RS' lt, /// `RM' tdexb /// ${mmrootsyntax2} /// ) // { tnodes = (t :- lt) :* 0.5 :* nodes :+ (t :+ lt) :/ 2 tweights = (t :- lt) :* weights :/ 2 chq = $chaz if (min(chq)<0) { errprintf("hazard() gives negative values\n") exit(198) } return(chq * tweights :+ logu) } function survsim_user_chazard( `RS' t, /// `RS' logu, /// `RS' i, /// `RM' expxb, /// `RS' lt, /// `RM' tdexb /// ${mmrootsyntax2} /// ) // { return((${chaz}) :+ logu) } function survsim_user_hazard_marg( `RS' t, /// `RS' logu, /// `RM' nodes, /// `RM' weights, /// `RS' i, /// `RM' expxb, /// `RS' lt, /// `RM' tdexb, /// `RS' N /// ${mmrootsyntax2} /// ) // { tnodes = (t :- lt) :* 0.5 :* J(N,1,nodes) :+ (t :+ lt) :/ 2 tweights = (t :- lt) :* weights :/ 2 chq = $chaz return(log(mean(exp(-chq * tweights))) :- logu) } end