.packageName <- "pseudo"
"ci.omit" <-
function(pseudo,tmax){
	
	#calculate cum. inc. function, leave one out
	
	howmany <- nrow(pseudo)
	
	d1 <- as.numeric(pseudo$event==1)
	d2 <- as.numeric(pseudo$event==2)
	event <- as.numeric(pseudo$event>0)
	
	td <- pseudo$time[event==1]
	lt.temp <- c(td[-1],td[length(td)]+1)
	lt <- which(td!=lt.temp)
	
	#km - i
	Y1 <- matrix(howmany:1,byrow=TRUE,ncol=howmany,nrow=howmany)
	Y2 <- matrix((howmany-1):0,byrow=TRUE,ncol=howmany,nrow=howmany)
	Y <- upper.tri(Y1,diag=FALSE)*Y1+lower.tri(Y2,diag=TRUE)*Y2
	N <- matrix(event,byrow=TRUE,ncol=howmany,nrow=howmany)
	Ndiag <- diag(diag(N))
	N <- N - Ndiag
	
	N1 <- matrix(d1,byrow=TRUE,ncol=howmany,nrow=howmany)
	Ndiag1 <- diag(diag(N1))
	N1 <- N1 - Ndiag1
	
	cum1 <- N1/Y
	
	N2 <- matrix(d2,byrow=TRUE,ncol=howmany,nrow=howmany)
	Ndiag2 <- diag(diag(N2))
	N2 <- N2 - Ndiag2
	
	cum2 <- N2/Y
	
	kmji <- (Y-N)/Y
		
	km <- t(apply(kmji,1,cumprod))
	

	#corrected value for the last time - last value carried forward 
	aje <- which(is.na(km[howmany,]))
	if(length(aje)>0){
		kir <- min(aje)
		km[howmany,kir:ncol(km)] <- km[howmany,kir-1] 
	}
	
	km <- cbind(rep(1,nrow(km)),km[,-ncol(km)])
	
	C1 <- t(apply(cum1*km,1,cumsum))
	C2 <- t(apply(cum2*km,1,cumsum))
	
	#only for deaths, one value per tie
	C1 <- C1[,event==1]
	C1 <- C1[,lt]
	C2 <- C2[,event==1]
	C2 <- C2[,lt]
	list(td=unique(td),C1=C1,C2=C2)	
}

"ci.tot" <-
function(pseudo){
	#calculate cum. inc. function, all cases
	
	howmany <- nrow(pseudo)
	
	d1 <- as.numeric(pseudo$event==1)
	d2 <- as.numeric(pseudo$event==2)
	event <- as.numeric(pseudo$event>0)
	
	td <- pseudo$time[event==1]
	lt.temp <- c(td[-1],td[length(td)]+1)
	lt <- which(td!=lt.temp)
	
	#km - i
	Y <- howmany:1
	N <- event
	N1 <- d1
	N2 <- d2
	cum1 <- N1/Y
	
	cum2 <- N2/Y
	
	kmji <- (Y-N)/Y
		
	km <- cumprod(kmji)
	
	km <- c(1,km[-length(km)])
	
	C1 <- cumsum(cum1*km)
	C2 <- cumsum(cum2*km)
	
	#only for deaths, one value per tie
	C1 <- C1[event==1]
	C1 <- C1[lt]
	C2 <- C2[event==1]
	C2 <- C2[lt]
	rbind(C1,C2)
}

