.packageName <- "vrtest"
`Boot.test` <-
function(y,kvec,nboot,indicator)
{
    set.seed(12345)
    y <- as.matrix(y)
    LC <- LMCD(y,kvec)
    
    statmat <- matrix(NA, nrow=nboot, ncol=length(kvec)+1)
    if (indicator == 2)
    {
        stat <- matrix(c(LC$M2,LC$CD2))
        for (i in 1:nboot)
        {
        ys <- y * rnorm(nrow(y))
        LCs <- LMCD(ys,kvec)
        statmat[i,] <- c(LCs$M2,LCs$CD2)
        }

    p <- matrix(NA,nrow = col(statmat), ncol=1)
    for (i in 1:ncol(statmat))
        {
        tem <- abs(statmat[,i]) > abs(stat[i])
        tem[tem == "TRUE"] <- 1
        p[i] <- mean(tem) 
        }
    }

    if (indicator == 1)
    {
        stat <- matrix(c(LC$M1,LC$CD1))
        for (i in 1:nboot)
        {
        index <- as.integer(runif(nrow(y), min=1, max=nrow(y)))
        ys <- as.matrix(y[index])
        LCs <- LMCD(ys,kvec)
        statmat[i,] <- c(LCs$LM1,LCs$CD1)
        } 
    
    p <- matrix(NA,nrow = col(statmat), ncol=1)
    for (i in 1:ncol(statmat))
        {
        tem <- abs(statmat[,i]) > abs(stat[i])
        tem[tem == "TRUE"] <- 1
        p[i] <- mean(tem) 
        }
    }
return(list(Holding.Period=kvec,LM.pval=as.numeric(p[1:length(kvec)]),CD.pval=as.numeric(p[length(kvec)+1])))
}

`Chow.Denning` <-
function(y,kvec)
{
    y <- as.matrix(y)
    n <- nrow(y)
    mq <- matrix(NA, nrow=length(kvec), ncol=2)
    for (i in 1:length(kvec))
    {
    k <- kvec[i]
    LM <- LM_stat(y,k)
    mq[i,] <- cbind(LM$LM1,LM$LM2)
    }

    mv1 <- max(abs(mq[,1]))
    mv2 <- max(abs(mq[,2]))
    
    alpha <- c(0.1,0.05,0.01)
    per <- 0.5*( 1-(1-alpha)^(1/length(kvec)))
    crit <- qnorm(1-per)

return(list(Holding.Periods=kvec,CD1=mv1,CD2=mv2,Critical.Values_10_5_1_percent=crit))
}

`JWright.crit` <-
function(n,kvec,nit)
{
    set.seed(12345)
    mat <- matrix(NA,nrow=nit,ncol=3)
    for (i in 1:nit)
    {
        
        ranking <- as.matrix(sample(1:n,n,replace=FALSE))
        r1 <- (ranking - 0.5*(n+1) )/sqrt((n-1)*(n+1)/12)
        r2 <- qnorm(ranking/(n+1))
        y <- as.matrix(rnorm(n))
        s <- sign(y)
        s[ s == 0] <- -1
    
        statmat <- matrix(NA, nrow=length(kvec), ncol=3)
    
        for (j in 1:length(kvec))
        {
        k <- kvec[j]
        statmat[j,] <- cbind(stat(r1,k),stat(r2,k),stat(s,k))
        }
    
    R1 <- max(abs(statmat[,1]))
    R2 <- max(abs(statmat[,2]))
    S1 <- max(abs(statmat[,3]))
    mat[i,] <- c(R1,R2,S1)
    }

alpha <- c(0.90,0.95,0.99)
R1crit <- quantile(mat[,1],alpha )
R2crit <- quantile(mat[,2],alpha )
S1crit <- quantile(mat[,3],alpha )
return(list(Holding.Period=kvec,JR1.crit=R1crit,JR2.crit=R2crit,JS1.crit=S1crit))    
}

`Joint.Wright` <-
function(y,kvec)
{
    y <- as.matrix(y)    
    n <- nrow(y)
    W_mat <- matrix(NA, nrow=length(kvec), ncol=3)
    for (i in 1:length(kvec))
    {
    k <- kvec[i]
    W <- Wright_stat(y,k)
    W_mat[i,] <- cbind(W$WR1,W$WR2,W$WS1)
    }

    jr1 <- max(abs(W_mat[,1]))
    jr2 <- max(abs(W_mat[,2]))
    js1 <- max(abs(W_mat[,3]))
    
return(list(Holding.Period=kvec,JR1=jr1,JR2=jr2,JS1=js1))
}

