.packageName <- "timereg"
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/Cpred.r"
Cpred<-function(cum,xval) 
{
designX<-as.matrix(cum); 
px<-as.integer(dim(designX)[2]);
nx<-as.integer(dim(designX)[1]);
nval<-length(xval); 
pred<-matrix(0,nval,px); 

sout<-.C("Cpred", 
as.double(cum),as.integer(nx),as.integer(px),
as.double(xval),as.integer(nval),as.double(pred),PACKAGE="timereg")

pred<-matrix(sout[[6]],nval,px);
return(pred)
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/Csmooth.r"
CsmoothB<-function(cumB,xval,b,degree=1,coef=1) 
{
cumB<-as.matrix(cumB); 
if(is.matrix(cumB) == TRUE) px<-as.integer(dim(cumB)[2]);
if(is.matrix(cumB) == TRUE) nx<-as.integer(dim(cumB)[1]);
nval<-length(xval); 
bhat<-matrix(0,nval,px-1);
bhat<-cbind(xval,bhat)
b<-matrix(b,nval,px-1); 
#print(b); 

sout<-.C("smoothB", 
as.double(cumB),as.integer(nx),as.integer(px),
as.double(bhat),as.integer(nval),
as.double(b),as.integer(degree),as.integer(coef),PACKAGE="timereg")

bhat<-matrix(sout[[4]],nval,px);
return(bhat)
}


Csmooth2B<-function(cumB,xval,b,degree=1,coef=1) 
{
cumB<-as.matrix(cumB); 
if(is.matrix(cumB) == TRUE) px<-as.integer(dim(cumB)[2]);
if(is.matrix(cumB) == TRUE) nx<-as.integer(dim(cumB)[1]);
nval<-length(xval); 
bhat<-matrix(0,nval,px-1);
bhat<-cbind(xval,bhat)
b<-matrix(b,nval,px-1); 

sout<-.C("smooth2B", 
as.double(cumB),as.integer(nx),as.integer(px),
as.double(bhat),as.integer(nval),
as.double(b),as.integer(degree),as.integer(coef),PACKAGE="timereg")

bhat<-matrix(sout[[4]],nval,px);
return(bhat)
}

#bhat<-smoothB(xval[100],3,SAtime$cum)
#ud<-CsmoothB(SAtime$cum,xval,3,degree=2)[100,];
#ud<-Csmooth2B(SAtime$cum,xval,bx,degree=2);
#(bhat/ud)
#bx<-c(rep(2,90),rep(3,211))

localTimeReg<-function(times,response,designX,xval,b,lin=1,dens=0) 
{
designX<-as.matrix(designX); 
if(is.matrix(designX) == TRUE) px<-as.integer(dim(designX)[2]);
if(is.matrix(designX) == TRUE) nx<-as.integer(dim(designX)[1]);
nval<-length(xval); 

bhat<-matrix(0,nval,(lin+1)*px);
bhat<-cbind(xval,bhat);
fdens<-cbind(xval,0); 

b<-matrix(b,nval,1); 

sout<-.C("localTimeReg", 
as.double(designX),as.integer(nx),as.integer(px),
as.double(times),as.double(response),
as.double(bhat),as.integer(nval),
as.double(b),as.integer(lin),as.double(fdens),PACKAGE="timereg")

bhat<-matrix(sout[[6]],nval,(lin+1)*px+1);
if (lin==2) bhat[,4]<-bhat[,4]*2
if (lin==3) bhat[,5]<-bhat[,5]*6

fdens<-matrix(sout[[10]],nval,2);
colnames(fdens)<-c("density","Ddensity"); 
if (dens==1) bhat<-cbind(bhat,fdens); 

return(bhat)
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/Gprop-odds.r"
Gprop.odds<-function(formula=formula(data),data=sys.parent(),beta=0,Nit=50,detail=0,start.time=0,max.time=NULL,id=NULL,n.sim=500,weighted.test=0,sym=0,mle.start=0)
{
id.call<-id; call<-match.call(); residuals<-0;  
robust<-0; ratesim<-0; profile<-0; exppar<-0; 
m<-match.call(expand = FALSE); 
m$max.time<-m$start.time<-m$weighted.test<-m$n.sim<-m$id<-m$Nit<-m$detail<-m$beta<-m$sym<-m$mle.start<-NULL
if (n.sim==0) sim<-0 else sim<-1; 
antsim<-n.sim; 

  special <- c("prop")
  Terms <- if(missing(data)) terms(formula, special)
           else              terms(formula, special, data=data)
  m$formula <- Terms
  m[[1]] <- as.name("model.frame")
  m <- eval(m, sys.parent())
  mt <- attr(m, "terms")
  intercept<-attr(mt, "intercept")
  Y <- model.extract(m, "response")

   XZ<-model.matrix(Terms,m)[, drop = FALSE]
   cols<-attributes(XZ)$assign
   l.cols<-length(cols)

   semicov <- attr(Terms, "specials")$prop
   ZtermsXZ<-semicov-1
#   print("semiterms"); print(semicov-1); 

   if (length(semicov)) { renaalen<-FALSE; Zterms<-c();
   for (i in ZtermsXZ) Zterms<-c(Zterms,(1:l.cols)[cols==i]); 
    } else {renaalen<-TRUE;}

    if (length(semicov)) {
       X<-as.matrix(XZ[,-Zterms]);
       covnamesZ <- dimnames(XZ)[[2]][-Zterms];
       dimnames(X)[[2]]<-covnamesZ; 
       Z<-as.matrix(XZ[,Zterms]);
       covnamesX <- dimnames(XZ)[[2]][Zterms]; 
       dimnames(Z)[[2]]<-covnamesX; 
       }
    else {X<-as.matrix(XZ); covnamesZ<-dimnames(XZ)[[2]]}

#    print("X"); print(X[1,]); print(covnamesX); 
#    if (renaalen==FALSE) {print("Z"); print(Z[1,]);
#    print(covnamesZ); 
#    }

    px <- ncol(X)
    if (renaalen == FALSE) pz <- ncol(Z) else pz <- 0
    pxz <- px + pz

  desX<-as.matrix(Z);
  if(is.matrix(desX) == TRUE) pg <- as.integer(dim(desX)[2])
  if(is.matrix(desX) == TRUE) nx <- as.integer(dim(desX)[1])

  desZ<-as.matrix(X); px<-ncol(desZ); 


if (!inherits(Y, "Surv")) stop("Response must be a survival object")

if (attr(m[, 1], "type") == "right") {
  time2  <- m[, 1][, "time"]; time   <- rep(0,length(time2));
  status <- m[, 1][, "status"]    } else 
if (attr(m[, 1], "type") == "counting") {
  time   <- m[, 1][,1]; time2  <- m[, 1][,2]; status <- m[, 1][,3]; } else {
  stop("only right-censored or counting processes data") } 

Ntimes <- sum(status); 

# adds random noise to make survival times unique
if (sum(duplicated(time2[status==1]))>0) {
#cat("Non unique survival times: break ties ! \n")
#cat("Break ties yourself\n");
ties<-TRUE
dtimes<-time2[status==1]; index<-(1:length(time2))[status==1];
ties<-duplicated(dtimes); nties<-sum(ties); index<-index[ties]
dt<-diff(sort(time2)); dt<-min(dt[dt>0]);
time2[index]<-time2[index]+runif(nties,0,min(0.001,dt/2));
} else ties<-FALSE; 

start<-time; stop<-time2; 
times<-c(start.time,time2[status==1]); times<-sort(times);
if (max.time==0) maxtimes<-max(times)+0.1 else maxtimes<-max.time; 
times<-times[times<maxtimes]
Ntimes <- length(times); 

########################################################################
if (is.null(id)==TRUE) {antpers<-length(time); id<-0:(antpers-1); }
else { pers<-unique(id); antpers<-length(pers); 
       id<-as.integer(factor(id,labels=1:(antpers)))-1; }

if (is.null(beta)) beta<-rep(0,pg);
if (length(beta)!=pg) beta<-rep(0,pg);

if (residuals==1) {
cumAi<-matrix(0,Ntimes,antpers*1);
cumAiiid<-matrix(0,Ntimes,antpers*1); }
else { cumAi<-0; cumAiiid<-0; }

cumint<-matrix(0,Ntimes,px+1); vcum<-matrix(0,Ntimes,px+1);
Rvcu<-matrix(0,Ntimes,px+1);
score<-beta;
Varbeta<-matrix(0,pg,pg); Iinv<-matrix(0,pg,pg);
RVarbeta<-matrix(0,pg,pg);
if (sim==1) Uit<-matrix(0,Ntimes,50*pg) else Uit<-FALSE;

test<-matrix(0,antsim,2*px); testOBS<-rep(0,2*px); unifCI<-c();
testval<-c();
rani<--round(runif(1)*10000); 
Ut<-matrix(0,Ntimes,pg+1); simUt<-matrix(0,antsim,pg);
loglike<-0; 
########################################################################

#cat("Generalised Proportional odds model \n"); 
#dyn.load("Gprop-odds.so")

nparout<- .C("Gtranssurv",
as.double(times),as.integer(Ntimes),as.double(desZ),
as.integer(nx),as.integer(px),as.double(desX),
as.integer(nx),as.integer(pg),as.integer(antpers),
as.double(start),as.double(stop),as.double(beta),
as.integer(Nit),as.double(cumint),as.double(vcum),
as.double(loglike),as.double(Iinv),as.double(Varbeta),
as.integer(detail),as.integer(sim),as.integer(antsim),
as.integer(rani),as.double(Rvcu), as.double(RVarbeta),
as.double(test),as.double(testOBS), as.double(Ut),
as.double(simUt),as.double(Uit),as.integer(id),
as.integer(status),as.integer(weighted.test),as.double(score),
as.double(cumAi),as.double(cumAiiid),as.integer(residuals),
as.integer(exppar),as.integer(sym),as.integer(mle.start)
,PACKAGE="timereg");

gamma<-matrix(nparout[[12]],pg,1);
cumint<-matrix(nparout[[14]],Ntimes,px+1);
vcum<-matrix(nparout[[15]],Ntimes,px+1);
Iinv<-matrix(nparout[[17]],pg,pg);
Varbeta<--matrix(nparout[[18]],pg,pg);
Rvcu<-matrix(nparout[[23]],Ntimes,px+1);
RVarbeta<--matrix(nparout[[24]],pg,pg);
score<-matrix(nparout[[33]],pg,1);
Ut<-matrix(nparout[[27]],Ntimes,pg+1);
loglike<-nparout[[16]]

if (residuals==1) {
cumAi<-matrix(nparout[[34]],Ntimes,antpers*1);
cumAiiid<-matrix(nparout[[35]],Ntimes,antpers*1);
cumAi<-list(time=times,dmg=cumAi,dmg.iid=cumAiiid);} else cumAi<-FALSE;

if (sim==1) {
Uit<-matrix(nparout[[29]],Ntimes,50*pg); UIt<-list();
for (i in (0:49)*pg) UIt[[i/pg+1]]<-as.matrix(Uit[,i+(1:pg)]);
simUt<-matrix(nparout[[28]],antsim,pg);
test<-matrix(nparout[[25]],antsim,2*px); testOBS<-nparout[[26]];
supUtOBS<-apply(abs(as.matrix(Ut[,-1])),2,max);
for (i in 1:(2*px)) testval<-c(testval,pval(test[,i],testOBS[i]));
for (i in 1:px) unifCI<-c(unifCI,percen(test[,i],0.95));
testUt<-c();
for (i in 1:pg) testUt<-c(testUt,pval(simUt[,i],supUtOBS[i]));

pval.testBeq0<-as.vector(testval[1:px]);
pval.testBeqC<-as.vector(testval[(px+1):(2*px)]);
obs.testBeq0<-as.vector(testOBS[1:px]);
obs.testBeqC<-as.vector(testOBS[(px+1):(2*px)]);
sim.testBeq0<-as.matrix(test[,1:px]);
sim.testBeqC<-as.matrix(test[,(px+1):(2*px)]);
sim.supUt<-as.matrix(simUt);
}

if (sim!=1) {
testUt<-FALSE;test<-FALSE;unifCI<-FALSE;supUtOBS<-FALSE;UIt<-FALSE;testOBS<-FALSE;testval<-FALSE;
pval.testBeq0<- pval.testBeqC<- obs.testBeq0<- obs.testBeqC<- sim.testBeq0<-
sim.testBeqC<-FALSE; testUt<-FALSE; sim.supUt<-FALSE;
}

ud<-list(t=Terms,cum=cumint,var.cum=vcum,robvar.cum=Rvcu,
gamma=gamma,var.gamma=Varbeta,robvar.gamma=RVarbeta,
resid.dMG=cumAi,D2linv=Iinv,score=score,loglike=loglike,
pval.testBeq0=pval.testBeq0,pval.testBeqC=pval.testBeqC,
obs.testBeq0=obs.testBeq0,obs.testBeqC=obs.testBeqC,
sim.testBeq0= sim.testBeq0,sim.testBeqC=sim.testBeqC,
conf.band=unifCI,
test.procProp=Ut,sim.test.procProp=UIt,pval.Prop=testUt,
sim.supProp=sim.supUt,prop.odds=TRUE)

colnames(ud$cum)<-colnames(ud$var.cum)<- c("time",covnamesZ)
if (robust==1) colnames(ud$robvar.cum)<- c("time",covnamesZ); 


if (px>0) {
if (sim==1) {
colnames(ud$test.procProp)<-c("time",covnamesX)
names(ud$pval.Prop)<-covnamesX
names(ud$conf.band)<-names(ud$pval.testBeq0)<-
names(ud$pval.testBeqC)<-names(ud$obs.testBeq0)<- 
names(ud$obs.testBeqC)<-colnames(ud$sim.testBeq0)<-covnamesZ;
} }

rownames(ud$gamma)<-c(covnamesX); colnames(ud$gamma)<-"estimate";
rownames(ud$score)<-c(covnamesX); colnames(ud$score)<-"score";
namematrix(ud$var.gamma,covnamesX);
namematrix(ud$robvar.gamma,covnamesX);
namematrix(ud$D2linv,covnamesX);


attr(ud,"Call")<-sys.call(); 
attr(ud,"Formula")<-formula; 
attr(ud,"id")<-id.call; 
class(ud)<-"cox.aalen"
return(ud); 
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/aalen-des.r"
des.aalen<-function (formula = formula(data),
data = sys.parent(), start.time = 0, max.time = NULL, 
id=NULL, clusters=NULL, deltaweight=1,approx="dt")
{
  m <- match.call(expand = FALSE)
  m$start.time <- m$max.time <-m$id <-
    m$clusters <- m$deltaweight<-m$approx<-NULL
  special <- c("const","cluster")
  Terms <- if (missing(data)) 
    terms(formula, special)
  else terms(formula, special, data = data)
  m$formula <- Terms
  m[[1]] <- as.name("model.frame")
  m <- eval(m, sys.parent())
  mt <- attr(m, "terms")
  intercept <- attr(mt, "intercept")
  Y <- model.extract(m, "response")
  if (!inherits(Y, "Surv")) 
    stop("Response must be a survival object")

  des<-read.design(m,Terms)
  X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
  covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ

  if(is.null(clusters)) clusters <- des$clusters  
  
  pxz <- px + pz;

  if (approx=="death-times" & des$npar==FALSE) npar<-TRUE; 
  survs<-read.surv(m,id,npar,clusters,start.time,max.time)
  times<-survs$times;id<-id.call<-survs$id.cal;
  if (approx=="death-times" & des$npar==FALSE) npar<-FALSE; 

  id<-id.call<-survs$id; 
  clusters<-cluster.call<-survs$clusters; 
  time2 <- survs$stop;  status <- survs$status; 
  start = survs$start; stop = survs$stop;
  antpers = survs$antpers; antclust = survs$antclust;

  Ntimes<-length(times)
  NDtimes<-sum(status[(stop>times[1]) & (stop<=times[Ntimes])])+1;
  ng=nx=antpers; 
  if (pz==0) Z=0; 

  desret<-matrix(0,antpers*(Ntimes-1),(pz+4)); 

  semiout<-.C("aalendesL",
              as.double(times),as.integer(Ntimes),as.integer(NDtimes),
              as.double(X),as.integer(nx),as.integer(px),
              as.double(Z),as.integer(ng),as.integer(pz),
              as.integer(antpers),as.double(start),as.double(stop),
              as.integer(status),as.integer(id),as.integer(clusters),
              as.integer(antclust),as.integer(deltaweight),as.double(desret),
              PACKAGE="timereg") 
  desret<-matrix(semiout[[18]],antpers*(Ntimes-1),pz+4)
  ud<-apply(desret[,1:pz],1,sum)!=0
  desret<-desret[ud,]
  colnames(desret)<-c(covnamesZ,"Y","dtime","id","time")
  return(data.frame(desret))
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/aalen-test.r"
aalenBaseTest<-function(times,fdata,designX,status,id,clusters,
                        robust=0,sim=0,retur=0,antsim=1000,
                        weighted.test=1,covariance=0,resample.iid=0,
                        namesX=NULL,offsets=0,weights=0,silent=0){
  Ntimes<-length(times)
  designX<-as.matrix(designX); 
  if(is.matrix(designX) == TRUE) p <- as.integer(dim(designX)[2])
  if(is.matrix(designX) == TRUE) nx <- as.integer(dim(designX)[1])

  if (robust==0 & sim>=1)  robust<-1;  devi<-rep(0,3); 
  cumint<-matrix(0,Ntimes,p+1); Vcumint<-cumint; 
  if (retur==1) cumAi<-matrix(0,Ntimes,fdata$antpers) else cumAi<-0;
  test<-matrix(0,antsim,3*p); testOBS<-rep(0,3*p); testval<-c(); 
  unifCI<-c();
  rani<--round(runif(1)*10000)


                                        # 50 tilfaeldige score processer til test H: b(t)=b returneres
  if (sim>=1) simUt<-matrix(0,Ntimes,50*p) else simUt<-NULL;
  Ut<-matrix(0,Ntimes,p+1); 
  if (covariance==1) covs<-matrix(0,Ntimes,p*p) else covs<-0;
  if (resample.iid==1) {
    B.iid<-matrix(0,Ntimes,fdata$antclust*p) } else B.iid<-NULL;
  if (sum(offsets)==0) mof<-0 else mof<-1;
  if (sum(weights)==0) mw<-0 else mw<-1;

  robVar<-Vcumint;
  aalenout<- .C("robaalentest",
                as.double(times), as.integer(Ntimes),
                as.double(designX),as.integer(nx),as.integer(p),
                as.integer(fdata$antpers),as.double(fdata$start),as.double(fdata$stop),
                as.double(cumint),as.double(Vcumint),as.double(robVar),
                as.integer(sim),as.integer(antsim),as.integer(retur),
                as.double(cumAi),as.double(test),as.integer(rani),as.double(testOBS),
                as.integer(status),as.double(Ut),as.double(simUt),as.integer(id),
                as.integer(weighted.test),as.integer(robust),as.integer(covariance),
                as.double(covs),as.integer(resample.iid),as.double(B.iid),
                as.integer(clusters),as.integer(fdata$antclust),as.double(devi),
                as.integer(mof),as.double(offsets),as.integer(mw),as.double(weights),
                as.integer(silent)
                ,PACKAGE="timereg")

  if (covariance==1)  {
    covit<-matrix(aalenout[[26]],Ntimes,p*p);
    cov.list<-list();
    for (i in 1:Ntimes) cov.list[[i]]<-matrix(covit[i,],p,p);
  } else cov.list<-NULL;

  if (resample.iid==1)  {
    covit<-matrix(aalenout[[28]],Ntimes,fdata$antclust*p); 
    B.iid<-list(); 
    for (i in (0:(fdata$antclust-1))*p) {
      B.iid[[i/p+1]]<-as.matrix(covit[,i+(1:p)]); 
      colnames(B.iid[[i/p+1]])<-namesX; } 
  }

  robV<-matrix(aalenout[[11]],Ntimes,p+1);
  if (retur==1) {
    cumAi<-matrix(aalenout[[15]],Ntimes,fdata$antpers*1); 
    cumAi<-list(time=times,dM=cumAi,dM.iid=cumAi); 
                                        #cumAI<-list(); 
                                        #for (i in (0:(fdata$antpers-1))*p) cumAI[[i/p+1]]<-cumAi[,i+(1:p)]
  } else cumAi<-NULL;

  if (sim>=1) {
    Uit<-matrix(aalenout[[21]],Ntimes,50*p); 
    UIt<-list(); for (i in (0:49)*p) 
      UIt[[i/p+1]]<-as.matrix(Uit[,i+(1:p)]);
    Ut<-matrix(aalenout[[20]],Ntimes,(p+1)); 
    test<-matrix(aalenout[[16]],antsim,3*p);
    testOBS<-aalenout[[18]];
    for (i in 1:(3*p)) testval<-c(testval,pval(test[,i],testOBS[i]))
    for (i in 1:p) unifCI<-as.vector(c(unifCI,percen(test[,i],0.95)));
    pval.testBeq0<-as.vector(testval[1:p]);
    pval.testBeqC<-as.vector(testval[(p+1):(2*p)]);
    pval.testBeqC.is<-as.vector(testval[(2*p+1):(3*p)]);
    obs.testBeq0<-as.vector(testOBS[1:p]);
    obs.testBeqC<-as.vector(testOBS[(p+1):(2*p)]);
    obs.testBeqC.is<-as.vector(testOBS[(2*p+1):(3*p)]);
    sim.testBeq0<-as.matrix(test[,1:p]);
    sim.testBeqC<-as.matrix(test[,(p+1):(2*p)]);
    sim.testBeqC.is<-as.matrix(test[,(2*p+1):(3*p)]);
  } else {test<-NULL; unifCI<-NULL; Ut<-NULL; UIt<-NULL; 
          pval.testBeq0<-NULL;pval.testBeqC<-NULL; obs.testBeq0<-NULL;obs.testBeqC<-NULL;
          sim.testBeq0<-NULL;sim.testBeqC<-NULL; 
          sim.testBeqC.is<-NULL; pval.testBeqC.is<-NULL; 
          obs.testBeqC.is<-NULL; 
        }
  cumint <-matrix(aalenout[[9]],Ntimes,p+1);
  Vcumint<-matrix(aalenout[[10]],Ntimes,p+1);
  devi<-aalenout[[31]]

  list(cum=cumint,var.cum=Vcumint,robvar.cum=robV,residuals=cumAi,
       pval.testBeq0=pval.testBeq0, obs.testBeq0=obs.testBeq0,
       pval.testBeqC=pval.testBeqC, pval.testBeqC.is=pval.testBeqC.is,
       obs.testBeqC=obs.testBeqC,obs.testBeqC.is=obs.testBeqC.is,
       sim.testBeq0= sim.testBeq0,
       sim.testBeqC=sim.testBeqC,sim.testBeqC.is=sim.testBeqC.is,
       conf.band=unifCI,test.procBeqC=Ut,sim.test.procBeqC=UIt,
       covariance=cov.list,B.iid=B.iid,deviance=devi)
}

semiaalenTest<-function(times,fdata,designX,designG,status,id,clusters,
bhat=0,gamma=0,robust=0,sim=0,antsim=1000,weighted.test=1,retur=0,
covariance=0,
resample.iid=0,namesX=NULL,namesZ=NULL,deltaweight=1,weights=0,offsets=0,
fixgam=0,pseudo.score=0,silent=0)
{
Nalltimes <- length(times);  
Ntimes<-sum(status[(fdata$stop>times[1]) & (fdata$stop<=times[Nalltimes])])+1;
#print(Ntimes); print(Nalltimes); 
#print(times);  print(status);  print(cbind(fdata$stop,fdata$start,status))
designX<-as.matrix(designX); designG<-as.matrix(designG); 
if(is.matrix(designX) == TRUE) px <- as.integer(dim(designX)[2])
if(is.matrix(designX) == TRUE) nx <- as.integer(dim(designX)[1])
if(is.matrix(designG) == TRUE) pg <- as.integer(dim(designG)[2])
if(is.matrix(designG) == TRUE) ng <- as.integer(dim(designG)[1])
nb<-1; 
if(is.matrix(bhat)==TRUE) nb<-as.integer(dim(bhat)[1]); 
if(is.matrix(bhat)==FALSE) bhat<-matrix(0,nb,px+1); 
if (sum(offsets)==0) mof<-0 else mof<-1;
if (sum(weights)==0) mw<-0 else mw<-1;

if (covariance==1) covs<-matrix(0,Ntimes,px*px) else covs<-0;

if (pseudo.score>=1) { 
pscoret<-matrix(0,Ntimes,pg+1);
pscoreiid<-matrix(0,Ntimes,fdata$antclust*pg);
IintZHZt<-matrix(0,Ntimes,pg*pg); ptest<-matrix(0,pseudo.score,pg);} 
else {pscoret<-pscoreiid<-IintZHZt<-ptest<-0}

if (resample.iid==1) {
gamma.iid<-matrix(0,fdata$antclust,pg); 
B.iid<-matrix(0,Ntimes,fdata$antclust*px) }
else { B.iid<-gamma.iid<-NULL; }

if (retur==1) cumAi<-matrix(0,Ntimes,fdata$antpers) else cumAi<-0;
if (nx!=ng) print(" A design og B designs er ikke ens\n");
cum<-matrix(0,Ntimes,px+1); 
Vcum<-cum; robVcum<-cum; 
if (sum(abs(gamma))==0) gamma<-rep(0,pg)  else gamma<-gamma; 
Vargam<-matrix(0,pg,pg); RobVargam<-matrix(0,pg,pg); 
intZHZ<-matrix(0,pg,pg); intZHdN<-rep(0,pg); 

test<-matrix(0,antsim,3*px); testOBS<-rep(0,3*px); testval<-c(); 
rani<--round(runif(1)*10000); devi<-rep(0,3); 

# 50 tilfaeldige score processer til test H: b(t)=b returneres
if (sim==1) simUt<-matrix(0,Ntimes,50*px) else simUt<-NULL;
Ut<-matrix(0,Ntimes,px+1); 
antpers<-fdata$antpers;
intHdN<-rep(0,antpers); intHZ<-matrix(0,antpers,pg); 
varintHdN<-matrix(0,antpers,antpers); 

semiout<-.C("semiaalentest",
as.double(times),as.integer(Nalltimes),as.integer(Ntimes),
as.double(designX),as.integer(nx),as.integer(px),
as.double(designG),as.integer(ng),as.integer(pg),
as.integer(antpers),as.double(fdata$start),as.double(fdata$stop), 
as.integer(nb),as.double(bhat),
as.double(cum),as.double(Vcum),as.double(robVcum),
as.double(gamma),as.double(Vargam),as.double(RobVargam),
as.integer(sim),as.integer(antsim), 
as.double(test),as.integer(rani),as.double(testOBS),as.integer(robust),
as.integer(status),as.double(Ut),as.double(simUt),as.integer(id),
as.integer(weighted.test),as.double(cumAi),as.integer(retur),as.integer(covariance),as.double(covs),
as.integer(resample.iid),as.double(gamma.iid),as.double(B.iid),
as.integer(clusters),as.integer(fdata$antclust),as.double(devi),
as.double(intZHZ),as.double(intZHdN),as.integer(deltaweight), 
as.integer(mof),as.double(offsets),
as.integer(mw),as.double(weights),
as.integer(fixgam),
as.integer(pseudo.score),as.double(pscoret),as.double(pscoreiid),
as.double(IintZHZt),as.double(ptest),
as.double(intHdN),as.double(intHZ),as.double(varintHdN),as.integer(silent),
PACKAGE="timereg"); 

if (resample.iid==1)  {
gamma.iid<-matrix(semiout[[37]],fdata$antclust,pg);
covit<-matrix(semiout[[38]],Ntimes,fdata$antclust*px); 
B.iid<-list(); 
for (i in (0:(fdata$antclust-1))*px) {
B.iid[[(i/px)+1]]<-as.matrix(covit[,i+(1:px)]);
colnames(B.iid[[i/px+1]])<-namesX; }
}
devi<-semiout[[41]]

if (pseudo.score>=1)  {
IintZHZt<-matrix(semiout[[53]],Ntimes,pg*pg);
intZHZt<-list();
for (i in 1:Ntimes) { intZHZt[[i]]<-matrix(IintZHZt[i,],pg,pg);
colnames(intZHZt[[i]])<-rownames(intZHZt[[i]])<-namesZ;  }

pscoreiid<-matrix(semiout[[52]],Ntimes,fdata$antclust*pg); 
pscore.iid<-list(); 
for (i in (0:(fdata$antclust-1))*pg) {
pscore.iid[[(i/pg)+1]]<-as.matrix(pscoreiid[,i+(1:pg)]);
colnames(pscore.iid[[i/pg+1]])<-namesZ; 
}

obs.pscore<-matrix(semiout[[51]],Ntimes,pg+1); 
sup.pscore<-as.vector(apply(as.matrix(abs(obs.pscore[,-1])),2,max)); 

ptest<-matrix(semiout[[54]],pseudo.score,pg); 

pstest.pval<-c()
for (i in 1:pg) pstest.pval<-c(pstest.pval,pval(ptest[,i],sup.pscore[i]))
}
else {sup.pscore<-intZHZt<-pscore.iid<-obs.pscore<-pstest.pval<-NULL}


if (covariance==1)  {
covit<-matrix(semiout[[35]],Ntimes,px*px);
cov.list<-list();
for (i in 1:Ntimes) cov.list[[i]]<-matrix(covit[i,],px,px);
} else cov.list<-NULL;

bhat<-matrix(semiout[[14]],nb,px+1); cum <-matrix(semiout[[15]],Ntimes,px+1); 
Vcum <-matrix(semiout[[16]],Ntimes,px+1); 
robVcum <-matrix(semiout[[17]],Ntimes,px+1); robVcum[,1] <-cum[,1]; 
gamma<-matrix(semiout[[18]],pg,1); Vargam<-matrix(semiout[[19]],pg,pg); 
robVargam<-matrix(semiout[[20]],pg,pg); 
intZHZ<-matrix(semiout[[42]],pg,pg); intZHdN<-matrix(semiout[[43]],pg,1); 
intHdN<-matrix(semiout[[55]],antpers,1); 
intHZ<-matrix(semiout[[56]],antpers,pg); 
varintHdN<-matrix(semiout[[57]],antpers,antpers); 

if (retur==1) {
cumAi<-matrix(semiout[[32]],Ntimes,fdata$antpers*1); 
cumAi<-list(time=Vcum[,1],dM=cumAi); 
#cumAI<-list(); 
#for (i in (0:(fdata$antclust-1))*p) cumAI[[i/p+1]]<-cumAi[,i+(1:p)]
} else cumAi<-NULL;

unifCI<-c();
if (sim>=1) {
test<-matrix(semiout[[23]],antsim,3*px);
testOBS<-semiout[[25]];
for (i in 1:(3*px)) testval<-c(testval,pval(test[,i],testOBS[i]))
Uit<-matrix(semiout[[29]],Ntimes,50*px); 
UIt<-list(); for (i in (0:49)*px) UIt[[i/px+1]]<-Uit[,i+(1:px)];
Ut<-matrix(semiout[[28]],Ntimes,(px+1)); 
for (i in 1:px) unifCI<-as.vector(c(unifCI,percen(test[,i],0.95)));
pval.testBeq0<-as.vector(testval[1:px]);
pval.testBeqC<-as.vector(testval[(px+1):(2*px)]);
pval.testBeqC.is<-as.vector(testval[(2*px+1):(3*px)]);
obs.testBeq0<-as.vector(testOBS[1:px]);
obs.testBeqC<-as.vector(testOBS[(px+1):(2*px)]);
obs.testBeqC.is<-as.vector(testOBS[(2*px+1):(3*px)]);
sim.testBeq0<-as.matrix(test[,1:px]);
sim.testBeqC<-as.matrix(test[,(px+1):(2*px)]);
sim.testBeqC.is<-as.matrix(test[,(2*px+1):(3*px)]);
} else {test<-NULL; unifCI<-NULL;UIt<-NULL; Ut<-NULL;
pval.testBeq0<-NULL;pval.testBeqC<-NULL; 
obs.testBeq0<-NULL;obs.testBeqC<-NULL;
sim.testBeq0<-NULL; sim.testBeqC<-NULL;
sim.testBeqC.is<-NULL; pval.testBeqC.is<-NULL; 
obs.testBeqC.is<-NULL; 
}

ud<-list(cum=cum,var.cum=Vcum,robvar.cum=robVcum,
gamma=gamma,var.gamma=Vargam,robvar.gamma=robVargam,residuals=cumAi,
pval.testBeq0=pval.testBeq0, obs.testBeq0=obs.testBeq0, 
pval.testBeqC=pval.testBeqC,pval.testBeqC.is=pval.testBeqC.is,
obs.testBeqC=obs.testBeqC, obs.testBeqC.is=obs.testBeqC.is,
sim.testBeq0= sim.testBeq0,
sim.testBeqC=sim.testBeqC,sim.testBeqC.is=sim.testBeqC.is,
conf.band=unifCI,test.procBeqC=Ut,sim.test.procBeqC=UIt,
covariance=cov.list,B.iid=B.iid,gamma.iid=gamma.iid,deviance=devi,
intZHZ=intZHZ,intZHdN=intZHdN,
obs.pscore=obs.pscore,pscore.iid=pscore.iid,intZHZt=intZHZt,
pstest.pval=pstest.pval,sup.pscore=sup.pscore,
intHdN=intHdN,intHZ=intHZ,varintHdN=varintHdN)

return(ud);
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/aalen.r"
aalenBase<-function(times,fdata,designX,status,id,clusters,robust=0,sim=0,retur=0,antsim=1000,weighted.test=1,covariance=0,resample.iid=0,namesX=NULL,silent=0,scale=1) 
{
Ntimes<-length(times)
designX<-as.matrix(designX); 
if(is.matrix(designX) == TRUE) p <- as.integer(dim(designX)[2])
if(is.matrix(designX) == TRUE) nx <- as.integer(dim(designX)[1])

if (robust==0 & sim>=1)  robust<-1;  devi<-rep(0,1); 
cumint<-matrix(0,Ntimes,p+1); Vcumint<-cumint; 
if (retur==1) cumAi<-matrix(0,Ntimes,fdata$antpers) else cumAi<-0;
test<-matrix(0,antsim,3*p); testOBS<-rep(0,3*p); testval<-c(); 
unifCI<-c(); rani<--round(runif(1)*10000)

# 49 tilfaeldige score processer til test H: b(t)=b returneres
if (sim>=1) simUt<-matrix(0,Ntimes,50*p) else simUt<-NULL;
Ut<-matrix(0,Ntimes,p+1); 
if (covariance==1) covs<-matrix(0,Ntimes,p*p) else covs<-0;
if (resample.iid==1) {
B.iid<-matrix(0,Ntimes,fdata$antclust*p) } else B.iid<-NULL;

#dyn.load("linaalen.so")

if (robust==2) {
aalenout<- .C("aalen",
as.double(times), as.integer(Ntimes),as.double(designX),
as.integer(nx),as.integer(p),as.integer(fdata$antpers),
as.double(fdata$start),as.double(fdata$stop),
as.double(cumint),as.double(Vcumint),as.integer(status),PACKAGE="timereg")
robV<-NULL; cumAI<-NULL; test<-NULL;
}
else {
robVar<-Vcumint; 
aalenout<- .C("robaalen",
as.double(times), as.integer(Ntimes),
as.double(designX),as.integer(nx),as.integer(p),
as.integer(fdata$antpers),as.double(fdata$start),as.double(fdata$stop),
as.double(cumint),as.double(Vcumint),as.double(robVar),
as.integer(sim),as.integer(antsim),as.integer(retur),
as.double(cumAi),as.double(test),as.integer(rani),as.double(testOBS),
as.integer(status),as.double(Ut),as.double(simUt),as.integer(id),
as.integer(weighted.test),as.integer(robust),as.integer(covariance),
as.double(covs),as.integer(resample.iid),as.double(B.iid),
as.integer(clusters),as.integer(fdata$antclust),as.double(devi),
as.integer(silent),PACKAGE="timereg")

if (covariance==1)  {
covit<-matrix(aalenout[[26]],Ntimes,p*p);
cov.list<-list();
for (i in 1:Ntimes) cov.list[[i]]<-matrix(covit[i,],p,p);
} else cov.list<-NULL;

if (resample.iid==1)  {
covit<-matrix(aalenout[[28]],Ntimes,fdata$antclust*p); 
B.iid<-list(); 
for (i in (0:(fdata$antclust-1))*p) {
B.iid[[i/p+1]]<-as.matrix(covit[,i+(1:p)]); 
colnames(B.iid[[i/p+1]])<-namesX; } 
}

robV<-matrix(aalenout[[11]],Ntimes,p+1);
if (retur==1) {
cumAi<-matrix(aalenout[[15]],Ntimes,fdata$antpers*1); 
cumAi<-list(time=times,dM=cumAi,dM.iid=cumAi); 
#cumAI<-list(); 
#for (i in (0:(fdata$antpers-1))*p) cumAI[[i/p+1]]<-cumAi[,i+(1:p)]
} else cumAi<-NULL; }

if (sim>=1) {
Uit<-matrix(aalenout[[21]],Ntimes,50*p); 
UIt<-list(); for (i in (0:49)*p) 
UIt[[i/p+1]]<-as.matrix(Uit[,i+(1:p)]);
Ut<-matrix(aalenout[[20]],Ntimes,(p+1)); 
test<-matrix(aalenout[[16]],antsim,3*p);
testOBS<-aalenout[[18]];
for (i in 1:(3*p)) testval<-c(testval,pval(test[,i],testOBS[i]))
for (i in 1:p) unifCI<-as.vector(c(unifCI,percen(test[,i],0.95)));
pval.testBeq0<-as.vector(testval[1:p]);
pval.testBeqC<-as.vector(testval[(p+1):(2*p)]);
pval.testBeqC.is<-as.vector(testval[(2*p+1):(3*p)]);
obs.testBeq0<-as.vector(testOBS[1:p]);
obs.testBeqC<-as.vector(testOBS[(p+1):(2*p)]);
obs.testBeqC.is<-as.vector(testOBS[(2*p+1):(3*p)]);
sim.testBeq0<-as.matrix(test[,1:p]);
sim.testBeqC<-as.matrix(test[,(p+1):(2*p)]);
sim.testBeqC.is<-as.matrix(test[,(2*p+1):(3*p)]);
} else {test<-NULL; unifCI<-NULL; Ut<-NULL; UIt<-NULL; 
pval.testBeq0<-NULL;pval.testBeqC<-NULL; obs.testBeq0<-NULL;obs.testBeqC<-NULL;
sim.testBeq0<-NULL;sim.testBeqC<-NULL; 
sim.testBeqC.is<-NULL; pval.testBeqC.is<-NULL; 
obs.testBeqC.is<-NULL; 
}
cumint <-matrix(aalenout[[9]],Ntimes,p+1);
Vcumint<-matrix(aalenout[[10]],Ntimes,p+1);
devi<-aalenout[[31]]

list(cum=cumint,var.cum=Vcumint,robvar.cum=robV,residuals=cumAi,
pval.testBeq0=pval.testBeq0, obs.testBeq0=obs.testBeq0,
pval.testBeqC=pval.testBeqC, pval.testBeqC.is=pval.testBeqC.is,
obs.testBeqC=obs.testBeqC,obs.testBeqC.is=obs.testBeqC.is,
sim.testBeq0= sim.testBeq0,
sim.testBeqC=sim.testBeqC,sim.testBeqC.is=sim.testBeqC.is,
conf.band=unifCI,test.procBeqC=Ut,sim.test.procBeqC=UIt,
covariance=cov.list,B.iid=B.iid,deviance=devi)
}

pval<-function(simt,Otest)
{
simt<-sort(simt);
p<-sum(Otest<simt)/length(simt);
return(p)
}

percen<-function(x,per)
{ n<-length(x); tag<-round(n*per)+1; ud<-sort(x)[tag]; return(ud) }

semiaalen<-function(times,fdata,designX,designG,status,id,clusters,bhat=0,gamma=0,robust=0,sim=0,antsim=1000,weighted.test=1,retur=0,covariance=0,
resample.iid=0,namesX=NULL,namesZ=NULL,deltaweight=1,silent=0,scale=0)
{
Nalltimes <- length(times);  
Ntimes<-sum(status[(fdata$stop>times[1]) & (fdata$stop<=times[Nalltimes])])+1;
#print(Ntimes); print(Nalltimes); 
#print(times);  print(status);  print(cbind(fdata$stop,fdata$start,status))
designX<-as.matrix(designX); designG<-as.matrix(designG); 
if(is.matrix(designX) == TRUE) px <- as.integer(dim(designX)[2])
if(is.matrix(designX) == TRUE) nx <- as.integer(dim(designX)[1])
if(is.matrix(designG) == TRUE) pg <- as.integer(dim(designG)[2])
if(is.matrix(designG) == TRUE) ng <- as.integer(dim(designG)[1])
nb<-1; 
if(is.matrix(bhat)==TRUE) nb<-as.integer(dim(bhat)[1]); 
if(is.matrix(bhat)==FALSE) bhat<-matrix(0,nb,px+1); 

if (covariance==1) covs<-matrix(0,Ntimes,px*px) else covs<-0;

if (resample.iid==1) {
gamma.iid<-matrix(0,fdata$antclust,pg); 
B.iid<-matrix(0,Ntimes,fdata$antclust*px) }
else { B.iid<-gamma.iid<-NULL; }

if (retur==1) cumAi<-matrix(0,Ntimes,fdata$antpers) else cumAi<-0;
if (nx!=ng) print(" A design og B designs er ikke ens\n");
cum<-matrix(0,Ntimes,px+1); 
Vcum<-cum; robVcum<-cum; 
if (sum(abs(gamma))==0) gamma<-rep(0,pg)  else gamma<-gamma; 
Vargam<-matrix(0,pg,pg); RobVargam<-matrix(0,pg,pg); 
intZHZ<-matrix(0,pg,pg); intZHdN<-rep(0,pg); 

test<-matrix(0,antsim,3*px); testOBS<-rep(0,3*px); testval<-c(); 
rani<--round(runif(1)*10000); devi<-rep(0,1); 

# 50 tilfaeldige score processer til test H: b(t)=b returneres
if (sim==1) simUt<-matrix(0,Ntimes,50*px) else simUt<-NULL;
Ut<-matrix(0,Ntimes,px+1); 

#dyn.load("linaalen.so")

semiout<-.C("semiaalen",
as.double(times),as.integer(Nalltimes),as.integer(Ntimes),
as.double(designX),as.integer(nx),as.integer(px),
as.double(designG),as.integer(ng),as.integer(pg),
as.integer(fdata$antpers),as.double(fdata$start),as.double(fdata$stop), 
as.integer(nb),as.double(bhat),
as.double(cum),as.double(Vcum),as.double(robVcum),
as.double(gamma),as.double(Vargam),as.double(RobVargam),
as.integer(sim),as.integer(antsim), 
as.double(test),as.integer(rani),as.double(testOBS),as.integer(robust),
as.integer(status),as.double(Ut),as.double(simUt),as.integer(id),
as.integer(weighted.test),as.double(cumAi),as.integer(retur),as.integer(covariance),as.double(covs),
as.integer(resample.iid),as.double(gamma.iid),as.double(B.iid),
as.integer(clusters),as.integer(fdata$antclust),as.double(devi),
as.double(intZHZ),as.double(intZHdN),as.integer(deltaweight),
as.integer(silent),PACKAGE="timereg"); 

if (resample.iid==1)  {
gamma.iid<-matrix(semiout[[37]],fdata$antclust,pg);
covit<-matrix(semiout[[38]],Ntimes,fdata$antclust*px); 
B.iid<-list(); 
for (i in (0:(fdata$antclust-1))*px) {
B.iid[[(i/px)+1]]<-as.matrix(covit[,i+(1:px)]);
colnames(B.iid[[i/px+1]])<-namesX; }
colnames(gamma.iid)<-namesZ
}
devi<-semiout[[41]]

if (covariance==1)  {
covit<-matrix(semiout[[35]],Ntimes,px*px);
cov.list<-list();
for (i in 1:Ntimes) cov.list[[i]]<-matrix(covit[i,],px,px);
} else cov.list<-NULL;

bhat<-matrix(semiout[[14]],nb,px+1); cum <-matrix(semiout[[15]],Ntimes,px+1); 
Vcum <-matrix(semiout[[16]],Ntimes,px+1); 
robVcum <-matrix(semiout[[17]],Ntimes,px+1); robVcum[,1] <-cum[,1]; 
gamma<-matrix(semiout[[18]],pg,1); Vargam<-matrix(semiout[[19]],pg,pg); 
robVargam<-matrix(semiout[[20]],pg,pg); 
intZHZ<-matrix(semiout[[42]],pg,pg); intZHdN<-matrix(semiout[[43]],pg,1); 

if (retur==1) {
cumAi<-matrix(semiout[[32]],Ntimes,fdata$antpers*1); 
cumAi<-list(time=Vcum[,1],dM=cumAi); 
#cumAI<-list(); 
#for (i in (0:(fdata$antclust-1))*p) cumAI[[i/p+1]]<-cumAi[,i+(1:p)]
} else cumAi<-NULL;

unifCI<-c();
if (sim>=1) {
test<-matrix(semiout[[23]],antsim,3*px);
testOBS<-semiout[[25]];
for (i in 1:(3*px)) testval<-c(testval,pval(test[,i],testOBS[i]))
Uit<-matrix(semiout[[29]],Ntimes,50*px); 
UIt<-list(); for (i in (0:49)*px) UIt[[i/px+1]]<-Uit[,i+(1:px)];
Ut<-matrix(semiout[[28]],Ntimes,(px+1)); 
for (i in 1:px) unifCI<-as.vector(c(unifCI,percen(test[,i],0.95)));
pval.testBeq0<-as.vector(testval[1:px]);
pval.testBeqC<-as.vector(testval[(px+1):(2*px)]);
pval.testBeqC.is<-as.vector(testval[(2*px+1):(3*px)]);
obs.testBeq0<-as.vector(testOBS[1:px]);
obs.testBeqC<-as.vector(testOBS[(px+1):(2*px)]);
obs.testBeqC.is<-as.vector(testOBS[(2*px+1):(3*px)]);
sim.testBeq0<-as.matrix(test[,1:px]);
sim.testBeqC<-as.matrix(test[,(px+1):(2*px)]);
sim.testBeqC.is<-as.matrix(test[,(2*px+1):(3*px)]);
} else {test<-NULL; unifCI<-NULL;UIt<-NULL; Ut<-NULL;
pval.testBeq0<-NULL;pval.testBeqC<-NULL; 
obs.testBeq0<-NULL;obs.testBeqC<-NULL;
sim.testBeq0<-NULL; sim.testBeqC<-NULL;
sim.testBeqC.is<-NULL; pval.testBeqC.is<-NULL; 
obs.testBeqC.is<-NULL; 
}

ud<-list(cum=cum,var.cum=Vcum,robvar.cum=robVcum,
gamma=gamma,var.gamma=Vargam,robvar.gamma=robVargam,residuals=cumAi,
pval.testBeq0=pval.testBeq0, obs.testBeq0=obs.testBeq0, 
pval.testBeqC=pval.testBeqC,pval.testBeqC.is=pval.testBeqC.is,
obs.testBeqC=obs.testBeqC, obs.testBeqC.is=obs.testBeqC.is,
sim.testBeq0= sim.testBeq0,
sim.testBeqC=sim.testBeqC,sim.testBeqC.is=sim.testBeqC.is,
conf.band=unifCI,test.procBeqC=Ut,sim.test.procBeqC=UIt,
covariance=cov.list,B.iid=B.iid,gamma.iid=gamma.iid,deviance=devi,
intZHZ=intZHZ,intZHdN=intZHdN)
return(ud);
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/additive-compSs.r"

additive.compSs<-function (formula = formula(data), data = sys.parent(), 
start.time=0,max.time=NULL,id=NULL,scale=FALSE,silent=0,omit=NULL) 
{ ## {{{
   call <- match.call()
    m <- match.call(expand = FALSE)
    m$start.time <- m$max.time <-  m$id <- m$scale<- m$silent<- m$omit<-NULL
    special <- c("const")
    Terms <- if (missing(data)) terms(formula, special)
    else terms(formula, special, data = data)
    m$formula <- Terms
    m[[1]] <- as.name("model.frame")
    m <- eval(m, sys.parent())
    mt <- attr(m, "terms")
    intercept <- attr(mt, "intercept")
    Y <- model.extract(m, "response")
    if (!inherits(Y, "Surv")) stop("Response must be a survival object")

des<-read.design(m,Terms)
X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ
if (scale==TRUE) Z<-scale(Z); 
pxz <- px + pz; 

clusters=NULL;
survs<-read.surv(m,id,FALSE,clusters,start.time,max.time)
times<-survs$times;id<-id.call<-survs$id.cal;
clusters<-cluster.call<-survs$clusters; 
time2<-survs$stop; time<-survs$start
status<-survs$status; 

if (!is.null(omit)) {
   time<-time[-omit]
   time2<-time2[-omit]; status<-status[-omit]
   X<-X[-omit,]; Z<-Z[-omit,]; id<-id[omit]; 
   times<-time2
   if (is.null(max.time) == TRUE) maxtimes <- max(times)
   else maxtimes <- max.time
   times <- times[times <= maxtimes]
   times <- c(times, maxtimes)
   times <- unique(times)
}
   Nalltimes <- length(times)
   Ntimes <- 
   sum(status[(time2 > times[1]) & (time <= times[Nalltimes])]) + 1
   nx<-nrow(X); 

   fix<-0; 
   if ( (attr(m[, 1], "type") == "right" ) ) {
     fix<-1
     if (fix==1) ot<-order(time2,status==1); # order in time, status=1 first for ties
     if (fix==2) ot<-order(time2,status==0); # order in time, status=1 first for ties
     time2<-time2[ot]; status<-status[ot]; time<-time[ot]; 
     X<-as.matrix(X[ot,])
     Z<-as.matrix(Z[ot,])
     survs$stop<-time2; 
     id<-(1:nx)-1; 
  }

   deltaweight<-1; 
   intZHZ<-matrix(0,pz,pz); intZHdN<-matrix(0,pz,1); 


if (fix==0) {
semiout<-.C("compSs",
as.double(times),as.integer(Nalltimes),as.integer(Ntimes),
as.double(X),as.integer(nx),as.integer(px),
 as.double(Z),as.integer(nx),as.integer(pz),
 as.integer(survs$antpers),as.double(time),as.double(time2),
 as.integer(id),as.integer(status), as.integer(deltaweight),
 as.double(intZHZ),as.double(intZHdN),as.integer(silent)
,package="timereg")
}
if (fix==1) {
semiout<-.C("compSsrev",
as.double(times),as.integer(Nalltimes),as.integer(Ntimes),
as.double(X),as.integer(nx),as.integer(px),
as.double(Z),as.integer(nx),as.integer(pz),
as.integer(survs$antpers),as.double(time),as.double(time2),
as.integer(id),as.integer(status), as.integer(deltaweight),
as.double(intZHZ),as.double(intZHdN),as.integer(silent)
,PACKAGE="timereg")
} 
if (fix==2) {
semiout<-.C("compSsforward",
as.double(times),as.integer(Nalltimes),as.integer(Ntimes),
as.double(X),as.integer(nx),as.integer(px),
as.double(Z),as.integer(nx),as.integer(pz),
as.integer(survs$antpers),as.double(time),as.double(time2),
as.integer(id),as.integer(status), as.integer(deltaweight),
as.double(intZHZ),as.double(intZHdN),as.integer(silent)
,PACKAGE="timereg")
}

intZHZ=matrix(semiout[[16]],pz,pz); 
intZHdN=matrix(semiout[[17]],pz,1); 

ud<-list(intZHZ=intZHZ,intZHdN=intZHdN)
class(ud) <- "pls"
attr(ud, "Call") <- sys.call()
attr(ud, "Formula") <- formula
ud$call <- call

return(ud)
} ## }}}


#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/additive-lasso.r"
surv.lars<-function(S,s,n, l1.weights=NULL, ...) 
{
    if (!require("lars")) stop("package Lars not available")
    if (is.null(l1.weights)==FALSE) adap<-1 else adap<-0; 
    adap<-0; 
    if (adap==1) S<-t(t(S)/l1.weights)
    fit <- my.lars(S, s ,n , ...)
    if (adap==1) fit$coef<-t(t(fit$coef)/l1.weights)
return(fit)
}

surv.lars.cv<-function(formula=formula(data),data=sys.parent(),
l1.weights = NULL, K = 10,start.time=0,max.time=NULL,id=NULL,
fraction = seq(from = 0, to = 1, length = 100), 
trace = FALSE, plot.it = FALSE , se = TRUE, silent=1, ...) 
{
   if (!require("lars")) stop("package Lars not available")
## {{{ reads design and survival times
    call <- match.call()
    m <- match.call(expand = FALSE)
    m$start.time <- m$max.time <-  m$id <-m$silent <- 
    m$covs<-m$l1.weight<-m$K<-m$fraction<-m$trace<-m$plot.it<-m$se<- NULL
    special <- c("const")
    Terms <- if (missing(data)) terms(formula, special)
    else terms(formula, special, data = data)
    m$formula <- Terms
    m[[1]] <- as.name("model.frame")
    m <- eval(m, sys.parent())
    mt <- attr(m, "terms")
    intercept <- attr(mt, "intercept")
    Y <- model.extract(m, "response")
    if (!inherits(Y, "Surv")) stop("Response must be a survival object")

   des<-read.design(m,Terms)
   X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
   covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ
   clusters <- NULL
   pxz <- px + pz; 

   survs<-read.surv(m,id,npar,clusters,start.time,max.time)
   times<-survs$times;id<-id.call<-survs$id.cal;
   time2<-survs$stop
   status<-survs$status;
## }}}

    antpers = nrow(Z); 
    all.folds <- cv.folds(antpers, K)
    residmat <- matrix(0, length(fraction), K)
    if (is.null(l1.weights) == FALSE) 
        adap <- 1
    else adap <- 0
    for (i in seq(K)) {
        omit <- all.folds[[i]]
        Xl<-X[-omit,]; Zl<-Z[-omit,]; 
        datal=data.frame(tt=time2[-omit],status=status[-omit])
        nn<-antpers-length(omit); 
        out<-additive.compSs(Surv(tt,status)~-1+Xl+const(Zl),data=datal,
            max.time=max.time,start.time=start.time,silent=silent)
        ###S=out$intZHZ; s=out$intZHdN
        fitno<-my.lars(out$intZHZ,out$intZHdN,nn)
        betas<-mypredict.lars(fitno, fraction, type="coefficients",
               mode = "fraction")$coef

        Xo<-X[omit,]; Zo<-Z[omit,]; 
        datao=data.frame(tt=time2[omit],status=status[omit])
        nno<- length(omit); 
        outo<-additive.compSs(Surv(tt,status)~-1+Xo+const(Zo),data=datao,
            max.time=max.time,start.time=start.time,silent=silent)

        fit<- apply(betas,1,function(x)  x %*% outo$intZHZ %*% x) 
        fit<- drop(fit - 2 *betas %*% outo$intZHdN )

        if (length(omit) == 1) 
            fit <- matrix(fit, nrow = 1)
        residmat[, i] <- fit
        if (trace) 
            cat("\n CV Fold", i, "\n\n")
    }
    cv <- apply(residmat, 1, mean)
    cv.error <- sqrt(apply(residmat, 1, var)/K)
    object <- list(fraction = fraction, cv = cv, cv.error = cv.error, 
        cv.frac = fraction[order(cv)][1])
    if (plot.it) 
        lars::plotCVLars(object, se = se)
    invisible(object)
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/additive-pls.r"
additive.plsR<-function (formula = formula(data),
                         data = sys.parent(), start.time = 0, max.time = NULL, 
                         robust=0, id=NULL, clusters=NULL, residuals = 0, n.sim = 0,  
                         weighted.test=0,
                         covariance=0,resample.iid=0,deltaweight=1,pls.dim=1,
                         scale=FALSE,semi.pls=1,silent=0){
###deltaweight<-1; # always default
  if (n.sim == 0) sim <- 0 else sim <- 1
  if (resample.iid==1 & robust==0) {
    cat("When robust=0 no iid representaion computed\n"); 
    resample.iid<-0;}
  if (covariance==1 & robust==0) {
    cat("When robust=0 no covariance computed \n"); 
    cat("Covariance based on robust iid representation\n")
    covariance<-0;}
  if (sim==1 & robust==0) {
    cat("When robust=0, No simulations \n"); 
    cat("n.sim set to 0\n"); n.sim<-0;}
  if (residuals==1 & robust==0) {
    cat("When robust=0, no martingale residuals \n"); 
    residuals<-0;}
  if (n.sim>0 & n.sim<50) {n.sim<-50 ; cat("Minimum 50 simulations\n");}
  call <- match.call()
  m <- match.call(expand = FALSE)
  m$start.time <- m$weighted.test <- m$max.time <- m$robust <- 
    m$sim <- m$residuals <- m$n.sim <- m$id <- m$covariance <- 
      m$resample.iid <- m$clusters <- m$deltaweight<-
        m$pls.dim<- m$semipls<- m$silent<- NULL
  special <- c("const","cluster")
  Terms <- if (missing(data)) terms(formula, special)
  else terms(formula, special, data = data)
  m$formula <- Terms
  m[[1]] <- as.name("model.frame")
  m <- eval(m, sys.parent())
  mt <- attr(m, "terms")
  intercept <- attr(mt, "intercept")
  Y <- model.extract(m, "response")
  if (!inherits(Y, "Surv")) stop("Response must be a survival object")

  des<-read.design(m,Terms)
  X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
  covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ

  if(is.null(clusters)) clusters <- des$clusters  
  
  pxz <- px + pz; 
  npar.pls<-npar; 

  survs<-read.surv(m,id,FALSE,clusters,start.time,max.time)
  times<-survs$times;id<-id.call<-survs$id.cal;
  clusters<-cluster.call<-survs$clusters; time2<-survs$stop
  status<-survs$status; 
  ldata<-list(start=survs$start,stop=survs$stop,
              antpers=survs$antpers,antclust=survs$antclust);

  px<-px-1; 
  beta<-matrix(0,pls.dim,px); pls.comp<-matrix(0,nrow(X),pls.dim); 

  Yorig<-as.matrix(X[,1]); 
  if (npar==FALSE) Z<-scale(Z,scale=scale); 
  X<-scale(X,scale=scale); 
  pls.cov<-as.matrix(X[,-1]); Zorig<-Z; 
  Xorig<-as.matrix(X[,-1]); 

  pvals<-var.gamma<-c()
  for (j in 1:pls.dim)
    {
      cat(paste("PLS component ",j,"\n")) 
      for (i in 1:px)
        {
          if (npar==TRUE ) {
            if (j==1) Z<-as.matrix(Xorig[,i]) else Z<-
              cbind(Xorig[,i],pls.comp[,1:(j-1)]); }
          if (npar==FALSE) {
            if (j==1) Z<-cbind(Xorig[,i],Zorig) else 
            Z<-cbind(Xorig[,i],pls.comp[,1:(j-1)],Zorig); }

        ud <- semiaalen(times, ldata, Yorig , Z, 
        status, id , clusters, robust = robust, sim = sim, antsim = n.sim, 
        weighted.test = weighted.test, retur =
        residuals,covariance=covariance,
        resample.iid=resample.iid,namesX=covnamesX,namesZ=covnamesZ,
                          deltaweight=deltaweight,silent=silent)

          pvals<-c(pvals,1-pchisq(ud$gamma[1]^2/ud$var.gamma,1))
          var.gamma<-c(var.gamma,ud$var.gamma)

          beta[j,i]<-c(ud$gamma)[1];
          pls.comp[,j]<-pls.comp[,j]+beta[j,i]*Xorig[,i]; 
        } 
    }
  cnames<-c()
  for (j in 1:pls.dim) cnames<-c(cnames,paste("PLS-",j)); 
  colnames(pls.comp)<-cnames

  if (npar==TRUE) Z<-pls.comp else Z<-cbind(pls.comp,Zorig)
  udf <- semiaalen(times, ldata, Yorig , Z, 
         status, id , clusters, robust = robust, sim = sim, antsim = n.sim, 
         weighted.test = weighted.test, retur =
         residuals,covariance=covariance,
         resample.iid=resample.iid,namesX=covnamesX,namesZ=covnamesZ,
         deltaweight=deltaweight)

ud<-list(pls.comp=pls.comp,beta.pls=beta,
         beta=udf$gamma,baseline=udf$cum,pvals=pvals,var.gamma=var.gamma)
class(ud) <- "pls"
attr(ud, "Call") <- sys.call()
attr(ud, "Formula") <- formula
ud$call <- call
return(ud)
}

additive.pls<-function (formula = formula(data), data = sys.parent(), 
start.time=0,max.time=NULL,id=NULL,
pls.dim=1, scale=FALSE,weighted.pls=0,silent=0) 
{ 
semipls=1; deltaweight<-1; constant<-1; # always !  
call <- match.call()
    m <- match.call(expand = FALSE)
    m$start.time <- m$max.time <-  m$id <- m$pls.dim<- m$semipls<- m$scale<-
    m$weighted.pls<- m$silent<- NULL
    special <- c("const")
    Terms <- if (missing(data)) terms(formula, special)
    else terms(formula, special, data = data)
    m$formula <- Terms
    m[[1]] <- as.name("model.frame")
    m <- eval(m, sys.parent())
    mt <- attr(m, "terms")
    intercept <- attr(mt, "intercept")
    Y <- model.extract(m, "response")
    if (!inherits(Y, "Surv")) stop("Response must be a survival object")

    des<-read.design(m,Terms)
    X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
    covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ
    pxz <- px + pz; 

    clusters=NULL;
    if (pls.dim>=1) survs<-read.surv(m,id,FALSE,clusters,start.time,max.time)
    else survs<-read.surv(m,id,TRUE,clusters,start.time,max.time)
    times<-survs$times;id<-id.call<-survs$id.cal;
    clusters<-cluster.call<-survs$clusters; time2<-survs$stop
    status<-survs$status; 
    ldata<-list(start=survs$start,stop=survs$stop,
                antpers=survs$antpers,antclust=survs$antclust);

    px<-px-1; 
    beta<-matrix(0,pls.dim,px); weights<-beta 
    pls.comp<-matrix(0,nrow(X),pls.dim); 

    Yorig<-as.matrix(X[,1]); colnames(Yorig)<-"Intercept"
    X<-scale(X,scale=scale); 
    pls.cov<-as.matrix(X[,-1]); 
    Zorig<-Z;  

    if (pls.dim>0) { 
    for (j in 1:pls.dim)
    {## {{{

    Xmat<-as.matrix(Yorig); 
    covnamesXo<-colnames(Xmat); 
    if (npar==TRUE ) {
    if (j==1) Z<-as.matrix(pls.cov[,1]) else  {
    if (constant==1)  {Z<-cbind(pls.comp[,1:(j-1)],pls.cov[,1]);} else
                      {Z<-as.matrix(pls.cov[,1]); 
                       Xmat<-as.matrix(cbind(Yorig,pls.comp[,1:(j-1)])); 
                       } } }
    if (npar==FALSE) {
    Xmat<-cbind(Yorig,Zorig); 
    covnamesXo<-colnames(Xmat); 
    if (j==1) Z<-as.matrix(pls.cov[,1]) else  {

    if (constant==1)  {Z<-cbind(pls.comp[,1:(j-1)],pls.cov[,1]);} else
                      {Z<-as.matrix(cbind(Zorig,pls.cov[,1])); 
                       Xmat<-as.matrix(cbind(Yorig,pls.comp[,1:(j-1)]));}}}

    Z<-as.matrix(Z); Xmat<-as.matrix(Xmat); 
    pg<-ncol(as.matrix(Z)); px<-ncol(as.matrix(Xmat)); nx<-nrow(Yorig); 

    dimplscov<-ncol(pls.cov);
    betapls<-rep(0,dimplscov); plscomp<-Yorig[,1]; 

    Nalltimes <- length(times);
    Ntimes<-sum(status[(ldata$stop>times[1]) & 
                (ldata$stop<=times[Nalltimes])])+1;
    cum<-matrix(0,Ntimes,px);  

    semiout<-.C("plssemiadd",
    as.double(times),as.integer(Nalltimes),as.integer(Ntimes),
    as.double(Xmat),as.integer(nx),as.integer(px),
    as.double(Z),as.integer(nx),as.integer(pg),
    as.integer(ldata$antpers),as.double(ldata$start),as.double(ldata$stop),
    as.integer(id),as.double(cum),as.integer(status),
    as.integer(deltaweight),as.double(pls.cov),
    as.integer(dimplscov),as.double(betapls),as.double(plscomp),
    as.integer(semipls),as.integer(weighted.pls),as.integer(silent)
    ,PACKAGE="timereg")

    plscomp<-semiout[[20]]; betapls<-semiout[[19]];

    beta[j,]<-betapls; 
    pls.comp[,j]<-plscomp;
    } ## }}}

    cnames<-c()
    for (j in 1:pls.dim) cnames<-c(cnames,paste("PLS-",j)); 

    colnames(beta)<-covnamesX[-1]; 
    Z<-as.matrix(pls.comp) 

    udf<-semiaalen(times, ldata, Xmat , Z, 
        status, id , clusters, robust = 0, sim = 0, 
        antsim = 0, weighted.test = 0 , retur = 0 ,
        covariance= 0 , resample.iid=0 ,
        namesX=covnamesXo,namesZ=covnamesZ, 
        deltaweight=deltaweight,silent=silent);

    betaf<-c(udf$gamma)
    tbeta.pls<-apply(beta*betaf[1:pls.dim],2,sum)
    colnames(udf$cum)<-c("times",covnamesXo)
} else {  ## {{{ pls.dim=0
    betaf<-rep(0,1); pls.comp<-matrix(0,nrow(Yorig),1); 
    names(betaf)<-"dummy"; 
    tbeta.pls<-rep(0,px); 
    names(tbeta.pls)<-covnamesX[-1]; 

    survs<-read.surv(m,id,TRUE,clusters,start.time,max.time)
    times<-survs$times;id<-id.call<-survs$id.cal;
    clusters<-cluster.call<-survs$clusters; time2<-survs$stop

    udf<-aalenBase(times, ldata, Yorig ,
        status, id , clusters, robust = 0, sim = 0,
        antsim = 0, weighted.test = 0 , retur = 0 ,
        covariance= 0 , resample.iid=0 ,
        namesX=colnames(Yorig),silent=silent);
        colnames(udf$cum)<-c("times","Intercept")
} ## }}}


ud<-list(pls.comp=pls.comp,beta.pls=beta,beta=betaf,
baseline=udf$cum,tbeta.pls=tbeta.pls)
class(ud) <- "pls"
attr(ud, "Call") <- sys.call()
attr(ud, "Formula") <- formula
ud$call <- call

return(ud)
}

predict.pls<-function(object,Z=NULL,X=NULL,times=NULL,monotone=TRUE, ...)
{ ## {{{
if(!(inherits(object,"pls")))stop("Must be output from additive.pls function")

  ## Allow for the possibility that X is a vector
  if (is.null(Z))  stop("Must specify Z, and baseline covariates X if needed \n");
  if(!is.matrix(Z) && !is.data.frame(Z)){
    Z<-matrix(Z,ncol = ncol(object$beta.pls)); }
    Z<-scale(Z);  
  nobs<-nrow(Z);
  if (is.null(X)) X <- matrix(1,nobs,1);
  if(!is.matrix(X) && !is.data.frame(X)){
    X<-matrix(X,ncol = ncol(object$baseline)-1); } else { X<-X; }

  risk<- object$tbeta.pls %*% t(Z)
  if (is.null(times)) {times<-object$baseline[,1]; cumbaselinet<-object$baseline } else
  cumbaselinet<-Cpred(object$baseline,times)

  cumhaz <- as.matrix(X) %*% t(cumbaselinet[, -1])
  surv<-as.matrix(exp(-cumhaz-t(rbind(c(risk)) %x% cbind(c(times)))))

  if (monotone==TRUE) {
     survm<- -t(apply(-surv,1,pava));
     survm[survm>1]<-1; survm[survm<0]<-0; } else survm<-surv; 

return(list(times=times,surv=survm))
} ## }}}

summary.pls<-function(object, ...)
{ ## {{{
if (!(inherits(object,"pls")))stop("Must be output from additive.pls function")
} ## }}}

print.pls<-function(x, ...)
{ ## {{{
if(!(inherits(x,"pls")))stop("Must be output from additive.pls function")
} ## }}}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/base.r"
coefBase<- function(object, digits=3, d2logl=0) {
  res <- cbind(object$gamma,
               diag(object$var.gamma)^0.5,
               diag(object$robvar.gamma)^0.5)
  if (d2logl==1) res<-cbind(res,diag(object$D2linv)^.5)
  wald <- object$gamma/diag(object$var.gamma)^0.5
  waldp <- (1 - pnorm(abs(wald))) * 2
  res <- as.matrix(cbind(res, wald, waldp))
  if (d2logl==1) colnames(res) <- c("Coef.", "SE", "Robust SE","D2log(L)^-1","z","P-val") else colnames(res) <- c("Coef.", "SE", "Robust SE", "z", "P-val")
  prmatrix(signif(res, digits))
}

timetest<-function(object,digits=3,hyp.label="p-value H_0: B(t)=b t")
{ 
  cat("Test for nonparametric terms \n")
  if (is.null(object$conf.band)==TRUE)  mtest<-FALSE else mtest<-TRUE;
  if (mtest==FALSE) cat("Test not computed, sim=0 \n\n")
  if (mtest==TRUE) {
  test0<-cbind(object$obs.testBeq0,object$pval.testBeq0)
  testC<-cbind(object$obs.testBeqC,object$pval.testBeqC)
  colnames(test0)<-c("Supremum-test of significance","p-value H_0: B(t)=0")
  colnames(testC)<-c("Kolmogorov-Smirnov test",hyp.label)
  if (is.null(object$obs.testBeqC.is)!=TRUE)  {
  testCis<-cbind(object$obs.testBeqC.is,object$pval.testBeqC.is)
  colnames(testCis) <-c("Cramer von Mises test",hyp.label)
  }
  cat("\n")
  cat("Test for non-significant effects \n")
  prmatrix(signif(test0,digits))
  cat("\n")
  cat("Test for time invariant effects \n")
  prmatrix(signif(testC,digits))
  if (is.null(object$obs.testBeqC.is)!=TRUE)  prmatrix(signif(testCis,digits))
  cat("\n")
}
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/comprisk.r"
comp.risk<-function(formula,data=sys.parent(),cause,times=NULL,Nit=50,
clusters=NULL,gamma=0,n.sim=500,weighted=0,model="additive",
causeS=1,cens.code=0,detail=0,interval=0.01,resample.iid=1,
cens.model="KM",time.pow=0){
# trans=1 P_1=1-exp(- ( x' b(b)+ z' gam t) ), 
# trans=2 P_1=1-exp(-exp(x a(t)+ z` b )
# trans=not done P_1=1-exp(-x a(t) exp(z` b )) is not good numerically
# trans=3 P_1=exp(-exp(x a(t)+ z` b )
  if (model=="additive") trans<-1; 
  if (model=="prop") trans<-2; 
  if (model=="logistic") trans<-3; 
  if (model=="1-additive") trans<-4; 
  ## if (is.null(line)) {
  if (trans==1) line<-1; if (trans==2) line<-0; 
  if (trans==3) line<-0; if (trans==4) line<-0; 
  ## }
# line=1 indicates that it is tested that "b(t) = gamma t".
# line=0 indicates that it is tested that "b(t) = gamma ".
  m<-match.call(expand = FALSE);
  m$gamma<-m$times<-m$cause<-m$Nit<-m$weighted<-m$n.sim<-
    m$model<-m$causeS<- m$detail<- m$cens.model<-m$time.pow<-
    m$cens.code<-m$interval<- m$clusters<-m$resample.iid<-NULL
  special <- c("const","cluster")
  if (missing(data)) {
    Terms <- terms(formula, special)
  }  else {
    Terms <- terms(formula, special, data = data)
  }
  m$formula <- Terms
  m[[1]] <- as.name("model.frame")
  m <- eval(m, sys.parent())
  mt <- attr(m, "terms")
  intercept <- attr(mt, "intercept")
  Y <- model.extract(m, "response")
  if (!inherits(Y, "Surv")) stop("Response must be a survival object")

  if (attr(m[, 1], "type") == "right") {
    time2 <- m[, 1][, "time"]; time <- rep(0, length(time2))
    status <- m[, 1][, "status"]
  } else if (attr(m[, 1], "type") == "counting") {
    stop("only right censored data"); 
    time <- m[, 1][, 1];time2 <- m[, 1][, 2];status <- m[, 1][, 3];
  } else {
    stop("only right-censored or counting processes data")
  }

  if (n.sim==0) sim<-0 else sim<-1; antsim<-n.sim;
  des<-read.design(m,Terms)
  X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
  covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ;

  if(is.null(clusters)){ clusters <- des$clusters}

  if(is.null(clusters)){
    clusters <- 0:(nrow(X) - 1)
    antclust <- nrow(X)
  } else {
    clusters <- as.integer(factor(clusters))-1
    antclust <- length(unique(clusters))
  }
    
  pxz <-px+pz;

  if (is.null(times)) {times<-sort(unique(time2[cause==causeS])); 
                       times<-times[-c(1:5)];}

  n<-nrow(X); ntimes<-length(times);
  if (npar==TRUE) {Z<-matrix(0,n,1); pg<-1; fixed<-0;} else {fixed<-1;pg<-pz;} 
  delta<-(cause!=cens.code)

  if (cens.model=="KM") {
    ud.cens<-survfit(Surv(time2,cause==cens.code)~+1); 
    Gfit<-cbind(ud.cens$time,ud.cens$surv)
    Gfit<-rbind(c(0,1),Gfit); 
    Gcx<-Cpred(Gfit,time2)[,2];
    Gctimes<-Cpred(Gfit,times)[,2];
  } else if (cens.model=="cox") { 
    if (npar==TRUE) XZ<-X[,-1] else XZ<-cbind(X,Z)[,-1];
    ud.cens<-cox.aalen(Surv(time2,cause==cens.code)~prop(XZ),n.sim=0,robust=0);
    Gcx<-Cpred(ud.cens$cum,time2)[,2];
    RR<-exp(XZ %*% ud.cens$gamma)
    Gcx<-exp(-Gcx*RR)
    Gfit<-rbind(c(0,1),cbind(time2,Gcx)); 
    Gctimes<-Cpred(Gfit,times)[,2];
    } else if (cens.model=="aalen") { 
    if (npar==TRUE) XZ<-X[,-1] else XZ<-cbind(X,Z)[,-1];
    ud.cens<-aalen(Surv(time2,cause==cens.code)~XZ,n.sim=0,robust=0);
    Gcx<-Cpred(ud.cens$cum,time2)[,-1];
    XZ<-cbind(1,XZ); 
    Gcx<-exp(-apply(Gcx*XZ,1,sum))
    Gcx[Gcx>1]<-1; Gcx[Gcx<0]<-0
    Gfit<-rbind(c(0,1),cbind(time2,Gcx)); 
    Gctimes<-Cpred(Gfit,times)[,2];
    } else { stop('Unknown censoring model') }

   times<-times[Gctimes>interval]; ntimes<-length(times); 

  if (resample.iid == 1) {
    biid <- double(ntimes* antclust * px);
    gamiid<- double(antclust *pg);
  } else {
    gamiid <- biid <- NULL;
  }

  ps<-px; betaS<-rep(0,ps); 

  if (model=="additive") est<-matrix(1/sum(cause==causeS),ntimes,ps+1) 
  else est<-matrix(0,ntimes,ps+1) 

  hess<-matrix(0,ps,ps); var<-score<-matrix(0,ntimes,ps+1); 
  if (sum(gamma)==0) gamma<-rep(0,pg); gamma2<-rep(0,ps); 
  test<-matrix(0,antsim,3*ps); testOBS<-rep(0,3*ps); unifCI<-c();
  testval<-c(); rani<--round(runif(1)*10000); 
  Ut<-matrix(0,ntimes,ps+1); simUt<-matrix(0,ntimes,50*ps);
  var.gamma<-matrix(0,pg,pg); 
  pred.covs.sem<-0

  if (sum(time.pow)==0 & model=="prop") time.pow<-rep(0,pg); 
  if (sum(time.pow)==0 & model=="additive") time.pow<-rep(1,pg); 

  out<-.C("itfit",
          as.double(times),as.integer(ntimes),as.double(time2),
          as.integer(delta), as.integer(cause),as.double(Gcx),
          as.double(X),as.integer(n),as.integer(px),
          as.integer(Nit), as.double(betaS), as.double(score),
          as.double(hess), as.double(est), as.double(var),
          as.integer(sim),as.integer(antsim),as.integer(rani),
          as.double(test), as.double(testOBS), as.double(Ut),
          as.double(simUt),as.integer(weighted),as.double(gamma),
          as.double(var.gamma),as.integer(fixed),as.double(Z),
          as.integer(pg),as.integer(trans),as.double(gamma2),
          as.integer(causeS),as.integer(line),as.integer(detail),
          as.double(biid),as.double(gamiid),as.integer(resample.iid),
          as.double(time.pow),as.integer(clusters),as.integer(antclust),
          PACKAGE="timereg")

  gamma<-matrix(out[[24]],pg,1); var.gamma<-matrix(out[[25]],pg,pg); 
  gamma2<-matrix(out[[30]],ps,1); 
  rownames(gamma2)<-covnamesX; 

  if (fixed==0) gamma<-NULL; 

  if (resample.iid==1)  {
    biid<-matrix(out[[34]],ntimes,antclust*px);
    if (fixed==1) gamiid<-matrix(out[[35]],antclust,pg) else gamiid<-NULL; 
    B.iid<-list();
    for (i in (0:(antclust-1))*px) {
    B.iid[[i/px+1]]<-matrix(biid[,i+(1:px)],ncol=px);
      colnames(B.iid[[i/px+1]])<-covnamesX; }
    if (fixed==1) colnames(gamiid)<-covnamesZ
  } else B.iid<-gamiid<-NULL;

  if (sim==1) {
    simUt<-matrix(out[[22]],ntimes,50*ps); UIt<-list();
    for (i in (0:49)*ps) UIt[[i/ps+1]]<-as.matrix(simUt[,i+(1:ps)]);
    Ut<-matrix(out[[21]],ntimes,ps+1);
    test<-matrix(out[[19]],antsim,3*ps); testOBS<-out[[20]];
    supUtOBS<-apply(abs(as.matrix(Ut[,-1])),2,max);
    p<-ps
    for (i in 1:(3*p)) testval<-c(testval,pval(test[,i],testOBS[i]))
    for (i in 1:p) unifCI<-as.vector(c(unifCI,percen(test[,i],0.95)));
    pval.testBeq0<-as.vector(testval[1:p]);
    pval.testBeqC<-as.vector(testval[(p+1):(2*p)]);
    pval.testBeqC.is<-as.vector(testval[(2*p+1):(3*p)]);
    obs.testBeq0<-as.vector(testOBS[1:p]);
    obs.testBeqC<-as.vector(testOBS[(p+1):(2*p)]);
    obs.testBeqC.is<-as.vector(testOBS[(2*p+1):(3*p)]);
    sim.testBeq0<-as.matrix(test[,1:p]);
    sim.testBeqC<-as.matrix(test[,(p+1):(2*p)]);
    sim.testBeqC.is<-as.matrix(test[,(2*p+1):(3*p)]);
  } else {test<-unifCI<-Ut<-UIt<-pval.testBeq0<-pval.testBeqC<-obs.testBeq0<-
          obs.testBeqC<- sim.testBeq0<-sim.testBeqC<-
          sim.testBeqC.is<- pval.testBeqC.is<-
          obs.testBeqC.is<-NULL;
        }

  est<-matrix(out[[14]],ntimes,ps+1); 
  score<-matrix(out[[12]],ntimes,ps+1); 
  var<-matrix(out[[15]],ntimes,ps+1); 
  colnames(var)<-colnames(est)<-c("time",covnamesX); 

  if (sim>=1) {
    colnames(Ut)<- c("time",covnamesX)
    names(unifCI)<-names(pval.testBeq0)<-
      names(pval.testBeqC)<- names(pval.testBeqC.is)<-
        names(obs.testBeq0)<-
          names(obs.testBeqC)<- names(obs.testBeqC.is)<-
            colnames(sim.testBeq0)<-
              colnames(sim.testBeqC)<- colnames(sim.testBeqC.is)<- covnamesX;
  }

  if (fixed==1) { rownames(gamma)<-c(covnamesZ);
                  colnames(var.gamma)<- rownames(var.gamma)<-c(covnamesZ); }

  colnames(score)<-c("time",covnamesX);
  if (is.na(sum(score))==TRUE) score<-NA  else 
  if (sum(score[,-1])<0.00001) score<-sum(score[,-1]); 

  ud<-list(cum=est,var.cum=var,gamma=gamma,score=score,
           gamma2=gamma2,var.gamma=var.gamma,robvar.gamma=var.gamma,
           pval.testBeq0=pval.testBeq0,pval.testBeqC=pval.testBeqC,
           obs.testBeq0=obs.testBeq0,
           obs.testBeqC.is=obs.testBeqC.is,
           obs.testBeqC=obs.testBeqC,pval.testBeqC.is=pval.testBeqC.is,
           conf.band=unifCI,B.iid=B.iid,gamma.iid=gamiid,
           test.procBeqC=Ut,sim.test.procBeqC=UIt)

  ud$call<-call; ud$model<-model; ud$n<-n; 
  ud$formula<-formula; class(ud)<-"comprisk"; 
  attr(ud, "Call") <- sys.call()
  attr(ud, "Formula") <- formula
  attr(ud, "time.pow") <- time.pow
  attr(ud, "cause") <- cause
  attr(ud, "times") <- times
  return(ud); 
}

print.comprisk <- function (x,...) {
  object <- x; rm(x);
  if (!inherits(object, 'comprisk')) stop ("Must be an comprisk object")
  if (is.null(object$gamma)==TRUE) semi<-FALSE else semi<-TRUE
    
   # We print information about object:  
  cat(paste(" Competing risks model with", object$model,"subdistribution hazard function\n\n"))
  cat(" Nonparametric terms : ");
  cat(colnames(object$cum)[-1]); cat("   \n");  
  if (semi) {
    cat(" Parametric terms :  ");
    cat(rownames(object$gamma)); 
    cat("   \n");
  } 
  cat("   \n");  

    }

coef.comprisk <- function(object, digits=3,...) {

   coefBase(object,digits=digits)
}

#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/cox-aalen.r"
cox.aalenBase<-function (times, fdata, designX, designG, status,
                         id, clusters, Nit = 5, beta = 0, weights=NULL, detail = 0, 
                         sim = 1, antsim = 1000, weighted.test= 0, robust = 1, 
                         ratesim = 1, residuals = 0, covariance = 1,
                         resample.iid=0,namesZ=NULL,namesX=NULL,beta.fixed=0) 
{
  additive.resamp <-0; ridge <- 0; XligZ <- 0;
  Ntimes <- length(times)
  designX <- as.matrix(designX)
  designG <- as.matrix(designG)
  if (is.matrix(designX) == TRUE) 
    px <- as.integer(dim(designX)[2])
  if (is.matrix(designX) == TRUE) 
    nx <- as.integer(dim(designX)[1])
  if (is.matrix(designG) == TRUE) 
    pg <- as.integer(dim(designG)[2])
  if (is.matrix(designG) == TRUE) 
    ng <- as.integer(dim(designG)[1])
  if (nx != ng) 
    print(" A design og B designs er ikke ens\n")
  if (is.null(weights)==FALSE) mw<-1 else { mw <- 0; weights <- rep(1, nx);}
  moff <- 0
  offset <- rep(1, nx)
  nb <- 1
  aalen <- 1
  if (covariance == 1) 
    covs <- matrix(0, Ntimes, px * px)
  else covs <- 0
  if (residuals == 1) {
    cumAi <- matrix(0, Ntimes, fdata$antpers * 1)
    gammaiid <- matrix(0, pg, fdata$antclust * 1)
                                        #dM.iid <- matrix(0, Ntimes, fdata$antpers * 1)
    dM.iid<-0                           # not used in this version
  }
  else {
    cumAi <- 0; gammaiid <- 0; dM.iid <- 0;
  }
  cumint <- matrix(0, Ntimes, px + 1)
  vcum <- matrix(0, Ntimes, px + 1)
  Rvcu <- matrix(0, Ntimes, px + 1)
  if (sum(abs(beta)) == 0) 
    betaS <- rep(0, pg)
  else betaS <- beta
  score <- betaS
  loglike <- rep(0,2); 
  Varbeta <- matrix(0, pg, pg)
  Iinv <- matrix(0, pg, pg)
  RVarbeta <- matrix(0, pg, pg)
  if (sim == 1) 
    Uit <- matrix(0, Ntimes, 50 * pg)
  else Uit <- NULL
  if (additive.resamp == 1) 
    baseproc <- matrix(0, Ntimes, 50 * px)
  else baseproc <- NULL
  if (resample.iid == 1) {
    biid <- matrix(0, Ntimes, fdata$antclust * px); 
    gamiid<- matrix(0,fdata$antclust,pg); }
  else {gamiid <- biid <- NULL; }
  test <- matrix(0, antsim, 2 * px)
  testOBS <- rep(0, 2 * px)
  unifCI <- c()
  testval <- c()
  rani <- -round(runif(1) * 10000)
  Ut <- var.score<- matrix(0, Ntimes, pg + 1)
  simUt <- matrix(0, antsim, pg)

                                        #dyn.load("lincox-aalen.so"); 

  nparout <- .C("score", as.double(times), as.integer(Ntimes), 
                as.double(designX), as.integer(nx), as.integer(px), 
                as.double(designG), as.integer(ng), as.integer(pg), 
                as.integer(fdata$antpers), as.double(fdata$start), as.double(fdata$stop),
                as.double(betaS), as.integer(Nit), as.double(cumint), 
                as.double(vcum), as.double(weights), as.integer(mw), 
                as.double(loglike), as.double(Iinv), as.double(Varbeta), 
                as.integer(detail), as.double(offset), as.integer(moff), 
                as.integer(sim), as.integer(antsim), as.integer(rani), 
                as.double(Rvcu), as.double(RVarbeta), as.double(test), 
                as.double(testOBS), as.double(Ut), as.double(simUt), 
                as.double(Uit), as.integer(XligZ), as.double(aalen), 
                as.integer(nb), as.integer(id), as.integer(status), 
                as.integer(weighted.test), as.double(ridge), as.integer(ratesim), 
                as.double(score), as.double(cumAi), as.double(gammaiid), 
                as.double(dM.iid), as.integer(residuals), as.integer(robust), 
                as.integer(covariance), as.double(covs), as.integer(additive.resamp),
                as.double(baseproc), as.integer(resample.iid), as.double(gamiid), 
                as.double(biid),as.integer(clusters),as.integer(fdata$antclust),
                as.double(var.score),as.integer(beta.fixed)
                ,PACKAGE = "timereg")

  Iinv <- matrix(nparout[[19]], pg, pg)
  RVarbeta <- -matrix(nparout[[28]], pg, pg)
  Rvcu <- matrix(nparout[[27]], Ntimes, px + 1)
  Ut <- matrix(nparout[[31]], Ntimes, pg + 1)
  var.score<-matrix(nparout[[57]],Ntimes,pg+1)

  if (resample.iid==1)  {
    gamiid<-matrix(nparout[[53]],fdata$antclust,pg);
    biid<-matrix(nparout[[54]],Ntimes,fdata$antclust*px);
    B.iid<-list();
    for (i in (0:(fdata$antclust-1))*px) {
      B.iid[[i/px+1]]<-as.matrix(biid[,i+(1:px)]);
      colnames(B.iid[[i/px+1]])<-namesX; }
    colnames(gamiid)<-namesZ
  } else B.iid<-gamiid<-NULL; 

  if (covariance == 1) {
    covit <- matrix(nparout[[49]], Ntimes, px * px)
    cov.list <- list()
    for (i in 1:Ntimes) cov.list[[i]] <- matrix(covit[i,], px, px) } else 
  cov.list <- NULL
  if (residuals == 1) {
    cumAi <- matrix(nparout[[43]],Ntimes,fdata$antpers * 1)
    gammaiid <- matrix(nparout[[44]],pg,fdata$antclust * 1)
    cumAi <- list(time = times, dM = cumAi, gamma.iid = gammaiid)
  }
  else cumAi <- NULL
  if (sim == 1) {
    Uit <- matrix(nparout[[33]], Ntimes, 50 * pg)
    UIt <- list()
    for (i in (0:49) * pg) UIt[[i/pg + 1]] <- as.matrix(Uit[, i + (1:pg)])
    simUt <- matrix(nparout[[32]], antsim, pg)
    test <- matrix(nparout[[29]], antsim, 2 * px)
    testOBS <- nparout[[30]]
    supUtOBS <- apply(abs(as.matrix(Ut[, -1])), 2, max)
    for (i in 1:(2 * px)) testval <- c(testval, pval(test[, 
                                                          i], testOBS[i]))
    for (i in 1:px) unifCI <- c(unifCI, percen(test[, i], 
                                               0.95))
    testUt <- c()
    for (i in 1:pg) testUt <- c(testUt, pval(simUt[, i], 
                                             supUtOBS[i]))
    pval.testBeq0 <- as.vector(testval[1:px])
    pval.testBeqC <- as.vector(testval[(px + 1):(2 * px)])
    obs.testBeq0 <- as.vector(testOBS[1:px])
    obs.testBeqC <- as.vector(testOBS[(px + 1):(2 * px)])
    sim.testBeq0 <- as.matrix(test[, 1:px])
    sim.testBeqC <- as.matrix(test[, (px + 1):(2 * px)])
    sim.supUt <- as.matrix(simUt)
  }
  if (additive.resamp == 1) {
    baseproc <- matrix(nparout[[51]], Ntimes, 50 * pg)
    additive.proc <- list()
    for (i in (0:49) * px)
      additive.proc[[i/px+1]]<-as.matrix(baseproc[,i+(1:px)])
  }
  else additive.proc <- NULL
  Varbeta <- -matrix(nparout[[20]], pg, pg)
  cumint <- matrix(nparout[[14]], Ntimes, px + 1)
  vcum <- matrix(nparout[[15]], Ntimes, px + 1)
  gamma <- matrix(nparout[[12]], pg, 1)
  score <- matrix(nparout[[42]], pg, 1)
  if (sim != 1) {
    testUt <- test <- unifCI <- supUtOBS <- UIt <- testOBS <- testval <- pval.testBeq0 <- pval.testBeqC <- obs.testBeq0 <- obs.testBeqC <- sim.testBeq0 <- sim.testBeqC <- testUt <- sim.supUt <- NULL 
  }
  if (robust==0 & beta.fixed==0) var.score<-NULL;

  ud <- list(cum = cumint, var.cum = vcum, robvar.cum = Rvcu, 
             gamma = gamma, var.gamma = Varbeta, robvar.gamma = RVarbeta, 
             residuals = cumAi, loglike = nparout[[18]], D2linv = Iinv, 
             score = score, var.score=var.score, 
             pval.testBeq0 = pval.testBeq0, pval.testBeqC = pval.testBeqC, 
             obs.testBeq0 = obs.testBeq0, obs.testBeqC = obs.testBeqC, 
             sim.testBeq0 = sim.testBeq0, sim.testBeqC = sim.testBeqC, 
             conf.band = unifCI, test.procProp = Ut, sim.test.procProp = UIt,
             pval.Prop = testUt, sim.supProp = sim.supUt, covariance = cov.list, 
             B.iid=B.iid,gamma.iid=gamiid)
  return(ud)
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/dynadd.r"
dynregBase<-function(times,status,response,fdata,designX,designA,id, 
bhat=NULL,b=1,sim=1,antsim=1000,retur=0,smoothXX=0,
weighted.test=0)
{
Ntimes <- length(times)

designA<-as.matrix(designA); 
pa <- as.integer(dim(designA)[2]); na <- as.integer(dim(designA)[1])

designX<-as.matrix(designX); 
px <- as.integer(dim(designX)[2]); nx <- as.integer(dim(designX)[1])

#if (nx!=na) print(" A design og B designs er ikke ens\n");
w<-rep(1,nx); mw<-0;  
vcum.ly<-cum.ly<-cum0<-cumf<-cum.ms<-vcum0<-vcumf<-robvcumf<-matrix(0,Ntimes,px+1); 
ly<-NULL;
if (retur==1) cumBi<-matrix(0,Ntimes,fdata$antpers*px) else cumBi<-0;
test<-matrix(0,antsim,3*px); testOBS<-rep(0,3*px); testval<-c();
unifCI<-c();
rani<--round(runif(1)*10000)

# 50 tilfaeldige score processer til test H: b(t)=b returneres
if (sim==1) simUt<-matrix(0,Ntimes,50*px) else simUt<-NULL;
Ut<-matrix(0,Ntimes,px+1);

if (is.null(id) == TRUE) {
   antpers <- length(time); id <- 0:(antpers - 1);} else 
   { pers <- unique(id); antpers <- length(pers);
    id<-as.integer(factor(id, labels = 1:(antpers))) - 1; }

   clusters<-id; antclust<-antpers;
   fdata$antpers <- antpers; fdata$antclust <- antclust

out.aalen<-aalenBase(times,fdata,designA,status,id,clusters); 

if (!is.null(bhat)) xval<-bhat[,1] else
xval<-seq(times[2],times[Ntimes],length=30); 
smooth.aalen<-CsmoothB(out.aalen$cum,xval,b); 
nxval<-length(xval); 
#print(smooth.aalen[,1:4]); print(bhat); 

if (is.null(bhat)) { bhat<-matrix(0,nxval,px+1);  bhat[,1]<-smooth.aalen[,1];}
if (length(b)==1) b<-rep(b,nxval); 
bhatny<-bhat

nparout<-.C("dynadd",
as.double(times),as.double(response),as.integer(Ntimes),
as.double(designX),as.integer(nx),as.integer(px),
as.double(designA),as.integer(na),as.integer(pa),
as.double(smooth.aalen),as.double(bhat),as.double(bhatny),
as.integer(nxval),as.integer(fdata$antpers),as.double(fdata$start),
as.double(fdata$stop),
as.double(cum0), as.double(cumf), as.double(cum.ms),
as.double(vcum0), as.double(vcumf), as.double(robvcumf), 
as.double(w),as.integer(mw),as.integer(rani),
as.integer(sim),as.integer(antsim),
as.double(cumBi),
as.double(test),as.double(testOBS),
as.integer(status),as.double(Ut),as.double(simUt),
as.double(b),as.double(cum.ly),as.integer(retur),as.integer(id),
as.integer(smoothXX),as.integer(weighted.test),as.double(vcum.ly),
PACKAGE="timereg")

cum0 <-matrix(nparout[[17]],Ntimes,px+1);
cumf <-matrix(nparout[[18]],Ntimes,px+1);
cum.ms <-matrix(nparout[[19]],Ntimes,px+1);
vcum0 <-matrix(nparout[[20]],Ntimes,px+1);
vcumf <-matrix(nparout[[21]],Ntimes,px+1); 
robvcumf <-matrix(nparout[[22]],Ntimes,px+1);
cum.ly <-matrix(nparout[[35]],Ntimes,px+1) 
vcum.ly <-matrix(nparout[[40]],Ntimes,px+1) 

if (retur==1) {
cumBi<-matrix(nparout[[28]],Ntimes,fdata$antpers*px);
cumBI<-list();
for (i in (0:(fdata$antpers-1))*px)
cumBI[[i/px+1]]<-cumBi[,i+(1:px)] } else cumBI<-NULL;

if (sim==1) {
Uit<-matrix(nparout[[33]],Ntimes,50*px);
UIt<-list(); for (i in (0:49)*px) UIt[[i/px+1]]<-Uit[,i+(1:px)];
Ut<-matrix(nparout[[32]],Ntimes,(px+1));
test<-matrix(nparout[[29]],antsim,3*px);
testOBS<-nparout[[30]];
for (i in 1:(3*px)) testval<-c(testval,pval(test[,i],testOBS[i]))
for (i in 1:px) unifCI<-as.vector(c(unifCI,percen(test[,i],0.95)));
pval.testBeq0<-as.vector(testval[1:px]);
pval.testBeqC<-as.vector(testval[(px+1):(2*px)]);
pval.testBeqC.is<-as.vector(testval[(2*px+1):(3*px)]);
obs.testBeq0<-as.vector(testOBS[1:px]);
obs.testBeqC<-as.vector(testOBS[(px+1):(2*px)]);
obs.testBeqC.is<-as.vector(testOBS[(2*px+1):(3*px)]);
sim.testBeq0<-as.matrix(test[,1:px]);
sim.testBeqC<-as.matrix(test[,(px+1):(2*px)]);
sim.testBeqC.is<-as.matrix(test[,(2*px+1):(3*px)]);
} else {test<-NULL; unifCI<-NULL; Ut<-NULL; UIt<-NULL;
pval.testBeqC.is<-NULL; obs.testBeqC.is<-NULL; sim.testBeqC.is<-NULL;
pval.testBeq0<-NULL;pval.testBeqC<-NULL;
obs.testBeq0<-NULL;obs.testBeqC<-NULL;
sim.testBeq0<-NULL;sim.testBeqC<-NULL; }

list(cum=cumf,var.cum=vcumf,robvar.cum=robvcumf,
cum0=cum0,var.cum0=vcum0,
cum.ms=cum.ms,var.cum.ms=vcumf,
cum.ly=cum.ly,var.cum.ly=vcum.ly,
residuals=cumBI,
pval.testBeq0=pval.testBeq0,pval.testBeqC=pval.testBeqC,
pval.testBeqC.is=pval.testBeqC.is,
obs.testBeqC.is=obs.testBeqC.is,
sim.testBeqC.is=sim.testBeqC.is,
obs.testBeq0=obs.testBeq0,obs.testBeqC=obs.testBeqC,
sim.testBeq0= sim.testBeq0,sim.testBeqC=sim.testBeqC,
conf.band=unifCI,test.procBeqC=Ut,sim.test.procBeqC=UIt)
}


semiregBase<-function(times,status,response,fdata,designX,
designG,designA,id,gamma=0,bhat=NULL,b=1,sim=1,antsim=1000,
retur=0,weighted.test=0)
{
Ntimes <- length(times); maxtime<-times[Ntimes]; 
designX<-as.matrix(designX); designG<-as.matrix(designG); 
designA<-as.matrix(designA); 
px <- as.integer(dim(designX)[2]); nx <- as.integer(dim(designX)[1])
pg <- as.integer(dim(designG)[2]); ng <- as.integer(dim(designG)[1])
pa <- as.integer(dim(designA)[2]); nar <- as.integer(dim(designA)[1])

if (nx!=nar) print("Aalen-design and X designs are not consistent\n");
if (nx!=ng) print("Semi-design and and X designs are not consistent\n");

w<-rep(1,nx); mw<-0;  
cumly<-cum0<-cumf<-cumMS<-vcum0<-vcumf<-robvcumf<-matrix(0,Ntimes,px+1); 
test<-matrix(0,antsim,3*px); testOBS<-rep(0,3*px); testval<-c();
unifCI<-c(); rani<--round(runif(1)*10000)

# 50 tilfaeldige score processer til test H: b(t)=b returneres
if (sim==1) simUt<-matrix(0,Ntimes,50*px) else simUt<-NULL;
Ut<-matrix(0,Ntimes,px+1); resid<-matrix(0,Ntimes,fdata$antpers*px) 

if (is.null(id) == TRUE) {
   antpers <- length(time); id <- 0:(antpers - 1);} else 
   { pers <- unique(id); antpers <- length(pers);
    id<-as.integer(factor(id, labels = 1:(antpers))) - 1; }

   clusters<-id; antclust<-antpers;
   fdata$antpers <- antpers; fdata$antclust <- antclust


out.aalen<-aalenBase(times,fdata,designA,status,id,clusters); 
xval<-seq(times[2],times[Ntimes],length=30); 
smooth.aalen<-CsmoothB(out.aalen$cum,xval,b); 
#print(smooth.aalen); 
naval<-nrow(smooth.aalen); 

if (length(b)==1) b<-rep(b,naval); 
if (is.null(bhat)) {bhat<-matrix(0,naval,px+pg+1); 
                    bhat[,1]<-smooth.aalen[,1];}

nxval<-nrow(bhat); bhatny<-bhat; 
if (sum(gamma)==0) gamma<-apply(bhat[,(px+2):(px+pg+1)],1,mean);

#print("Prelim estimate of gamma based on non-parametric model is"); 
gamma2<-gamly<-gamkor<-gameffi<-gameffims<-gamma
cum0<-cumf<-cumef<-rvcum<-rvcumef<-matrix(0,Ntimes,px+1); 
Vgam0<-Vgamef<-Vkorgam<-robvargam<-robvargame<-VgammaLY<-Vgamma<-Vkorgam<-C<-matrix(0,pg,pg); 

semiout<-.C("semidynadd",
as.double(times),as.double(response),as.integer(Ntimes),
as.double(designX),as.integer(nx),as.integer(px),
as.double(designG),as.integer(ng),as.integer(pg),
as.double(designA),as.integer(nar),as.integer(pa),
as.double(smooth.aalen),as.integer(naval),as.double(bhat),
as.integer(nxval),as.integer(fdata$antpers),as.double(fdata$start),
as.double(fdata$stop),
as.double(cum0),as.double(cumf),as.double(cumMS),
as.double(rvcum), as.double(rvcumef),
as.double(gamma),as.double(gamma2),as.double(gamly),
as.double(gamkor),as.double(gameffi),as.double(gameffims),
as.double(Vgamma),as.double(Vkorgam),
as.double(Vgamef),as.double(robvargam),as.double(robvargame),
as.double(w),as.integer(mw),
as.integer(rani), as.integer(sim),as.integer(antsim),
as.double(resid),as.double(test),as.double(testOBS),
as.double(Ut),as.double(simUt),as.double(b),as.integer(id),
as.integer(status),as.integer(weighted.test),as.double(VgammaLY),
PACKAGE="timereg") 


cum0 <-matrix(semiout[[20]],Ntimes,px+1); 
cumf <-matrix(semiout[[21]],Ntimes,px+1);
cum.ms <-matrix(semiout[[22]],Ntimes,px+1);
vcumf<-matrix(semiout[[23]],Ntimes,px+1);
robvcumf<-matrix(semiout[[23]],Ntimes,px+1);
vcum0 <-NULL; 
#cum.ly<-matrix(semiout[[36]],Ntimes,px+1);
cum.ly<-NULL; var.cum.ly<-NULL;

gamma<-matrix(semiout[[25]],pg,1); 
gamma2<-matrix(semiout[[26]],pg,1); 
gamly<-matrix(semiout[[27]],pg,1); 
gamkor<-matrix(semiout[[28]],pg,1); 
gameffi<-matrix(semiout[[29]],pg,1); 
gameffims<-matrix(semiout[[30]],pg,1);

Vgamma<-matrix(semiout[[31]],pg,pg); 
Vkorgam<-matrix(semiout[[32]],pg,pg); 
Vgamef<-matrix(semiout[[33]],pg,pg); 
robvargam<-matrix(semiout[[34]],pg,pg);
robvargame<-matrix(semiout[[35]],pg,pg);
VgammaLY<-matrix(semiout[[50]],pg,pg); 

if (retur==1) {
cumBi<-matrix(semiout[[41]],Ntimes,fdata$antpers*px); 
cumBI<-list();
for (i in (0:(fdata$antpers-1))*px)
cumBI[[i/px+1]]<-cumBi[,i+(1:px)] } else cumBI<-NULL;

if (sim==1) {
test<-matrix(semiout[[42]],antsim,3*px); testOBS<-semiout[[43]];
Ut<-matrix(semiout[[44]],Ntimes,(px+1));
Uit<-matrix(semiout[[45]],Ntimes,50*px);
UIt<-list(); for (i in (0:49)*px) UIt[[i/px+1]]<-Uit[,i+(1:px)];
for (i in 1:(3*px)) testval<-c(testval,pval(test[,i],testOBS[i]))
for (i in 1:px) unifCI<-as.vector(c(unifCI,percen(test[,i],0.95)));
pval.testBeq0<-as.vector(testval[1:px]);
pval.testBeqC<-as.vector(testval[(px+1):(2*px)]);
pval.testBeqC.is<-as.vector(testval[(2*px+1):(3*px)]);
obs.testBeq0<-as.vector(testOBS[1:px]);
obs.testBeqC<-as.vector(testOBS[(px+1):(2*px)]);
obs.testBeqC.is<-as.vector(testOBS[(2*px+1):(3*px)]);
sim.testBeq0<-as.matrix(test[,1:px]);
sim.testBeqC<-as.matrix(test[,(px+1):(2*px)]);
sim.testBeqC.is<-as.matrix(test[,(2*px+1):(3*px)]);
} else {test<-NULL; unifCI<-NULL; Ut<-NULL; UIt<-NULL;
pval.testBeq0<-NULL; obs.testBeq0<-NULL; sim.testBeq0<-NULL;
pval.testBeqC<-NULL; obs.testBeqC<-NULL; sim.testBeqC<-NULL; 
pval.testBeqC.is<-NULL; obs.testBeqC.is<-NULL; sim.testBeqC.is<-NULL;
}

#gamma.ef=gameffi,gamma.efms=gameffims,
#var.gamma.ef=Vgamef,robvar.gamma.ef=robvargame, 

list(cum=cumf,var.cum=vcumf,robvar.cum=robvcumf,cum.ms=cum.ms,
cum0=cum0,var.cum0=vcum0,cum.ly=cum.ly,var.cum.ly=NULL,
gamma0=gamma,var.gamma0=Vgamma,gamma.ly=gamly,var.gamma.ly=VgammaLY,
gamma=gamkor,gamma.ms=gamma2,var.gamma=Vkorgam,var.gamma.ms=Vkorgam,
robvar.gamma=robvargam,
residuals=cumBI,
pval.testBeq0=pval.testBeq0, pval.testBeqC=pval.testBeqC,
pval.testBeqC.is=pval.testBeqC.is, obs.testBeqC.is=obs.testBeqC.is,
sim.testBeqC.is=sim.testBeqC.is,
obs.testBeq0=obs.testBeq0,obs.testBeqC=obs.testBeqC,
sim.testBeq0= sim.testBeq0,sim.testBeqC=sim.testBeqC,
conf.band=unifCI,test.procBeqC=Ut,sim.test.procBeqC=UIt)
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/krylow.pls.r"
krylow.pls<-function(D,d,dim)
{
R=d;  Sxxsxy=R;
if (dim>=2)
for (i in 2:dim)
{
Sxxsxy=D %*% Sxxsxy  ;
R=cbind(R,Sxxsxy);
}
beta= R %*% solve(t(R) %*% D %*% R) %*% t(R) %*% d
beta=  beta;
return(list(beta=beta))
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/mgresid.r"
cum.residuals<-function(object,data=sys.parent(),modelmatrix=0,cum.resid=0,
n.sim=500,weighted.test=1,start.design=1)
{
  if (!(class(object)!="aalen" | class(object)!="timecox" |
        class(object)!="cox.aalen" ))
    stop ("Must be output from aalen() timecox() or cox.aalen() functions\n") 
  if (class(object)=="timecox") if (object$method!="basic") 
    stop("Residuals available only for method=basic\n")
  if (class(object)=="timecox") if (is.null(object$gamma)==FALSE) 
    stop("Residuals available only for timecox model with no const terms\n")
  if (class(object)=="aalen") if (is.null(object$gamma)==FALSE) 
    stop("Residuals available only for Aalen model with no const terms\n")
  if (is.null(object$residuals$dM)==TRUE) 
    stop("Residuals not computed, add option residuals=1\n");

  if (sum(modelmatrix)==0 && cum.resid==0) 
    stop("No modelmatrix or continous covariates given to cumulate residuals\n"); 

  if (class(object)=="cox.aalen") {
    dcum<-apply(as.matrix(object$cum[,-1]),2,diff); 
    beta<-object$gamma; coxaalen<-1; } else {
      dcum<-0; beta<-0; coxaalen<-0; pg<-0;designG<-0; }

  id<-attr(object,"id"); cluster<-attr(object,"cluster"); 
  formula<-attr(object,"Formula"); 
  start.time<-attr(object,"start"); 
  pers<-unique(id); antpers<-length(pers); 
  clust<-unique(cluster); antclust<-length(clust); 

if (class(object)=="cox.aalen") 
  ldata<-aalen.des(formula,data,model="cox.aalen") else ldata<-aalen.des(formula,data) 

  X<-ldata$X; 
  time<-ldata$time; time2<-ldata$time2; 
  covar<-X; 
  time2<-attr(object,"time2"); 

  status<-ldata$status; 
  if (coxaalen==1) {
    designG<-ldata$Z;  covnamesZ<-ldata$covnamesZ; 
    pg<-ncol(designG); }
  Ntimes <- sum(status); 

  if (sum(duplicated(time2[status==1]))>0) {
    cat("Ties may cause difficulties, break them ! \n"); 
  }

  if (ldata$type == "right") {
#    cat("Cumulative martingale residuals for Right censored survival times\n");
  } # else {cat("Counting process style data\n"); }
  times<-c(start.time,time2[status==1]); times<-sort(times);

  antpers=length(time); ntot<-nrow(X); px<-ldata$px

  lmgresids<-length(object$residuals$time); 

  if (coxaalen==1) gamma.iid<-object$residuals$gamma.iid else gamma.iid<-0;

  if (coxaalen==1) {covar<-cbind(X,designG);
                    ptot<-px+pg;} else {covar<-covar; ptot<-px;}

  covnames0<-colnames(covar); 
  antal<-0;  maxval<-0; intercept<-0; antal2<-0;  maxval2<-0; 
  xvals<-list();  ant<-rep(0,ptot);  
  for (i in 1:ptot) xvals[[i]]<-c(); 
  rani<-round(runif(1)*10000);
  keepcumz<-c(); k<-0
  for (j in 1:ptot) { 
    z<-unique(covar[,j]); z<-sort(z); 
    antal<-antal+1; ant[j]<-length(z); 
    if (ant[j]>2) { k<-k+1; keepcumz<-c(keepcumz,j); xvals[[k]]<-z;
        maxval<-max(maxval,length(z)); }
  }

  if (sum(keepcumz)==0 && cum.resid==1) 
    stop(" No continous covariates given to cumulate residuals \n"); 

  pcumz<-length(keepcumz); 
  test<-matrix(0,n.sim,pcumz); uni.test<-matrix(0,n.sim,pcumz); 
  testOBS<-rep(0,4*pcumz); 
  univar.proc<-matrix(0,maxval,pcumz); 
  robvarcumz<-matrix(0,maxval,pcumz); 
  sim.univar.proc<-matrix(0,maxval,50*pcumz); 
  time.proc<-matrix(0,lmgresids,2); 
  sim.time.proc<-matrix(0,lmgresids,50); 
  simcumz<-matrix(0,n.sim,pcumz);
  xval<-matrix(0,maxval,pcumz); 
  k<-1; 
  for (i in keepcumz) {xval[1:ant[i],k]<-xvals[[k]]; k<-k+1;}


  # testOBS size and location of supremum, test simulated sup's
  unitime.test<-time.test<-mult.test<-multtime.test<-test
  unitime.testOBS<-uni.testOBS<-time.testOBS<-mult.testOBS<-
  multtime.testOBS<-testOBS

  inXorZ<-rep(0,pcumz); 
  if (pcumz>0) {
    antX<-(sum(ant[1:px]>2)) 
    if (antX>0) {inX<-(1:px)[(ant[1:px]>2)]; inXorZ[1:antX]<-1} else {inX<-c();} 
    if (coxaalen==1) {inZ<-(1:pg)[(ant[(px+1):(px+pg)]>2)]; }  else inZ<-c()
    inXZ<-c(inX,inZ); 
    inXZ<-inXZ-1
  } else {inXZ<-0; inXorZ<-0} 
  ant<-ant[keepcumz]; 


  if (sum(modelmatrix)==0) {modelmatrix<-0;model<-0;pm<-1;}  else 
  {model<-1; modelmatrix<-as.matrix(modelmatrix); pm<-ncol(modelmatrix); 
   test<-matrix(0,n.sim,3*pm); testOBS<-rep(0,2*pm); 
   covnames<-colnames(modelmatrix); 
  }

  Ut<-cummgt<-matrix(0,lmgresids,pm+1); 
  robvarcum<-matrix(0,lmgresids,pm+1); 
  simUt<-matrix(0,lmgresids,pm*50); 

#dyn.load("mgresid.so");

  mgout<- .C("mgresid",
     as.double(X),as.integer(ntot),as.integer(px), 
     as.integer(antpers),as.double(time),as.double(time2),
     as.integer(status),as.integer(id),as.double(object$residuals$time),
     as.integer(lmgresids),as.double(object$residuals$dM),as.integer(n.sim),
     as.integer(rani),as.double(xval), as.integer(ant), 
     as.double(univar.proc),as.double(time.proc),as.double(sim.univar.proc),
     as.double(sim.time.proc),as.double(uni.test),as.double(uni.testOBS),
     as.double(time.test),as.double(time.testOBS),as.double(unitime.test),
     as.double(unitime.testOBS),as.double(modelmatrix),as.integer(model),
     as.integer(pm),as.double(cummgt),as.double(object$residuals$dM.iid),
     as.double(robvarcum),as.double(testOBS),as.double(test),
     as.double(simUt),as.double(Ut),as.integer(cum.resid),
     as.integer(maxval),as.integer(start.design),as.integer(coxaalen),
     as.double(dcum),as.double(beta),as.double(designG),
     as.integer(pg),as.double(gamma.iid),as.integer(cluster),
     as.integer(antclust), as.double(robvarcumz), as.double(simcumz),
     as.integer(inXZ), as.integer(inXorZ),as.integer(pcumz),PACKAGE="timereg")

  if (model==1) {
    cum<-matrix(mgout[[29]],lmgresids,pm+1); 
    robvar.cum<-matrix(mgout[[31]],lmgresids,pm+1);
    var.cum<-robvar.cum; Ut<-matrix(mgout[[35]],lmgresids,pm+1);

    colnames(Ut)<-colnames(cum)<-colnames(var.cum)<-
      colnames(robvar.cum)<- c("time",covnames)
    test.procBeq0<-Ut; 

    sim<-1; 
    if (sim>=1) {
      Uit<-matrix(mgout[[34]],lmgresids,50*pm);
      UIt<-list(); for (i in (0:49)*pm) UIt[[i/pm+1]]<-as.matrix(Uit[,i+(1:pm)]);
      testOBS<-mgout[[32]];
      test<-matrix(mgout[[33]],n.sim,3*pm);
      #simcumz<-matrix(mgout[[48]],n.sim,pcumz);
      testval<-c(); unifCI<-c(); 
      for (i in 1:(2*pm)) testval<-c(testval,pval(test[,i],testOBS[i]))
      for (i in 1:pm) unifCI<-as.vector(c(unifCI,percen(test[,2*pm+i],0.95)));
      obs.testBeq0<-as.vector(testOBS[1:pm]);
      obs.testBeq0.is<-as.vector(testOBS[(pm+1):(2*pm)]);
      pval.testBeq0<-as.vector(testval[1:pm]);
      pval.testBeq0.is<-as.vector(testval[(pm+1):(2*pm)]);
      sim.testBeq0<-test[,(2*pm+1):(3*pm)]; 

      sim.test.procBeq0<-UIt; 
      names(unifCI)<- names(pval.testBeq0)<- names(obs.testBeq0)<- 
        names(pval.testBeq0.is)<- names(obs.testBeq0.is)<- covnames
    } else {
      test<-unifCI<-Ut<-UIt<-pval.testBeq0<-pval.testBeq0.is<-obs.testBeq0<-
        obs.testBeq0.is<-sim.testBeq0<-NULL; }
  } else {
    cum<-robvar.cum<-test<-unifCI<-Ut<-UIt<-pval.testBeq0<-
      pval.testBeq0.is<-obs.testBeq0<-obs.testBeq0.is<-sim.testBeq0<-NULL; 
  } 

  if (cum.resid>=1) {
    univar.p<-matrix(mgout[[16]],maxval,pcumz)
    #print(univar.p)
    robvarcumz<-matrix(mgout[[47]],maxval,pcumz)
    #print(robvarcumz)
    simcumz<-matrix(mgout[[48]],n.sim,pcumz)
    #print(sim.cumz); 
    univar.proc<-list(); 
    for (i in 1:pcumz) {
      univar.proc[[i]]<-cbind(xvals[[i]],univar.p[1:ant[i],i]); 
      colnames(univar.proc[[i]])<-c(covnames0[keepcumz[i]],"cum. martingale residual"); 
    }
    Uiz<-matrix(mgout[[18]],maxval,50*pcumz);
    UIz<-list(); 
    k<-1; 
    for (i in 1:pcumz) {
       UIz[[i]]<-matrix(Uiz[1:ant[i],i+(0:49)*pcumz],ncol=50);
      k<-k+1;}
    uni.test<-matrix(mgout[[20]],n.sim,pcumz)
    uni.test<-as.matrix(uni.test); 
    uni.testOBS<-mgout[[25]][1:pcumz]; 
    testval<-c(); 

    for (i in 1:pcumz)  testval<-c(testval,pval(uni.test[,i],uni.testOBS[i])) 
    unifCIz<-c()
    for (i in 1:pcumz)  unifCIz<-c(unifCIz,percen(simcumz[,i],0.95))

    uni.pval<-testval
    names(uni.testOBS)<-names(uni.pval)<-colnames(uni.test)<-covnames0[keepcumz]; 
    #uni.testOBS<-uni.testOBS[keepcumz]; uni.pval<-uni.pval[keepcumz]
    #uni.test<-uni.test[,keepcumz];
  } else { unifCIz<-uni.testOBS<-uni.pval<-proc.cumz<-UIz<-
           unitime.pval<-unitime.testOBS<-NULL;}

  ud<-list(cum=cum,robvar.cum=robvar.cum,robvar.cumz=robvarcumz,
           pval.testBeq0=pval.testBeq0, obs.testBeq0=obs.testBeq0,
           pval.testBeq0.is=pval.testBeq0.is, obs.testBeq0.is=obs.testBeq0.is,
           sim.testBeq0=sim.testBeq0,
           procBeq0=Ut,sim.test.procBeq0=UIt,
           conf.band=unifCI,
           conf.band.cumz=unifCIz,
           obs.test=uni.testOBS,pval.test=uni.pval,
           sim.test=uni.test,
           #pval.testtime=unitime.pval,
           proc.cumz=univar.proc,sim.test.proccumz=UIz)

  attr(ud,"Call")<-sys.call(); 
  class(ud)<-"cum.residuals"
  return(ud); 
}

"print.cum.residuals"<- function (x,...)
{
    object <- x; rm(x);
	if (!inherits(object, 'cum.residuals')) stop ("Must be an MG resid object")

	cat("  Call: \n")
	dput(attr(object, "Call"))
	cat("\n")
}

"plot.cum.residuals" <- function (x,pointwise.ci=1,hw.ci=0,sim.ci=0,
		robust=1, specific.comps=FALSE,level=0.05, start.time = 0, 
	stop.time = 0, add.to.plot=FALSE, mains=TRUE, 
	xlab="Time",ylab ="Cumulative Residuals",ylim=NULL,
	score=0,conf.band=FALSE,...) 
{
  object <- x; rm(x);
  if (!inherits(object,'cum.residuals') ) stop ("Must be output from cum.residuals()") 

  if (score <2) {
    B<-object$cum;
    if (sum(B)==0)  {
      cat(" To compute cumulative residuals provide model matrix \n");
    } }
  if (score==2) { ## {{{
    if (sum(object$obs.test)==0)
      stop("To plot cumulative residuals vs. covariates, cum.resid=1"); 
  }

  if (score==0) {
    B<-object$cum; 
    if (robust>=1) V<-object$robvar.cum else V<-object$var.cum
    p<-dim(B)[[2]]; 

    if (specific.comps==FALSE) comp<-(2:p) else comp<-specific.comps+1
    if (stop.time==0) stop.time<-max(B[,1]);

    med<-B[,1]<=stop.time & B[,1]>=start.time
    B<-B[med,]; Bs<-B[1,];  B<-t(t(B)-Bs); B[,1]<-B[,1]+Bs[1];
    V<-V[med,]; Vs<-V[1,]; V<-t( t(V)-Vs); 
    Vrob<-object$robvar.cum; 
    Vrob<-Vrob[med,]; Vrobs<-Vrob[1,]; Vrob<-t( t(Vrob)-Vrobs); 

    c.alpha<- qnorm(1-level/2)
    for (v in comp) { 
      c.alpha<- qnorm(1-level/2)
      est<-B[,v];ul<-B[,v]+c.alpha*V[,v]^.5;nl<-B[,v]-c.alpha*V[,v]^.5;
      if (add.to.plot==FALSE) 
        {
          plot(B[,1],est,ylim=1.05*range(ul,nl),type="s",xlab=xlab,ylab=ylab) 
          if (mains==TRUE) title(main=colnames(B)[v]); }
      else lines(B[,1],est,type="s"); 
      if (pointwise.ci>=1) {
        lines(B[,1],ul,lty=pointwise.ci,type="s");
        lines(B[,1],nl,lty=pointwise.ci,type="s"); }
      if (robust>=1) {
        lines(B[,1],ul,lty=robust,type="s"); 
        lines(B[,1],nl,lty=robust,type="s"); }
      if (hw.ci>=1) {
        if (level!=0.05) cat("Hall-Wellner bands only 95 % \n");
        tau<-length(B[,1])
        nl<-B[,v]-1.13*V[tau,v]^.5*(1+V[,v]/V[tau,v])
        ul<-B[,v]+1.13*V[tau,v]^.5*(1+V[,v]/V[tau,v])
        lines(B[,1],ul,lty=hw.ci,type="s"); 
        lines(B[,1],nl,lty=hw.ci,type="s"); }
      if (sim.ci>=1) {
        if (level!=0.05) c.alpha<-percen(object$sim.testBeq0[,v-1],1-level)
        else c.alpha<-object$conf.band[v-1];
        nl<-B[,v]-c.alpha*Vrob[,v]^.5; ul<-B[,v]+c.alpha*Vrob[,v]^.5;
        lines(B[,1],ul,lty=sim.ci,type="s"); 
        lines(B[,1],nl,lty=sim.ci,type="s"); }
      abline(h=0)
    } ## }}}
  } else if (score==1)  ## {{{
    {
                                        # plot score proces
      dim1<-ncol(object$procBeq0)
      if (sum(specific.comps)==FALSE) comp<-2:dim1 else comp<-specific.comps+1

      for (i in comp)
        {
          ranyl<-range(object$procBeq0[,i]);
          for (j in 1:50) ranyl<-range(c(ranyl,
                                         (object$sim.test.procBeq0[[j]])[,i-1]));
          mr<-max(abs(ranyl));

          if (add.to.plot==FALSE)
            plot(object$procBeq0[,1],object$procBeq0[,i],type="l",ylim=c(-mr,mr),
                 lwd=2,xlab=xlab,ylab=ylab)
          else
            lines(object$procBeq0[,1],object$procBeq0[,i])
          if (mains==TRUE) title(main=colnames(object$procBeq0)[i]);
          for (j in 1:50)
            lines(object$procBeq0[,1],as.matrix(object$sim.test.procBeq0[[j]])[,i-1],
                  col="grey",lwd=1,lty=1)
          lines(object$procBeq0[,1],object$procBeq0[,i],lwd=2)
        }  ## }}}
    } else if (score==2) { ## {{{  plot score proces
      dim1<-length(object$obs.test)
      if (sum(specific.comps)==FALSE) comp<-1:dim1 else comp<-specific.comps

      for (i in comp)
        {
          if (nrow(object$proc.cumz[[i]])==1) TYPE<-"p" else TYPE<-"l"; 

          if (TYPE=="l") 
            {
              ranyl<-range(object$proc.cumz[[i]][,2]);
              for (j in 1:50) ranyl<-range(c(ranyl,(object$sim.test.proccumz[[i]])[,j])); 
              mr<-max(abs(ranyl));

              if (add.to.plot==FALSE)
                plot(object$proc.cumz[[i]][,1],object$proc.cumz[[i]][,2],type=TYPE,
                     ylim=c(-mr,mr),lwd=2,xlab=colnames(object$proc.cumz[[i]])[1],
                     ylab="Cumulative residuals")
              else
                lines(object$proc.cumz[[i]][,1],object$proc.cumz[[i]][,2],type="l")
              if (mains==TRUE) title(main=colnames(object$proc.cumz[[i]])[1]); 
              if (TYPE=="l") for (j in 1:50)
                lines(object$proc.cumz[[i]][,1],object$sim.test.proccumz[[i]][,j],
                      col="grey",lwd=1,lty=1,type="l")
              if (TYPE=="p") for (j in 1:50)
                points(object$proc.cumz[[i]][,1],object$sim.test.proccumz[[i]][,j],pch=".")
              lines(object$proc.cumz[[i]][,1],object$proc.cumz[[i]][,2],lwd=2); 
            } 
    ## Prediction bandds ## {{{
    if (conf.band==TRUE) {
     col.alpha<-0.2
     col.ci<-"darkblue"
     lty.ci<-2
      if (col.alpha==0) col.trans <- col.ci
      else
      col.trans <- sapply(col.ci, FUN=function(x) do.call(rgb,as.list(c(col2rgb(x)/255,col.alpha))))
      if (level!=0.05) c.alpha<-percen(object$sim.test[,i],1-level)
      else c.alpha<-object$conf.band.cumz[i];
      t<-object$proc.cumz[[i]][,1]
      ci<-c.alpha*object$robvar.cumz[1:length(t),i]^.5
      #print(t); print(ci)
      lines(t,ci , lwd=1, col=col.ci, lty=lty.ci)
      lines(t,-ci , lwd=1, col=col.ci, lty=lty.ci)
      tt <- c(t, rev(t))
      yy <- c(ci, rev(-ci))
      polygon(tt,yy, col=col.trans, lty=0)      
  } ## }}}
  }

    } ## }}}
}

"summary.cum.residuals" <-
function (object,digits=3,...) 
{
  if (!inherits(object, 'cum.residuals')) stop ("Must be an cum.residuals object")

  # We print information about object:  
  cat("Test for cumulative MG-residuals \n\n")

  mtest<-(sum(object$conf.band)>0)

  if (mtest==FALSE) { 
    cat("Grouped cumulative residuals not computed, you must provide\n")
    cat("modelmatrix to get these (see help) \n\n")
  }
  if (mtest==TRUE) { 
    test0<-cbind(object$obs.testBeq0,object$pval.testBeq0)
    test0.is<-cbind(object$obs.testBeq0.is,object$pval.testBeq0.is) 
    colnames(test0)<- c("sup|  hat B(t) |","p-value H_0: B(t)=0")
    colnames(test0.is)<- c("int ( B(t) )^2 dt","p-value H_0: B(t)=0")  

    cat("Grouped Residuals consistent with model \n\n")
    prmatrix(round(test0,digits))
    cat("\n")
    prmatrix(round(test0.is,digits))
    cat("\n")
  }

  cumtest<-!is.null(object$obs.test)
  if (cumtest==FALSE) { 
    cat("Cumulative tests versus covariates not computed \n\n")
    cat("cum.resid=1 to compute these \n\n"); 
  }
  if (cumtest==TRUE) { 
    test0<-cbind(object$obs.test,object$pval.test)
    colnames(test0)<- c("sup|  hat B(t) |","p-value H_0: B(t)=0")

    cat("Residual versus covariates consistent with model \n\n")
    prmatrix(round(test0,digits))
  }
  cat("  \n");cat("  Call: \n");dput(attr(object, "Call"));
  cat("\n");
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/mylars.r"
my.lars<-function (Gram, xy, n, y, type = c("lasso", "lar", "forward.stagewise", 
    "stepwise"), trace = FALSE, normalize = FALSE, intercept = FALSE , 
     eps = .Machine$double.eps, max.steps, use.Gram = TRUE) 
{
    if (!require("lars")) stop("package Lars not available")
    y<-rep(1,n); x<-rep(1,n)
    call <- match.call()
    type <- match.arg(type)
    TYPE <- switch(type, lasso = "LASSO", lar = "LAR", forward.stagewise = "Forward Stagewise", 
        stepwise = "Forward Stepwise")
    if (trace) 
        cat(paste(TYPE, "sequence\n"))
    #nm <- dim(x) #n <- nm[1] #m <- nm[2]
    m <- ncol(Gram)
    im <- inactive <- seq(m)
    one <- rep(1, n)
    vn <- dimnames(x)[[2]]
    if (intercept) {
        meanx <- drop(one %*% x)/n
        x <- scale(x, meanx, FALSE)
        mu <- mean(y)
        y <- drop(y - mu)
    }
    else {
        meanx <- rep(0, m)
        mu <- 0
        y <- drop(y)
    }
    if (normalize) {
        normx <- sqrt(drop(one %*% (x^2)))
        nosignal <- normx/sqrt(n) < eps
        if (any(nosignal)) {
            ignores <- im[nosignal]
            inactive <- im[-ignores]
            normx[nosignal] <- eps * sqrt(n)
            if (trace) 
                cat("LARS Step 0 :\t", sum(nosignal), "Variables with Variance < eps; dropped for good\n")
        }
        else ignores <- NULL
        names(normx) <- NULL
        x <- scale(x, FALSE, normx)
    }
    else {
        normx <- rep(1, m)
        ignores <- NULL
    }
    if (use.Gram & missing(Gram)) {
        if (m > 500 && n < m) 
            cat("There are more than 500 variables and n<m;\nYou may wish to restart and set use.Gram=FALSE\n")
        if (trace) 
            cat("Computing X'X .....\n")
        Gram <- t(x) %*% x
    }
    Cvec<-xy;
    ssy <- sum(y^2)
    residuals <- y
    if (missing(max.steps)) 
        max.steps <- 8 * min(m, n - intercept)
    beta <- matrix(0, max.steps + 1, m)
    lambda = double(max.steps)
    Gamrat <- NULL
    arc.length <- NULL
    R2 <- 1
    RSS <- ssy
    first.in <- integer(m)
    active <- NULL
    actions <- as.list(seq(max.steps))
    drops <- FALSE
    Sign <- NULL
    R <- NULL
    k <- 0
    while ((k < max.steps) & (length(active) < min(m - length(ignores), 
        n - intercept))) {
        action <- NULL
        C <- Cvec[inactive]
        Cmax <- max(abs(C))
        if (Cmax < eps * 100) {
            if (trace) 
                cat("Max |corr| = 0; exiting...\n")
            break
        }
        k <- k + 1
        lambda[k] = Cmax
        if (!any(drops)) {
            new <- abs(C) >= Cmax - eps
            C <- C[!new]
            new <- inactive[new]
            for (inew in new) {
                if (use.Gram) {
                  R <- lars::updateR(Gram[inew, inew], R, drop(Gram[inew, 
                    active]), Gram = TRUE, eps = eps)
                }
                else {
                  R <- lars::updateR(x[, inew], R, x[, active], Gram = FALSE, 
                    eps = eps)
                }
                if (attr(R, "rank") == length(active)) {
                  nR <- seq(length(active))
                  R <- R[nR, nR, drop = FALSE]
                  attr(R, "rank") <- length(active)
                  ignores <- c(ignores, inew)
                  action <- c(action, -inew)
                  if (trace) 
                    cat("LARS Step", k, ":\t Variable", inew, 
                      "\tcollinear; dropped for good\n")
                }
                else {
                  if (first.in[inew] == 0) 
                    first.in[inew] <- k
                  active <- c(active, inew)
                  Sign <- c(Sign, sign(Cvec[inew]))
                  action <- c(action, inew)
                  if (trace) 
                    cat("LARS Step", k, ":\t Variable", inew, 
                      "\tadded\n")
                }
            }
        }
        else action <- -dropid
        Gi1 <- backsolve(R, lars::backsolvet(R, Sign))
        dropouts <- NULL
        if (type == "forward.stagewise") {
            directions <- Gi1 * Sign
            if (!all(directions > 0)) {
                if (use.Gram) {
                  nnls.object <- lars::nnls.lars(active, Sign, R, directions, 
                    Gram[active, active], trace = trace, use.Gram = TRUE, 
                    eps = eps)
                }
                else {
                  nnls.object <- lars::nnls.lars(active, Sign, R, directions, 
                    x[, active], trace = trace, use.Gram = FALSE, 
                    eps = eps)
                }
                positive <- nnls.object$positive
                dropouts <- active[-positive]
                action <- c(action, -dropouts)
                active <- nnls.object$active
                Sign <- Sign[positive]
                Gi1 <- nnls.object$beta[positive] * Sign
                R <- nnls.object$R
                C <- Cvec[-c(active, ignores)]
            }
        }
        A <- 1/sqrt(sum(Gi1 * Sign))
        w <- A * Gi1
        if (!use.Gram) 
            u <- drop(x[, active, drop = FALSE] %*% w)
        if ((length(active) >= min(n - intercept, m - length(ignores))) | 
            type == "stepwise") {
            gamhat <- Cmax/A
        }
        else {
            if (use.Gram) {
                a <- drop(w %*% Gram[active, -c(active, ignores), 
                  drop = FALSE])
            }
            else {
                a <- drop(u %*% x[, -c(active, ignores), drop = FALSE])
            }
            gam <- c((Cmax - C)/(A - a), (Cmax + C)/(A + a))
            gamhat <- min(gam[gam > eps], Cmax/A)
        }
        if (type == "lasso") {
            dropid <- NULL
            b1 <- beta[k, active]
            z1 <- -b1/w
            zmin <- min(z1[z1 > eps], gamhat)
            if (zmin < gamhat) {
                gamhat <- zmin
                drops <- z1 == zmin
            }
            else drops <- FALSE
        }
        beta[k + 1, ] <- beta[k, ]
        beta[k + 1, active] <- beta[k + 1, active] + gamhat * 
            w
        if (use.Gram) {
            Cvec <- Cvec - gamhat * Gram[, active, drop = FALSE] %*% 
                w
        }
        else {
            residuals <- residuals - gamhat * u
            Cvec <- drop(t(residuals) %*% x)
        }
        Gamrat <- c(Gamrat, gamhat/(Cmax/A))
        arc.length <- c(arc.length, gamhat)
        if (type == "lasso" && any(drops)) {
            dropid <- seq(drops)[drops]
            for (id in rev(dropid)) {
                if (trace) 
                  cat("Lasso Step", k + 1, ":\t Variable", active[id], 
                    "\tdropped\n")
                R <- lars::downdateR(R, id)
            }
            dropid <- active[drops]
            beta[k + 1, dropid] <- 0
            active <- active[!drops]
            Sign <- Sign[!drops]
        }
        if (!is.null(vn)) 
            names(action) <- vn[abs(action)]
        actions[[k]] <- action
        inactive <- im[-c(active, ignores)]
        if (type == "stepwise") 
            Sign = Sign * 0
    }
    beta <- beta[seq(k + 1), , drop = FALSE]
    lambda = lambda[seq(k)]
    dimnames(beta) <- list(paste(0:k), vn)
    if (trace) 
        cat("Computing residuals, RSS etc .....\n")
    #residuals <- y - x %*% t(beta)
    residuals <- 0 
    beta <- scale(beta, FALSE, normx)
    RSS <- 0 # apply(residuals^2, 2, sum)
    R2 <- 0 #1 - RSS/RSS[1]
    actions = actions[seq(k)]
    netdf = sapply(actions, function(x) sum(sign(x)))
    df = cumsum(netdf)
    if (intercept) 
        df = c(Intercept = 1, df + 1)
    else df = c(Null = 0, df)
    rss.big = rev(RSS)[1]
    df.big = n - rev(df)[1]
    if (rss.big < eps | df.big < eps) 
        sigma2 = NaN
    else sigma2 = rss.big/df.big
    Cp <- RSS/sigma2 - n + 2 * df
    attr(Cp, "sigma2") = sigma2
    attr(Cp, "n") = n
    object <- list(call = call, type = TYPE, df = df, lambda = lambda, 
        R2 = R2, RSS = RSS, Cp = Cp, actions = actions[seq(k)], 
        entry = first.in, Gamrat = Gamrat, arc.length = arc.length, 
        Gram = if (use.Gram) Gram else NULL, beta = beta, mu = mu, 
        intZHdN=xy, normx = normx, meanx = meanx)
    class(object) <- "lars"
    object
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/new.aalen-test.r"

aalen.test<-function (formula = formula(data),
data = sys.parent(), start.time = 0, max.time = NULL, 
robust=1, id=NULL, clusters=NULL, residuals = 0, n.sim = 1000,  
weighted.test=0,covariance=0,resample.iid=0,weights=0,offsets=0,
fix.gam=0,pseudo.score=0,approx="dt",gamma=0,silent=0)
{
  deltaweight<-1; 
  if (n.sim == 0) sim <- 0 else sim <- 1
  if (resample.iid==1 & robust==0) {
    cat("When robust=0 no iid representaion computed\n"); 
    resample.iid<-0;}
  if (covariance==1 & robust==0) {
    cat("When robust=0 no covariance computed \n"); 
    cat("Covariance based on robust iid representation\n")
    covariance<-0;}
  if (sim==1 & robust==0) {
    cat("When robust=0, No simulations \n"); 
    cat("n.sim set to 0\n"); n.sim<-0;}
  if (resample.iid==0 & pseudo.score>=1) {
    cat("When pseudo.score>=1, resample.iid set to 1 \n"); 
    resample.iid<-1;}
  if (residuals==1 & robust==0) {
    cat("When robust=0, no martingale residuals \n"); 
    residuals<-0;}
  if (n.sim>0 & n.sim<50) {n.sim<-50 ; cat("Minimum 50 simulations\n");}
  call <- match.call()
  m <- match.call(expand = FALSE)
  m$pseudo.score<-m$start.time <- m$weighted.test <- m$max.time <-
    m$robust <- m$sim <- m$residuals <- m$n.sim <- m$id <-
      m$fix.gam<- m$covariance <- m$resample.iid <- m$clusters <- 
        m$weights<-m$offsets<- m$gamma<-m$deltaweight<-m$approx<-m$silent<-NULL
  special <- c("const","cluster")
  Terms <- if (missing(data)) 
    terms(formula, special)
  else terms(formula, special, data = data)
  m$formula <- Terms
  m[[1]] <- as.name("model.frame")
  m <- eval(m, sys.parent())
  mt <- attr(m, "terms")
  intercept <- attr(mt, "intercept")
  Y <- model.extract(m, "response")
  if (!inherits(Y, "Surv")) 
    stop("Response must be a survival object")

  des<-read.design(m,Terms)
  X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
  covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ

  if(is.null(clusters)) clusters <- des$clusters  

  pxz <- px + pz;

  if (approx=="death-times") npar.call<-TRUE else npar.call<-FALSE
  survs<-read.surv(m,id,npar.call,clusters,start.time,max.time)
  times<-survs$times;id<-id.call<-survs$id.cal;
  if (approx=="death-times" & des$npar==FALSE) npar.call<-FALSE; 

  id<-id.call<-survs$id; 
  clusters<-cluster.call<-survs$clusters; 
  time2 <- survs$stop;  status <- survs$status
  ldata <- list(start = survs$start, stop = survs$stop,
                antpers = survs$antpers, antclust = survs$antclust)

  if (npar== TRUE) {
                                        #cat("Nonparametric Additive Risk Model\n")
    ud <- aalenBaseTest(times, ldata, X, status, id, clusters, robust = robust, 
                        sim = sim, retur = residuals, antsim = n.sim,
                        weighted.test = weighted.test,covariance=covariance,
                        resample.iid=resample.iid,namesX=covnamesX,weights=weights,
                        offsets=offsets,silent=silent)
    colnames(ud$cum) <- colnames(ud$var.cum) <- c("time", 
                                                  covnamesX)
    if (robust == 1) 
      colnames(ud$robvar.cum) <- c("time", covnamesX)
    if (sim >= 1) {
      colnames(ud$test.procBeqC) <- c("time", covnamesX)
      names(ud$conf.band) <- names(ud$pval.testBeq0) <- names(ud$pval.testBeqC) <- names(ud$pval.testBeqC.is) <- names(ud$obs.testBeq0) <- names(ud$obs.testBeqC) <- names(ud$obs.testBeqC.is) <- colnames(ud$sim.testBeq0) <- colnames(ud$sim.testBeqC) <- colnames(ud$sim.testBeqC.is) <- covnamesX
      ud$sim.testBeqC.is <- ud$sim.testBeqC <- FALSE
    }
  }
  else {
                                        #   cat("Semiparametric Additive Risk Model\n")
    if (px == 0) 
      stop("No nonparametric terms (needs one!)")
    ud <- semiaalenTest(times, ldata, X, Z, 
                        status, id , clusters, robust = robust, sim = sim, antsim = n.sim, 
                        weighted.test = weighted.test, retur =
                        residuals,covariance=covariance,
                        resample.iid=resample.iid,namesX=covnamesX,namesZ=covnamesZ,
                        deltaweight=deltaweight,weights=weights,offsets=offsets,
                        fixgam=fix.gam,gamma=gamma,pseudo.score=pseudo.score,
                        silent=silent)
    if (px > 0) {
      colnames(ud$cum) <- colnames(ud$var.cum) <- c("time", covnamesX)
      if (robust == 1) 
        colnames(ud$robvar.cum) <- c("time", covnamesX)
      if (sim >= 1) {
        colnames(ud$test.procBeqC) <- c("time", covnamesX)
        names(ud$conf.band) <- names(ud$pval.testBeq0) <- names(ud$pval.testBeqC) <- names(ud$pval.testBeqC.is) <- names(ud$obs.testBeqC.is) <- names(ud$obs.testBeq0) <- names(ud$obs.testBeqC) <- colnames(ud$sim.testBeq0) <- colnames(ud$sim.testBeqC.is) <- colnames(ud$sim.testBeqC) <- covnamesX
        ud$sim.testBeqC.is <- ud$sim.testBeqC <- FALSE
      }
    }
    if (pseudo.score>=1) {
      names(ud$pstest.pval)<- names(ud$sup.pscore)<-c(covnamesZ); 
      colnames(ud$obs.pscore)<-c("time",covnamesZ); 
    }
    ud$gamma<-as.matrix(ud$gamma);
    rownames(ud$gamma) <- c(covnamesZ)
    rownames(ud$intZHdN) <- c(covnamesZ)
    colnames(ud$gamma) <- "estimate"
    colnames(ud$var.gamma) <- c(covnamesZ)
    rownames(ud$var.gamma) <- c(covnamesZ)
    colnames(ud$robvar.gamma) <- c(covnamesZ)
    colnames(ud$intZHZ) <- c(covnamesZ)
    rownames(ud$var.gamma) <- c(covnamesZ)
  }
  attr(ud, "Call") <- sys.call()
  attr(ud, "Formula") <- formula
  attr(ud, "id") <- id.call
  attr(ud, "cluster") <- cluster.call
  attr(ud, "start") <- start.time
  attr(ud, "time2") <- time2
  class(ud) <- "aalen"
  ud$call<-call
  return(ud)
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/new.aalen.r"
.packageName <- "timereg"

.First.lib <- function(lib, pkg) {
  library.dynam("timereg", pkg, lib)
  cat("aalen.test    : semiparametric additive model with
improved test for constant effects and offsets \n")
  cat("aalen         : semiparametric additive model\n")
  cat("timecox       : semiparametric multiplicative model\n")
  cat("cox.aalen     : Cox-Aalen model\n")
  cat("prop.excess   : proportional excess model\n")
  cat("prop.odds     : semiparametric proportional odds-model\n")
  cat("Gprop.odds    : generalized semiparametric proportional odds-model\n")
  cat("pe.sasieni    : The proportional excess model by Peter Sasieni\n")
  cat("dynreg        : longitudinal data model\n")
  cat("cum.residuals : cumulative residuals for goodness-of-fit\n")
  cat("two.stage     : Clayton-Oakes-Glidden Two-Stage estimation\n")
  cat("two.stage.reg : Clayton-Oakes-Glidden Two-Stage with Frailty regression\n")
  cat("comp.risk     : For flexible regression modellling for competing risks data\n"); 
  cat(" plus more \n"); 
}

.Last.lib <- function(lib){
  library.dynam.unload("timereg",lib)
}

aalen<-function (formula = formula(data),
                 data = sys.parent(), start.time = 0, max.time = NULL, 
                 robust=1, id=NULL, clusters=NULL, residuals = 0, n.sim = 1000, 
                 weighted.test= 0,covariance=0,resample.iid=0,deltaweight=1,
                 silent=0){
###deltaweight<-1; # always default
  if (n.sim == 0) sim <- 0 else sim <- 1
  scale<-0;
  if (resample.iid==1 & robust==0) {
    cat("When robust=0 no iid representaion computed\n"); resample.iid<-0;}
  if (covariance==1 & robust==0) {
    cat("When robust=0 no covariance computed \n"); 
    cat("Covariance based on robust iid representation\n")
    covariance<-0;}
  if (sim==1 & robust==0) {
    cat("When robust=0, No simulations \n"); cat("n.sim set to 0\n"); n.sim<-0;}
#if (residuals==1 & robust==0) {
#cat("When robust=0, no martingale residuals \n"); 
#residuals<-0;}
  if (n.sim>0 & n.sim<50) {n.sim<-50 ; cat("Minimum 50 simulations\n");}
  call <- match.call()
  m <- match.call(expand = FALSE)
  m$start.time <- m$weighted.test <- m$max.time <- m$robust <- 
  m$sim <- m$residuals <- m$n.sim <- m$id <- m$covariance <- 
  m$resample.iid <- m$clusters <- m$deltaweight <- m$silent<- NULL
  special <- c("const","cluster") ###########
  Terms <- if (missing(data)){
    terms(formula, special)
  } else {
    terms(formula, special, data = data)
  }
  m$formula <- Terms
  m[[1]] <- as.name("model.frame")
  m <- eval(m, sys.parent())
  mt <- attr(m, "terms")
  intercept <- attr(mt, "intercept")
  Y <- model.extract(m, "response")
  if (!inherits(Y, "Surv")) stop("Response must be a survival object")

  des<-read.design(m,Terms)
  X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
  covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ

  if (scale==1) { X<-scale(as.matrix(X)); Z<-scale(as.matrix(Z)); 
     sXscale<- attr(X,"scaled:scale"); sXcenter<- attr(X,"scaled:center") 
     sZscale<- attr(Z,"scaled:scale"); sZcenter<- attr(Z,"scaled:center") 
     X[,attr(X,"scaled:scale")==0]<-1; Z[,attr(Z,"scaled:scale")==0]<-1; 
  }; 

  if(is.null(clusters)) clusters <- des$clusters ##########
  
  pxz <- px + pz; 

  survs<-read.surv(m,id,npar,clusters,start.time,max.time)
  times<-survs$times;id<-id.call<-survs$id.cal;
  clusters<-cluster.call<-survs$clusters; time2<-survs$stop
  status<-survs$status; 
  ldata<-list(start=survs$start,stop=survs$stop,
              antpers=survs$antpers,antclust=survs$antclust);

  if (npar== TRUE) { #cat("Nonparametric Additive Risk Model\n")
    ud <- aalenBase(times, ldata, X, status, id, clusters, robust = robust, 
                    sim = sim, retur = residuals, antsim = n.sim,
                    weighted.test = weighted.test,covariance=covariance,
                    resample.iid=resample.iid,namesX=covnamesX,silent=silent,scale=scale)
    colnames(ud$cum) <- colnames(ud$var.cum) <- c("time", covnamesX)
    if (robust == 1) colnames(ud$robvar.cum) <- c("time", covnamesX)
    if (sim >= 1) {
      colnames(ud$test.procBeqC) <- c("time", covnamesX)
      names(ud$conf.band) <- names(ud$pval.testBeq0) <- names(ud$pval.testBeqC) <- names(ud$pval.testBeqC.is) <- names(ud$obs.testBeq0) <- names(ud$obs.testBeqC) <- names(ud$obs.testBeqC.is) <- colnames(ud$sim.testBeq0) <- colnames(ud$sim.testBeqC) <- colnames(ud$sim.testBeqC.is) <- covnamesX
      ud$sim.testBeqC.is <- ud$sim.testBeqC <- FALSE
    }

  }
  else { #cat("Semiparametric Additive Risk Model\n")
    if (px == 0) 
      stop("No nonparametric terms (needs one!)")
    ud <- semiaalen(times, ldata, X, Z, 
                    status, id , clusters, robust = robust, sim = sim, antsim = n.sim, 
                    weighted.test = weighted.test, retur =
                    residuals,covariance=covariance,
                    resample.iid=resample.iid,namesX=covnamesX,namesZ=covnamesZ,
                    deltaweight=deltaweight,silent=silent,scale=scale)

    if (px > 0) {
      colnames(ud$cum) <- colnames(ud$var.cum) <- c("time", covnamesX)
      if (robust == 1) 
        colnames(ud$robvar.cum) <- c("time", covnamesX)
      if (sim >= 1) {
        colnames(ud$test.procBeqC) <- c("time", covnamesX)
        names(ud$conf.band) <- names(ud$pval.testBeq0) <- names(ud$pval.testBeqC) <- names(ud$pval.testBeqC.is) <- names(ud$obs.testBeqC.is) <- names(ud$obs.testBeq0) <- names(ud$obs.testBeqC) <- colnames(ud$sim.testBeq0) <- colnames(ud$sim.testBeqC.is) <- colnames(ud$sim.testBeqC) <- covnamesX
        ud$sim.testBeqC.is <- ud$sim.testBeqC <- FALSE
      }
    }
    ud$gamma<-as.matrix(ud$gamma);
    rownames(ud$gamma) <- c(covnamesZ)
    rownames(ud$intZHdN) <- c(covnamesZ)
    colnames(ud$gamma) <- "estimate"
    colnames(ud$var.gamma) <- c(covnamesZ)
    rownames(ud$var.gamma) <- c(covnamesZ)
    colnames(ud$robvar.gamma) <- c(covnamesZ)
    colnames(ud$intZHZ) <- c(covnamesZ)
    rownames(ud$var.gamma) <- c(covnamesZ)
  }
  attr(ud, "Call") <- sys.call()
  attr(ud, "Formula") <- formula
  attr(ud, "id") <- id.call
  attr(ud, "cluster") <- cluster.call
  attr(ud, "start") <- start.time
  attr(ud, "time2") <- time2
  class(ud) <- "aalen"
  ud$call<-call
  return(ud)
}

plot.aalen <-  function (x, pointwise.ci=1, hw.ci=0,
sim.ci=0, robust=0, specific.comps=FALSE,level=0.05, start.time = 0, 
stop.time = 0, add.to.plot=FALSE, mains=TRUE, xlab="Time",
ylab ="Cumulative coefficients",score=FALSE,...) 
{
  object <- x; rm(x);
  if (!inherits(object,'aalen') ) 
    stop ("Must be output from Aalen function") 
 
  if (score==FALSE) plot.cums(object, pointwise.ci=pointwise.ci, 
        hw.ci=hw.ci,
        sim.ci=sim.ci, robust=robust, specific.comps=specific.comps,level=level, 
        start.time = start.time, stop.time = stop.time, add.to.plot=add.to.plot, 
        mains=mains, xlab=xlab, ylab =ylab) 
  else plot.score(object, specific.comps=specific.comps, mains=mains,
                  xlab=xlab,ylab =ylab); 
}

"print.aalen" <- function (x,...) 
{
  object <- x; rm(x);
  if (!inherits(object, 'aalen')) stop ("Must be an aalen object")

  if (is.null(object$gamma)==TRUE) semi<-FALSE else semi<-TRUE
    
                                        # We print information about object:
  
  cat("Additive Aalen Model \n\n")
  cat(" Nonparametric terms : "); cat(colnames(object$cum)[-1]); cat("   \n");  
  if (semi) {
    cat(" Parametric terms :  "); cat(rownames(object$gamma)); 
    cat("   \n");  } 
  cat("   \n");  

  cat("  Call: \n"); dput(attr(object, "Call")); cat("\n"); 
}


"summary.aalen" <-
function (object,digits = 3,...) 
{
  aalen.object <- object; rm(object);
  
  obj<-aalen.object
  if (!inherits(aalen.object, 'aalen')) stop ("Must be an aalen object")
  
  if (is.null(aalen.object$gamma)==TRUE) semi<-FALSE else semi<-TRUE
    
  # We print information about object:  
  cat("Additive Aalen Model \n\n")
  #cat(paste("loglikelihood : ",round(aalen.object$deviance,3),"\n"))
  #cat("Nonparametric terms : "); cat(colnames(aalen.object$cum)[-1]);
  #cat("   \n");  

  timetest(obj,digits=digits); 

  if (semi) {
    cat("Parametric terms :  ");  #cat(rownames(aalen.object$gamma)); 
  }
  cat("   \n");  

  if (semi) {
    coef.aalen(aalen.object,digits=digits); 

    if (is.null(aalen.object$pstest.pval)==FALSE) {
      res<-cbind(aalen.object$sup.pscore,aalen.object$pstest.pval);
      colnames(res)<-c("sup of pseudo-score test","p-value H_0: B(t)=b t");  
      cat(" \n");  
      cat("Test for time invariant effects \n")
      prmatrix(signif(res,digits))
    }
  }
  cat("   \n");  

  cat("  Call: \n")
  dput(attr(aalen.object, "Call"))
  cat("\n")
}

coef.aalen <- function(object, digits=3,...) {
  
   coefBase(object,digits=digits)
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/new.cox-aalen.r"
prop<-function(x) x

cox.aalen<-function(formula=formula(data),data=sys.parent(),
beta=0,Nit=10,detail=0,start.time=0,max.time=NULL, id=NULL, 
clusters=NULL, n.sim=500, residuals=0,robust=1,
weighted.test=0,covariance=0,resample.iid=0,weights=NULL,
rate.sim=1,beta.fixed=0)
{
  ridge<-0; ratesim<-rate.sim; if (n.sim==0) sim<-0 else sim<-1; 
  call <- match.call()
  m <- match.call(expand=FALSE)
  m$robust<-m$start.time<-m$scaleLWY<-m$weighted.test<-m$beta<-m$Nit<-m$detail<-m$max.time<-m$residuals<-m$n.sim<-m$id<-m$covariance<-m$resample.iid<-m$clusters<-m$rate.sim<-m$beta.fixed<-NULL

  if (resample.iid==1 & robust==0) {
    cat("When robust=0 no iid representaion computed\n"); 
    resample.iid<-0;}
  if (covariance==1 & robust==0) {
    cat("When robust=0 no covariance computed \n"); 
    cat("Covariance based on robust iid representation\n")
    covariance<-0;}
  if (sim==1 & robust==0) {
    cat("When robust=0, No simulations \n"); 
    cat("n.sim set to 0\n"); 
    sim<-0;}
#  if (residuals==1 & robust==0) {
#    cat("When robust=0, no martingale residuals \n"); 
#    residuals<-0;}
  if (n.sim>0 & n.sim<50) {n.sim<-50 ; cat("Minimum 50 simulations\n");}
  if (beta.fixed==1) Nit<-1; 

  special <- c("prop","cluster")
  Terms <- if(missing(data)) terms(formula, special)
  else          terms(formula, special, data=data)
  m$formula <- Terms
  m[[1]] <- as.name("model.frame")
  m <- eval(m, sys.parent())
  mt <- attr(m, "terms")
  intercept<-attr(mt, "intercept")
  Y <- model.extract(m, "response")
  if (!inherits(Y, "Surv")) stop("Response must be a survival object")

  des<-read.design(m,Terms,model="cox.aalen")
  X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
  covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ

  if(is.null(clusters)) clusters <- des$clusters  
  
  pxz <- px + pz;

  survs<-read.surv(m,id,npar,clusters,start.time,max.time,model="cox.aalen")
  times<-survs$times;id<-id.call<-survs$id.cal;
  clusters<-cluster.call<-survs$clusters; 
  time<-survs$start; time2<-survs$stop; status<-survs$status;
  ldata<-list(start=survs$start,stop=survs$stop,
              antpers=survs$antpers,antclust=survs$antclust);

  if (npar==FALSE) covar<-data.matrix(cbind(X,Z)) else 
  stop("Both multiplicative and additive model needed");
  Ntimes <- sum(status); 

  #times<-c(start.time,time2[status==1]); times<-sort(times);
  #if (is.null(max.time)==TRUE) maxtimes<-max(times)+0.1 else 
  #maxtimes<-max.time; 
  #times<-times[times<maxtimes]
  #print(cbind(time,time2)); 
  if ((sum(beta)==0) & (beta.fixed==0)) beta<-coxph(Surv(time,time2,status)~Z)$coef; 

  #cat("Cox-Aalen Survival Model"); cat("\n")
  if (px==0) stop("No nonparametric terms (needs one!)");
  ud<-cox.aalenBase(times,ldata,X,Z,
                    status,id,clusters,Nit=Nit,detail=detail,beta=beta,weights=weights,
                    sim=sim,antsim=n.sim,residuals=residuals,robust=robust,
                    weighted.test=weighted.test,ratesim=ratesim,
                    covariance=covariance,resample.iid=resample.iid,namesX=covnamesX,namesZ=covnamesZ,
                    beta.fixed=beta.fixed);

  colnames(ud$test.procProp)<-c("time",covnamesZ)
  if (beta.fixed==1) colnames(ud$var.score)<-c("time",covnamesZ)
  if (robust==1 & beta.fixed==0) colnames(ud$var.score)<-c("time",covnamesZ)

  if (px>0) {
    colnames(ud$cum)<-colnames(ud$var.cum)<- c("time",covnamesX)
    if (robust==1) colnames(ud$robvar.cum)<- c("time",covnamesX)
    if (sim==1) {
      names(ud$pval.Prop)<- covnamesZ
      names(ud$conf.band)<- names(ud$pval.testBeq0)<-
        names(ud$pval.testBeqC)<-
          names(ud$obs.testBeq0)<- names(ud$obs.testBeqC)<-
            colnames(ud$sim.testBeq0)<- covnamesX; 
    } }
  covariance<-ud$covariance

  rownames(ud$gamma)<-c(covnamesZ); colnames(ud$gamma)<-"estimate"; 
  rownames(ud$score)<-c(covnamesZ); colnames(ud$score)<-"score"; 
  namematrix(ud$var.gamma,covnamesZ); 
  namematrix(ud$robvar.gamma,covnamesZ); 
  if (beta.fixed==1) {ud$var.gamma<-matrix(0,pz,pz); 
                      ud$robvar.gamma<-matrix(0,pz,pz);}
  namematrix(ud$D2linv,covnamesZ); 

  attr(ud,"Call")<-sys.call(); 
  class(ud)<-"cox.aalen"
  attr(ud,"Formula")<-formula;
  attr(ud,"id")<-id.call;
  attr(ud,"cluster")<-cluster.call;
  attr(ud,"start")<-start.time; 
  attr(ud,"time2")<-time2; 
  ud$call<-call

  return(ud); 
}

"plot.cox.aalen" <-  function (x,..., pointwise.ci=1, hw.ci=0,
sim.ci=0, robust=0, specific.comps=FALSE,level=0.05, start.time = 0,
stop.time = 0, add.to.plot=FALSE, mains=TRUE, xlab="Time",
ylab ="Cumulative coefficients",score=FALSE)
{
  object <- x; rm(x);  
  if (!inherits(object,'cox.aalen') ) stop ("Must be output from Cox-Aalen function")

  if (score==FALSE) plot.cums(object, pointwise.ci=pointwise.ci,
        hw.ci=hw.ci,
        sim.ci=sim.ci, robust=robust, specific.comps=specific.comps,level=level,
        start.time = start.time, stop.time = stop.time, add.to.plot=add.to.plot,
        mains=mains, xlab=xlab, ylab =ylab)
  else plot.score(object, specific.comps=specific.comps, mains=mains,
                  xlab=xlab,ylab =ylab);
}


"print.cox.aalen" <-
function (x,...) 
{
    cox.aalen.object <- x; rm(x);
  if (!inherits(cox.aalen.object, 'cox.aalen')) 
    stop ("Must be an aalen object")

if (is.null(cox.aalen.object$prop.odds)==TRUE) p.o<-FALSE else p.o<-TRUE

if (is.null(cox.aalen.object$gamma)==TRUE) prop<-FALSE else prop<-TRUE
    
  # We print information about object:  
  cat("Cox-Aalen Model \n\n")
  cat("Additive Aalen terms : "); 
  cat(colnames(cox.aalen.object$cum)[-1]); cat("   \n");  
  if (prop) {
  cat("Proportional Cox terms :  "); 
  cat(rownames(cox.aalen.object$gamma)); 
  cat("   \n");  }
  cat("   \n");  

  cat("  Call: \n")
  dput(attr(cox.aalen.object,"Call"))
  cat("\n")
}


"summary.cox.aalen" <-
function (object,digits = 3,...) 
{
  cox.aalen.object <- object; rm(object);
  obj<-cox.aalen.object
  if (!inherits(cox.aalen.object, 'cox.aalen')) 
    stop ("Must be a Cox-Aalen object")
  
  prop<-TRUE; 
  if (is.null(cox.aalen.object$gamma)==TRUE) stop(" No regression terms"); 
  if (is.null(cox.aalen.object$prop.odds)==TRUE) p.o<-FALSE else p.o<-TRUE
    
  if (p.o==FALSE) cat("Cox-Aalen Model \n\n") else cat("Proportional Odds model \n\n")

  if (sum(abs(cox.aalen.object$score)>0.000001)) 
    cat("Did not converge, allow more iterations\n\n"); 

  if (p.o==FALSE) cat("Test for Aalen terms \n") else  cat("Test for baseline \n")

  if (is.null(obj$conf.band)==TRUE)  mtest<-FALSE else mtest<-TRUE; 
  if (mtest==FALSE) cat("Test not computed, sim=0 \n\n")
  if (mtest==TRUE) { 

    timetest(obj,digits=digits)
  }

  if (prop) {
    if (p.o==FALSE) cat("Proportional Cox terms :  \n") else  cat("Covariate effects \n")

    coef.cox.aalen(obj); 

    if (p.o==FALSE) cat("Test for Proportionality \n") else  
    cat("Test for Goodness-of-fit \n")
    if (is.null(obj$pval.Prop)==TRUE)  ptest<-FALSE else ptest<-TRUE; 
    if (ptest==FALSE) cat("Test not computed, sim=0 \n\n")
    if (ptest==TRUE) { 
      testP<-cbind(
                   apply(abs(as.matrix(obj$test.procProp[,-1])),2,max),
                   obj$pval.Prop)
      testP<-as.matrix(testP); 
      colnames(testP) <- c("sup|  hat U(t) |","p-value H_0 ")
      prmatrix(signif(testP,digits)); cat("\n"); }  }

  cat("   \n");  
  cat("  Call: \n")
  dput(attr(obj, "Call"))
  cat("\n")
}

coef.cox.aalen<-function(object,...,digits=3,d2logl=1) {
   coefBase(object,digits=digits, d2logl=d2logl)
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/new.dynreg.r"
dynreg<-function(formula,data=sys.parent(),aalenmod,
bandwidth=0.5,id=NULL,bhat=NULL,start.time=0,
max.time=NULL,n.sim=500,meansub=1,weighted.test=0)
{
  if (n.sim==0) sim<-0 else sim<-1; smoothXX<-0
  if (n.sim>0 & n.sim<50) {n.sim<-50 ; cat("Minimum 50 simulations\n");} 
  residuals<-0; 

  b<-bandwidth
  call <- match.call()
  m <- match.call(expand=FALSE)
  m$weighted.test<-m$meansub<-m$bandwidth<-m$aalenmod<-m$start.time<-m$max.time<-m$return.mg<-m$n.sim<-m$bhat<-m$id<-NULL
  special <- c("const")
  Terms <- if(missing(data)) terms(formula, special)
  else              terms(formula, special, data=data)
  m$formula <- Terms
  m[[1]] <- as.name("model.frame")
  m <- eval(m, sys.parent())
  mt <- attr(m, "terms")
  intercept<-attr(mt, "intercept")
  Y <- model.extract(m, "response")

  des<-read.design(m,Terms)
  X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
  covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ
  pxz <- px + pz;
  XZ<-cbind(X,Z); 

####################################################################
### Aalen design is interpreted  
  udaal<-aalen.des(aalenmod,data); 
  time<-udaal$time; time2<-udaal$time2; 
  covarA<-data.matrix(udaal$X); status<-udaal$status; 
  pa<-ncol(covarA); 

####################################################################
  meanY<-mean(Y); 
  if (meansub==1) { Y<-Y-meanY;}
  covar<-data.matrix(cbind(Y,XZ,covarA)); 
####################################################################
  Ntimes <- sum(status); 

   # adds random noise to make survival times unique
  if (sum(duplicated(time2[status==1]))>0) {
    # cat("Non unique survival times: break ties ! \n")
    # cat("Break ties yourself\n");
    ties<-TRUE; 
    dtimes<-time2[status==1]
    index<-(1:length(time2))[status==1]
    ties<-duplicated(dtimes); nties<-sum(ties); index<-index[ties]
    dt<-diff(sort(time2)); dt<-min(dt[dt>0]);
    time2[index]<-time2[index]+runif(nties,0,min(0.001,dt/2));
  } else ties<-FALSE; 

  if (is.null(id)==TRUE) stop("Must specify subject id variable \n")

  Ntimes <- Ntimes+1; 
  times<-c(0,time2[status==1]); 
  if (is.null(max.time)==TRUE) max.time<-max(times)+0.1 else max.time<-min(max(times),max.time);   
  times<-times[times<max.time & times>start.time]; 
  times<-sort(times); Ntimes<-length(times); 

  if (is.null(id)==TRUE) {antpers<-length(time); id<-0:(antpers-1); }
  else { pers<-unique(id); antpers<-length(pers); 
         id<-as.integer(factor(id,labels=1:(antpers)))-1; }
  ldata<-list(start=time,stop=time2,antpers=length(time))
  ldata$antpers<-antpers; 
  #X<-as.matrix(covar); 

  if (npar==TRUE) {
  #cat("Nonparametric Additive Model "); cat("\n")
  # local linear regression for preliminary estimates 
####################################################
    bandwidth<-(max.time-start.time)*bandwidth;

    if (is.null(bhat)==TRUE) {
      xval<-seq(times[2],times[Ntimes],length=30); 
      bhat<-localTimeReg(time2,Y[status==1],X[status==1,],xval,b,lin=1)[,1:(px+1)]
    }

    ud<-dynregBase(times,status,Y,ldata,X,covarA,id,
                   sim=sim,retur=residuals,antsim=n.sim,b=b,bhat=bhat,
                   smoothXX=smoothXX,weighted.test=weighted.test);

    colnames(ud$cum.ly)<- colnames(ud$var.cum.ly)<-  
      colnames(ud$cum)<-colnames(ud$var.cum)<- colnames(ud$cum0)<- 
        colnames(ud$cum.ms)<-colnames(ud$robvar.cum)<-c("time",covnamesX)

    if (sim==1) {
      colnames(ud$test.procBeqC)<- c("time",covnamesX)
      names(ud$conf.band)<- names(ud$pval.testBeq0)<- names(ud$pval.testBeqC)<- 
        names(ud$obs.testBeq0)<- names(ud$obs.testBeqC)<- 
          names(ud$obs.testBeqC.is)<- names(ud$pval.testBeqC.is)<- 
            colnames(ud$sim.testBeq0)<- colnames(ud$sim.testBeqC) <- 
              colnames(ud$sim.testBeqC.is) <- covnamesX; }
  }
  else {
                                        #cat(" Semiparametric Additive Model"); cat("\n")

    if (is.null(bhat)==TRUE) {
      cat(" Computes initial estimates based on local regression\n")
      cat(" for efficient estimates, you may provide these\n");
      xval<-seq(times[2],times[Ntimes],length=30); 
      bhat<-localTimeReg(time2,Y[status==1],XZ[status==1,],xval,b,lin=1); 
      bhat<-bhat[,1:(pxz+1)]; 
      gamma<-apply(as.matrix(bhat[,((px+2):(pxz+1))]),2,mean); 
      bhat<-bhat[,1:(px+1)]; 
    } else {bhat<-cbind(xval,matrix(0,30,px)); gamma<-rep(0,pz);}

#if (is.null(bhat)==TRUE) {
#ud<-dynregBase(times,status,Y,ldata,
#X,covarA,id,bhat=bhat, 
#sim=0,retur=0,antsim=0,b=b,smoothXX=smoothXX,
#weighted.test=weighted.test);
##pcregci(ud$cum,ud$var.cum,0,3); 
#xval<-seq(times[1],times[Ntimes],length=30); 
#bhat<-CsmoothB(ud$cum,xval,b); 
#gamma<-ud$cum[signif(Ntimes*3/4),(px+2):(px+pz+1)]/
#       ud$cum[signif(Ntimes*3/4),1];
#};
#print(apply(cbind(X[,1:(pxz+1)],X[,(pxz+2):(pxz+pa+1)]),2,mean))
#print(ud$cum[200,]); 

ud<-semiregBase(times,status,Y,ldata,X,Z,covarA,id,
 bhat=bhat,sim=sim,antsim=n.sim,b=b,gamma=gamma,weighted.test=weighted.test);

    if (px>0) {
      colnames(ud$cum)<- colnames(ud$var.cum)<- colnames(ud$cum0)<- 
        colnames(ud$cum.ms)<- colnames(ud$robvar.cum)<-c("time",covnamesX)

      if (sim==1) {
        colnames(ud$test.procBeqC)<- c("time",covnamesX)
        names(ud$conf.band)<- names(ud$pval.testBeq0)<- 
          names(ud$pval.testBeqC)<- 
            names(ud$pval.testBeqC.is)<- names(ud$obs.testBeqC.is)<- 
              names(ud$obs.testBeq0)<- names(ud$obs.testBeqC)<- 
                colnames(ud$sim.testBeq0)<- 

                  colnames(ud$sim.testBeqC.is)<- 
                    colnames(ud$sim.testBeqC)<- covnamesX; }
    }

    ud$gamma<-nameestimate(ud$gamma,covnamesZ); 
    ud$gamma.ms<-nameestimate(ud$gamma.ms,covnamesZ); 
    ud$gamma0<-nameestimate(ud$gamma0,covnamesZ); 
    ud$gamma.ly<-nameestimate(ud$gamma.ly,covnamesZ); 
#ud$gamma.ef<-nameestimate(ud$gamma.ef,covnamesZ); 
#ud$gamma.efms<-nameestimate(ud$gamma.efms,covnamesZ); 

    ud$var.gamma<-namematrix(ud$var.gamma,covnamesZ); 
    ud$robvar.gamma<-namematrix(ud$robvar.gamma,covnamesZ); 
    ud$var.gamma.ms<-namematrix(ud$var.gamma.ms,covnamesZ); 
    ud$var.gamma.ly<-namematrix(ud$var.gamma.ly,covnamesZ); 
#ud$var.gamma.ef<-namematrix(ud$var.gamma.ef,covnamesZ); 
#ud$robvar.gamma.ef<-namematrix(ud$robvar.gamma.ef,covnamesZ); 
ud$mean.response<-meanY;
  }
  attr(ud,"Call")<-sys.call(); 
  class(ud)<-"dynreg"
  return(ud); 
}

namematrix<-function(mat,names)
{ colnames(mat)<-names; rownames(mat)<-names; return(mat); }
nameestimate<-function(mat,names)
{ colnames(mat)<-"estimate"; rownames(mat)<-names; return(mat); }

"plot.dynreg"<-function(x,type="eff.smooth",pointwise.ci=1,hw.ci=0,
sim.ci=0,robust=0,specific.comps=FALSE,level=0.05,start.time=0,stop.time=0,
add.to.plot=FALSE,mains=TRUE,xlab="Time",ylab ="Cumulative coefficients",score=FALSE,...)
{
  object <- x; rm(x);  
  if (!inherits(object, 'dynreg')) 
    stop ("Must be output from dynreg() function") 
 
  if (score==FALSE) {
    if (type=="eff.smooth") { B<-object$cum;V<-object$var.cum;}
    else if (type=="ms.mpp") {B<-object$cum.ms;V<-object$var.cum;}
    else if (type=="0.mpp") { B<-object$cum0; 
                              if (is.numeric(object$gamma)==FALSE) V<-object$var.cum0 else V<-B*0; }
    else if (type=="ly.mpp") {
      if (is.numeric(object$gamma)==FALSE) {
        B<-object$cum.ly; V<-object$var.cum.ly;} else 
      stop("Non-par estimates not computed for LY correction\n"); }
    else stop("not valid type"); 

    p<-dim(B)[[2]]; 
    if (is.null(V)==TRUE) robust<-1; 
    if (robust>=1) V<-object$robvar.cum; 

    if (sum(specific.comps)==FALSE) comp<-2:p else comp<-specific.comps+1
    if (stop.time==0) stop.time<-max(B[,1]);

    med<-B[,1]<=stop.time & B[,1]>=start.time
    B<-B[med,]; Bs<-B[1,];  B<-t(t(B)-Bs); B[,1]<-B[,1]+Bs[1];
    V<-V[med,]; Vs<-V[1,]; V<-t( t(V)-Vs); 
    Vrob<-object$robvar.cum; 
    Vrob<-Vrob[med,]; Vrobs<-Vrob[1,]; Vrob<-t( t(Vrob)-Vrobs); 

    c.alpha<- qnorm(1-level/2)
    for (v in comp) { 
      c.alpha<- qnorm(1-level/2)
      est<-B[,v];ul<-B[,v]+c.alpha*V[,v]^.5;nl<-B[,v]-c.alpha*V[,v]^.5;
      if (add.to.plot==FALSE) 
        {
          plot(B[,1],est,ylim=1.05*range(ul,nl),type="s",xlab=xlab,ylab=ylab) 
          if (mains==TRUE) title(main=colnames(B)[v]); }
      else lines(B[,1],est,type="s"); 
      if (pointwise.ci>=1) {
        lines(B[,1],ul,lty=pointwise.ci,type="s");
        lines(B[,1],nl,lty=pointwise.ci,type="s"); }
      if (robust>=1) {
        lines(B[,1],ul,lty=robust,type="s"); 
        lines(B[,1],nl,lty=robust,type="s"); }
      if (hw.ci>=1) {
        if (level!=0.05) cat("Hall-Wellner bands only 95 % \n");
        tau<-length(B[,1])
        nl<-B[,v]-1.13*V[tau,v]^.5*(1+V[,v]/V[tau,v])
        ul<-B[,v]+1.13*V[tau,v]^.5*(1+V[,v]/V[tau,v])
        lines(B[,1],ul,lty=hw.ci,type="s"); 
        lines(B[,1],nl,lty=hw.ci,type="s"); }
      if (sim.ci>=1) {
        if (sum(object$conf.band)==FALSE)
          cat("Uniform simulation based bands only computed for n.sim> 0\n")
        if (level!=0.05) c.alpha<-percen(object$sim.testBeq0[,v-1],1-level)
        else c.alpha<-object$conf.band[v-1];
        nl<-B[,v]-c.alpha*Vrob[,v]^.5; ul<-B[,v]+c.alpha*Vrob[,v]^.5;
        lines(B[,1],ul,lty=sim.ci,type="s"); 
        lines(B[,1],nl,lty=sim.ci,type="s"); }
      abline(h=0)
    }
  } else {
                                        # plot score proces
    dim1<-ncol(object$test.procBeqC)
    if (sum(specific.comps)==FALSE) comp<-2:dim1 else comp<-specific.comps+1

    for (i in comp)
      {
        ul<-2*max(abs(object$test.procBeqC[,i]));
        plot(object$test.procBeqC[,1],
             object$test.procBeqC[,i],type="l",ylim=c(-ul,ul),
             lwd=2,xlab=xlab,ylab=ylab)
        if (mains==TRUE) title(main=colnames(object$test.procBeqC)[i]); 
        for (j in 1:50)
          lines(object$test.procBeqC[,1],
                as.matrix(object$sim.test.procBeqC[[j]])[,i-1],lwd=1,col="grey",lty=1)
        lines(object$test.procBeqC[,1],object$test.procBeqC[,i],lwd=2)
      } }

}

"print.dynreg" <-
function (x,...) 
{
  dynreg.object <- x; rm(x);
  if (!inherits(dynreg.object, 'dynreg')) 
    stop ("Must be a dynreg object")

if (is.null(dynreg.object$gamma0)==TRUE) semi<-FALSE else semi<-TRUE
    
  # We print information about object:  
  cat("Dynamic Additive Regression Model \n\n")
  cat(" Nonparametric terms : "); cat(colnames(dynreg.object$cum)[-1]);
  cat("   \n");  
  if (semi) {
  cat(" Parametric terms :  "); cat(rownames(dynreg.object$gamma0)); 
  cat("   \n");  }
  cat("   \n");  

  cat("  Call: \n")
  dput(attr(dynreg.object, "Call"))
  cat("\n")
}


"summary.dynreg" <- function(object,digits = 3,...) 
{
  dynreg.object <- object; rm(object);
  obj<-dynreg.object
  if (!inherits(dynreg.object, 'dynreg')) stop ("Must be an dynreg object")
  if (is.null(dynreg.object$gamma.ms)==TRUE) semi<-FALSE else semi<-TRUE
    
                                        # We print information about object:  
  cat("Dynamic Additive Regression Model \n\n")
  cat(" Nonparametric terms : "); cat(colnames(dynreg.object$cum)[-1]);
  cat("   \n");  

  timetest(obj,digits=digits);

  if (semi) {
    cat(" Parametric terms :  "); cat(rownames(dynreg.object$gamma0)); 
    cat("   \n");  
    coef.dynreg(dynreg.object,digits=digits); }
  cat("   \n");  

  cat("  Call: \n")
  dput(attr(dynreg.object, "Call"))
  cat("\n")
}


coef.dynreg<- function(object,...,digits=3) {
   coefBase(object,digits=digits)
}

aalen.des<-function(formula=formula(data),data=sys.parent(),model="aalen")
{
  call <- match.call(); 
  m <- match.call(expand=FALSE); 
  m$model<-NULL
  special <- c("cluster","prop","const")
  Terms <- if(missing(data)) terms(formula,special) else terms(formula, special, data=data)
  m$formula <- Terms
  m[[1]] <- as.name("model.frame")
  m <- eval(m, sys.parent())
  mt <- attr(m, "terms")
  intercept<-attr(mt, "intercept")
  Y <- model.extract(m,"response")

  des<-read.design(m,Terms,model=model)
  X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px;
  pz<-des$pz;
  covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ;
  clusters<-des$clusters;

  if (attr(m[, 1], "type") == "right") {
    type<-"right"; 
    status <- m[, 1][, "status"];
    time2  <- m[, 1][, "time"]; time   <- rep(0,length(time2)); 
  } else if (attr(m[, 1], "type") == "counting") {
    type<-"counting"; 
    time   <- m[, 1][,1]; time2  <- m[, 1][,2]; status <- m[, 1][,3];
  } else { stop("only right-censored or counting processes data") } 
return(list(type=type,time=time,time2=time2,status=status,
 X=X,Z=Z,px=px,pz=pz,npar=npar,
 covnamesX=covnamesX,covnamesZ=covnamesZ,clusters=clusters))
}
#ud<-aalen.des(Surv(days/365,status==1)~factor(ulc)+thick+
#factor(sex),melanom)
#print(ud)
#ud<-aalen.des(Surv(days/365,status==1)~prop(factor(ulc))+
#prop(thick)+factor(sex),melanom)
#print(ud)

#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/new.pe-sasieni.r"
pe.sasieni<-function (formula = formula(data),data = sys.parent(), 
id=NULL,start.time=0,max.time=NULL,offsets=0,Nit=50,detail=0,n.sim=500)
{
  call <- match.call()
  m <- match.call(expand = FALSE)
  m$id<-m$Nit<-m$detail<-m$start.time <- m$max.time <-
    m$offsets<-m$n.sim <- NULL 
  Terms <- if (missing(data)) 
    terms(formula ) else terms(formula, data = data)
  m$formula <- Terms
  m[[1]] <- as.name("model.frame")
  m <- eval(m, sys.parent())
  mt <- attr(m, "terms")
  intercept <- attr(mt, "intercept")
  Y <- model.extract(m, "response")
  if (!inherits(Y, "Surv")) 
    stop("Response must be a survival object")

  XZ<-model.matrix(Terms,m)[, drop = FALSE]
  cols<-attributes(XZ)$assign
  l.cols<-length(cols)

  X<-as.matrix(XZ[,1]); covnamesX <- dimnames(XZ)[[2]][1];
  dimnames(X)[[2]]<-covnamesX; 
  Z<-as.matrix(XZ[,-1]); covnamesZ <- dimnames(XZ)[[2]][-1]; 
  px <- ncol(X); pz <- ncol(Z); pxz <- px + pz


  if (attr(m[, 1], "type") == "right") {
    X <- data.matrix(X); Z <- data.matrix(Z); 
    time2 <- m[, 1][, "time"]; time <- rep(0, length(time2))
    status <- m[, 1][, "status"]
  }
  else if (attr(m[, 1], "type") == "counting") {
    X <- data.matrix(X); Z <- data.matrix(Z) ; 
    time <- m[, 1][, 1]; time2 <- m[, 1][, 2]; status <- m[, 1][, 3]
  }
  else { stop("only right-censored or counting processes data") }

  if (sum(duplicated(time2[status==1]))>0) {
    #cat("Non unique survival times: break ties ! \n")
    # cat("Break ties yourself\n");
    ties<-TRUE
    dtimes<-time2[status==1]
    index<-(1:length(time2))[status==1]
    ties<-duplicated(dtimes); nties<-sum(ties); index<-index[ties]
    dt<-diff(sort(time2)); dt<-min(dt[dt>0]); 
    time2[index]<-time2[index]+runif(nties,0,min(0.001,dt/2));
  } else ties<-FALSE; 

  times<-unique(time2); 
  times <- c(start.time, times[times>start.time]); times <- sort(times)
  if (is.null(max.time) == TRUE) maxtimes <- max(times) else maxtimes <- max.time
  times<-times[times<=maxtimes];
  times<-c(times,maxtimes)  
  times<-unique(times); Ntimes <- length(times); 
  ldata <- list(start = time, stop =time2)

  ntot <- ncol(XZ); px <- ncol(X)
  Nalltimes <- length(times);  
  Ntimes<-sum(status[(time2>times[1]) & (time2<=times[Nalltimes])])+1;

                                        #print(Ntimes); print(Nalltimes); 
                                        #print(times);  print(status);  print(cbind(time2,time,status))
  X<-as.matrix(X); Z<-as.matrix(Z); 
  px <- as.integer(dim(X)[2]); nx <- as.integer(dim(X)[1]);
  pg <- as.integer(dim(Z)[2]); ng <- as.integer(dim(Z)[1]);

  if (length(offsets)==1) mof<-0 else mof<-1;
  mw<-0; weights<-0;  

  cum<-Vcum<-matrix(0,Ntimes,px+1); 
  Ut<-matrix(0,Nalltimes,pg+1); 
  gamma<-intZHdN<-rep(0,pg); 
  Vargam<-intZHZ<-matrix(0,pg,pg); 
  antpers<-length(unique(id))
  dUt<-matrix(0,Ntimes,pg*pg);
  if (n.sim >0) {testOBS<-rep(0,pg); test<-matrix(0,n.sim,pg);}
  else {testOBS<-0; test<-0;}
  rani<--round(runif(1)*10000)

                                        #dyn.load("pes.so"); 

  semiout<-.C("pes",
              as.double(times),as.integer(Nalltimes),as.integer(Ntimes),
              as.double(X),as.integer(nx),as.integer(px),
              as.double(Z),as.integer(ng),as.integer(pg),
              as.integer(antpers),as.double(time),as.double(time2), 
              as.double(cum),as.double(Vcum),as.double(gamma),
              as.double(Vargam),as.integer(status),as.double(Ut),
              as.double(intZHZ),as.double(intZHdN),as.integer(mof),
              as.double(offsets),as.integer(mw),as.double(weights),
              as.integer(Nit),as.integer(detail),
              as.integer(rani),as.integer(n.sim),as.double(test),
              PACKAGE="timereg"); 

  cum <-matrix(semiout[[13]],Ntimes,px+1); 
  Vcum <-matrix(semiout[[14]],Ntimes,px+1); 
  gamma<-matrix(semiout[[15]],pg,1); Vargam<-matrix(semiout[[16]],pg,pg); 
  intZHZ<-matrix(semiout[[19]],pg,pg); intZHdN<-matrix(semiout[[20]],pg,1); 
  Ut<-matrix(semiout[[18]],Nalltimes,pg+1); 

                                        #dUt<-matrix(semiout[[27]],Ntimes,pg*pg); dUt.list<-list();
                                        #for (i in 1:Ntimes) dUt.list[[i]]<-matrix(dUt[i,],pg,pg);

  if (n.sim>0) {test<-matrix(semiout[[29]],n.sim,pg);
                testOBS<-apply(abs(Ut),2,max)[-1]; testval<-c(); 
                for (i in 1:pg) testval<-c(testval,pval(test[,i],testOBS[i]));
                pval.Prop<-testval; 
                names(pval.Prop) <- names(testOBS)<-covnamesZ
              } else {pval.Prop<-NULL;testOBS<-NULL;}

  ud<-list(cum=cum,var.cum=Vcum,gamma=gamma,var.gamma=Vargam,
           Ut=Ut,D2linv=intZHZ,score=intZHdN,test.Prop=testOBS,pval.Prop=pval.Prop); 

  colnames(ud$cum) <- colnames(ud$var.cum) <- c("time", covnamesX)
  ud$gamma<-as.matrix(ud$gamma);

  rownames(ud$gamma) <- c(covnamesZ)
  colnames(ud$gamma) <- "estimate"
  colnames(ud$var.gamma) <- c(covnamesZ)
  rownames(ud$var.gamma) <- c(covnamesZ)
  rownames(ud$score) <- c(covnamesZ)
  colnames(ud$D2linv) <- c(covnamesZ)

  attr(ud, "Call") <- sys.call()
  attr(ud, "Formula") <- formula
  attr(ud, "start") <- start.time
  attr(ud, "time2") <- time2
  class(ud) <- "pe.sasieni"
  ud$call<-call
  return(ud)
}

summary.pe.sasieni <- function (object,digits=3,...) {
  obj <- object; rm(object);
  if (!inherits(obj, 'pe.sasieni')) 
    stop ("Must be a Proportional Excess Survival Model object based")
  if (is.null(obj$gamma)==TRUE) stop(" No proportional  terms"); 
    
  cat("\nProportional Excess Survival Model \n\n")

  cat("Proportional terms:  \n"); 
  res <- cbind(obj$gamma,diag(obj$var.gamma)^.5) 
  z<-c((res[,1]/res[,2])); 
  pval<-1-pchisq(z^2,1)
  res<-as.matrix(cbind(res,z,pval)); 
  colnames(res) <- c("coef", "se(coef)","z","p") 
  prmatrix(signif(res, digits)); cat("   \n");  

  if (is.null(obj$pval.Prop)==TRUE)  ptest<-FALSE else ptest<-TRUE;
  if (ptest==TRUE) { cat("Test for Proportionality\n"); 
                     testP<-cbind(obj$test.Prop,obj$pval.Prop); testP<-as.matrix(testP);
                     colnames(testP) <- c("sup|  hat U(t) |","p-value H_0 ")
                     prmatrix(signif(testP,digits)); cat("\n"); }

  cat("  Call: "); dput(attr(obj, "Call")); cat("\n")
}


print.pe.sasieni <- function (x,digits=3,...) {
  obj <- x; rm(x);
  if (!inherits(obj, 'pe.sasieni')) 
    stop ("Must be a Proportional Excess Survival Model object based")
  if (is.null(obj$gamma)==TRUE) stop(" No proportional  terms");

  if (is.null(obj$gamma)==TRUE) cox<-FALSE else cox<-TRUE
      
  cat(" Proportional Excess Survival Model,\n   using Sasieni proportional excess risk \n\n")
  cat(" Nonparametric terms: "); 
  cat(colnames(obj$cum)[-1]);
  cat("   \n");  
  if (cox) {
    cat(" Proportional terms:  "); 
    cat(rownames(obj$gamma)); 
    cat("   \n");
  }
  cat("   \n");    

  cat("  Call: "); dput(attr(obj, "Call")); cat("\n")
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/new.prop-excess.r"
cox<-function(x) x

prop.excess<-function(formula=formula(data),data=sys.parent(),excess=1,
tol=0.0001,max.time=NULL,n.sim=1000,alpha=1,frac=1)
  {
    id<-NULL;detail<-0
    robust<-0;  
    call <- match.call()
    m <- match.call(expand=FALSE)
    if (n.sim>0 & n.sim<50) {n.sim<-50 ; cat("Minimum 50 simulations\n");}
    m$detail<-m$excess<-m$alpha<-m$frac<-m$id<-m$tol<-m$max.time<-
      m$n.sim<-NULL

    special <- c("cox")
    Terms <- if(missing(data)) terms(formula, special)
    else              terms(formula, special, data=data)
    m$formula <- Terms
    m[[1]] <- as.name("model.frame")
    m <- eval(m, sys.parent())
    mt <- attr(m, "terms")
    intercept<-attr(mt, "intercept")
    Y <- model.extract(m, "response")

    des<-read.design(m,Terms,model="prop.excess")
    X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
    covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ
    pxz <- px + pz;

    start.time<-0; clusters<-NULL; 
    survs<-read.surv(m,id,npar,clusters,start.time,max.time,model="prop-exs")
    times<-survs$times;id<-id.call<-survs$id.cal;
    clusters<-cluster.call<-survs$clusters; time2<-survs$stop
    status<-survs$status;
    ldata<-list(start=survs$start,stop=survs$stop,
                antpers=survs$antpers,antclust=survs$antclust);

    if (npar==FALSE) {covar<-cbind(X,Z);}
    else {stop("Both multiplicative and additive model needed");}

    Ntimes <- sum(status); 

    times<-c(0,time2[status==1]); times<-sort(times);
    if (is.null(max.time)==TRUE) maxtimes<-max(times)+0.1 else maxtimes<-max.time; 
    times<-times[times<maxtimes] 
    status[time2>maxtimes]<-0

                                        #cat(" Proportional Excess Survival Model "); cat("\n")
    if (px==0) stop("No Aalen terms (need one!)");

    ud<-prop.excessBase(time2,status,X,Z,excess,alpha=1,frac=1,no.sim=n.sim)

    colnames(ud$cum)<-colnames(ud$var.cum)<- 
      c("time",covnamesX,"Excess baseline")
    rownames(ud$gamma)<-c(covnamesZ); 
    colnames(ud$gamma)<-"estimate"; 
    namematrix(ud$var.gamma,covnamesZ); 
                                        #namematrix(ud$robvar.gamma,covnamesZ); 
                                        #namematrix(ud$D2linv,covnamesZ); 

    attr(ud,"Call")<-sys.call(); 
    ud$call<-call

    class(ud)<-"prop.excess"
    return(ud); 
  }


"plot.prop.excess" <- function(x, 
pointwise.ci=1, hw.ci=0,sim.ci=0,specific.comps=FALSE,level=0.95,start.time = 0, stop.time = 0, add.to.plot=FALSE, mains=TRUE, 
xlab="Time", ylab ="Cumulative regression function",score=FALSE,...) 
{
  prop.excess.object <- x; rm(x);
                                        # pointwise.ci   Pointwise confidence intervals 
                                        # hw.ci          Hall-Wellner confidence bands 95 \% 
                                        # robust         Robust variance used #not included here 
                                        # specific.comps Plots specific components c(2,3,4), e.g.
                                        # signi          Significance level
  signi<-1-level; 

  if (!inherits(prop.excess.object,'prop.excess') ) 
    stop ("Must be output from Proportional Excess Survival Model function") 
                                        #if (score==TRUE) {cat("Do not plot score processes"); score<-FALSE;}
 
  if (score==FALSE) {
    B<-prop.excess.object$cum; V<-prop.excess.object$var.cum; 
    p<-dim(B)[[2]]; 
                                        # if (robust==1) V<-prop.excess.object$robvar.cum; 

    if (sum(specific.comps)==FALSE) comp<-2:p else comp<-specific.comps+1

    if (stop.time==0) stop.time<-max(B[,1]);

    med<-B[,1]<=stop.time & B[,1]>=start.time
    B<-B[med,]; V<-V[med,]
    Bs<-B[1,];  Vs<-V[1,]
    B<-t(t(B)-Bs); V<-t( t(V)-Vs); 
    B[,1]<-B[,1]+Bs[1]

    c.alpha<- qnorm(1-signi/2)

    for (v in comp) { 
      ul<-B[,v]+c.alpha*V[,v]^.5; nl<-B[,v]-c.alpha*V[,v]^.5
      est<-B[,v]; 
      if (add.to.plot==FALSE) 
        {
          plot(B[,1],est,ylim=range(ul,nl),type="s",xlab=xlab,ylab=ylab) 
          if (mains==TRUE) title(main=colnames(B)[v]); }
      else lines(B[,1],B[,v],type="s"); 
      if (pointwise.ci>=1) {
        lines(B[,1],ul,lty=pointwise.ci,type="s"); 
        lines(B[,1],nl,lty=pointwise.ci,type="s"); }
                                        #if (robust>=1) {
                                        #lines(B[,1],ul,lty=robust,type="s"); 
                                        #lines(B[,1],nl,lty=robust,type="s"); }
      if (hw.ci>=1) {
        if (signi!=0.05) cat("Hall-Wellner band only 95% \n"); 
        tau<-length(B[,1])
        nl<-B[,v]-prop.excess.object$quant95HW[v-1]*V[tau,v]^.5*(1+V[,v]/V[tau,v])
        ul<-B[,v]+prop.excess.object$quant95HW[v-1]*V[tau,v]^.5*(1+V[,v]/V[tau,v])
        lines(B[,1],ul,lty=hw.ci,type="s"); lines(B[,1],nl,lty=hw.ci,type="s"); }
      if (sim.ci>=1) {
        if (signi!=0.05) cat("Simulation based band only 95% \n");                                        
        V<-prop.excess.object$var.cum;                             
        nl<-B[,v]-prop.excess.object$quant95[v-1]*V[,v]^.5; 
        ul<-B[,v]+prop.excess.object$quant95[v-1]*V[,v]^.5;        
        lines(B[,1],ul,lty=sim.ci); lines(B[,1],nl,lty=sim.ci,type="s"); }

      abline(h=0)
    }
  } else {
                                        # plot score process
    dim1<-ncol(prop.excess.object$simScoreProp[[1]])
    if (sum(specific.comps)==FALSE) comp<-1:dim1 else comp<-specific.comps

    for (i in comp)
      {
        ranyl<-range(as.matrix(prop.excess.object$simScoreProp[[1]])[,i]);
        for (j in 2:51)
          ranyl<-range(c(ranyl,
                         as.matrix(prop.excess.object$simScoreProp[[j]])[,i]));
        mr<-max(abs(ranyl));

        plot(c(0,prop.excess.object$cum[,1]),
             c(0,as.matrix(prop.excess.object$simScoreProp[[1]])[,i]),type="s",
             ylim=c(-mr,mr),lwd=2,xlab=xlab,ylab="Scoreprocess")
        if (mains==TRUE) title(main=rownames(prop.excess.object$gamma)[i]); 
        for (j in 2:51)
          lines(c(0,prop.excess.object$cum[,1]),
                c(0,as.matrix(prop.excess.object$simScoreProp[[j]])[,i]),
                col="grey",lwd=1,lty=1,type="s")
        lines(c(0,prop.excess.object$cum[,1]),
              c(0,as.matrix(prop.excess.object$simScoreProp[[1]])[,i]),lwd=2,type="s")
      } }
}

"print.prop.excess" <- function (x,...) {
  prop.excess.object <- x; rm(x);
  if (!inherits(prop.excess.object, 'prop.excess')) 
    stop ("Must be a Proportional Excess Survival Model object")

  if (is.null(prop.excess.object$gamma)==TRUE) cox<-FALSE else cox<-TRUE
    
                                        # We print information about object:  
  cat("Proportional Excess Survival Model \n\n")
  cat("Additive Aalen terms: "); 
  cat(colnames(prop.excess.object$cum)[-1]);
  cat("   \n");  
  if (cox) {
    cat("Proportional terms:  "); 
    cat(rownames(prop.excess.object$gamma)); 
    cat("   \n");  }
  cat("   \n");  

  cat("  Call: ")
  dput(attr(prop.excess.object, "Call"))
  cat("\n")
}


"summary.prop.excess" <-
function (object,digits=3,...) 
{
    prop.excess.object <- object; rm(object);
  obj<-prop.excess.object
  if (!inherits(prop.excess.object, 'prop.excess')) 
    stop ("Must be a Proportional Excess Survival Model object")
  
  cox<-TRUE; 
  if (is.null(prop.excess.object$gamma)==TRUE) stop(" No proportional  terms"); 
    
                                        # We print information about object:  
  cat("Proportional Excess Survival Model \n\n")

                                        #if (sum(obj$conf.band)==FALSE)  mtest<-FALSE else mtest<-TRUE; 
                                        #if (mtest==FALSE) cat("Test not computed, sim=0 \n\n")
                                        #if (mtest==TRUE) { 
  test0<-cbind(obj$pval.HW,obj$pval.CM)
                                        # testC<-cbind(obj$obs.testBeqC,obj$pval.testBeqC) 
  colnames(test0)<- c("KS-test pval",
                      "CM-test pval")
  rownames(test0)<-colnames(prop.excess.object$cum)[-1]
                                        #rownames(test0)<- c("","p-value")
                                        #colnames(testC)<- c("sup| B(t) - (t/tau)B(tau)|","p-value H_0: B(t)=b t")  
  cat("Test for non-significant effects \n");cat("   \n");
  cat("Test for Aalen terms, H_0: B(t)=0  \n")
  prmatrix(signif(test0,digits));cat("   \n");  
                                        #cat("Test for time invariant effects \n")
                                        #prmatrix(signif(testC,digits))
                                        #cat("\n")
                                        #}

  if (cox) {
    cat("Proportional terms:  \n"); 

    res <- cbind(obj$gamma,
                 diag(obj$var.gamma)^.5) #,diag(obj$robvar.gamma)^.5,diag(obj$D2linv)^.5)
    z<-c((res[,1]/res[,2]))
    pval<-1-pchisq(z^2,1)
    res<-as.matrix(cbind(res,z,pval)); 
    colnames(res) <- c("coef", "se(coef)","z","p")
                                        #,#Robust Std.  Error","D2log(L)^-(1/2)")  
    prmatrix(signif(res, digits)); cat("   \n");  
  }

  cat("  Call: ")
  dput(attr(obj, "Call"))
  cat("\n")
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/new.timecox.r"
const<-function(x) x

timecox<-function(formula=formula(data),data=sys.parent(),
start.time=0,max.time=NULL,id=NULL,clusters=NULL,
n.sim=1000,residuals=0,robust=1,Nit=20,bandwidth=0.5,
method="basic",weighted.test=0,degree=1,covariance=0)
{
  sim2<-0; if (n.sim==0) sim<-0 else sim<-1;
  if (method!="basic") stop("Only runs the default method at the moment\n"); 

                                        #if (resample.iid==1 & robust==0) {
                                        #cat("When robust=0 no iid representaion computed\n"); 
                                        #resample.iid<-0;}
  if (covariance==1 & robust==0) {
    cat("When robust=0 no covariance computed \n"); 
    cat("covariance set to 0\n"); 
    covariance<-0;}
  if (sim==1 & robust==0) {
    cat("When robust=0, No simulations \n"); 
    cat("n.sim set to 0\n"); 
    n.sim<-0;}
  if (residuals==1 & robust==0) {
    cat("When robust=0, no martingale residuals \n"); 
    cat("residuals set to 0\n"); 
    residuals<-0;}
  if (n.sim>0 & n.sim<50) {n.sim<-50 ; cat("Minimum 50 simulations\n");}

  call <- match.call()
  m <- match.call(expand=FALSE)
  m$robust<-m$start.time<-m$degree<-m$weighted.test<-
    m$method<-m$Nit<-m$bandwidth<-m$max.time<-m$pers<-
      m$residuals<-m$n.sim<-m$id<-m$covariance<-NULL

  special <- c("const","cluster")
  Terms <- if(missing(data)) terms(formula, special)
  else              terms(formula, special, data=data)
  m$formula <- Terms
  m[[1]] <- as.name("model.frame")
  m <- eval(m, sys.parent())
  mt <- attr(m, "terms")
  intercept<-attr(mt, "intercept")
  Y <- model.extract(m, "response")
  if (!inherits(Y, "Surv")) 
    stop("Response must be a survival object")

  des<-read.design(m,Terms)
  X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
  covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ

  if(is.null(clusters)) clusters <- des$clusters  
  
  if (is.null(Z)==TRUE) XZ<-X else XZ<-cbind(X,Z); 

  if (method=="breslow" && intercept==1) { 
    covnamesX<-covnamesX[-1]; X<-as.matrix(X[,-1]); XZ<-as.matrix(XZ[,-1]); 
    colnames(X)<-covnamesX; px<-px-1;}
  pxz <- px + pz;

  survs<-read.surv(m,id,npar,clusters,start.time,max.time,model="timecox")
  times<-survs$times;id<-id.call<-survs$id.cal;
  clusters<-cluster.call<-survs$clusters; 
  time2<-survs$stop; time<-survs$start
  status<-survs$status; Ntimes<-sum(status); 
  ldata<-list(start=survs$start,stop=survs$stop,
              antpers=survs$antpers,antclust=survs$antclust);

  times<-c(start.time,time2[status==1]); times<-sort(times);
  Ntimes <- Ntimes+1; 
  if (is.null(max.time)==TRUE) maxtimes<-max(times)+0.1 else maxtimes<-max.time; 
  times<-times[times<maxtimes];
  bandwidth<-(maxtimes-start.time)*bandwidth; 


  if (method=="breslow") 
    beta<-coxph(Surv(time,time2,status)~XZ)$coef
  else if (method=="basic" && intercept==1) 
    beta<-coxph(Surv(time,time2,status)~XZ[,-1])$coef
  else beta<-coxph(Surv(time,time2,status)~XZ)$coef;
  beta0<-c(0,0,beta)  
  if (method=="basic" && intercept==0)  beta0<-c(0,beta); 
  bhat<-matrix(beta0,length(times)-1,length(beta0),byrow=TRUE); 
  timerange<-range(times); 
  bhat[,1]<-times[-1]; 
  if (method=="breslow" || intercept==1) {
    bhat[,2]<-sum(status)/sum(ldata$stop-ldata$start);
    if (method=="basic") bhat[,2]<-log(bhat[,2]); 
  }

  if (npar==TRUE) {
                                        #cat("Nonparametric Multiplicative Hazard Model"); cat("\n");
    ud<-timecoxBase(times,ldata,X,status,id,bhat,
                    sim=sim,antsim=n.sim,degree=degree,robust=robust,
                    band=bandwidth,it=Nit,method=method,retur=residuals,sim2=sim2,
                    weighted.test=weighted.test,covariance=covariance);

    if (method=="breslow") covnamesX<-c("Cumulative Baseline",covnamesX); 
    colnames(ud$cum)<-colnames(ud$var.cum)<-c("time",covnamesX)
    if (robust==1) colnames(ud$robvar.cum)<-c("time",covnamesX)

    if (sim==1) {
                                        #if (method=="breslow") covnamesX<-covnamesX[-1]; 
      colnames(ud$test.procBeqC)<- c("time",covnamesX)
      names(ud$conf.band)<-names(ud$pval.testBeq0)<- 
        names(ud$pval.testBeqC)<- names(ud$pval.testBeqC.is)<- 
          names(ud$obs.testBeqC.is)<- 
            names(ud$obs.testBeq0)<- names(ud$obs.testBeqC)<- covnamesX; 
      colnames(ud$sim.testBeq0)<- colnames(ud$sim.testBeqC)<- 
        colnames(ud$sim.testBeqC.is)<- covnamesX; 
      ud$sim.testBeqC.is<-ud$sim.testBeqC<-NULL;
      if (method=="breslow" && sim2==1) 
        names(ud$pval.testBeqC.is1)<-names(ud$pval.testBeqC.is2)<-
          names(ud$obs.testBeqC.is1)<-names(ud$obs.testBeqC.is2)<- covnamesX; 
    }
  }
  else {
                                        #cat("Semiparametric Multiplicative Risk Model"); cat("\n");
    if (px==0) { stop("No nonparametric terms (needs one!)"); }

    if (method=="breslow") {
                                        #print(c(px,pxz)); 
      gamma<-bhat[1,(px+3):(pxz+2)]; bhat<-bhat[,1:(px+2)]; } 
    else {
      gamma<-bhat[1,(px+2):(pxz+1)]; bhat<-bhat[,1:(px+1)] }
                                        #print(gamma); print(bhat)
                                        #print(X[1:5,]); print(Z[1:5,]); 

    ud<-semicox(times,ldata,X,Z,
                status,id,bhat,gamma=gamma,sim=sim,antsim=n.sim,
                band=bandwidth,it=Nit,method=method,retur=residuals,robust=robust,
                degree=degree,weighted.test=weighted.test,covariance=covariance)

    if (px>0) {
      if (method=="breslow") 
        colnames(ud$cum)<- colnames(ud$var.cum)<- 
          c("time","Cumulative Baseline",covnamesX)
      else 
        colnames(ud$cum)<- colnames(ud$var.cum)<- c("time",covnamesX)
      if (robust==1) { 
        if (method=="breslow") colnames(ud$robvar.cum)<- 
          c("time","Cumulative Baseline",covnamesX) else
        colnames(ud$robvar.cum)<-c("time",covnamesX);  }
      if (sim>=1) {
        if (method=="breslow") name<-
          c("time","Cumulative Baseline",covnamesX) else name<-c("time",covnamesX)

        colnames(ud$test.procBeqC)<- name;
        names(ud$conf.band)<- names(ud$pval.testBeq0)<- 
          names(ud$pval.testBeqC)<- 
            names(ud$pval.testBeqC.is)<- names(ud$obs.testBeqC.is)<- 
              names(ud$obs.testBeq0)<- names(ud$obs.testBeqC)<- 
                colnames(ud$sim.testBeq0)<- colnames(ud$sim.testBeqC.is)<- 
                  colnames(ud$sim.testBeqC)<- name[-1]; 
        ud$sim.testBeqC.is<-ud$sim.testBeqC<-NULL;
      }
    }

    rownames(ud$gamma)<-c(covnamesZ); 
    colnames(ud$gamma)<-"estimate"; 
    colnames(ud$var.gamma)<-c(covnamesZ); 
    rownames(ud$var.gamma)<-c(covnamesZ); 
    colnames(ud$robvar.gamma)<-c(covnamesZ); 
    rownames(ud$var.gamma)<-c(covnamesZ); 
  }

  ud$method<-method
  attr(ud,"Call")<-sys.call(); 
  class(ud)<-"timecox"
  attr(ud,"Formula")<-formula;
  attr(ud,"id")<-id.call;
  attr(ud,"cluster")<-cluster.call;
  attr(ud,"start")<-start.time;
  attr(ud,"time2")<-time2;
  ud$call<-call

  return(ud); 
}


"plot.timecox" <-  function (x,..., pointwise.ci=1,
hw.ci=0, sim.ci=0, robust=0, specific.comps=FALSE,level=0.05,
start.time = 0,
stop.time = 0, add.to.plot=FALSE, mains=TRUE, xlab="Time",
ylab ="Cumulative coefficients",score=FALSE)
{
  object <- x; rm(x);
  if (!inherits(object,'timecox') ) stop ("Must be output
from Cox-Aalen function")

  if (score==FALSE) plot.cums(object,
        pointwise.ci=pointwise.ci,
        hw.ci=hw.ci,
        sim.ci=sim.ci, robust=robust,
        specific.comps=specific.comps,level=level,
        start.time = start.time, stop.time = stop.time,
        add.to.plot=add.to.plot,
        mains=mains, xlab=xlab, ylab =ylab)
  else plot.score(object, specific.comps=specific.comps,
                  mains=mains,
                  xlab=xlab,ylab =ylab);
}

"print.timecox"<-
function (x,...) 
{
  timecox.object <- x; rm(x);
  if (!inherits(timecox.object, 'timecox')) 
    stop ("Must be an timecox.object")

if (is.null(timecox.object$gamma)==TRUE) semi<-FALSE else semi<-TRUE
    
  # We print information about object:  
  cat("Multiplicative Hazard Model \n\n")
  cat(" Nonparametric terms : "); cat(colnames(timecox.object$cum)[-1]);
  cat("   \n");  
  if (semi) {
  cat(" Parametric terms :  "); cat(rownames(timecox.object$gamma)); 
  cat("   \n");  }
  cat("   \n");  

  cat("  Call: \n")
  dput(attr(timecox.object, "Call"))
  cat("\n")
}


"summary.timecox" <-
function (object,..., digits = 3) 
{
  timecox.object <- object; rm(object);
  obj<-timecox.object
  if (!inherits(timecox.object, 'timecox')) 
    stop ("Must be an timecox.object")
  
  if (is.null(timecox.object$gamma)==TRUE) semi<-FALSE else semi<-TRUE
    
                                        # We print information about object:  
  cat("Multiplicative Hazard Model \n\n")

  timetest(obj,digits=digits); 

  if (obj$method=="breslow" && (!semi) && (obj$obs.testBeqC.is1!=FALSE)) {
    testsupBL<-cbind(obj$obs.testBeqC.is1,obj$pval.testBeqC.is1)
    testssBL<-cbind(obj$obs.testBeqC.is2,obj$pval.testBeqC.is2)
    cat("Tests without baseline correction\n")
    cat("BL(t) = int_0^t lambda_0(t) b(t) dt, L(t) = int_0^t lambda_0(t) dt \n")
    colnames(testsupBL)<-c("sup| BL(t) - (t/tau)B(tau) L(t)|","p-value H_0: B(t)=b t")  
    colnames(testssBL)<-c("int (BL(t)-(t/tau)B(tau) L(t))^2dt","p-value H_0: B(t)=b t")
    prmatrix(signif(testsupBL,digits))
    prmatrix(signif(testssBL,digits)) }


  if (semi) {
    cat("Parametric terms :  "); #cat(rownames(timecox.object$gamma)); 
  }
  cat("   \n");  

  if (semi) { coef.timecox(timecox.object,digits=digits); }
  cat("   \n");  

  cat("  Call: \n")
  dput(attr(timecox.object, "Call"))
  cat("\n")
}

coef.timecox<- function(object,..., digits=3) {
   coefBase(object,digits=digits)
}

#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/plots.r"
plot.cums <-  function (x , pointwise.ci=1, hw.ci=0,
sim.ci=0, robust=0, specific.comps=FALSE,level=0.05, start.time = 0, 
stop.time = 0, add.to.plot=FALSE, mains=TRUE, xlab="Time",
ylab ="Cumulative coefficients",...) 
{
 object<-x; rm(x); 
 B<-object$cum; V<-object$var.cum; p<-dim(B)[[2]]; 
 if (robust>=1) {V<-object$robvar.cum;}

 if (sum(specific.comps)==FALSE) comp<-2:p else comp<-specific.comps+1
 if (stop.time==0) stop.time<-max(B[,1]);

 med<-B[,1]<=stop.time & B[,1]>=start.time
 B<-B[med,]; Bs<-B[1,];  B<-t(t(B)-Bs); B[,1]<-B[,1]+Bs[1];
 V<-V[med,]; Vs<-V[1,]; V<-t( t(V)-Vs); 
 Vrob<-object$robvar.cum; 
 Vrob<-Vrob[med,]; Vrobs<-Vrob[1,]; Vrob<-t( t(Vrob)-Vrobs); 

 c.alpha<- qnorm(1-level/2)
 for (v in comp) { 
 c.alpha<- qnorm(1-level/2)
 est<-B[,v];ul<-B[,v]+c.alpha*V[,v]^.5;nl<-B[,v]-c.alpha*V[,v]^.5;
 if (add.to.plot==FALSE) 
 {
 plot(B[,1],est,ylim=1.05*range(ul,nl),type="s",xlab=xlab,ylab=ylab) 
 if (mains==TRUE) title(main=colnames(B)[v]); }
 else lines(B[,1],est,type="s"); 
 if (pointwise.ci>=1) {
 lines(B[,1],ul,lty=pointwise.ci,type="s");
 lines(B[,1],nl,lty=pointwise.ci,type="s"); }
 if (robust>=1) {
 lines(B[,1],ul,lty=robust,type="s"); 
 lines(B[,1],nl,lty=robust,type="s"); }
 if (hw.ci>=1) {
 if (level!=0.05) cat("Hall-Wellner bands only 95 % \n");
 tau<-length(B[,1])
 nl<-B[,v]-1.13*V[tau,v]^.5*(1+V[,v]/V[tau,v])
 ul<-B[,v]+1.13*V[tau,v]^.5*(1+V[,v]/V[tau,v])
 lines(B[,1],ul,lty=hw.ci,type="s"); 
 lines(B[,1],nl,lty=hw.ci,type="s"); }
 if (sim.ci>=1) {
 if (is.null(object$conf.band)==TRUE) 
 cat("Uniform simulation based bands only computed for n.sim> 0\n")
 if (level!=0.05) c.alpha<-percen(object$sim.testBeq0[,v-1],1-level)
 else c.alpha<-object$conf.band[v-1];
 nl<-B[,v]-c.alpha*Vrob[,v]^.5; ul<-B[,v]+c.alpha*Vrob[,v]^.5;
 lines(B[,1],ul,lty=sim.ci,type="s"); 
 lines(B[,1],nl,lty=sim.ci,type="s"); }
 abline(h=0)
 }
}

plot.score<-function (object, 
specific.comps=FALSE,mains=TRUE, xlab="Time",
ylab ="Cumulative coefficients") 
{
if (ylab=="Cumulative regression function") ylab<-"Test process";

if (class(object)=="cox.aalen") {
            obsProc<-object$test.procProp; 
            simProc<-object$sim.test.procProp; }
else {      obsProc<-object$test.procBeqC; 
            simProc<-object$sim.test.procBeq; }

dim1<-ncol(obsProc)
if (sum(specific.comps)==FALSE) comp<-2:dim1 else comp<-specific.comps+1

for (i in comp) {
ranyl<-range(obsProc[,i]);
for (j in 1:50)
ranyl<-range(c(ranyl,as.matrix(simProc[[j]])[,i-1]));
mr<-max(abs(ranyl)); 

plot(obsProc[,1],obsProc[,i],ylim=c(-mr,mr),
     lwd=2,xlab=xlab,ylab=ylab,type="s")
if (mains==TRUE) title(main=colnames(obsProc)[i]); 
for (j in 1:50)
lines(obsProc[,1],as.matrix(simProc[[j]])[,i-1],
col="grey",lwd=1,lty=1,type="s")
lines(obsProc[,1],obsProc[,i],lwd=2,type="s")
} 
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/pls.cv.r"
pls.surv.cv<-function(formula=formula(data),data=sys.parent(),
K = 10,start.time=0,max.time=NULL,id=NULL,
pls.dims = seq(from = 0, to = 5, by = 1), 
trace = FALSE, plot.it = FALSE , se = TRUE, silent=1,
    ...) 
{ ## {{{
## {{{ reads design and survival times
    call <- match.call()
    m <- match.call(expand = FALSE)
    m$start.time <- m$max.time <-  m$id <-
    m$K<-m$pls.dims<-m$trace<-m$plot.it<-m$se<- m$silent<- NULL
    special <- c("const")
    Terms <- if (missing(data)) terms(formula, special)
    else terms(formula, special, data = data)
    m$formula <- Terms
    m[[1]] <- as.name("model.frame")
    m <- eval(m, sys.parent())
    mt <- attr(m, "terms")
    intercept <- attr(mt, "intercept")
    Y <- model.extract(m, "response")
    if (!inherits(Y, "Surv")) stop("Response must be a survival object")

   des<-read.design(m,Terms)
   X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
   covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ
   clusters <- NULL
   pxz <- px + pz; 
   Yorig<-X[,1]
   X<-X[,-1]

   survs<-read.surv(m,id,npar,clusters,start.time,max.time)
   times<-survs$times;id<-id.call<-survs$id.cal;
   time2<-survs$stop
   status<-survs$status;
## }}}

    antpers = nrow(X); 
    all.folds <- cv.folds(antpers, K)
    residmat <- matrix(0, length(pls.dims), K)

    for (i in seq(K)) {
        omit <- all.folds[[i]]
        Xl<-X[-omit,]; Zl<-Z[-omit,]; 
        datal=data.frame(tt=time2[-omit],status=status[-omit])
        nn<-antpers-length(omit); 
        Xo<-X[omit,]; Zo<-Z[omit,]; 
        datao=data.frame(tt=time2[omit],status=status[omit])
        nno<- length(omit); 
        if (npar==TRUE) 
        outo<-additive.compSs(Surv(tt,status)~const(Xo),data=datao,
            max.time=max.time,start.time=start.time,silent=silent)
        else 
        outo<-additive.compSs(Surv(tt,status)~-1+Xo+const(Zo),data=datao,
            max.time=max.time,start.time=start.time,silent=silent)
        #print(outo$intZHZ); print(outo$intZHdN)
        pfit<-c()
        for (j in pls.dims)
        {
        if (npar==TRUE) 
        out<-additive.pls(Surv(tt,status)~Xl,data=datal,pls.dim=j,
            max.time=max.time,start.time=start.time,silent=silent)
        else out<-additive.pls(Surv(tt,status)~Xl+const(Zl),data=datal,pls.dim=j,
            max.time=max.time,start.time=start.time,silent=silent)
        betas<-matrix(out$tbeta.pls,nrow=1)
        #print(betas)

        fit<- apply(betas,1,function(x)  x %*% outo$intZHZ %*% x) 
        fit<- drop(fit - 2 *betas %*% outo$intZHdN )
        pfit<-c(pfit,fit)
        }
        if (length(omit) == 1) 
            fit <- matrix(pfit, nrow = 1)
        residmat[, i] <- pfit
        if (trace) 
            cat("\n CV Fold", i, "\n\n")
    }
    cv <- apply(residmat, 1, mean)
    cv.error <- sqrt(apply(residmat, 1, var)/K)
    object <- list(pls.dims = pls.dims, cv = cv, cv.error = cv.error, 
        cv.dim = pls.dims[order(cv)][1])
    if (plot.it) plot(pls.dims,cv,type="l")
    invisible(object)
} ## }}}

cv.folds<- function (n, folds = 10) 
{
    split(sample(1:n), rep(1:folds, length = n))
}

#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/predict-timereg.r"
slaaop<-function(z,time,cum)
{x<-time; y<-cum; index<-sum(x<=z);if (index==0) index<-1;
retur<-y[index]; return(retur); }

pred.cum<-function(x,time,cum) {ud<-sapply(x,slaaop,time,cum); 
 return(ud)}

"pred.des"<-function(formula,data=sys.parent())
{ ## {{{
  call <- match.call();
  m <- match.call(expand=FALSE);
  special <- c("const")
  Terms <- if(missing(data)) terms(formula, special)
           else          terms(formula, special,data=data)
  m$formula <- Terms
  m[[1]] <- as.name("model.frame")
  m <- eval(m, data)
  mt <- attr(m, "terms")

  XZ<-model.matrix(Terms,m)[,drop = FALSE]
  cols<-attributes(XZ)$assign
  l.cols<-length(cols)
  semicov <- attr(Terms, "specials")$const
  ZtermsXZ<-semicov-1

  if (length(semicov)) {renaalen<-FALSE; Zterms<-c();
  for (i in ZtermsXZ) Zterms<-c(Zterms,(1:l.cols)[cols==i]);
   } else {renaalen<-TRUE;}

 if (length(semicov)) {
  X<-as.matrix(XZ[,-Zterms]);
  #covnamesX <- dimnames(XZ)[[2]][-Zterms]; dimnames(X)[[2]]<-covnamesX;
  Z<-as.matrix(XZ[,Zterms]);
  #covnamesZ <- dimnames(XZ)[[2]][Zterms];dimnames(Z)[[2]]<-covnamesZ;          
 }
  else {X<-as.matrix(XZ); #covnamesX <- dimnames(XZ)[[2]];
        Z<-FALSE; #dimnames(X)[[2]]<-covnamesX; 
  }
  X <- data.matrix(X); 
  return(list(covarX=X,covarZ=Z))
} ## }}}

predict.aalen <-  function(object,...){

  predict.comprisk(object,...)

}

predict.cox.aalen <-  function(object,...){

  predict.comprisk(object,...)

}


predict.comprisk<-function(object,newdata=NULL,X=NULL,
                           Z=NULL,n.sim=500, uniform=TRUE,
                           se=TRUE,alpha=0.05,...){
## {{{
  if (!(inherits(object,'comprisk') || inherits(object,'aalen')
        || inherits(object,'cox.aalen')))
    stop ("Must be output from comp.risk function")

  if (is.null(object$B.iid)==TRUE & se==TRUE) {
    stop("resample processes necessary for these computations, set resample.iid=1");
  }
  if (is.null(object$gamma)==TRUE) {
    semi<-FALSE
  } else {
    semi<-TRUE
  }

  ## cox.aalen uses prop(...), while aalen and comp.risk use const(...)
  ## this accounts for the different number of characters
  if(inherits(object,'cox.aalen')){
    indexOfFirstChar <- 6;
  } else {
    indexOfFirstChar <- 7;
  }
  
  constant.covs <- NULL
  if (!is.null(newdata)) {
    ##  The time-constant effects first
    if (semi==TRUE) {
      const <- c(object$gamma)
      names(const) <-substr(dimnames(object$gamma)[[1]],indexOfFirstChar,
                            nchar(dimnames(object$gamma)[[1]])-1)
      constant.covs <- newdata[,names(const)]
      constant.covs<-as.matrix(constant.covs); 
    }

    ## Then extract the time-varying effects
    time.coef <- data.frame(object$cum)
    ntime <- nrow(time.coef)
    fittime <- time.coef[,1,drop=TRUE]
    ntimevars <- ncol(time.coef)-2
    time.vars <- cbind(1,newdata[,names(time.coef)[-(1:2)],drop=FALSE])
    nobs <- nrow(newdata)
  } else if ((is.null(Z)==FALSE) || (is.null(X)==FALSE)){

    if(is.null(Z) || is.matrix(Z) || is.data.frame(Z)){
      constant.covs<-Z;
    } else {
      constant.covs<-matrix(Z,ncol = nrow(object$gamma));
    }

  if ((is.null(Z)==FALSE) && is.null(X))
  {
   if (ncol(object$cum)==2) X<-time.vars<-matrix(1,nrow(Z),1) else
   stop("When X is not specified we assume that it an intercept terms\n");
  }
      
    ## Allow for the possibility that X is a vector 
    if(!is.matrix(X) && !is.data.frame(X)){
      time.vars<-matrix(X,ncol = ncol(object$cum)-1);
    } else {
      time.vars<-X;
    }
    nobs<-nrow(time.vars);
    ## extract the time-varying effects
    time.coef <- data.frame(object$cum)
    ntime <- nrow(time.coef)
  } else {
    stop("Must specify either newdata or X, Z\n");
  }

  if (semi==TRUE) {
    constant.part <- constant.covs %*% object$gamma
  }
  
  if(inherits(object,'aalen')) {
    modelType <- 'aalen';
  } else if(inherits(object,'comprisk')) {
    modelType <- object$model;
  } else if(inherits(object,'cox.aalen')) {
    modelType <- 'cox.aalen';
  }
  n <- length(object$B.iid) ## Number of clusters (or number of individuals
                            ## if no cluster structure is specified)

  cumhaz<-as.matrix(time.vars) %*% t(time.coef[,-1])
  
  time<-time.coef[,1];
  nt<-length(time);
  if (modelType == "additive") {
    if (semi==FALSE){
      P1=1-exp(-cumhaz);
    } else {
      P1=1-exp(-cumhaz-constant.part %*% time)
    }
    RR<-NULL; 
  } else if (modelType == '1-additive') { # P1=exp(-x^T b(t) - z^t gamma) 
      if (semi==FALSE){
         P1=exp(-cumhaz);
       } else {
         P1<-exp(-cumhaz-matrix(constant.part,nobs,nt));
       }
       RR<-1;
  } else if (modelType == 'prop') {     #model proportional 
    if (semi==FALSE){
      RR<-exp(cumhaz);
    } else {
      RR<-exp(cumhaz+matrix(constant.part,nobs,nt));
    }
    P1<-1-exp(-RR);
  } else if (modelType == 'logistic') { #model logistic
    if (semi==FALSE){
      RR<-exp(cumhaz);
    } else {
      RR<-exp(cumhaz+matrix(constant.part,nobs,nt));
    }
    P1<-RR/(1+RR);
  } else if (modelType == "aalen") {    #Aalen model
    if (semi==FALSE){
      S0=exp(-cumhaz);
    } else {
      S0=exp(-cumhaz-constant.part %*% time)
    }
    RR<-NULL; 
  } else if(modelType == 'cox.aalen'){  #Cox-Aalen model
    if(semi == FALSE){
      RR <- NULL;
      S0 <- exp(-cumhaz);
    } else {
      RR <- exp(matrix(constant.part,nobs,nt));
      S0 <- exp(-cumhaz * RR);
    }
  }

  se.P1 <- NULL
  se.S0 <- NULL
  ## i.i.d decomposition for computation of standard errors 
  if (se==1) {
    pg<-length(object$gamma); 
    delta<-c();
    for (i in 1:n) {
      tmp<- as.matrix(time.vars) %*% t(object$B.iid[[i]]) 
      if (semi==TRUE) {
        gammai <- matrix(object$gamma.iid[i,],pg,1); 
        tmp.const <- constant.covs %*% gammai;
      }

      if (i==0) {
        print(tmp.const);
        if (modelType=="additive" || modelType == 'aalen'){ 
          print(tmp.const %*% matrix(time,1,nt))
        } else if (modelType=="prop"){
          print(tmp.const %*% matrix(1,1,nt));
        } else if (modelType=="cox.aalen") {
          tmp <- RR * tmp + RR * cumhaz * matrix(tmp.const,nobs,nt);
        }
      }

      if (semi==TRUE){
        if(modelType=="additive" || modelType == "aalen") {
           # || modelType=="1-additive") {
          tmp<-tmp+tmp.const %*% matrix(time,1,nt)
        } else if (modelType=="prop" || modelType=="1-additive") {
          tmp<-RR*tmp+RR*matrix(tmp.const,nobs,nt);
	  ## modification of jeremy's code RR
        } else if (modelType=="cox.aalen") {
          tmp <- RR * tmp + RR * cumhaz * matrix(tmp.const,nobs,nt);
        }
      }
      delta<-cbind(delta,c(tmp)); 
    }
    se<-apply(delta^2,1,sum)^.5
    if(modelType == 'additive' || modelType == 'prop'){
      se.P1<-matrix(se,nobs,nt)*(1-P1) 
    } 
    else if(modelType == '1-additive'){
      se.P1<-matrix(se,nobs,nt)*(P1) 
    } 
    else if (modelType == 'logistic'){
      se.P1<-matrix(se,nobs,nt)*P1/(1+RR)
    } 
    else if (modelType == 'aalen' || modelType == 'cox.aalen'){
      se.S0<-matrix(se,nobs,nt)*S0
    }

    ### uniform confidence bands, based on resampling 
    if (uniform==1) {

      mpt <- .C('confBandBasePredict',
                delta = as.double(delta),
                nObs = as.integer(nobs),
                nt = as.integer(nt),
                n = as.integer(n),
                se = as.double(se),
                mpt = double(n.sim*nobs),
                nSims = as.integer(n.sim),
		PACKAGE="timereg")$mpt;
  
      mpt <- matrix(mpt,n.sim,nobs,byrow = TRUE);
      uband <- apply(mpt,2,percen,per=1-alpha);
    } else uband<-NULL; 
  } else {
    uband<-NULL;
  }

  if(modelType == 'additive' || modelType == 'prop' || modelType=="logistic"
     || modelType=='1-additive'){
    P1<-matrix(P1,nrow=nobs);
  } else if (modelType == 'aalen' || modelType == 'cox.aalen'){
    S0<-matrix(S0,nrow=nobs);
  }

  out<-list(time=time,unif.band=uband,model=modelType,alpha=alpha,
            newdata=list(X = time.vars, Z = constant.covs),RR=RR,
            call=sys.calls()[[1]], initial.call = attr(object,'Call'));
  if(modelType == 'additive' || modelType == 'prop' || modelType=="logistic"
     || modelType=='1-additive'){
    out$P1 <- P1;
    out$se.P1 <- se.P1;    
  } else if (modelType == 'aalen' || modelType == 'cox.aalen'){
    out$S0 <- S0;
    out$se.S0 <- se.S0;    
  }
   # e.g. for an compound risk model, className = predictComprisk
  className <- switch(class(object),aalen='predictAalen',cox.aalen='predictCoxAalen',comprisk='predictComprisk')
  class(out) <- className

  return(out)
} ## }}}


plot.predictAalen <-  function(x,...){

  plot.predictComprisk(x,...)

}

plot.predictCoxAalen <-  function(x,...){

  plot.predictComprisk(x,...)

}


pava = function(x, w=rep(1,length(x)))  # R interface to the compiled code
{ ## {{{
  n = length(x)
  if (n != length(w)) return (0)    # error
  result  = .C("pava",
        y = as.double(x),
        as.double(w),
        as.integer(n) )
  result[["y"]]
} ## }}}


plot.predictComprisk<-function(x,uniform=1,new=1,se=1,col=1,lty=1,lwd=2,multiple=0,specific.comps=0,
xlab="Time",ylab="Probability",transparency=FALSE,monotone=TRUE,...){
## {{{
  object <- x; rm(x);
  modelType <- object$model;
  time<-object$time;
  uband<-object$unif.band;
  nobs<-nrow(object$newdata$X);
  RR<-object$RR;
  alpha <- object$alpha;
  ### Here we use mainLine as the central line (between confidence
  ### intervals or bands), so that we don't have to distinguish
  ### between the case when we want to plot a predicted survival function
  ### and the case when we want to plot a predicted risk funcion
  
  if (modelType == 'aalen' || modelType == 'cox.aalen'){
    type<-"surv"
    mainLine <- object$S0;
    if (monotone==TRUE) { mainLine<--t(apply(as.matrix(-mainLine),1,pava)); 
    mainLine[mainLine<0]<-0; 
    mainLine[mainLine>1]<-1; 
    }
    mainLine.se <- object$se.S0;    
  } else if(modelType == 'additive' || modelType == 'prop' || modelType=="logistic" || modelType=="1-additive"){
    type<-"cif"
    mainLine <- object$P1;
    if (monotone==TRUE) { mainLine<-t(apply(as.matrix(mainLine),1,pava)); 
                           mainLine[mainLine<0]<-0; 
                           mainLine[mainLine>1]<-1; 
    }
    mainLine.se <- object$se.P1;    
  }
  
  if (length(col)!=nobs){
    col<-rep(col[1],nobs);
  }
  if (length(lty)!=nobs){
    lty<-rep(lty[1],nobs); 

  }
  if (length(lwd)!=nobs){
    lwd<-rep(lwd[1],nobs); 
  }
  if (sum(specific.comps)==0){
    comps<-1:nobs
  } else {
    comps<-specific.comps
  }

  for (i in comps) {
    if (new==1 & (multiple!=1 | i==comps[1])) {
      plot(time,mainLine[i,],type="s",ylim=c(0,1),xlab=xlab,ylab=ylab,col=col[i],lty=lty[i],lwd=lwd[i],...)
    } else {
      lines(time,mainLine[i,],type="s",col=col[i],lty=lty[i],lwd=lwd[i])
    }

    if (se==1 & is.null(mainLine.se)==FALSE ) {
      lower<-mainLine[i,]-qnorm(1-alpha/2)*mainLine.se[i,]
      upper<-mainLine[i,]+qnorm(1-alpha/2)*mainLine.se[i,]
       if (monotone==TRUE) { 
       if (type=="cif") { lower<- pava(lower); upper<- pava(upper); }
       if (type=="surv") { lower<- -pava(-lower); upper<- -pava(-upper); }
        lower[lower<0]<-0; lower[lower>1]<-1; 
        upper[upper<0]<-0; upper[upper>1]<-1; 
       }

      lines(time,lower,type="s",col=col[i],lty=3,lwd=lwd[i]/2);
      lines(time,upper,type="s",col=col[i],lty=3,lwd=lwd[i]/2);
    }

    if (uniform==1 & is.null(uband)==FALSE ) {
      #if (level!=0.05) c.alpha<-percen(object$sim.test[,i],1-level)
      #else c.alpha<-object$conf.band.cumz[i];
      c.alpha=uband[i]; 
      upper<-mainLine[i,]-uband[i]*mainLine.se[i,];
      lower<-mainLine[i,]+uband[i]*mainLine.se[i,];
       if (monotone==TRUE) { 
          if (type=="cif") { lower<- pava(lower); upper<- pava(upper); }
          if (type=="surv") { lower<- -pava(-lower); upper<- -pava(-upper); }
          lower[lower<0]<-0; lower[lower>1]<-1; 
          upper[upper<0]<-0; upper[upper>1]<-1; 
       }
      if (transparency==0 || transparency==2) {
      lines(time,upper,type="s",col=col[i],lty=2,lwd=lwd[i]/2);
      lines(time,lower,type="s",col=col[i],lty=2,lwd=lwd[i]/2);
      }

    ## Prediction polygons bandds ## {{{
    if (transparency>=1) {
     col.alpha<-0.2
     col.ci<-"darkblue"
     col.ci<-col[i]; 
     lty.ci<-2
      if (col.alpha==0) col.trans <- col.ci
      else
      col.trans <- sapply(col.ci, FUN=function(x) do.call(rgb,as.list(c(col2rgb(x)/255,col.alpha))))

      #print(t); print(ci)
      n<-length(time)
      tt<-seq(time[1],time[n],length=n*10); 
      ud<-Cpred(cbind(time,upper,lower),tt)[,2:3]
      tt <- c(tt, rev(tt))
      yy <- c(upper, rev(lower))
#      tt <- c(time, rev(time))
#      yy <- c(upper, rev(lower))
     yy <- c(ud[,1], rev(ud[,2]))
      polygon(tt,yy, col=col.trans, lty=0)      
  } ## }}}

    }
  }
} ## }}}



print.predictAalen <- function(x,...){

  print.predictComprisk(x,...)
  
}

print.predictCoxAalen <- function(x,...){

  print.predictComprisk(x,...)
  
}

print.predictComprisk <- function(x,...){

  object <- x; rm(x);
  
  if(!(inherits(object,'predictAalen') ||
       inherits(object,'predictCoxAalen') ||
       inherits(object,'predictComprisk'))){
    stop('Wrong class of object');
  }

  if (is.null(object$newdata$Z)==TRUE) semi<-FALSE else semi<-TRUE
  
  modelType <- object$model;
  modelAnnouncement <- ' Predicted survival for'
  addTo <- switch(modelType,
                  cox.aalen = 'a Cox-Aalen',
                  aalen = 'an Aalen',
                  prop = 'a proportional competing risks',
                  additive = 'an additive competing risks')
  modelAnnouncement <- paste(modelAnnouncement,addTo,'model',sep = ' ')
  cat(modelAnnouncement,fill=TRUE)

  cat(" Nonparametric terms : "); cat(colnames(object$newdata$X)[-1]); cat("   \n");  
  if (semi == TRUE) {
    cat(" Parametric terms :  "); cat(rownames(object$newdata$Z)); 
    cat("   \n");  } 
  cat("   \n");  
  
  call <- object$call;
  cat('Call to predict:',fill=TRUE);
  print(call)
  call <- object$initial.call;
  cat('Initial call:',fill=TRUE);
  print(call)
    
}

summary.predictAalen <- function(object,...){

  summary.predictComprisk(object,...)
  
}

summary.predictCoxAalen <- function(object,...){

  summary.predictComprisk(object,...)
  
}

summary.predictComprisk <- function(object,...){

  if(!(inherits(object,'predictAalen') ||
       inherits(object,'predictCoxAalen') ||
       inherits(object,'predictComprisk'))){
    stop('Wrong class of object');
  }

  modelClass <- class(object)
  modelType <- object$model;
  time<-object$time;
  uband<-object$unif.band;
  nobs<-nrow(object$newdata$X);
  RR<-object$RR;
  alpha <- object$alpha;
  call <- object$call;
  if (modelType == 'aalen' || modelType == 'cox.aalen'){
    se <- object$se.S0;    
  } else if(modelType == 'additive' || modelType == 'prop'){
    se <- object$se.P1;    
  }
  
  modelAnnouncement <- 'Predicted survival for'
    addTo <- switch(modelType,
                    cox.aalen = 'a Cox-Aalen',
                    aalen = 'an Aalen',
                    prop = 'a proportional competing risks',
                    additive = 'an additive competing risks')
  modelAnnouncement <- paste(modelAnnouncement,addTo,'model',sep = ' ')
  cat(modelAnnouncement,fill=TRUE)
  timeStatement <- paste('At',length(time),'times:',paste(c(head(time),''),collapse = ', '),'...,',time[length(time)])
  cat(timeStatement,fill=TRUE)
  obsStatement <- paste('Given covariates for',nobs,'new observations');
  cat(obsStatement,fill=TRUE)
  if(is.null(se)){
    addTo <- " - not yet done";
  } else if(is.null(uband)){
    addTo <- " - only pointwise calculations have been done"
  } else {
    addTo <- " - pointwise CI and uniform confidence band available"
  }
  cat('Standard error calculations:',fill=TRUE);
  cat(addTo,fill=TRUE);
  cat('Call:',fill=TRUE);
  print(call)
  
}

plot.comprisk <-  function (x, pointwise.ci=1, hw.ci=0,
                            sim.ci=0, specific.comps=FALSE,level=0.05, start.time = 0,
                            stop.time = 0, add.to.plot=FALSE, mains=TRUE, xlab="Time",
                            ylab ="Coefficients",score=FALSE,...){
## {{{
  object <- x; rm(x);

  if (!inherits(object,'comprisk') ){
    stop ("Must be output from comp.risk function")
  }

  if (score==FALSE) {
    B<-object$cum;
    V<-object$var.cum;
    p<-dim(B)[[2]]; 

    if (sum(specific.comps)==FALSE){
      comp<-2:p
    } else {
      comp<-specific.comps+1
    }
    if (stop.time==0) {
      stop.time<-max(B[,1]);
    }

    med<-B[,1]<=stop.time & B[,1]>=start.time
    B<-B[med,];
    V<-V[med,]; 

    c.alpha<- qnorm(1-level/2)
    for (v in comp) { 
      c.alpha<- qnorm(1-level/2)
      est<-B[,v];
      ul<-B[,v]+c.alpha*V[,v]^.5;
      nl<-B[,v]-c.alpha*V[,v]^.5;
      if (add.to.plot==FALSE) {
        plot(B[,1],est,ylim=1.05*range(ul,nl),type="s",xlab=xlab,ylab=ylab) 
        if (mains==TRUE) title(main=colnames(B)[v]);
      } else {
        lines(B[,1],est,type="s");
      }
      if (pointwise.ci>=1) {
        lines(B[,1],ul,lty=pointwise.ci,type="s");
        lines(B[,1],nl,lty=pointwise.ci,type="s");
      }
      if (hw.ci>=1) {
        if (level!=0.05){
          cat("Hall-Wellner bands only 95 % \n");
        }
        tau<-length(B[,1])
        nl<-B[,v]-1.13*V[tau,v]^.5*(1+V[,v]/V[tau,v])
        ul<-B[,v]+1.13*V[tau,v]^.5*(1+V[,v]/V[tau,v])
        lines(B[,1],ul,lty=hw.ci,type="s"); 
        lines(B[,1],nl,lty=hw.ci,type="s");
      }
      if (sim.ci>=1) {
        if (is.null(object$conf.band)==TRUE){
          cat("Uniform simulation based bands only computed for n.sim> 0\n")
        }
        if (level!=0.05){
          c.alpha<-percen(object$sim.testBeq0[,v-1],1-level)
        } else {
          c.alpha<-object$conf.band[v-1];
        }
        nl<-B[,v]-c.alpha*V[,v]^.5;
        ul<-B[,v]+c.alpha*V[,v]^.5;
        lines(B[,1],ul,lty=sim.ci,type="s"); 
        lines(B[,1],nl,lty=sim.ci,type="s");
      }
      abline(h = 0)
    }
  } else {
    # plot score proces
    if (is.null(object$pval.testBeqC)==TRUE) {
      cat("Simulations not done \n"); 
      cat("To construct p-values and score processes under null n.sim>0 \n"); 
    } else {
      if (ylab=="Cumulative regression function"){ 
        ylab<-"Test process";
      }
      dim1<-ncol(object$test.procBeqC)
      if (sum(specific.comps)==FALSE){
        comp<-2:dim1
      } else {
        comp<-specific.comps+1
      }

      for (i in comp){
          ranyl<-range(object$test.procBeqC[,i]);
          for (j in 1:50){
            ranyl<-range(c(ranyl,(object$sim.test.procBeqC[[j]])[,i-1]));
          }
          mr<-max(abs(ranyl));

          plot(object$test.procBeqC[,1],
               object$test.procBeqC[,i],
               ylim=c(-mr,mr),lwd=2,xlab=xlab,ylab=ylab,type="s")
          if (mains==TRUE){
            title(main=colnames(object$test.procBeqC)[i]);
          }
          for (j in 1:50){
            lines(object$test.procBeqC[,1],
                  as.matrix(object$sim.test.procBeqC[[j]])[,i-1],col="grey",lwd=1,lty=1,type="s")
          }
          lines(object$test.procBeqC[,1],object$test.procBeqC[,i],lwd=2,type="s")
        }
    }
  }
} ## }}}


"summary.comprisk" <- function (object,digits = 3,...) {
  if (!inherits(object, 'comprisk')) stop ("Must be a comprisk object")
  
  if (is.null(object$gamma)==TRUE) semi<-FALSE else semi<-TRUE
    
  # We print information about object:  
  cat("Competing risks Model \n\n")
  
  modelType<-object$model
  #if (modelType=="additive" || modelType=="1-additive") 
  if (modelType=="additive") 
    hyp.label<-"p-value H_0: B(t)=b t" else hyp.label<-"p-value H_0: B(t)=b"
 
  if (sum(object$obs.testBeq0)==FALSE) cat("No test for non-parametric terms\n") else
  timetest(object,digits=digits,hyp.label=hyp.label); 

  if (semi) { cat("Parametric terms : \n"); coef(object); cat("   \n"); }

  cat("  Call: \n")
  dput(attr(object, "Call"))
  cat("\n")
}

#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/predict.lars.r"
mypredict.lars<-function (object, s, type = c("fit", "coefficients"), 
mode = c("step", "fraction", "norm"), ...) 
{
    newx<-NULL
    mode <- match.arg(mode)
    type <- match.arg(type)
    if (missing(newx) & type == "fit") {
        # warning("Type=fit with no newx argument; type switched to coefficients")
        type <- "coefficients"
    }
    betas <- object$beta
    sbetas <- scale(betas, FALSE, 1/object$normx)
    sbetas<-betas; 
    kp <- dim(betas)
    k <- kp[1]
    p <- kp[2]
    steps <- seq(k)
    if (missing(s)) {
        s <- steps
        mode <- "step"
    }
    sbeta <- switch(mode, step = {
        if (any(s < 0) | any(s > k)) 
            stop("Argument s out of range")
        steps
    }, fraction = {
        if (any(s > 1) | any(s < 0)) 
            stop("Argument s out of range")
        nbeta <- drop(abs(sbetas) %*% rep(1, p))
        nbeta/nbeta[k]
    }, norm = {
        nbeta <- drop(abs(sbetas) %*% rep(1, p))
        if (any(s > nbeta[k]) | any(s < 0)) 
            stop("Argument s out of range")
        nbeta
    })
    sfrac <- (s - sbeta[1])/(sbeta[k] - sbeta[1])
    sbeta <- (sbeta - sbeta[1])/(sbeta[k] - sbeta[1])
    usbeta <- unique(sbeta)
    useq <- match(usbeta, sbeta)
    sbeta <- sbeta[useq]
    betas <- betas[useq, ]
    coord <- approx(sbeta, seq(sbeta), sfrac)$y
    left <- floor(coord)
    right <- ceiling(coord)
    newbetas <- ((sbeta[right] - sfrac) * betas[left, , drop = FALSE] + 
        (sfrac - sbeta[left]) * betas[right, , drop = FALSE])/(sbeta[right] - 
        sbeta[left])
    newbetas[left == right, ] <- betas[left[left == right], ]
    fitf<- apply(newbetas,1,function(x)  x %*% object$Gram %*% x) 
    fitf<- fitf - 2 *newbetas %*% object$intZHdN 
    robject <- switch(type, coefficients = list(s = s, fraction = sfrac, 
                mode = mode, coefficients = drop(newbetas)), 
                fit = list(s = s, fraction = sfrac, mode = mode, fit = fitf)) 
robject
}

mycoef.lars<- function (object, ...)
{
    mypredict.lars(object, type = "coefficient", ...)$coef
}

myplot.lars<-
function (x, xvar = c("norm", "df", "arc.length"), breaks = TRUE, 
    plottype = c("coefficients", "Cp"), omit.zeros = TRUE, eps = 1e-10, 
    ...) 
{
    object <- x
    plottype <- match.arg(plottype)
    xvar <- match.arg(xvar)
    coef1 <- object$beta
    # coef1 <- scale(coef1, FALSE, 1/object$normx)
    if (omit.zeros) {
        c1 <- drop(rep(1, nrow(coef1)) %*% abs(coef1))
        nonzeros <- c1 > eps
        cnums <- seq(nonzeros)[nonzeros]
        coef1 <- coef1[, nonzeros]
    }
    else cnums <- seq(ncol(coef1))
    s1 <- switch(xvar, norm = {
        s1 <- apply(abs(coef1), 1, sum)
        s1/max(s1)
    }, df = seq(length(object$arc.length) + 1), arc.length = cumsum(c(0, 
        object$arc.length)))
    xname <- switch(xvar, norm = "|beta|/max|beta|", df = "Df", 
        arc.length = "Arc Length")
    if (plottype == "Cp") {
        Cp <- object$Cp
        plot(s1, Cp, type = "b", xlab = xname, main = object$type, 
            ...)
    }
    else {
        matplot(s1, coef1, xlab = xname, ..., type = "b", pch = "*", 
            ylab = "Coefficients")
        title(object$type, line = 2.5)
        abline(h = 0, lty = 3)
        axis(4, at = coef1[nrow(coef1), ], label = paste(cnums), 
            cex = 0.8, adj = 0)
        if (breaks) {
            axis(3, at = s1, labels = paste(seq(s1) - 1), cex = 0.8)
            abline(v = s1)
        }
    }
    invisible()
}
#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/prop-excess.r"
#source('propbase.r')

prop.excessBase<-function(time,status,X,Z,excess,tol=0.0001,alpha=1,frac=1,
                          no.sim=500){
               X<-as.matrix(X); Z<-as.matrix(Z); # ts 
	   n<-length(time);p<-dim(X)[2];q<-dim(Z)[2]

           status[status!=1]<-0 
	   #beta<-rep(0,q)
	   #beta<-c(0.12,-1.28,0.06)
	   #print(c('q:	',q))
           beta<-coxph(Surv(time,status)~Z[,1:q])$coeff
           beta<-matrix(beta,q,1)#; print(c('beta:',beta))
           phi<-numeric(n)
           #if (int==1){X<-cbind(1+numeric(n),X);
           #            p<-p+1}#Intercept is added ;  Is now added automatically
           X.til<-cbind(X,phi)
           k<-sum(status);s.time<-sort(time[status==1]);     
           Uinp<-matrix(0,q,1);dUinp<-matrix(0,q,q);optinp<-matrix(0,q,q);   
           Psiinp<-matrix(0,p+1,k);CoVarPsiinp<-matrix(0,(p+1)*(p+1),k)   
           VarPsiinp<-matrix(0,(p+1),k);
           testinp<-matrix(0,p+1,(no.sim+1));
           testinpHW<-matrix(0,p+1,(no.sim+1));
           testinpCM<-matrix(0,p+1,(no.sim+1));
           Scoreinp<-matrix(0,k*q,51);#Score-vector-function and 50 simulated values
           testinpGOFCM<-numeric((no.sim+1));
           rani<-(-round(runif(1)*10000));
           k1<-round(frac*k)
        storage.mode(time)<-"double"
	storage.mode(status)<-"double"
	storage.mode(X)<-"double"
	storage.mode(X.til)<-"double"
	storage.mode(Z)<-"double"
	storage.mode(Uinp)<-"double"
	storage.mode(dUinp)<-"double"
	storage.mode(optinp)<-"double"
	storage.mode(excess)<-"double"
	storage.mode(phi)<-"double"
        storage.mode(s.time)<-"double"
        storage.mode(beta)<-"double"
        storage.mode(tol)<-"double"
        storage.mode(alpha)<-"double"
        storage.mode(Psiinp)<-"double"
        storage.mode(CoVarPsiinp)<-"double"
        storage.mode(VarPsiinp)<-"double"
        storage.mode(testinp)<-"double"
        storage.mode(testinpHW)<-"double"
        storage.mode(testinpCM)<-"double"
        storage.mode(Scoreinp)<-"double"
        storage.mode(testinpGOFCM)<-"double"
        storage.mode(n)<-"integer"
        storage.mode(p)<-"integer"
        storage.mode(q)<-"integer"
        storage.mode(k)<-"integer"
        storage.mode(k1)<-"integer"
        storage.mode(rani)<-"integer"
        storage.mode(no.sim)<-"integer"
	#dyn.load("allfunctions.o")
	#dyn.load("addmult.so")
	#dyn.load("linaddmult.so")
       #if (system=="unix") dyn.load("addmult.so")
       #if (system=="linux") dyn.load("linaddmult.so")
	#print(c('CHECK'))
	#print(cbind(time,status)[111:121,])
	#print(status)
	#print(X[1:10,])
	#print(X.til)
	#print(Z[1:10,])
	#print(excess)
	#print(phi)
	#print(s.time)
	#print(beta)
	#print(c('n, k, k1',n,k,k1))
	#print(c('p,q',p,q))
	#print(c('alpha,no.sim,tol',alpha,no.sim,tol))
	  U.out<-.C("addmult",time,status,X,X.til,Z,Uinp,dUinp,optinp,
                        excess,phi,s.time,beta,n,p,q,k,tol,alpha,
                        Psiinp,CoVarPsiinp,VarPsiinp,rani,testinp,testinpHW,testinpCM,
                        testinpGOFCM,Scoreinp,no.sim,k1,PACKAGE="timereg")
          U.bet<-U.out[[6]]
          D.bet<-U.out[[7]];#print(c('D.bet',D.bet))
          I.bet<-U.out[[8]];#print(c('I.bet',I.bet))
          V.bet<-U.out[[8]];
          rank.D.bet<-qr(D.bet)$rank
          no.it<-U.out[[13]];#print(c('no.it',no.it))
          if (rank.D.bet==q){eigenV<-eigen(D.bet)$values;#print(c('eigenV',eigenV))
          indik<-sum( (eigenV<0) );
          if (indik<q){
          cat("First derivative of score function is not negative definite");cat("\n");
          beta<- Varbeta<-Psi<-VarPsi<-p.valHW<-p.valCM<-quant95<-quant95HW<-p.valGOFCM<-NA
	   }}
          if ((rank.D.bet==q)&(no.it<50)){
          if (indik==q){       
          beta<-U.out[[12]]
          Psi<-U.out[[19]]
          CoVarPsi<-U.out[[20]]
          VarPsi<-U.out[[21]]
          testout<-U.out[[23]];p.val<-numeric(p+1);quant95<-numeric(p+1)
          testoutHW<-U.out[[24]];p.valHW<-numeric(p+1);quant95HW<-numeric(p+1)
          testoutCM<-U.out[[25]];p.valCM<-numeric(p+1)
          testoutGOFCM<-U.out[[26]];
          #print(testoutGOFCM)
          Scoreout<-U.out[[27]];sim.test.procProp<-list()
	  for (j in 0:	50){
	   index<-seq(j*q*k+1,(j+1)*q*k,1)
	   sim.test.procProp[[j+1]]<-matrix(Scoreout[index],k,q)}
	  # print(sim.test.procProp[[1]])
          for (j in 1:(p+1)){
             p.val[j]<-sum(testout[j,1]<testout[j,2:(no.sim+1)])/no.sim
             quant95[j]<-quantile(sort(testout[j,2:(no.sim+1)]),0.95)# Simulation based CI
             p.valHW[j]<-sum(testoutHW[j,1]<testoutHW[j,2:(no.sim+1)])/no.sim
             p.valCM[j]<-sum(testoutCM[j,1]<testoutCM[j,2:(no.sim+1)])/no.sim
             quant95HW[j]<-quantile(sort(testoutHW[j,2:(no.sim+1)]),0.95)}
            p.valGOFCM<-sum(testoutGOFCM[1]<testoutGOFCM[2:(no.sim+1)])/no.sim
          Varbeta<-V.bet
       y.max<-max(Scoreout);       y.min<-min(Scoreout)
        #print(Scoreout[,1])
                    #  plot(s.time,Scoreout[,1],ylim=c(y.min,y.max),xlab='Time',
                #      ylab='Standardized score process',type='n')
                #  for (j in 2:51){lines(s.time,Scoreout[,j],lwd=0.5,lty=2)}}
     # print(cbind(Scoreout[,1],Scoreout[,2:51]))
     #solve(D.bet)%*%I.bet%*%solve(D.bet)
     #     Kol.Smir<-Cramer<-numeric(p+1)
     #     Gamma<-f.Gamma<-d.f.Gamma<-VarPsi[,1:k1];
     #     for (j in 1:(p+1)){Gamma[j,]<-VarPsi[j,1:k1]/VarPsi[j,k1];
     #     f.Gamma[j,]<-Gamma[j,]/(1+Gamma[j,]);
     #     d.f.Gamma[j,]<-c(f.Gamma[j,1],
     #     f.Gamma[j,2:k1]-f.Gamma[j,1:(k1-1)])
     #     Kol.Smir[j]<-max(abs( Psi[j,1:k1]*
     #      sqrt(VarPsi[j,k1])/(VarPsi[j,k1]+VarPsi[j,1:k1])))
     #     Cramer[j]<-sum( (( Psi[j,1:k1]/sqrt(VarPsi[j,k1]))/(1+Gamma[j,]))^2*
     #        d.f.Gamma[j,])}
	}}
        if (rank.D.bet<q){
          cat("Singular first derivative of score function");cat("\n");
          beta<- Varbeta<-Psi<-VarPsi<-p.valHW<-p.valCM<-quant95<-quant95HW<-p.valGOFCM<-NA
          }
        if (no.it==50){
          cat("Iterative procedure did not converge");cat("\n");
          beta<- Varbeta<-Psi<-VarPsi<-p.valHW<-p.valCM<-quant95<-quant95HW<-p.valGOFCM<-NA}
ud<-list(cum=cbind(s.time,t(Psi)),var.cum=cbind(s.time,t(VarPsi)),
gamma=beta,var.gamma=Varbeta,pval=p.val,score=D.bet,
pval.HW=p.valHW,pval.CM=p.valCM,quant95=quant95,quant95HW=quant95HW,
   simScoreProp=sim.test.procProp); 
	#	       return(s.time,beta,Varbeta,Psi,VarPsi,p,q,D.bet,p.valHW,p.valCM,
        #       p.valGOFCM,quant95,quant95HW,simScoreProp)
	return(ud)
	 }

#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/prop-odds.r"
prop.odds<-function(formula,data=sys.parent(),beta=0,
Nit=10,detail=0,start.time=0,max.time=NULL,id=NULL,n.sim=500,weighted.test=0,
profile=1,sym=0)
{
id.call<-id; call<-match.call(); residuals<-0;  
robust<-0; ratesim<-0; # profile<-0; 
m<-match.call(expand = FALSE);
m$sym<-m$profile<-m$max.time<-m$start.time<-m$weighted.test<-m$n.sim<-
m$id<-m$Nit<-m$detail<-m$beta<-NULL
if (n.sim==0) sim<-0 else sim<-1; 
antsim<-n.sim; 

Terms <- if(missing(data)) terms(formula)
           else              terms(formula, data=data)
m$formula <- Terms
m[[1]] <- as.name("model.frame")
m <- eval(m, sys.parent())
mt <- attr(m, "terms")
intercept<-attr(mt, "intercept")
Y <- model.extract(m, "response")
if (!inherits(Y, "Surv")) stop("Response must be a survival object")

if (attr(m[, 1], "type") == "right") {
  time2  <- m[, 1][, "time"]; time   <- rep(0,length(time2));
  status <- m[, 1][, "status"]    } else 
if (attr(m[, 1], "type") == "counting") {
  time   <- m[, 1][,1]; time2  <- m[, 1][,2]; status <- m[, 1][,3]; } else {
  stop("only right-censored or counting processes data") } 

X <- model.matrix(Terms, m)[,-1,drop=FALSE]; covnamesX<-dimnames(X)[[2]]; 
desX<-as.matrix(X);
if(is.matrix(desX) == TRUE) pg <- as.integer(dim(desX)[2])
if(is.matrix(desX) == TRUE) nx <- as.integer(dim(desX)[1])
px<-1; 
Ntimes <- sum(status); 

# adds random noise to make survival times unique
if (sum(duplicated(time2[status==1]))>0) {
#cat("Non unique survival times: break ties ! \n")
#cat("Break ties yourself\n");
ties<-TRUE
dtimes<-time2[status==1]
index<-(1:length(time2))[status==1]
ties<-duplicated(dtimes); nties<-sum(ties); index<-index[ties]
dt<-diff(sort(time2)); dt<-min(dt[dt>0]);
time2[index]<-time2[index]+runif(nties,0,min(0.001,dt/2));
} else ties<-FALSE; 

start<-time; stop<-time2; 
dtimes<-time2[status==1]; 
times<-c(start.time,dtimes[dtimes>start.time]); times<-sort(times);
if (is.null(max.time)==TRUE) maxtimes<-max(times)+0.1 else maxtimes<-max.time; 
times<-times[times<=maxtimes]
Ntimes <- length(times); 

########################################################################
if (is.null(id)==TRUE) {antpers<-length(time); id<-0:(antpers-1); }
else { pers<-unique(id); antpers<-length(pers); 
       id<-as.integer(factor(id,labels=1:(antpers)))-1; }

if (sum(abs(beta))==0) beta<-rep(0,pg); 
if (length(beta)!=pg) beta<-rep(0,pg);

if (residuals==1) {
cumAi<-matrix(0,Ntimes,antpers*1);
cumAiiid<-matrix(0,Ntimes,antpers*1); }
else { cumAi<-0; cumAiiid<-0; }

cumint<-matrix(0,Ntimes,px+1); vcum<-matrix(0,Ntimes,px+1);
Rvcu<-matrix(0,Ntimes,px+1);
score<-beta;
Varbeta<-matrix(0,pg,pg); Iinv<-matrix(0,pg,pg);
RVarbeta<-matrix(0,pg,pg);
if (sim==1) Uit<-matrix(0,Ntimes,50*pg) else Uit<-NULL;

test<-matrix(0,antsim,2*px); testOBS<-rep(0,2*px); unifCI<-c();
testval<-c();
rani<--round(runif(1)*10000); 
Ut<-matrix(0,Ntimes,pg+1); simUt<-matrix(0,antsim,pg);
loglike<-0; 
########################################################################

###cat("Proportional odds model \n"); 
###dyn.load("Gprop-odds.so")

nparout<- .C("transsurv",
as.double(times),as.integer(Ntimes),as.double(desX),
as.integer(nx),as.integer(pg),as.integer(antpers),
as.double(start),as.double(stop), as.double(beta),
as.integer(Nit), as.double(cumint), as.double(vcum),
as.double(Iinv),as.double(Varbeta),as.integer(detail),
as.integer(sim),as.integer(antsim),as.integer(rani),
as.double(Rvcu),as.double(RVarbeta),as.double(test),
as.double(testOBS),as.double(Ut),as.double(simUt),
as.double(Uit),as.integer(id),as.integer(status),
as.integer(weighted.test),as.integer(ratesim),as.double(score),
as.double(cumAi),as.double(cumAiiid),as.integer(residuals),
as.double(loglike),as.integer(profile),as.integer(sym),
PACKAGE="timereg");

gamma<-matrix(nparout[[9]],pg,1);
cumint<-matrix(nparout[[11]],Ntimes,px+1);
vcum<-matrix(nparout[[12]],Ntimes,px+1);
Iinv<-matrix(nparout[[13]],pg,pg);
Varbeta<--matrix(nparout[[14]],pg,pg);
Rvcu<-matrix(nparout[[19]],Ntimes,px+1);
RVarbeta<--matrix(nparout[[20]],pg,pg);
score<-matrix(nparout[[30]],pg,1);
Ut<-matrix(nparout[[23]],Ntimes,pg+1);
loglike<-nparout[[34]]

if (residuals==1) {
cumAi<-matrix(nparout[[31]],Ntimes,antpers*1);
cumAiiid<-matrix(nparout[[32]],Ntimes,antpers*1);
cumAi<-list(time=times,dmg=cumAi,dmg.iid=cumAiiid);} else cumAi<-NULL;

if (sim==1) {
Uit<-matrix(nparout[[25]],Ntimes,50*pg); UIt<-list();
for (i in (0:49)*pg) UIt[[i/pg+1]]<-as.matrix(Uit[,i+(1:pg)]);
simUt<-matrix(nparout[[24]],antsim,pg);
test<-matrix(nparout[[21]],antsim,2*px); testOBS<-nparout[[22]];
supUtOBS<-apply(abs(as.matrix(Ut[,-1])),2,max);
for (i in 1:(2*px)) testval<-c(testval,pval(test[,i],testOBS[i]));
for (i in 1:px) unifCI<-c(unifCI,percen(test[,i],0.95));
testUt<-c();
for (i in 1:pg) testUt<-c(testUt,pval(simUt[,i],supUtOBS[i]));

pval.testBeq0<-as.vector(testval[1:px]);
pval.testBeqC<-as.vector(testval[(px+1):(2*px)]);
obs.testBeq0<-as.vector(testOBS[1:px]);
obs.testBeqC<-as.vector(testOBS[(px+1):(2*px)]);
sim.testBeq0<-as.matrix(test[,1:px]);
sim.testBeqC<-as.matrix(test[,(px+1):(2*px)]);
sim.supUt<-as.matrix(simUt);
}

if (sim!=1) {
testUt<-NULL;test<-NULL;unifCI<-NULL;supUtOBS<-NULL;UIt<-NULL;testOBS<-NULL;testval<-NULL;
pval.testBeq0<- pval.testBeqC<- obs.testBeq0<- obs.testBeqC<- sim.testBeq0<-
sim.testBeqC<-NULL; testUt<-NULL; sim.supUt<-NULL;
}

ud<-list(cum=cumint,var.cum=vcum,robvar.cum=Rvcu,
gamma=gamma,var.gamma=Varbeta,robvar.gamma=RVarbeta,
resid.dMG=cumAi,D2linv=Iinv,score=score,loglike=loglike,
pval.testBeq0=pval.testBeq0,pval.testBeqC=pval.testBeqC,
obs.testBeq0=obs.testBeq0,obs.testBeqC=obs.testBeqC,
sim.testBeq0= sim.testBeq0,sim.testBeqC=sim.testBeqC,
conf.band=unifCI,
test.procProp=Ut,sim.test.procProp=UIt,pval.Prop=testUt,
sim.supProp=sim.supUt,prop.odds=TRUE)

colnames(ud$cum)<-colnames(ud$var.cum)<- c("time","Baseline")
if (robust==1) colnames(ud$robvar.cum)<- c("time","Baseline"); 

if (px>0) {
if (sim==1) {
colnames(ud$test.procProp)<-c("time",covnamesX)
names(ud$pval.Prop)<-covnamesX
names(ud$conf.band)<-names(ud$pval.testBeq0)<-
names(ud$pval.testBeqC)<-names(ud$obs.testBeq0)<- 
names(ud$obs.testBeqC)<-colnames(ud$sim.testBeq0)<-"Baseline";
} }

rownames(ud$gamma)<-c(covnamesX); colnames(ud$gamma)<-"estimate";
rownames(ud$score)<-c(covnamesX); colnames(ud$score)<-"score";
namematrix(ud$var.gamma,covnamesX);
namematrix(ud$robvar.gamma,covnamesX);
namematrix(ud$D2linv,covnamesX);


attr(ud,"Call")<-sys.call(); 
attr(ud,"Formula")<-formula; 
attr(ud,"id")<-id.call; 
class(ud)<-"cox.aalen"
return(ud); 
}

#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/read-design.r"
read.design<-function(m,Terms,model="aalen"){
  mt <- attr(m, "terms")
  intercept <- attr(mt, "intercept")

  XZ<-model.matrix(Terms,m)[, drop = FALSE]

  clusterTerms<- grep("^cluster[(][A-z0-9._:]*",colnames(XZ),perl=TRUE)

  if(length(clusterTerms) == 1){
    l.cols<-length(attributes(XZ)$assign) - 1
    clusters <- as.vector(XZ[,clusterTerms]);
    cols<-attributes(XZ)$assign
    cols <- cols[-clusterTerms]
  } else if(length(clusterTerms) == 0){
    l.cols<-length(attributes(XZ)$assign)
    cols<-attributes(XZ)$assign
    clusters <- NULL;
  } else {
    stop("More than one cluster(-) term was included in the formula")
  }

  if (model=="aalen") semicov <- grep("^const[(][A-z0-9._:]*",colnames(XZ),perl=TRUE)
  if (model=="prop.excess") semicov <- grep("^cox[(][A-z0-9._:]*",colnames(XZ),perl=TRUE)
  if (model=="cox.aalen") semicov <- grep("^prop[(][A-z0-9._:]*",colnames(XZ),perl=TRUE)
  
   ZtermsXZ<-semicov-1

  if (length(semicov)) {
    npar<-FALSE; Zterms<-c();
    for (i in ZtermsXZ) Zterms<-c(Zterms,(1:l.cols)[cols==i]); 
  } else {
    npar<-TRUE;
  }
Zterms<-semicov # ts 25-6-2008

  if (length(semicov)>0) {
    X<-as.matrix(XZ[,-c(Zterms,clusterTerms)]);
    covnamesX <- dimnames(XZ)[[2]][-c(Zterms,clusterTerms)];
    dimnames(X)[[2]]<-covnamesX;
    Z<-as.matrix(XZ[,Zterms]);
    covnamesZ <- dimnames(XZ)[[2]][Zterms];
  } else if(length(clusterTerms)>0) {
    X<-as.matrix(XZ[,-clusterTerms]);
    covnamesX <- dimnames(XZ)[[2]][-clusterTerms]
  } else {
    X<-as.matrix(XZ);
    covnamesX <- dimnames(XZ)[[2]]
  }

  px <- ncol(X)
  if (npar == FALSE) pz <- ncol(Z) else pz <- 0
  pxz <- px + pz

  X <- data.matrix(X)
  if (npar == FALSE){
    Z <- data.matrix(Z)
  }else {
    Z <- NULL; covnamesZ<-NULL
  }
  if(length(clusterTerms) > 0){
    clusters <- as.vector(clusters)
  }

  ud<-list(X=X,Z=Z,px=px,pz=pz,npar=npar,
           covnamesX=covnamesX,covnamesZ=covnamesZ,
           clusters=clusters)
   return(ud)
}

read.surv<-function(m,id,npar,clusters,start.time,max.time,model="aalen"){

  if (attr(m[, 1], "type") == "right") {
    time2 <- m[, 1][, "time"]; time <- rep(0, length(time2))
    status <- m[, 1][, "status"]
  }
  else if (attr(m[, 1], "type") == "counting") {
    if (is.null(id)==TRUE) 
      cat("For counting process data, with multiple records the id variable must be set to get correct robust standard errors and simulations\n");
    time <- m[, 1][, 1];time2 <- m[, 1][, 2];status <- m[, 1][, 3];
  }
  else { stop("only right-censored or counting processes data") }

  if (sum(duplicated(time2[status==1]))>0) {
    # cat("Non unique survival times: break ties ! \n")
    # cat("Break ties yourself\n");
    ties<-TRUE; 
    dtimes<-time2[status==1]
    index<-(1:length(time2))[status==1]
    ties<-duplicated(dtimes); nties<-sum(ties); index<-index[ties]
    dt<-diff(sort(time2)); dt<-min(dt[dt>0]); 
    time2[index]<-time2[index]+runif(nties,0,min(0.001,dt/2));
  } else ties<-FALSE; 

  if ((model=="aalen") &  (npar==FALSE)) times<-unique(time2) else times<-time2[status==1];

  times <- c(start.time, times[times>start.time]); times <- sort(times)
  if (is.null(max.time) == TRUE) maxtimes <- max(times) else maxtimes <- max.time
  times<-times[times<=maxtimes];
  if ((npar==FALSE) & (model!="cox.aalen")) times<-c(times,maxtimes)  
  times<-unique(times); Ntimes <- length(times); 

  if (is.null(id) == TRUE) {antpers <- length(time); id <- 0:(antpers - 1);}
  else {pers <- unique(id); antpers <- length(pers);
        id <- as.integer(factor(id, labels = 1:(antpers))) - 1; }

  if (is.null(clusters)== TRUE) {clusters<-id; antclust<-antpers;} else {
    clus<-unique(clusters); antclust<-length(clus); 
    clusters <- as.integer(factor(clusters, labels = 1:(antclust))) - 1;}

  ud2<-list(status=status,start=time,stop=time2,antpers=antpers,antclust=antclust,
            times=times,id.call=id,clusters=clusters)
  return(ud2)
}

check.missing<-function(X,Z,time,time2,status,npar)
{
XZ<-cbind(X,Z)
  if  ((prod(is.na(XZ) == FALSE) == 0) || (prod(is.na(time) == 
    FALSE) == 0) || (prod(is.na(time2) == FALSE) == 0) || 
   (prod(is.na(status) == FALSE) == 0)) cat("Missing values\n")

}

rm.missing<-function(X,Z,time,time2,status,npar,na.rm=TRUE)
{
  if (is.null(Z)==TRUE) XZ<-cbind(X,Z) else XZ<-X; 

  if ((prod(is.na(XZ) == FALSE) == 0) || (prod(is.na(time) == 
             FALSE) == 0) || (prod(is.na(time2) == FALSE) == 0) || 
      (prod(is.na(status) == FALSE) == 0)) {
    if (na.rm) {
      notmissing <- c(rep(1, times = dimcovar[1]))
      i <- 1
      for (i in 1:dimcovar[1]) {
        notmissing[i] <- prod(is.na(XZ[i, ]) == FALSE) }
      notmissing <- notmissing * (is.na(time) == FALSE) * 
        (is.na(time2) == FALSE) * (is.na(status) == FALSE)
      cat(dimcovar[1] - sum(notmissing), " observations ignored because of missing values\n")
      dimcovar[1] <- sum(notmissing)
      XZ<- XZ[notmissing == 1, ]
      X <- X[notmissing == 1, ]
      time <- time[notmissing == 1, ]
      time2 <- time2[notmissing == 1, ]
      if (npar== FALSE) Z <- Z[notmissing == 1, ]
      trisk <- trisk[notmissing == 1]
      status <- status[notmissing == 1]
    }
    else { stop("Missing not allowed unless na.rm=TRUE\n\n") }
  }

  return(list(X=X,Z=Z,time=time,time2=time2,status=status))
}

#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/timecox.r"
timecoxBase<-function(times,fdata,designX,status,id,bhat,
method="basic",band=1,degree=1,it=20,sim=1,retur=0,robust=1,
antsim=1000,sim2=sim2,weighted.test=0,covariance=0)
{
Ntimes <- length(times); designX<-as.matrix(designX); 
if(is.matrix(designX) == TRUE) p<-as.integer(dim(designX)[2]);
if(is.matrix(designX) == TRUE) nx<-as.integer(dim(designX)[1]);
bhat<-as.matrix(bhat); schoen<-FALSE; 
nb<-as.integer(dim(bhat)[1]);
band<-matrix(band,nb,as.integer(dim(bhat)[2])-1); 
cum<-matrix(0,Ntimes,p+1); Vcum<-Vcum2<-rvcu<-cum; 
nullresid<-(-1);
if (method=="breslow") pdim<-p+1 else pdim<-p; 

if (retur==1) {cumAi<-matrix(0,Ntimes,fdata$antpers*1) 
               cumAiid<-matrix(0,Ntimes,fdata$antpers*1); } else { 
	       cumAi<-0; cumAiid<-0; }

if (covariance==1) covs<-matrix(0,Ntimes,p*p) else covs<-0;



if (sim>=1) {test<-matrix(0,5*pdim,antsim); testOBS<-rep(0,5*pdim);}
else {test<-0; testOBS<-0;} 
rani<--round(runif(1)*10000);  testval<-c();  unifCI<-c(); 

# 50 tilfaeldige score processer til test H: b(t)=b returneres
if (sim>=1) simUt<-matrix(0,Ntimes,50*pdim) else simUt<-NULL;
Ut<-matrix(0,Ntimes,pdim+1);

if (method=="basic") {
timeout<- .C("OStimecox",
as.double(times), as.integer(Ntimes),as.double(designX),
as.integer(nx),as.integer(p),as.integer(fdata$antpers), 
as.double(fdata$start),as.double(fdata$stop),as.integer(nb),
as.double(bhat), as.double(cum),as.double(Vcum),
as.integer(it),as.double(band),as.integer(degree),
as.integer(id), as.integer(status), as.integer(sim),
as.integer(antsim), as.double(cumAi), as.double(test),
as.integer(rani),as.double(testOBS),as.double(Ut),
as.double(simUt), as.double(rvcu), as.integer(retur),
as.integer(weighted.test),as.double(cumAiid),
as.integer(robust),as.integer(covariance),as.double(covs),
PACKAGE="timereg");

if (covariance==1)  {
covit<-matrix(timeout[[32]],Ntimes,p*p);
cov.list<-list();
for (i in 1:Ntimes) cov.list[[i]]<-matrix(covit[i,],p,p);
} else cov.list<-NULL;


schoen<- 
obs.testBeqC.is1<- obs.testBeqC.is2<- 
pval.testBeqC.is1<- pval.testBeqC.is2<- 
sim.testBeqC.is1<- sim.testBeqC.is2<-NULL;

rvcu<-matrix(timeout[[26]],Ntimes,p+1);

if (retur==1) {
cumAi<-matrix(timeout[[20]],Ntimes,fdata$antpers*1);
cumAiid<-matrix(timeout[[29]],Ntimes,fdata$antpers*1);
cumAi<-list(time=times,dM=cumAi,dM.iid=cumAiid);} else cumAi<-NULL;

if (sim>=1) {
Ut<-matrix(timeout[[24]],Ntimes,(p+1));
Uit<-matrix(timeout[[25]],Ntimes,50*p);
UIt<-list(); for (i in (0:49)*p) UIt[[i/p+1]]<-as.matrix(Uit[,i+(1:p)]);
test<-matrix(timeout[[21]],antsim,5*p); test<-test[,1:(3*p)]; 
testOBS<-timeout[[23]];
for (i in 1:(3*p)) testval<-c(testval,pval(test[,i],testOBS[i]))
for (i in 1:p)
unifCI<-as.vector(c(unifCI,percen(test[,i],0.95)));
pval.testBeq0<-as.vector(testval[1:p]);
pval.testBeqC<-as.vector(testval[(p+1):(2*p)]);
pval.testBeqC.is<-as.vector(testval[(2*p+1):(3*p)]);
obs.testBeq0<-as.vector(testOBS[1:p]);
obs.testBeqC<-as.vector(testOBS[(p+1):(2*p)]);
obs.testBeqC.is<-as.vector(testOBS[(2*p+1):(3*p)]);
sim.testBeq0<-as.matrix(test[,1:p]);
sim.testBeqC<-as.matrix(test[,(p+1):(2*p)]);
sim.testBeqC.is<-as.matrix(test[,(2*p+1):(3*p)]);
} else {
test<- unifCI<- Ut<- UIt<-
pval.testBeq0<- 
obs.testBeq0<- sim.testBeq0<-
pval.testBeqC<- obs.testBeqC<- sim.testBeqC<- 
obs.testBeqC.is<- pval.testBeqC.is<- 
sim.testBeqC.is<- test.procBeqC<- test.procBeqC.is<-NULL; 
}
}
else if (method=="breslow") {
schoen<-matrix(0,Ntimes,p+1); 
cumlam<-cum<-Vcum<-rvcu<-matrix(0,Ntimes,p+2); 

timeout<-.C("OSbreslow", 
as.double(times),as.integer(Ntimes),as.double(designX),
as.integer(nx),as.integer(p),as.integer(fdata$antpers), 
as.double(fdata$start),as.double(fdata$stop),as.integer(nb),
as.double(bhat),as.double(cum),as.double(Vcum),
as.integer(it),as.double(band),as.integer(degree),
as.double(schoen),as.integer(sim),as.integer(antsim),
as.double(test),as.integer(rani),as.double(testOBS),
as.double(rvcu),as.double(cumlam),as.integer(nullresid),
as.integer(status),as.integer(id),as.integer(sim2),
as.double(Ut),as.double(simUt),as.integer(weighted.test),
as.integer(robust),
PACKAGE="timereg"); 

cov.list<-NULL; 
schoen<-matrix(timeout[[16]],Ntimes,p+1); 
rvcu<-matrix(timeout[[22]],Ntimes,p+2);

if (sim2!=1) {
obs.testBeqC.is1<- obs.testBeqC.is2<- 
pval.testBeqC.is1<- pval.testBeqC.is2<- 
sim.testBeqC.is1<- sim.testBeqC.is2<-NULL;
}

cumAi<-NULL;  # calculated for time basic version

if (sim>=1) {
Ut<-matrix(timeout[[28]],Ntimes,(pdim+1));
Uit<-matrix(timeout[[29]],Ntimes,50*pdim);
UIt<-list(); for (i in (0:49)*pdim) UIt[[i/pdim+1]]<-as.matrix(Uit[,i+(1:pdim)]);
test<-matrix(timeout[[19]],antsim,5*pdim);
testOBS<-timeout[[21]]; testval<-c(); unifCI<-c(); 
for (i in 1:(5*pdim)) testval<-c(testval,pval(test[,i],testOBS[i]))
for (i in 1:pdim) unifCI<-c(unifCI,percen(test[,i],0.95)); 
pval.testBeq0<-as.vector(testval[1:pdim]);
pval.testBeqC<-as.vector(testval[(pdim+1):(2*pdim)]);
pval.testBeqC.is<-as.vector(testval[(2*pdim+1):(3*pdim)]);
obs.testBeq0<-as.vector(testOBS[1:pdim]);
obs.testBeqC<-as.vector(testOBS[(pdim+1):(2*pdim)]);
obs.testBeqC.is<-as.vector(testOBS[(2*pdim+1):(3*pdim)]);
sim.testBeq0<-as.matrix(test[,1:pdim]);
sim.testBeqC<-as.matrix(test[,(pdim+1):(2*pdim)]);
sim.testBeqC.is<-as.matrix(test[,(2*pdim+1):(3*pdim)]);
sim2<-0
if (sim2==1) {
pval.testBeqC.is1<-as.vector(testval[(3*pdim+1):(4*pdim)]);
pval.testBeqC.is2<-as.vector(testval[(4*pdim+1):(5*pdim)]);
obs.testBeqC.is1<-as.vector(testOBS[(3*pdim+1):(4*pdim)]);
obs.testBeqC.is2<-as.vector(testOBS[(4*pdim+1):(5*pdim)]);
sim.testBeqC.is1<-as.matrix(test[,(3*pdim+1):(4*pdim)]);
sim.testBeqC.is2<-as.matrix(test[,(3*pdim+1):(4*pdim)]); }
} else {test<- unifCI<- Ut<- UIt<-
pval.testBeq0<-pval.testBeqC<-
obs.testBeq0<-obs.testBeqC<-
sim.testBeq0<-sim.testBeqC<- 
sim.testBeqC.is<- sim.testBeqC.is1<- sim.testBeqC.is2<- 
pval.testBeqC.is<- pval.testBeqC.is1<- pval.testBeqC.is2<- 
obs.testBeqC.is<- obs.testBeqC.is1<- obs.testBeqC.is2<-NULL; 
}
} else  stop("Methods are : breslow and basic\n"); 

bhat<-matrix(timeout[[10]],nb,pdim+1); 
cum<-matrix(timeout[[11]],Ntimes,pdim+1); 
Vcum<-matrix(timeout[[12]],Ntimes,pdim+1);

# additional output ? band=band,method=method,degree=degree,it=it,
# beta.t=bhat,
ud<-list(cum=cum,var.cum=Vcum,robvar.cum=rvcu,
residuals=cumAi,schoenfeld.residuals=schoen,
schoenfeld.residual=schoen,
obs.testBeq0=obs.testBeq0, pval.testBeq0=pval.testBeq0,
pval.testBeqC=pval.testBeqC, obs.testBeqC=obs.testBeqC,
obs.testBeqC.is=obs.testBeqC.is, pval.testBeqC.is=pval.testBeqC.is,
obs.testBeqC.is1=obs.testBeqC.is1,pval.testBeqC.is1=pval.testBeqC.is1,
obs.testBeqC.is2=obs.testBeqC.is2,pval.testBeqC.is2=pval.testBeqC.is2,
sim.testBeq0= sim.testBeq0,sim.testBeqC=sim.testBeqC,
conf.band=unifCI,test.procBeqC=Ut,sim.test.procBeqC=UIt,
sim.testBeqC.is=sim.testBeqC.is, sim.testBeqC.is=sim.testBeqC.is1,
sim.testBeqC.is=sim.testBeqC.is2,covariance=cov.list)
return(ud); 
}

semicox<-function(times,fdata,designX,designG,status,id,bhat,gamma=0,
band=1,degree=1,it=10,method="basic",sim=0,retur=0,antsim=1000,
robust=1,weighted.test=0,covariance=0) 
{
Nalltimes <- length(times); 
Ntimes<-sum(status[(fdata$stop>times[1]) & (fdata$stop<=times[Nalltimes])])+1;
designX<-as.matrix(designX); designG<-as.matrix(designG); 
if(is.matrix(designX) == TRUE) px <- as.integer(dim(designX)[2])
if(is.matrix(designX) == TRUE) nx <- as.integer(dim(designX)[1])
if(is.matrix(designG) == TRUE) pg <- as.integer(dim(designG)[2])
if(is.matrix(designG) == TRUE) ng <- as.integer(dim(designG)[1])
bhat<-as.matrix(bhat); 
nb<-as.integer(dim(bhat)[1]);
band<-matrix(band,nb,as.integer(dim(bhat)[2])-1); 
if (method=="breslow") pdim<-px+1 else pdim<-px; 

if (covariance==1) covs<-matrix(0,Ntimes,px*px) else
covs<-0;


if (nx!=ng) print(" A design og B designs er ikke ens\n");
cum<-matrix(0,Ntimes,px+1); rvcu<-Vcum<-cum; 
if (sum(abs(gamma))==0) gamma<-rep(0,pg)  else gamma<-gamma; 
RobVargam<-Vargam<-matrix(0,pg,pg); 

test<-matrix(0,antsim,3*pdim); testOBS<-rep(0,3*pdim);
testval<-c(); rani<--round(runif(1)*10000);

# 50 tilfaeldige score processer til test H: b(t)=b returneres
if (sim>=1) simUt<-matrix(0,Ntimes,50*pdim) else simUt<-NULL;
Ut<-matrix(0,Ntimes,pdim+1);
if (retur==1) cumAi<-matrix(0,Ntimes,fdata$antpers) else cumAi<-0;
sim.testBeqC.is1<- sim.testBeqC.is2<-
obs.testBeqC.is1<- obs.testBeqC.is2<-
pval.testBeqC.is1<- pval.testBeqC.is2<-NULL;

# LOAD NECESSARY ROUTINES
#if (method=="basic" && system=="unix") dyn.load("timecox.so")
#if (method=="basic" && system=="linux") dyn.load("lintimecox.so")
#else if (method=="breslow" && system=="unix") dyn.load("breslow.so") 
#else if (method=="breslow" && system=="linux") dyn.load("linbreslow.so")
#else if (method=="breslow" && system=="windows") dyn.load("breslow.dll"); 


if (method=="basic") 
{
semiout<-.C("OSsemicox",
as.double(times),as.integer(Ntimes),
as.double(designX),
as.integer(nx),as.integer(px),as.double(designG),
as.integer(ng),as.integer(pg),as.integer(fdata$antpers),
as.double(fdata$start),as.double(fdata$stop),as.integer(nb),
as.double(bhat),as.double(cum),as.double(Vcum),
as.double(gamma),as.double(Vargam),as.double(band),
as.integer(degree), as.integer(it), as.double(RobVargam), 
as.double(rvcu), as.integer(sim), as.integer(antsim), 
as.integer(retur), as.double(cumAi), as.double(test), 
as.integer(rani), as.double(testOBS), as.integer(status), 
as.double(Ut), as.double(simUt), as.integer(id),
as.integer(weighted.test),as.integer(robust),
as.integer(covariance),as.double(covs),PACKAGE="timereg");

if (covariance==1)  {
covit<-matrix(semiout[[37]],Ntimes,px*px);
cov.list<-list();
for (i in 1:Ntimes) cov.list[[i]]<-matrix(covit[i,],px,px);
} else cov.list<-NULL;

bhat<-matrix(semiout[[13]],nb,px+1);
cum<-matrix(semiout[[14]],Ntimes,px+1);
Vcum<-matrix(semiout[[15]],Ntimes,px+1);
rvcu<-matrix(semiout[[22]],Ntimes,px+1);

gamma<-matrix(semiout[[16]],pg,1);
Vargam<-matrix(semiout[[17]],pg,pg);
RobVargam<-matrix(semiout[[21]],pg,pg);

if (retur==1) {
cumAi<-matrix(semiout[[26]],Ntimes,fdata$antpers);
cumAi<-list(time=times,dM=cumAi); 
#cumAI<-list();
#for (i in (0:(fdata$antpers-1))*p) cumAI[[i/p+1]]<-cumAi[,i+(1:p)]
} else cumAi<-NULL;


unifCI<-c();
if (sim>=1) {
test<-matrix(semiout[[27]],antsim,3*px);
testOBS<-semiout[[29]];
for (i in 1:(3*px))
testval<-c(testval,pval(test[,i],testOBS[i]))
Ut<-matrix(semiout[[31]],Ntimes,(px+1));
Uit<-matrix(semiout[[32]],Ntimes,50*px);
UIt<-list(); for (i in (0:49)*px) UIt[[i/px+1]]<-as.matrix(Uit[,i+(1:px)]);
for (i in 1:px)
unifCI<-as.vector(c(unifCI,percen(test[,i],0.95)));
obs.testBeq0<-as.vector(testOBS[1:px]);
pval.testBeq0<-as.vector(testval[1:px]);
sim.testBeq0<-as.matrix(test[,1:px]);
obs.testBeqC<-as.vector(testOBS[(px+1):(2*px)]);
pval.testBeqC<-as.vector(testval[(px+1):(2*px)]);
sim.testBeqC<-as.matrix(test[,(px+1):(2*px)]);
pval.testBeqC.is<-as.vector(testval[(2*px+1):(3*px)]);
obs.testBeqC.is<-as.vector(testOBS[(2*px+1):(3*px)]);
sim.testBeqC.is<-as.matrix(test[,(2*px+1):(3*px)]);
} else {
test<- unifCI<-UIt<- Ut<-
pval.testBeq0<-pval.testBeqC<-
obs.testBeq0<- obs.testBeqC<-
obs.testBeqC.is<- pval.testBeqC.is<-
sim.testBeq0<- sim.testBeqC<- sim.testBeqC.is<-NULL; 
}
}
else if (method=="breslow") 
{

schoen<-0; cum<-Vcum<-rvcu<-matrix(0,Ntimes,px+2); 
cumAi<-NULL; 

semiout<-.C("semibreslow",
as.double(times),as.integer(Ntimes),
as.double(designX),
as.integer(nx),as.integer(px),as.double(designG),
as.integer(ng),as.integer(pg),as.integer(fdata$antpers),
as.double(fdata$start),as.double(fdata$stop),as.integer(nb),
as.double(bhat),as.double(cum), as.double(Vcum), 
as.double(rvcu),as.double(gamma),as.double(Vargam),
as.double(RobVargam),as.double(band),as.integer(degree),
as.integer(it),as.integer(sim),as.integer(antsim),
as.double(test),as.integer(rani),as.double(testOBS),
as.integer(status),as.integer(id),as.double(schoen),
as.double(simUt),as.double(Ut),PACKAGE="timereg")  

bhat<-matrix(semiout[[13]],nb,px+2);
cum <-matrix(semiout[[14]],Ntimes,px+2);
Vcum <-matrix(semiout[[15]],Ntimes,px+2);
rvcu<-matrix(semiout[[16]],Ntimes,px+2);
gamma<-matrix(semiout[[17]],pg,1);
Vargam<-matrix(semiout[[18]],pg,pg);
RobVargam<-matrix(semiout[[19]],pg,pg);

schoen<-NULL; 
sim.testBeqC.is1<- sim.testBeqC.is2<-
obs.testBeqC.is1<- obs.testBeqC.is2<-
pval.testBeqC.is1<- pval.testBeqC.is2<-NULL;

if (sim>=1) {
unifCI<-c();
test<-matrix(semiout[[25]],antsim,3*pdim);
testOBS<-semiout[[27]];
for (i in 1:(3*pdim)) testval<-c(testval,pval(test[,i],testOBS[i]))
Uit<-matrix(semiout[[31]],Ntimes,50*pdim);
UIt<-list(); for (i in (0:49)*pdim)
UIt[[i/pdim+1]]<-as.matrix(Uit[,i+(1:pdim)]);
Ut<-matrix(semiout[[32]],Ntimes,(pdim+1));
for (i in 1:pdim) unifCI<-as.vector(c(unifCI,percen(test[,i],0.95)));
obs.testBeq0<-as.vector(testOBS[1:pdim]);
pval.testBeq0<-as.vector(testval[1:pdim]);
sim.testBeq0<-as.matrix(test[,1:pdim]);
pval.testBeqC<-as.vector(testval[(pdim+1):(2*pdim)]);
obs.testBeqC<-as.vector(testOBS[(pdim+1):(2*pdim)]);
sim.testBeqC<-as.matrix(test[,(pdim+1):(2*pdim)]);
pval.testBeqC.is<-as.vector(testval[(2*pdim+1):(3*pdim)]);
obs.testBeqC.is<-as.vector(testOBS[(2*pdim+1):(3*pdim)]);
sim.testBeqC.is<-as.matrix(test[,(2*pdim+1):(3*pdim)]);
} else {
test<-unifCI<-UIt<-Ut<-pval.testBeq0<-pval.testBeqC<-
obs.testBeq0<-obs.testBeqC<-obs.testBeqC.is<-Fpval.testBeqC.is<-
sim.testBeq0<-sim.testBeqC<-sim.testBeqC.is<-NULL; 
}
cov.list<-NULL; 

} else stop("Methods are : breslow and basic\n"); 

# method=method
ud<-list(cum=cum,var.cum=Vcum,robvar.cum=rvcu,
gamma=gamma,var.gamma=Vargam,robvar.gamma=RobVargam,
residuals=cumAi,
pval.testBeq0=pval.testBeq0, obs.testBeq0=obs.testBeq0,
pval.testBeqC=pval.testBeqC, obs.testBeqC=obs.testBeqC,
pval.testBeqC.is=pval.testBeqC.is, obs.testBeqC.is=obs.testBeqC.is,
sim.testBeq0= sim.testBeq0,sim.testBeqC=sim.testBeqC,
sim.testBeqC.is=sim.testBeqC.is,
conf.band=unifCI,test.procBeqC=Ut,sim.test.procBeqC=UIt,
covariance=cov.list)
return(ud);
}

pval<-function(simt,Otest)
{
simt<-sort(simt);
p<-sum(Otest<simt)/length(simt);
return(p)
}

percen<-function(x,per)
{ n<-length(x); tag<-round(n*per)+1; ud<-sort(x)[tag];
return(ud) }

#line 1 "/private/tmp/Rtmp08zS1i/R.INSTALL10d63af1/timereg/R/two-stage-reg.r"
prop<-function(x) x

two.stage<-function(formula=formula(data),data=sys.parent(),
beta=0,Nit=60,detail=0,start.time=0,max.time=NULL,id=NULL, 
clusters=NULL, robust=1,
rate.sim=1,beta.fixed=0,theta=NULL,theta.des=NULL,var.link=0,step=1)
{
  ratesim<-rate.sim; inverse<-var.link
  call <- match.call()
  m <- match.call(expand=FALSE)
  m$robust<-m$start.time<-m$beta<-m$Nit<-m$detail<-m$max.time<-m$clusters<-m$rate.sim<-m$beta.fixed<-m$theta<-m$theta.des<-m$var.link<-m$step<-NULL

  if (robust==0) cat("When robust=0 no variance estimate\n"); 

  special <- c("prop","cluster")
  Terms <- if(missing(data)) terms(formula, special)
  else          terms(formula, special, data=data)
  m$formula <- Terms
  m[[1]] <- as.name("model.frame")
  m <- eval(m, sys.parent())
  mt <- attr(m, "terms")
  intercept<-attr(mt, "intercept")
  Y <- model.extract(m, "response")
  if (!inherits(Y, "Surv")) stop("Response must be a survival object")

  des<-read.design(m,Terms,model="cox.aalen")
  X<-des$X; Z<-des$Z; npar<-des$npar; px<-des$px; pz<-des$pz;
  covnamesX<-des$covnamesX; covnamesZ<-des$covnamesZ

  if(is.null(clusters)) clusters <- des$clusters  
  
  pxz <- px + pz;

  survs<-read.surv(m,id,npar,clusters,start.time,max.time)
  times<-survs$times;id<-id.call<-survs$id.cal;
  clusters<-cluster.call<-survs$clusters; 
  time<-survs$start; time2<-survs$stop; status<-survs$status;
  ldata<-list(start=survs$start,stop=survs$stop,
              antpers=survs$antpers,antclust=survs$antclust);

  if (npar==FALSE) covar<-data.matrix(cbind(X,Z)) else 
  stop("Both multiplicative and additive model needed");

  Ntimes <- sum(status); 
  times<-c(start.time,time2[status==1]); times<-sort(times);
  if (is.null(max.time)==TRUE) maxtimes<-max(times)+0.1 else maxtimes<-max.time; 
  times<-times[times<maxtimes]

  if ((sum(beta)==0) & (beta.fixed==0)) beta<-coxph(Surv(time,time2,status)~Z)$coef; 

  if (px==0) stop("No nonparametric terms (needs one!)");
  ud<-two.stageBase.reg(times,ldata,X,Z,
                        status,id,clusters,Nit=Nit,detail=detail,beta=beta,
                        robust=robust,ratesim=ratesim,namesX=covnamesX,
   namesZ=covnamesZ,beta.fixed=beta.fixed,theta=theta,theta.des=theta.des,
   inverse=var.link,step=step);

  if (px>0) {
    colnames(ud$cum)<-colnames(ud$var.cum)<- c("time",covnamesX)
    if (robust==1) colnames(ud$robvar.cum)<- c("time",covnamesX) }

  rownames(ud$gamma)<-c(covnamesZ); colnames(ud$gamma)<-"estimate"; 
  rownames(ud$score)<-c(covnamesZ); colnames(ud$score)<-"score"; 

  ptheta<-length(ud$theta); 
  if (ptheta>1) {
                rownames(ud$theta)<-colnames(theta.des);
                names(ud$theta.score)<-colnames(theta.des); } 
 else { names(ud$theta.score)<- rownames(ud$theta)<-"intercept" } 

  attr(ud,"Call")<-sys.call(); 
  class(ud)<-"two.stage"
  attr(ud,"Formula")<-formula;
  attr(ud,"id")<-id.call;
  attr(ud,"cluster")<-cluster.call;
  attr(ud,"start")<-start.time; 
  attr(ud,"time2")<-time2; 
  attr(ud,"var.link")<-var.link

  return(ud); 
}

two.stageBase.reg<-function (times, fdata, designX, designG, status,
id, clusters, Nit = 5, beta = 0, detail = 0, robust = 1, 
ratesim = 1, namesZ=NULL,namesX=NULL,beta.fixed=0,theta=NULL,
theta.des=NULL,inverse=0,step=1) 
{
    additive.resamp <-0; ridge <- 0; XligZ <- 0;
    Ntimes <- length(times)
    designX <- as.matrix(designX); designG <- as.matrix(designG)
    if (is.matrix(designX) == TRUE) px <- as.integer(dim(designX)[2])
    if (is.matrix(designX) == TRUE) nx <- as.integer(dim(designX)[1])
    if (is.matrix(designG) == TRUE) pg <- as.integer(dim(designG)[2])
    if (is.matrix(designG) == TRUE) ng <- as.integer(dim(designG)[1])
    if (nx != ng) print(" A design og B designs er ikke ens\n")

    cumint <- matrix(0, Ntimes, px + 1)
    vcum <- matrix(0, Ntimes, px + 1)
    Rvcu <- matrix(0, Ntimes, px + 1)
    if (sum(abs(beta)) == 0) betaS <- rep(0, pg) else betaS <- beta
    score <- betaS
    Varbeta <- matrix(0, pg, pg)
    Iinv <- matrix(0, pg, pg)
    RVarbeta <- matrix(0, pg, pg)
    if (is.null(theta.des)==TRUE) ptheta<-1; 
    if (is.null(theta.des)==TRUE) theta.des<-matrix(1,ng,ptheta) else
    theta.des<-as.matrix(theta.des); 
    ptheta<-ncol(theta.des); 
    if (is.null(theta)==TRUE) theta<-rep(0.1,ptheta); 
    if (length(theta)!=ptheta) theta<-rep(theta[1],ptheta); 
    theta.score<-rep(0,ptheta);Stheta<-var.theta<-matrix(0,ptheta,ptheta); 

    cluster.size<-as.vector(table(clusters));
    maxclust<-max(cluster.size)
    idiclust<-matrix(0,fdata$antclust,maxclust); 
    for (i in 1:fdata$antclust) { idiclust[i,]<- which( clusters %in% (i-1))-1 }

    #dyn.load("two-stage-reg.so"); 

    nparout <- .C("twostagereg", 
        as.double(times), as.integer(Ntimes), 
        as.double(designX), as.integer(nx), as.integer(px), 
	as.double(designG), as.integer(ng), as.integer(pg), 
	as.integer(fdata$antpers),as.double(fdata$start),as.double(fdata$stop),
	as.double(betaS), as.integer(Nit), as.double(cumint), 
	as.double(vcum),  as.double(Iinv), as.double(Varbeta), 
	as.integer(detail), as.double(Rvcu), as.double(RVarbeta), 
         as.integer(id), as.integer(status), as.integer(ratesim), 
	as.double(score), as.integer(robust), as.integer(clusters),
        as.integer(fdata$antclust), as.integer(beta.fixed),
        as.double(theta),as.double(var.theta),as.double(theta.score),
        as.integer(inverse), as.integer(cluster.size), as.double(theta.des),
        as.integer(ptheta), as.double(Stheta),as.double(step),
        as.integer(idiclust),PACKAGE = "timereg")

    gamma <- matrix(nparout[[12]], pg, 1)
    cumint <- matrix(nparout[[14]], Ntimes, px + 1)
    vcum <- matrix(nparout[[15]], Ntimes, px + 1)
    Iinv <- matrix(nparout[[16]], pg, pg)
    Varbeta <- -matrix(nparout[[17]], pg, pg)
    Rvcu <- matrix(nparout[[19]], Ntimes, px + 1)
    RVarbeta <- -matrix(nparout[[20]], pg, pg)
    score <- matrix(nparout[[24]], pg, 1)


   theta<-matrix(nparout[[29]],ptheta,1);  
   var.theta<-matrix(nparout[[30]],ptheta,ptheta); 
   theta.score<-nparout[[31]]; 
   Stheta<-matrix(nparout[[32]],ptheta,ptheta); 

   ud <- list(cum = cumint, var.cum = vcum, robvar.cum = Rvcu, 
       gamma = gamma, var.gamma = Varbeta, robvar.gamma = RVarbeta, 
       D2linv = Iinv, score = score,  theta=theta,var.theta=var.theta,
       S.theta=Stheta,theta.score=theta.score)
   return(ud)
}

prop<-function(x) x


"summary.two.stage" <- function (object,digits = 3,...) {
  if (!(inherits(object, 'two.stage') || inherits(object, 'two.stage.reg'))) stop("Must be a Two-Stage object")
  
  prop<-TRUE; 
  if (is.null(object$gamma)==TRUE) stop(" No regression terms"); 
  if (is.null(object$prop.odds)==TRUE) p.o<-FALSE else p.o<-TRUE
    
  var.link<-attr(object,"var.link");
  cat("Dependence parameter for Clayton-Oakes-Glidden  model\n"); 

  if (sum(abs(object$theta.score)>0.000001) ) 
    cat("Variance parameters did not converge, allow more iterations\n\n"); 

  ptheta<-nrow(object$theta)
  sdtheta<-diag(object$var.theta)^.5
  if (var.link==0) {
      vari<-object$theta
      sdvar<-diag(object$var.theta)^.5
  }
  else {
      vari<-exp(object$theta)
      sdvar<-vari*diag(object$var.theta)^.5
  }
  dep<-cbind(object$theta[,1],sdtheta)
  walddep<-object$theta[,1]/sdtheta; 
  waldpdep<-(1-pnorm(abs(walddep)))*2

  kendall<-1/(1+2/vari) 
  kendall.ll<-1/(1+2/(object$theta+1.96*sdvar)) 
  kendall.ul<-1/(1+2/(object$theta-1.96*sdvar)) 
  if (var.link==0) resdep<-signif(as.matrix(cbind(dep,walddep,waldpdep,kendall)),digits)
  else resdep<-signif(as.matrix(cbind(dep,walddep,waldpdep,vari,sdvar,kendall)),digits);

  if (var.link==0) colnames(resdep) <- c("Variance","SE","z","P-val","Kendall's tau") 
  else colnames(resdep)<-c("log(Variance)","SE","z","P-val","Variance","SE Var.",
                           "Kendall's tau")
  prmatrix(resdep); cat("   \n");  

  cat("Marginal Cox-Aalen model fit\n\n"); 
  if (sum(abs(object$score)>0.000001) && sum(object$gamma)!=0) 
    cat("Marginal model did not converge, allow more iterations\n\n"); 

  if (prop) {
    if (p.o==FALSE) cat("Proportional Cox terms :  \n") else  cat("Covariate effects \n")

    coef.two.stage(object,digits=digits);
    cat("   \n");  cat("  Call: \n"); dput(attr(object, "Call")); cat("\n");
  }
}

print.two.stage <- function (x,digits = 3,...) {
  if (!(inherits(x, 'two.stage') || inherits(x, 'two.stage.reg'))) stop("Must be a Two-Stage object")
  cat(" Two-stage estimation for Clayton-Oakes-Glidden  model\n"); 
  cat(" Marginals of Cox-Aalen form, dependence by variance of Gamma distribution\n\n");  
  object <- x; rm(x);
  
  cat(" Nonparametric components : "); cat(colnames(object$cum)[-1]); cat("   \n");  
  if (!is.null(object$gamma)) {
    cat(" Parametric components :  "); cat(rownames(object$gamma)); 
    cat("   \n");
  } 
  cat("   \n");  

  cat(" Call: \n");
  print(attr(object,'Call'))
}


coef.two.stage<-function(object,digits=3,d2logl=1,...) {
   coefBase(object,digits=digits,d2logl=d2logl,...)
}

"plot.two.stage" <- function (x,  pointwise.ci=1, robust=0, specific.comps=FALSE,level=0.05, 
                              start.time = 0, stop.time = 0, add.to.plot=FALSE,mains=TRUE,
                              xlab="Time", ylab ="Cumulative regression function",...) {
  if (!(inherits(x, 'two.stage') || inherits(x, 'two.stage.reg'))) stop("Must be a Two-Stage object")
  object <- x; rm(x);  
 
  B<-object$cum; V<-object$var.cum; p<-dim(B)[[2]]; 
  if (robust>=1) V<-object$robvar.cum; 

  if (sum(specific.comps)==FALSE) comp<-2:p else comp<-specific.comps+1
  if (stop.time==0) stop.time<-max(B[,1]);

  med<-B[,1]<=stop.time & B[,1]>=start.time
  B<-B[med,]; Bs<-B[1,];  B<-t(t(B)-Bs); B[,1]<-B[,1]+Bs[1];
  V<-V[med,]; Vs<-V[1,]; V<-t( t(V)-Vs); 
  Vrob<-object$robvar.cum; 
  Vrob<-Vrob[med,]; Vrobs<-Vrob[1,]; Vrob<-t( t(Vrob)-Vrobs); 

  c.alpha<- qnorm(1-level/2)
  for (v in comp) { 
    c.alpha<- qnorm(1-level/2)
    est<-B[,v];ul<-B[,v]+c.alpha*V[,v]^.5;nl<-B[,v]-c.alpha*V[,v]^.5;
    if (add.to.plot==FALSE) 
      {
        plot(B[,1],est,ylim=1.05*range(ul,nl),type="s",xlab=xlab,ylab=ylab) 
        if (mains==TRUE) title(main=colnames(B)[v]); }
    else lines(B[,1],est,type="s"); 
    if (pointwise.ci>=1) {
      lines(B[,1],ul,lty=pointwise.ci,type="s");
      lines(B[,1],nl,lty=pointwise.ci,type="s"); }
    if (robust>=1) {
      lines(B[,1],ul,lty=robust,type="s"); 
      lines(B[,1],nl,lty=robust,type="s"); }
    abline(h=0); 
  }
}