"pseudoci" <-
function(time, event, tmax){

	if(any(is.na(time)))
		stop("missing values in 'time' vector")
		
	if(any(time)<0)
		stop("'time' must be nonnegative")
	
	if(any(is.na(event)))
		stop("missing values in 'event' vector")
	
	if(any(event!=0 & event!=1 & event!=2))
		stop("'event' must be a 0/1/2 variable (alive/cause 1/cause 2)")
		
	if(missing(tmax)) 
		tmax <- unique(time[event!=0])
	
	if(any(is.na(tmax)))
		stop("missing values in 'tmax' vector")
	
	if (sum(tmax > max(time)) > 0) 
	   stop ("tmax greater than largest observation time")
   
	tmax <- sort(tmax)
	ltmax <- length(tmax)
	howmany <- length(time)

	# preparing the output
	pseudo <- as.data.frame(matrix(data = NA, ncol = 2*ltmax+3, nrow = howmany))
	pseudo[,1] <- 1:howmany
	pseudo[,2] <- time
	pseudo[,3] <- event
	
	names(pseudo) <- c("id","time", "event", paste(rep(c("r1","r2"),ltmax),rep(round(tmax,3),each=2),sep=",t="))
	
	# sort in time
	pseudo <- pseudo[order(pseudo$time,-pseudo$event),]
	
	# time points chosen	
	tu <- unique(pseudo$time[pseudo$event!=0])
	ltu <- length(tu)
	tu <- matrix(tu,byrow=TRUE,ncol=ltu,nrow=ltmax)
	tgiven <- matrix(tmax,byrow=FALSE,ncol=ltu,nrow=ltmax)
	inx <- apply(tgiven>=tu,1,sum)

	# CI, leave one out
	pseu <- ci.omit(pseudo)
	CI1 <- pseu$C1[,inx,drop=FALSE]
	CI2 <- pseu$C2[,inx,drop=FALSE]
	CI.omit <- matrix(rbind(CI1,CI2),ncol=2*ltmax,nrow=nrow(CI1))

	# CI, all cases
	CI.tot <- ci.tot(pseudo)[,inx]
	CI.tot <- matrix(CI.tot,byrow=TRUE,ncol=2*ltmax,nrow=howmany)
	
      	## Pseudo-observations
      	pseudo[,4:(3+2*ltmax)] <- howmany*CI.tot - (howmany-1)*CI.omit

	#back to original order
   	pseudo <- pseudo[order(pseudo$id),]
   	pseudo <- pseudo[,-1]
	
	return(pseudo)
}

"pseudomean" <-
function(time, event, tmax){

	if(any(is.na(time)))
		stop("missing values in 'time' vector")
		
	if(any(time)<0)
		stop("'time' must be nonnegative")
	
	if(any(is.na(event)))
		stop("missing values in 'event' vector")
	
	if(any(event!=0 & event!=1))
		stop("'event' must be a 0/1 variable (alive/dead)")
		
	if(missing(tmax)) 
		tmax <- max(time[event==1])

	if(is.na(tmax))
		stop("missing value of 'tmax'")

	
	rmtime <- ifelse(time >= tmax ,tmax,time)
	rmdead <- ifelse(time >= tmax ,0, event)

	if(sum(rmdead)==0)
		stop("no events occured before time 'tmax'")
    
	howmany <- length(rmtime)
    	
    
	## preparing the output
    	pseudo <- as.data.frame(matrix(data = NA, ncol = 6, nrow = howmany))
    	pseudo[,1] <- 1:howmany
    	pseudo[,2] <- rmtime
    	pseudo[,3] <- time
    	pseudo[,4] <- event
    	pseudo[,5] <- rmdead
    	names(pseudo) <- c("id","time","timet","eventt","event","psumean")
    
    	# sort in time
    	pseudo <- pseudo[order(pseudo$time,-pseudo$event),]
	 
    
	# RM, leave one out
	RM.omit <- surv.omit(pseudo,tmax)
	
	#RM, all cases
	RM.tot <- surv.tot(pseudo,tmax)

	# pseudo-observations
	pseu <- howmany*RM.tot - (howmany-1)*RM.omit

	#back to original order
	pseudo[,-(1:5)] <- pseu
	pseudo <- pseudo[order(pseudo$id),]
	pseudo <- pseudo[,-c(1,2,5)]
	names(pseudo)[1:2] <- c("time","event")
	return(pseudo)    
}