`LMCD` <-
function(y,kvec)
{
    y <- as.matrix(y)
    n <- nrow(y)
    mq <- matrix(NA, nrow=length(kvec), ncol=2)
    for (i in 1:length(kvec))
    {
    k <- kvec[i]
    LM <- LM_stat(y,k)
    mq[i,] <- cbind(LM$LM1,LM$LM2)
    }

    mv1 <- max(abs(mq[,1]))
    mv2 <- max(abs(mq[,2]))
    
return(list(M1=mq[,1],M2=mq[,2],CD1=mv1,CD2=mv2))
}

`LM_stat` <-
function(y,k)
{
    y <- as.matrix(y)
    n <- nrow(y) 
    m <- mean(y)
    vr1 <- sum( (y-m)^2 )/n

    index <- 1:k
    summ <- 0

    for (i in k:n)
    {
    summ <- summ + (sum(y[index]) -k*m)^2
    index <- index+1
    }

    vr2 <- summ/(n*k)
    vr <- vr2/vr1

    tem1 <- 2*(2*k-1)*(k-1)
    tem2 <- 3*k

    m1 <- sqrt(n)*(vr-1)/sqrt( tem1/tem2 )

    y1 <- y-m
    dvec <- matrix(NA, nrow=(k-1), ncol=1)

    for (j in 1:(k-1))
    {
    summ <- 0
    i <- j+1
    for (i in (j+1):n)
    {
    summ <- summ + y1[i]^2*y1[i-j]^2
    }
    dvec[j] <- summ/( sum(y1^2)^2 )
    }

    summ <- 0
    for (j in 1:(k-1))
    {
    summ <- summ + ((2*(k-j)/k)^2*dvec[j])
    }

    m2 <- sqrt(n)*(vr-1)*((n*summ)^(-.5) )
return(list(LM1=m1,LM2=m2))
}

`Lo.Mac` <-
function(y,kvec)
{
    y <- as.matrix(y)
    n <- nrow(y)
    mq <- matrix(NA, nrow=length(kvec), ncol=2)
    for (i in 1:length(kvec))
    {
    k <- kvec[i]
    LM <- LM_stat(y,k)
    mq[i,] <- cbind(LM$LM1,LM$LM2)
    }
    return(list(Holding.Periods=kvec,M1.stat=mq[,1],M2.stat=mq[,2]))
}

`Subsample.test` <-
function(y,kvec)
{
    y <- as.matrix(y)
    n <- nrow(y)
    b1 <- as.integer(2.5*n^(0.3))
    b2 <- as.integer(3.5*n^(0.6))
    term <- as.integer( (b2-b1)/7 ) 
    b1vec <- as.matrix(seq(b1,b2,term)[2:7])

    p <- matrix(NA,nrow = nrow(b1vec), ncol=1)

    for (i in 1:nrow(b1vec))    
    {   
        mv <- WK_stat2(y,kvec)
        b1 <- b1vec[i]
        mvsamp <- matrix(NA,nrow=(n-b1+1),ncol=1) 
        index <- 1:b1
        for (j in 1:(n-b1+1))
            {
            xsub <- as.matrix(y[index])
            mvsamp[j] <- WK_stat2(xsub,kvec)
            index <- index+1
            }
   
   tem <- mvsamp > mv
   tem[tem == "TRUE"] <- 1
   p[i] <- mean(tem) 
   }   
return(list(Holding.Period=kvec,Block.length=as.numeric(b1vec),pval=as.numeric(p)))
}

`WK_stat1` <-
function(y,k)
{
    y <- as.matrix(y)
    n <- nrow(y) 
    m <- mean(y)
    vr1 <- sum( (y-m)^2 )/n

    index <- 1:k
    summ <- 0

    for (i in k:n)
    {
    summ <- summ + (sum(y[index]) -k*m)^2
    index <- index+1
    }

    vr2 <- summ/(n*k)
    vr <- vr2/vr1

    m1 <- sqrt(n)*(vr-1)
return(m1)
}

`WK_stat2` <-
function(y,kvec)
{
    y <- as.matrix(y)
    n <- nrow(y)
    mq <- matrix(NA, nrow=length(kvec), ncol=1)
    for (i in 1:length(kvec))
    {
    k <- kvec[i]
    mq[i,] <- WK_stat1(y,k)
    }

return(max(abs(mq)))
}

