`pvalstest_logrank` <-
function(datacgh,data.info,dataclinvar,whtime=1,whstatus=2,lgonly=0,af=0,niter=1000){
    #datacgh<-datacgh;data.info<-datainfo;dataclinvar<-dataclinvar;niter=10;sepfile<- "no";whtime<-3;whstatus<-4;lgonly<-0;af<-0.1

########FUNCTIONS #################

    pvalpermtwono <- function(pl,nit){
        pv <- c(1)
        for (i in 2:nit){
            if(pl[i]==pl[i-1]) pv <- c(pv,pv[i-1]) else pv <- c(pv,(nit-i+1)/nit)
        }
        return(pv)
    }
    
    pvalpermtwoyes <- function(pl,nit){
        pv <- c(1)
        pv2 <- c(1)
        l <- length(pl)
        pl2 <- pl[l:1]
        for (i in 2:nit){
            if(pl[i]==pl[i-1]) pv <- c(pv,pv[i-1]) else pv <- c(pv,(nit-i+1)/nit)
            if(pl2[i]==pl2[i-1]) pv2 <- c(pv2,pv2[i-1]) else pv2 <- c(pv2,(nit-i+1)/nit)
        }
        pvmin <- 2*apply(cbind(pv,pv2[l:1]),1,min2)
        return(pvmin)
    }
    
    min2 <- function(lst){
        return(min(lst[1],lst[2],0.5))
    }
    
    pvalfuntwono <- function(lijst,nit){
        obs <- lijst[1]
        lijstperm <- lijst[2:(nit+1)] #changed 23/7/09
        tlarg <- length(lijstperm[lijstperm >= obs])/nit
        return(tlarg)
    }
    
    pvalfuntwoyes <- function(lijst,nit){
        #lijst<-TESTpermobs[1738,];nit<-10
        obs <- lijst[1]
        lijstperm <- lijst[2:(nit+1)] #changed 23/7/09
        tlarg <- length(lijstperm[lijstperm >= obs])/nit
        tsmall <- length(lijstperm[lijstperm <= obs])/nit
        return(min(1,2*min(tlarg,tsmall)))
     }
    
    
    
    countlev <- function(row,level)
    {
    length(row[row==level])
    }
    
    countall <- function(row,levels)
    {
    sapply(levels,countlev,row=row)
    }
    
    includewh <- function(exprow, cutp)
    {
    exprow2 <- matrix(exprow,nrow=2)
    exprow3 <- exprow2[1,]+exprow2[2,]
    sapply(exprow3,function(x)ifelse(x>cutp,1,0))
    }

levels<-sort(unique(unlist(as.list(datacgh))))
lossonly <- function(x){min(x,0)}
gainonly <- function(x){if(x>=1){return(1)} else {return(0)}}
countnonnull <- function(row){return(length(row[row!=0]))}

Xmat <- as.matrix(datacgh)
if (lgonly==-1) 
{
Xmat <- apply(Xmat,c(1,2),lossonly)
levels <- c(-1,0)
}
if (lgonly==1)
{
Xmat <- apply(Xmat,c(1,2),gainonly)
levels <- c(0,1)
}
wr <- apply(Xmat,1,countnonnull)
nc <-ncol(Xmat)
whichrows <- which(wr>=nc*af)
Xmat <- Xmat[whichrows,]

datacl <- data.info[whichrows,]

clinvarname <- colnames(dataclinvar)[whtime]
surv.time <- dataclinvar[,whtime]
surv.status01 <- dataclinvar[,whstatus]
surv.status <- surv.status01==1
surv.obj <- Surv(surv.time, surv.status)
twosided <- "no"


    

    
    
    TESTlogrank <- function(cgh,surv.obj){
     if(length(unique(cgh)) == 1) return(1) else {
        cghfac <- as.factor(cgh)
        stest <- survdiff(surv.obj ~ cghfac)
        stat <- stest$chisq
        return(stat)
        }
    }
    
    ####observed values  #########  AND  ####Permutation algorithm   #####

    
    
    #logrank test
   
    TESTobs0 <- apply(Xmat,1,TESTlogrank, surv.obj=surv.obj)
    TESTobs <- TESTobs0
    pmt <- proc.time()
    all_label <- 1:nc
    TESTpermall <- c()
    for (i in (1:niter))
    {
    print(i)
    ranseq <- sample(all_label)
    permmat <- Xmat[,ranseq]
    TESTperm0 <- apply(permmat,1,TESTlogrank, surv.obj=surv.obj) 
    TESTperm <- TESTperm0
    TESTpermall <- cbind(TESTpermall,TESTperm)
    }
    proc.time() - pmt
    
    
    
    
   
    
    TESTpermsort <- matrix(apply(TESTpermall,1,sort),byrow=TRUE,nrow=nrow(TESTpermall))
    TESTpermind <- matrix(apply(TESTpermall,1,order),byrow=TRUE,nrow=nrow(TESTpermall))
    TESTpermobs <- cbind(TESTobs,TESTpermsort)
    
    if (twosided=="yes") {
    pvalue <- apply(TESTpermobs,1,pvalfuntwoyes, nit=niter)
    pvpa <- apply(TESTpermsort,1,pvalpermtwoyes, nit=niter)
    pvpa <- apply(cbind(t(pvpa),TESTpermind),1,function(x){el <- length(x);
    x1 <- x[1:(el/2)];x2 <- x[(el/2+1):el]; f1 <- array(dim=c(el/2));f1[x2]<-x1;return(f1)})
    } else
    {
    pvalue <- apply(TESTpermobs,1,pvalfuntwono, nit=niter)
    pvpa <- apply(TESTpermsort,1,pvalpermtwono, nit=niter)
    pvpa <- apply(cbind(t(pvpa),TESTpermind),1,function(x){el <- length(x);
    x1 <- x[1:(el/2)];x2 <- x[(el/2+1):el]; f1 <- array(dim=c(el/2));f1[x2]<-x1;return(f1)})
    }
      
    pvs <- list(pvals=pvalue,pvperm=t(pvpa),info=datacl)
    
    return(pvs)  #pvalue + pvpa
}