"pseudosurv" <-
function(time, event, tmax){
	
	if(any(is.na(time)))
		stop("missing values in 'time' vector")
		
	if(any(time)<0)
		stop("'time' must be nonnegative")
	
	if(any(is.na(event)))
		stop("missing values in 'event' vector")
	
	if(any(event!=0 & event!=1))
		stop("'event' must be a 0/1 variable (alive/dead)")
		
	if(missing(tmax)) 
		tmax <- unique(time[event==1])
	
	if(any(is.na(tmax)))
		stop("missing values in 'tmax' vector")
	
	if (sum(tmax > max(time)) > 0) 
	   stop ("tmax greater than largest observation time")
	   
	tmax <- sort(tmax)
	ltmax <- length(tmax)
	howmany <- length(time)
	

	## preparing the output
	pseudo <- as.data.frame(matrix(data = NA, ncol = length(tmax)+3, nrow = howmany))
	pseudo[,1] <- 1:howmany
	pseudo[,2] <- time
	pseudo[,3] <- event
	names(pseudo) <- c("id","time", "event",paste("tmax =", round(tmax,3), sep=""))

	# sort in time
	pseudo <- pseudo[order(pseudo$time,-pseudo$event),]

	# time points chosen	
	tu <- unique(pseudo$time[pseudo$event==1])
	ltu <- length(tu)
	tu <- matrix(tu,byrow=TRUE,ncol=ltu,nrow=ltmax)
	tgiven <- matrix(tmax,byrow=FALSE,ncol=ltu,nrow=ltmax)
	inx <- apply(tgiven>=tu,1,sum)
	
	# KM, leave one out
	KM.omit <- surv.omit(pseudo)
	KM.omit <- KM.omit[,inx,drop=FALSE]
	
	# KM, all cases
	KM.tot <- surv.tot(pseudo)[inx]
	KM.tot <- matrix(KM.tot,byrow=TRUE,nrow=howmany,ncol=length(tmax))
	
	# pseudo-observations
	pseu <- howmany*KM.tot - (howmany-1)*KM.omit
	
	# back to original order
	pseudo[,-(1:3)] <- pseu
	pseudo <- pseudo[order(pseudo$id),]
	pseudo <- pseudo[,-1]
	return(pseudo)

}

"surv.omit" <-
function(pseudo,tmax){
	
	# calculate Kaplan - Meier, leave one out 
	howmany <- nrow(pseudo)
	
	td <- pseudo$time[pseudo$event==1]
	lt.temp <- c(td[-1],td[length(td)]+1)
	lt <- which(td!=lt.temp)
	
	#km - i
	Y1 <- matrix(howmany:1,byrow=TRUE,ncol=howmany,nrow=howmany)
	Y2 <- matrix((howmany-1):0,byrow=TRUE,ncol=howmany,nrow=howmany)
	Y <- upper.tri(Y1,diag=FALSE)*Y1+lower.tri(Y2,diag=TRUE)*Y2
	N <- matrix(pseudo$event,byrow=TRUE,ncol=howmany,nrow=howmany)
	Ndiag <- diag(diag(N))
	N <- N - Ndiag
	
	kmji <- (Y-N)/Y
		
	km <- t(apply(kmji,1,cumprod))
	
	if(!missing(tmax)){
		tt <- matrix(pseudo$time,byrow=TRUE,nrow=nrow(pseudo),ncol=nrow(pseudo))
		#diag(tt) <- c(diag(tt[-nrow(pseudo),-1]),tmax)
		diag(tt) <- c(0,diag(tt[-1,-nrow(pseudo)]))
		tt <- tt[,pseudo$event==1,drop=FALSE]
		tt <- tt[,lt,drop=FALSE]
		tt <- cbind(rep(0,nrow(pseudo)),tt,rep(tmax,nrow(pseudo)))
		tt <- t(apply(tt,1,diff))
	}
	
	
	#corrected value for the last time - last value carried forward 
	aje <- which(is.na(km[howmany,]))
	if(length(aje)>0){
		kir <- min(aje)
		km[howmany,kir:ncol(km)] <- km[howmany,kir-1] 
	}
	
	#only for deaths, one value per tie
	km <- km[,pseudo$event==1,drop=FALSE]
	km <- km[,lt,drop=FALSE]
	if(!missing(tmax)){
		km <- apply(cbind(rep(1,nrow(pseudo)),km)*tt,1,sum)
	}
	km	
}

"surv.tot" <-
function(pseudo,tmax){

	# calculate Kaplan - Meier, all cases

	howmany <- nrow(pseudo)
	
	td <- pseudo$time[pseudo$event==1]
	lt.temp <- c(td[-1],td[length(td)]+1)
	lt <- which(td!=lt.temp)
	
	#km - i
	Y <- howmany:1
	N <- pseudo$event
	
	kmji <- (Y-N)/Y
		
	km <- cumprod(kmji)
	
	if(!missing(tmax)){
		tt <- pseudo$time[pseudo$event==1]
		tt <- tt[lt]
		tt <- c(0,tt,tmax)
		tt <- diff(tt)
	}
	
	#only for deaths, one value per tie
	km <- km[pseudo$event==1]
	km <- km[lt]
	if(!missing(tmax)){
		km <- sum(c(1,km)*tt)
	}
	km	
}