`Wald` <-
function(y,kvec)
{
    y <- as.matrix(y)
    n <- nrow(y)
    mvr <- matrix(NA, nrow=length(kvec), ncol=1)
    for (i in 1:length(kvec))
    {
    k <- kvec[i]
    VR <- Wald1(y,k)
    mvr[i,] <- cbind(VR)
    }
    mat <-covmat(kvec)
    w <- n* t(mvr) %*% solve(mat) %*% mvr
    alpha <- c(0.1,0.05,0.01)
    cr <- qchisq(1-alpha,length(kvec))
    return(list(Holding.Periods=kvec,Wald.stat=as.numeric(w),Critical.Values_10_5_1_percent=cr))
}

`Wald1` <-
function(y,k)
{
    y <- as.matrix(y)
    n <- nrow(y) 
    m <- mean(y)
    vr1 <- sum( (y-m)^2 )/n

    index <- 1:k
    summ <- 0

    for (i in k:n)
    {
    summ <- summ + (sum(y[index]) -k*m)^2
    index <- index+1
    }

    vr2 <- summ/(n*k)
    vr <- vr2/vr1 -1
 return(vr)
 }

`Wright` <-
function(y,kvec)
{
    y <- as.matrix(y)
    n <- nrow(y)
    W_mat <- matrix(NA, nrow=length(kvec), ncol=3)
    for (i in 1:length(kvec))
    {
    k <- kvec[i]
    W <- Wright_stat(y,k)
    W_mat[i,] <- cbind(W$WR1,W$WR2,W$WS1)
    }

return(list(Holding.Period=kvec,R1.test=W_mat[,1],R2.test=W_mat[,2],S1.test=W_mat[,3]))
}

`Wright.crit` <-
function(n,k,nit)
{
    set.seed(12345)
    mat <- matrix(NA,nrow=nit,ncol=3)
    for (i in 1:nit)
    {
    
    ranking <- as.matrix(sample(1:n,n,replace=FALSE))
    r1 <- (ranking - 0.5*(n+1) )/sqrt((n-1)*(n+1)/12)
    r2 <- qnorm(ranking/(n+1))
    
    y <- as.matrix(rnorm(n))
    s <- sign(y)
    s[ s == 0] <- -1

    R1 <- stat(r1,k) 
    R2 <- stat(r2,k)
    S1 <- stat(s,k) 
    mat[i,] <- c(R1,R2,S1)
    }

alpha <- c(0.01,0.05,0.1)
R1crit <- quantile(mat[,1],c(0.5*alpha, rev(1-0.5*alpha)) )
R2crit <- quantile(mat[,2],c(0.5*alpha, rev(1-0.5*alpha)) )
S1crit <- quantile(mat[,3],c(0.5*alpha, rev(1-0.5*alpha)) )
return(list(Holding.Period=k,R1.crit=R1crit,R2.crit=R2crit,S1.crit=S1crit))    
}

`Wright_stat` <-
function(y,k) 
{
    y <- as.matrix(y)
    n <- nrow(y)
    ranking <- as.matrix(rank(y))
    r1 <- (ranking - 0.5*(n+1) )/sqrt((n-1)*(n+1)/12)
    r2 <- qnorm(ranking/(n+1))
    s <- sign(y)
    s[ s == 0] <- -1

    R1 <- stat(r1,k) 
    R2 <- stat(r2,k)
    S1 <- stat(s,k) 
    
return(list(WR1=R1,WR2=R2,WS1=S1))
}

`covmat` <-
function(kvec)
{
    d <- length(kvec)
    mat <- matrix(0,nrow=d,ncol=d)
    dvec <- (2*(2*kvec-1) * (kvec-1)) / (3*kvec)
    diag(mat) <- dvec

    for (i in 1:d)
    {
        for (j in 1:d)
        {
        if (i==j)
        tem <- 0
        if (j > i)
        tem <- 0
    
        mat[i,j] <- (2*(3*kvec[i]-kvec[j]-1)*(kvec[j]-1))/(3*kvec[i])
        mat[j,i] <- mat[i,j]
        }
    }
return(mat)
}

`stat` <-
function(x,k)
{
    y <- as.matrix(x)
    n <- nrow(x)
    index <- 1:k
    summ <- 0

    for (i in k:n)
    {
    summ <- summ + sum(x[index])^2
    index <- index+1
    }

    vr1 <- sum(x^2)/n
    vr2 <- summ/(n*k)

    vr <- vr2/vr1
    tem1 <- 2*(2*k-1)*(k-1)
    tem2 <- 3*k*n

    vrstat <- (vr-1)/sqrt( tem1/tem2 )
}

