.packageName <- "crossdes"
"GF" <-
function(p,n){

  require(conf.design)

  if( (p%%1) || (p < 2) ){stop("p is not a prime number.")}
  if( primes(p)[length(primes(p))]!=p ){stop("p is not a prime number.")}
  if( (n%%1) || (n < 1) ){stop("n is not a positive integer.")}

  ord <- p^n                                     # order of the field 
  
  if( n==1 )                                     # trivial case
   { elemente <- c(0:(p-1))
     primpol <- NULL
     out<-list(elemente,primpol)}
  else
   {  
     a <- factor.comb(p,n)                       # The monic polynomials are constructed using a full factorial plan 
     g <- cbind( rep(1,ord), a )  
                                                 # evaluate polynomials for 0,1,...,p-1
                                                 # rows where h is all non-zero correspond to irreducible polynomials 
                                                 # get them into irr      
     h <- matrix(0, ord, p)
    
     for (i in 0:(p-1)){                                 
       a <- numeric(ord)
       for (j in 1:n){ 
         a <- a + g[,j]*(i^(n+1-j))  
       }
       h[,i+1] <- (a + g[,n+1])%%p
     }
     
     irr <- g[apply(h,1,all),]
     if(is.vector(irr))
       { irr <- matrix(irr,nrow=1) }
   
     # Get the primitive roots. For all polynomials compute : p^1,p^2,...,p^(ord-1).
     # Cycle is completed after at most ord-1 powers. If ord-1 powers are needed, a primitive root is found.
     # Look for smallest power of p that has coefficients equal to (0,...,0,0,1).
     # First power is always equal to (0,...,0,1,0), don't need to check that.
    
     nirr <- nrow(irr)
     z1 <- numeric(nirr)
    
     for (i in 1:nirr){
       dummy <- c(numeric(ord-3),1,0)            # 1st power of (1,0); ord-3>0 since p,n>2. 
       j <- 0
       while( z1[i]==0 ){                        # ord-1st to 2nd power of (1,0)
         j <- j+1
         dummy <- redu.modp(c(dummy,0), irr[i,], p)        
                                                 # division modulo p
         if( all(dummy==c(numeric(n-1),1)) ) {z1[i] <- j+1}       
           # dummy is a polynomial of degree n-1.
           # all(...)==TRUE if the result by division modulo p is (0,1), i.e. the number one.
           # Here rest(x^n : polynom) = rest(x*rest(x^n-1 : polynom))
           # get smallest power that equals (0,1)
       }
     }
    
     primpol <- irr[which(z1==(ord-1)),]            
     if (is.vector(primpol)){ primpol <- t(as.matrix(primpol)) } 
    
     elemente <- matrix(0,ord,n,byrow=TRUE)
     elemente[2,n] <- 1                          # 1st element is =0,...,0; 2nd element is 0,...0,1;
     elemente[3,n-1] <- 1                        # 3rd element ist =0,..,0,1,0.
      
     dummy <- c(numeric(ord-3),1,0)              # 1st power of (1,0); ord-3>0 since p,n>2. 
     for( i in 4:ord ){                          # 2nd ord-2nd power of (1,0)
        dummy <- redu.modp(c(dummy,0), primpol[1,], p)        
        elemente[i,] <- dummy
     }    
    
     out<-list(elemente,primpol)
    
   }  
  out
}
"MOLS" <-
function(p,n,primpol=GF(p,n)[[2]][1,]){

  require(conf.design)

  if( ((p%%1) != 0) || (p < 2) ){stop("p is not a prime number.")}
  if( primes(p)[length(primes(p))]!=p ){stop("p is not a prime number.")}      # here library(conf.design) is needed!
  if( ((n%%1) != 0) || (n < 1) ){stop("n is not a positive integer.")}

  ord <- p^n                                     # order of the field
  if( (p^n)<3 ){stop("The order of the field is too small")}
  
  M <- array(0, c(ord,ord,ord-1))                # The resulting ord-1 latin squares are put into M
  
  if( n==1 ){                                    # ord is prime
  
    f <- 0:(p-1)
    for (m in 1:(p-1)){
      for (i in 1:p){
        for (j in 1:p){
          dummy <- (f[m+1]*f[i] + f[j])%%p       # a_ij(m) = f_m * f_i + f_j,
                                                 # i,j=0,1,..,ord-1; arithmetic is done modulo p
          M[i,j,m] <- dummy +1
    }}}
  }
  else{                                          # ord is prime power
    f <- factor.comb(p,n)                        # rows are polynomials f_0 through f_(ord-1) 
    for (m in 1:(ord-1)){
      for (i in 1:ord){
        for (j in 1:ord){
          dummy <- mult(f[m+1,], f[i,]) + c(numeric(n-1),f[j,])  
                                                 # a_ij(m) = f_m * f_i + f_j,
                                                 # i,j=0,1,..,ord-1
    
          dummy<-(redu(dummy, primpol))%%p       # division mod p
          a<-0
          for (r in 1:(n-1)){ 
              a <- a + dummy[r]*(p^(n-r))  
          }
          M[i,j,m] <- a + dummy[n] +1
          
    }}}
  }   
  M  
}
"Q.t" <-
function(n){
    diag(n)-1/n}
"Td" <-
function( d ){

  trt <- max(d)
  b   <- nrow(d)
  k   <- ncol(d)
  Td <- matrix(rep(0,trt*b*k),ncol=trt)
  dtrt<-diag(trt)

  for (i in 1:b){
    for (j in 1:k){
      Td[(i-1)*k+j,] <- dtrt[d[i,j],]
      }}
  Td
}
"all.combin" <-
function(trt,k){
 
  require(gregmisc)

  permutations(trt,k)
}
"analyze.rand" <-
function(where, fig=FALSE, ref=FALSE, refval=numeric(6), reftext="Reference Value", 
 pch1=46, col1="red", col2="black",  ...){

  if(!(ref %in% c("azais","bailey","contrast","other"))){
   "Please choose a different reference value for the mean of the estimated contrast"}

  a   <- scan(file=where)                        # Scan the file.
  la  <- length(a)                               # 12*n + 10 or 12*n + 20, depending on whether n%%5 equals 0 
  
  n   <- a[la-9]                                 # No of simulation runs   
  
  if(n%%100){stop("n is not a multiple of 100!")}
  n1 <- n/100                                    # The data from the simulation study is partitioned
                                                 # into n1 groups of 100 observations each.
  
  trt <- a[la-8]                                 # No of treatments        
  b   <- a[la-7]                                 # No of rows              
  k   <- a[la-6]                                 # No of columns           
  fg  <- a[la-5]                                 # Model degrees of freedom    
  tau1<- a[la-4]                                 # Value for tau_1             
  rho <- a[la-3]                                 # Value for rho_1 resp. rho_2 

  if(!ref){refval <- c(0,tau1,0,tau1,0,tau1)}    # true value of the contrast l'tau (otherwise use refval from above)
    
                                                                                                                               
  contrast <- numeric(n)
  varhat <- numeric(n)
  tstat   <- numeric(n)                          # Permutation t-statistics
  Z <- 0                                         # Statistic to test if contrast estimate is unbiased
                            
  s2teilcontrast <- matrix(0,6,n1)
  
  meanteilvar <- matrix(0,6,n1)                  # Average value of the variances in the subgroups
  vardiff <- numeric(n1)                         # Estimate of the difference var(l'tu)-E(vr(l'tu)) 
  kivardiff <- numeric(3) 
   
  out1 <- matrix(0,nrow=6,ncol=5)
  rownames(out1) <- 1:6
  colnames(out1) <- c("      No < qt", "  Level/Power", "   ave. l'tu", "   compare to", "            Z")

  out2 <- matrix(0,nrow=6,ncol=5)
  rownames(out2) <- 1:6
  colnames(out2) <- c("  s^2 (l'tu)", "     ave. vr", "  lower bound", "mean(var-vr)", "  upper bound")     
   
   
  # Rearrange the data in the file. There are n entries for tu_1 - tu_t in Case 1, then there are 
  # n entries for tu_1 - tu_t in Case 2 etc. The contrast estimates are followed by the varhat-values.
      
  for (i in 6:1){
    contrast <- a[ ((i-1)*n + 1) : ((i-1)*n + n) ] 
    varhat <- a[  (.5*(la-10) + (i-1)*n + 1) : (.5*(la-10) + (i-1)*n + n) ]
    tstat <- contrast / sqrt( varhat )           # Randomization t-statistics
    Z <- sqrt(n)*( mean(contrast)-refval[i] )/sqrt(var(contrast))                
                   # is approx. standard normal, i.e. absolute value larger than 1.96 means signif. bias of l'tu
                                       
    for (j in 1:n1){
      s2teilcontrast[i,j] <- var(contrast[((j-1)*100+1):((j-1)*100+100)])
                                                 # Partition the permutations in n1 groups of 100 observations each and
                                                 # compute the empirical variance of the contrast estimates in each set.
                                    
      meanteilvar[i,j] <- mean(varhat[((j-1)*100+1):((j-1)*100+100)])   
                                                 # same for the averages of vr(l'tu) in each subset
    } 
    
    vardiff <- (s2teilcontrast[i,]-meanteilvar[i,])  
   
    kivardiff <- c( mean(vardiff) - qt(.975,n1-1)*sqrt(var(vardiff)/n1), mean(vardiff),
      mean(vardiff) + qt(.975,n1-1)*sqrt(var(vardiff)/n1) )  
                                                 # confidence interval for var-E(vr) of the n1 subgroups
                                                 # 1st column lower end, 2nd column estimate of var-E(vr)
                                                 # 3rd column upper end.
    
 # Tables of results
   
    out1[i,] <- c( sum(tstat< qt(.05,fg)) , round(sum(tstat< qt(.05,fg))/n,4) , 
     round(mean(contrast),4), round(refval[i],4), round(Z,2) )
    out2[i,] <- c( round(var(contrast),4) , round(mean(varhat),4), round(kivardiff,4) ) 
                                                
 # Various Graphs
 
    if (fig) {
      
    
      x11()
      qqnorm(vardiff,main=paste("Normal Q-Q Plot of var - vr, Case",i), ...) # q-q-plot of the difference of variance estimates
      x11()
      qqnorm(contrast, main =paste("Normal Q-Q Plot of tau_1 - tau_5, Case",i),
       xlab = "Theoretical Quantiles", ylab = "Sample Quantiles", pch=pch1, ...)
                                                 # q-q-plot of the contrasts for all 6 cases 
                                                   
      x11()
      tcdf.plot(tstat,n,fg,paste("Empirical cumulative distribution function","\n","of the t-statistic, case",i),
       "x", 2, col1=col1, col2=col2, ...)
                                                 # Comparison of the empirical CDF of the t-statistics
                                                 # with the CDF of the t distribution
                
      x11()
      minmax <- sort(contrast)[c(1,n)]
      histogr <- invisible(  hist( contrast,sqrt(n)  )  ) 
      histogr <- hist( contrast,sqrt(n),main=paste("Histogram of the contrast, case",i) ,xlab="x",ylab="count", 
       xlim=c(min(c(minmax[1],refval[i])),max(c(minmax[2],refval[i]))), ylim=c(0,1.1*max(histogr$co)), ... )          
                                                 # Histogram of the contrast estimates
      abline(v=refval[i],col=col1)
      legend( min(contrast),1.1*max(histogr$co), reftext ,lty=1,col=col1)
                                                 # At least for GYD (???)
    }
  }
  
   

  out <- list(out1,out2)
  names(out) <- c("Table 1", "Table 2")

  cat("\n")
  print(out)
  cat("\n")                                 
  
}
"balminRMD" <-
function(trt,n,p){

#check if input parameters make sense
ifelse( any(c(trt,n,p)%%1 ), stop("Please check your design parameters."),
  ifelse( p>=trt, stop("Please check your design parameters."), lambda <- n/trt ))
if( lambda%%1 ){stop("There is no balanced minimal RMDfor these parameters.")}
if( lambda*(p-1) != (trt-1) ){stop("There is no balanced minimal RMDfor these parameters.")}

#construct c-vector that gives rise to a difference set
vec <- numeric(trt)             
if(!(trt%%2))
  {for(i in 1:(trt/2))
    {vec[(2*i -1):(2*i)]<-c(i,trt+1-i)}
  }
else
  {for(i in 1:(trt+1)%/%4)
    {vec[(2*i -1):(2*i)]<-c(2*i-1,trt+2-2*i)}
  }  

dummy <- 2*((trt+1)%/%4) 
if( !((trt-1)%%4) ){ vec<-c(vec[1:dummy], (trt+1)/2, rev(vec[1:dummy]))}   
if( !((trt+1)%%4) ){ vec<-c(vec[1:dummy], rev(vec[1:(dummy-1)]))}   

#construct design matrix (rows represent periods, columns represent subjects)
des <- matrix(0,p,n)
for(i in 1:lambda){
  for(j in 1:trt){
    des[,trt*(i-1) +j] <- (vec[ ((p-1)*(i-1)+1):((p-1)*i+1)] + j-1 )%%trt }}  
des[!des] <- trt             # rename treatment number 0 to treatment number trt.
t(des)                       # final design with subjects as rows
}
"choices" <-
function(trt, k=trt, maxsub=1000){

 choices <- logical(5)                 # Which constructions work?
                            
 b0 <- c( (gamma(trt+1)/gamma(trt-k+1)), ifelse(!(trt%%2),trt,2*trt), trt*(trt-1), NA, trt*(trt-1)/(k-1) ) 
                                       # How many subjects are required?

 primep100 <- c(2,3,4,5,7,8,9,11,13,16,17,19,23,25,27,29,31,32,37,41,43,47,49,53,59,
      61,64,67,71,73,79,81,83,89,97)   # Prime powers are not yet implemented. Get the first 35 ones manually.
 
 choices[1] <- b0[1]<=maxsub
 choices[2] <- (b0[2]<=maxsub) && (k==trt)
 choices[3] <- (b0[3]<=maxsub) && (trt %in% primep100[-1])
                                                                     
                                        
 patsub<-0
 i<-0
 ifelse(!(k%%2), maxi <- maxsub/k, maxi <- maxsub/(2*k) )
 while (!patsub && (i <= maxi) ){
       i <- i+1
       if( !((i*k/trt)%%1) && !((i*k*(k-1)/(trt*(trt-1)))%%1) ){ 
         patsub <- (1+(k%%2))*i*k 
       }
 }
 if ( (k<trt)&&(patsub>0) ){ 
   choices[4] <- TRUE
   b0[4] <- patsub}


 if ( ((b0[5]<=maxsub)&(k<trt)) & ((((trt-1)/(k-1))%%1)==0) ){ choices[5] <- TRUE } 

 out <- list( choices, b0 )
 names(out)<-c("works","number")
 out
  
}
"des.MOLS" <-
function(trt,k){
x <- MOLS(trt[1],trt[2]) 
d <- NULL
for( i in 1:(trt[1]^trt[2] -1) ){ d <- rbind(d, t(x[,,i])) }
d <- d[,1:k] 
}
"design.row" <-
function(d){

  require(combinat)

  if(!is.matrix(d) || !is.numeric(d)){stop("Please check your design matrix")}
  trt <- max(d)
  if(any( sort(unique(as.vector(d))) != 1:length(unique(as.vector(d))))){stop("Please check your design matrix")}
  b   <- nrow(d)
  k   <- ncol(d)
  if(any( c(trt,b,k) == 1)){stop("Please check your design matrix")}
  a1  <- floor(k/trt)+1

  td    <- Td(d)                                 # Treatment design matrix
  bd    <- kronecker(diag(b),rep(1,k))           # Block design matrix
  occ   <- diag(t(td)%*%td)                      # Number of occurences of treatments in design d
  rinc  <- t(bd)%*%td                            # Row-incidence matrix

if( (min(rinc) < a1-1) | (max(rinc) > a1) )
  { bin.row<-FALSE }
else
  { bin.row<-TRUE }                              # TRUE if the design is binary w.r.t rows
    
  pairwise<-rinc[,combn(trt,2)]        
  sumpair<-matrix(0,b,trt*(trt-1)/2)
  for (i in 1:(trt*(trt-1)/2)){
    for (j in 1:b){                       
      if( all(pairwise[j,(2*i-1):(2*i)]) )       # either >0 or =0
        { sumpair[j,i]<-1}
      else
        { sumpair[j,i]<-0}
  }}
      
  sumpair<-apply(sumpair,2,sum)                  # Get no. of blocks with treatments i,j, i != j.

  blockocc <- ifelse( rinc>0, 1, 0)
  blockocc <- apply(blockocc,2,sum)              # Get no. of blocks with occurences of treatment i.

  pairinc <- matrix(0,trt,trt)
  pairinc[which(lower.tri(pairinc))] <- sumpair
  pairinc <- pairinc + t(pairinc)
  diag(pairinc) <- blockocc
                                                 # pairinc gives number of blocks, where treatments i and j both appear.
                                                 # For a binary design with k<=t this is the number of times that i and j 
                                                 # appear together in a block, summed over all blocks. 
  pair.row <- matrix(0,nrow=trt,ncol=trt)
  if(bin.row){
    for (i in 1:trt) {
       for (j in i:trt){
         pair.row[i,j] <- sum( (rinc[,i]+rinc[,j])==(2*a1) )
  }}}
                                                 # For each pair i,j of treatments the number of rows
                                                 # satisfying rinc[i,r]=rinc[j,r]=a1 is computed. 
                                                 # Note that this is only checked for binary designs.
                                                 # The formula above works for binary designs since max(rinc)=a1
                                                 # for such designs.

  xi <-  ( b*(k-trt*(a1-1))*(k-trt*(a1-1)-1) )/( trt*(trt-1) )

  # Check type of design 
  
  type <- c(FALSE, bin.row, FALSE, FALSE, FALSE, FALSE)
  if( all(occ==(b*k/trt)) ){ type[1]<-TRUE }     # TRUE if all treatments occur equally often in d
  if( (bin.row==TRUE) && ( all( (pair.row[upper.tri(pair.row)]) == xi ) ) ){ type[3]<-TRUE }   
                                                 # TRUE if in a binary design for each pair i,j of treatments the 
                                                 # number of rows satisfying rinc[i,r]=rinc[j,r]=a1 is equal
                                            
  if(k<trt){ type[4]<-TRUE }                     # TRUE, if d is incomplete w.r.t. rows
  if(k==trt){ type[5]<-TRUE }                    # TRUE, if d is complete w.r.t. rows
  if(((k/trt)%%1)==0){ type[6]<- TRUE }          # TRUE, if a BBD d is uniform on the rows

  # Output
  
  names(occ)     <- 1:trt
  rownames(rinc) <- 1:b
  colnames(rinc) <- 1:trt 
  rownames(pairinc) <- 1:trt
  colnames(pairinc) <- 1:trt
  
  list(occ,rinc,pairinc,type)

}
"factor.comb" <-
function(p,n){
  f <- matrix(0,p^n,n)
  for( i in 1:n ){
    f[,i] <- rep( 0:(p-1), p^(i-1), each=p^(n-i) )
  }
  f
}
"get.plan" <-
function(trt, k=trt, maxsub=1000){
   
 if( trt<2 ){stop("Number of treatments must be at least 2")}
 if( (k<2)||(k>trt) ){stop("Number of periods must be larger than one and no larger than the number of treatments.")}
 
  primep100 <- c(2,3,4,5,7,8,9,11,13,16,17,19,23,25,27,29,31,32,37,41,43,47,49,53,59,
      61,64,67,71,73,79,81,83,89,97) 
  
  choi <- choices(trt,k,maxsub)        # get possible methods of construction for the specified parameters
  if (!sum(choi[[1]])){
                                       # get new parameters, until there is at least one feasible method
    while(!sum(choi[[1]])){
      dummy <- menu( c("Increase the maximum number of subjects", "Choose a different value of k", "Exit"), 
        title=cat("\n","I don't have a design for just",maxsub,"subjects.",
        "\n","Please choose one of the following items.","\n") )
      if (dummy==1){ 
        cat("Please specify the maximum number of subjects.","\n")
      maxsub <- .Internal(menu(as.character(2:10000)))}  
      if (dummy==2){
        cat("Please specify the value of k.","\n")
      k <- .Internal(menu(as.character(2:trt)))}
      if(dummy==3){
        stop("Exit function.","\n")} 
      choi <- choices(trt,k,maxsub)
    }
  }

  choichar <- c( "All combinations", "Williams", "MOLS", "Patterson", "no BBD needed" )[choi[[1]]]
  cat("Possible constructions and minimum numbers of subjects:","\n")
  showchoices <- rbind( choichar, choi[[2]][choi[[1]]] )   
  rownames(showchoices)<-c("Method: ","Number: ")
  colnames(showchoices)<-NULL
  print(showchoices)
  cat("\n")
                                                                                        
  nextchoi <- menu( c(choichar,"Exit"), title="Please choose one of the following constructions" ) 
                                       # Choose one of the possible methods

  if ( nextchoi==(length(choichar)+1) ){ stop("Exit function") }

  construct <- which( c( "All combinations", "Williams", "MOLS", "Patterson", "no BBD needed" )==choichar[nextchoi] )  
  maxsubchoicon <- maxsub %/% choi[[2]][construct]
  cat(choichar[nextchoi], "selected. How many 'replicates' do you wish (1 -", maxsubchoicon,")?","\n")
  replic <- .Internal(menu(as.character(1:maxsubchoicon)))
  if (replic > maxsubchoicon) {
    replic <- maxsubchoicon
    cat(maxsubchoicon, "replications chosen","\n") }
                                       # Choose the number of "replicates", determining the number of subjects 
                                       # which is replic*choi[[2]][construct].
                                       # Those aren't true replicates. There are new subjects assigned to
                                       # the replicates. They do not correspond to replications of the actual experiment.  
  
 # Now we can construct/generate the design
 # Let's start with one replicate 
  
  if( choi[[1]][3]){ 
  primefact<-matrix( c(2,3,2,5,7,2,3,11,13,2,17,19,23,5,3,29,31,2,37,41,43,47,7,53,59,
    61,2,67,71,73,79,3,83,89,97, 1,1,2,1,1,3,2,1,1,4,1,1,1,2,3,1,1,5,1,1,1,1,2,1,1,1,6,1,1,1,1,4,1,1,1),ncol=2) 
  trtpp <- primefact[primep100==trt,]
  }
                                       # The primepowers in primep100, in the representation p^n
                                       # This is used in des.MOLS (and MOLS). 
                                           
  bibdsub <- ifelse( !(k%%2), (choi[[2]][construct])/k, (choi[[2]][construct])/(2*k) )                                         
                                       # Note in Method 4: choi[[2]][con..] is the number of subjects for the resulting design,
                                       # the BIBD has only this number divided by k resp. 2k subjects.

  des <- switch( construct, all.combin(trt,k), williams(trt), des.MOLS(trtpp,k), 
    williams.BIB(opttodes(trt,bibdsub,k)), balminRMD(trt,choi[[2]][construct],k) )

  
 # Now replicate the design as requested
  des <- kronecker( rep(1,replic), des)
 
 ###                                        RANDOMIZATION                                   ###
 
 # Randomize rows (subjects) and treatment labels!
  
  des <- random.bailey(des)
  
 # Print the design
  
  cat("\n","The design has been properly randomized. Rows represent subjects, columns represent periods.","\n","\n")
  
  des
    
}
"isCbalanced" <-
function( d, preperiod=FALSE ){

  if(!is.matrix(d) || !is.numeric(d)){stop("Please check your design matrix")}
  trt <- max(d)
  if(any( sort(unique(as.vector(d))) != 1:length(unique(as.vector(d))))){stop("Please check your design matrix")}
  b   <- nrow(d)
  k   <- ncol(d)
  if(any( c(trt,b,k) == 1)){stop("Please check your design matrix")}
  
  balance <- FALSE
  
  V <- matrix(0,nrow=trt,ncol=trt)
  
  if(preperiod)
    { V <- diag(k)[c(k,1:(k-1)),] }
  else
    { V <- rbind(numeric(k),diag(k)[1:(k-1),]) }

  M <- t(Td(d)) %*% kronecker(diag(b),t(V)) %*%  Td(d)
                                            # M=[m_ij] where i is left neighbour to j
  
  cat("\n")
  
  if( !any(diag(M)) && length(unique(as.vector(M-2*b*k*diag(trt))))==2 )
    { balance <- TRUE
      cat("The design is carry-over balanced.", "\n","\n") 
    }
  else
    { cat("The design is not carry-over balanced.", "\n","\n") }
                             # If M is completely symmetric and the diagonal of M is zero then d is 
                             # neighbourbalanced. Hence, if the diagonal is zero and 
                             # length(unique(as.vector(M-2*b*k*diag(trt)))) [negative diagonal!]
                             # is two then d is carry-over balanced.
  
  cat("Left neighbour incidence matrix (i is left neighbour of j)","\n","\n")
  print(M)
  invisible(list(balance, M))  
  
}
"isGYD" <-
function(d, invis=FALSE, tables=FALSE, coded=FALSE){

  rows <- design.row(d)                       # Analyze d w.r.t. rows
  cols <- design.row(t(d))                    # Analyze d w.r.t. columns 
  rows4 <- rows[[4]]
  cols4 <- cols[[4]]
  dummy<-TRUE

  if (!invis){
    
    cat("\n")
    if( all(c(rows4[c(1:3,5)],cols4[c(1:3,5)])) )
      { print("The design is a latin square.",quote=FALSE) }
    else
      { if( all(c(rows4[c(1:3,6)],cols4[c(1:3,6)])) )
          { print("The design is a generalized latin square.",quote=FALSE) } 
        else
          { if (all(c(rows4[c(1:3,6)],cols4[1:3])) )
              { print("The design is a regular generalized Youden design that is uniform on the rows.",quote=FALSE) }     
            else
              { if (all(c(rows4[1:3],cols4[c(1:3,6)])) ) 
                  { print("The design is a regular generalized Youden design that is uniform on the columns.",quote=FALSE) }
                else
                  { if (all(c(rows4[1:3],cols4[1:3])) ) 
                      { print("The design is a generalized Youden design.",quote=FALSE) }
                    else 
                      { dummy <- FALSE }         # Check for various types of generalized Youden designs       
                  }
              }
          }
      }
  
    if( !dummy )
      { if (all(rows4[c(1:3,5)]))
          { print("The design is a balanced complete block design w.r.t. rows.",quote=FALSE) }
        else 
          { if (all(rows4[c(1:3,4)]))
              { print("The design is a balanced incomplete block design w.r.t. rows.",quote=FALSE) }
            else
              { if (all(rows4[c(1:3)]))
                  { print("The design is a balanced block design w.r.t. rows.",quote=FALSE) }
                else 
                  { if (all(cols4[c(1:3,5)]))
                      { print("The design is a balanced complete block design w.r.t. columns.",quote=FALSE) }
                    else
                      { if (all(cols4[c(1:3,4)]))
                          { print("The design is a balanced incomplete block design w.r.t. columns.",quote=FALSE) }
                        else 
                          { if (all(cols4[c(1:3)]))
                              { print("The design is a balanced block design w.r.t. columns.",quote=FALSE) }
                            else
                              { print("The design is neither balanced w.r.t. rows nor w.r.t. columns.",quote=FALSE) }
                          }                      # Check for various types of balanced designs  
                      }
                  }
              }
          }
      }    
  
  cat("\n")     
  }
  
  # Tables and characteristica of the design

  out <- list(rows[[1]],rows[[2]],cols[[2]],rows[[3]],cols[[3]])
  names(out) <- c("Number of occurences of treatments in d", "Row incidence matrix of d", "Column incidence matrix of d",
   "Rows with occurences of pairs", "Columns with occurences of pairs" )  

  typeout <- c(rows4,cols4) 

  if(tables){ print(out) }
  if(coded){ typeout }

}
"mult" <-
function(a,b){


 
  la <- length(a)
  lb <- length(b)
  le <- la+lb-1       # length of result m
  m  <- rep(0,le)     # this will be the result of a*b
  
  dummy <- matrix(0,le,lb)  # to contain partial Results

  for (i in 1:lb){
    dummy[i:(i+la-1), i] <- a*b[i] 
  }
  m <- apply(dummy,1,sum)
  m
}
"opttodes" <-
function( trt,b,k,iter=50 ){

 require(Dopt)

 tr<-factor(1:trt)
 bl<-c(rep(1:b, rep(k,b))) 
 i<-0                                             # initialise stop criterions i, BIB
 BIB<-FALSE
 while( (!BIB) && (i<iter) ){
   i <- i+1
   d <-Dopt(~tr,bl)
   trtsequence <- d[,trt+1]
   des <- matrix(trtsequence,b,k,byrow=TRUE)
   BIB <- all(isGYD(des,TRUE,FALSE,TRUE)[1:4])
 }
 isGYD(des)
 des
}
"rand.design.RC" <-
function( design, dat, n, where, tau1, rho ) { 

  require(MASS)

  # Preliminary operations
                         

  if(!is.matrix(design) || !is.numeric(design)){stop("Please check your design matrix")}
  trt <- max(design)
  if(any( sort(unique(as.vector(design))) != 1:length(unique(as.vector(design))))){stop("Please check your design matrix")}
  b   <- nrow(design)
  k   <- ncol(design)
  if(any( c(trt,b,k) == 1)){stop("Please check your design matrix")}
  if(length(design)!=length(dat)){stop("Length of data doesn't match number of plots")}
 
  Qt  <- Q.t(trt)                                # I_t - 1/t 1_t 1_t'                  
  kron<- kronecker( Q.t(b), Q.t (k) )            # Corrects for row and column effects 
  
  fg  <- (b-1)*(k-1)-trt+1                       # Model degrees of freedom

  tauhat    <- array(0,dim=c(n,trt,6))           # simulated tu_1 , ..., tu_t             
  varhat    <- matrix(0,ncol=6,nrow=n)           # simulated estimates of var(tau_1 - tau_t)

 
# Main Loop

  for (i in 1:n){
 
    d   <- random.bailey(design)                 # randomised design (rows and tratment labels)
    dpr <- t(d)
    Tdd <- Td(d)                                 # treatment design matrix 
    Tddpr <- t(Tdd)
    
    cma <- round( Tddpr%*%kron%*%Tdd, 14)        # information matrix, rounded to 14 digits
    gcma <- ginv(cma)                            # Moore-Penrose generalized inverse of the information matrix
    lgcmal <- gcma[1,1] - 2*gcma[1,trt] + gcma[trt,trt]
                                                 # We are interested in the contrast l'tau= tau_1 - tau_t.
                                                 # lgcmal is l'C^+ l= c+_11 - 2c+_1t + c+_tt.
                                                  
    gcmaTddprkron <- gcma %*% Tddpr %*% kron 
    
    g <- which(dpr==1)                           # Plots with treatment 1               
    w <- which(dpr==1)[which(dpr==1) %% k != 0]  # Plots with treatment 1 (unless last plot in row) 
    a <- which(dpr==2)[which(dpr==2) %% k != 0]  # Plots with treatment 2 (unless last plot in row) 
    
                                          
    # Visit the different combiations of treatment effect and neighbour effect we are interested
      
    # non main effects, no residual effects
    
    tauhat[i,,1] <- gcmaTddprkron %*% dat
    varhat[i,1] <- ( t(dat)%*%kron%*%dat - t(tauhat[i,,1])%*%cma%*%tauhat[i,,1] ) 
                                                 # sigma2hat * fg
                                                                                                              
    # tau_1 = tau1, all other tau_i = 0 and rho = 0
    
    dat.e <- dat
    dat.e[g] <- dat[g] +tau1 
    
    tauhat[i,,2] <- gcmaTddprkron %*% dat.e   
    varhat[i,2] <- ( t(dat.e)%*%kron%*%dat.e - t(tauhat[i,,2])%*%cma%*%tauhat[i,,2] ) 
    
    # tau = 0, rho_2 = rho, all other rho_i = 0
    
    dat.e <- dat
    dat.e[a+1] <- dat[a+1] +rho 
    
    tauhat[i,,3] <- gcmaTddprkron %*% dat.e 
    varhat[i,3] <- ( t(dat.e)%*%kron%*%dat.e - t(tauhat[i,,3])%*%cma%*%tauhat[i,,3] ) 
      
    # tau_1 = tau1, rho_2 = rho and all other tau_i, rho_i = 0
    
    dat.e <- dat
    dat.e[g] <- dat[g] +tau1 
    dat.e[a+1] <- dat.e[a+1] +rho 
    
    tauhat[i,,4] <- gcmaTddprkron %*% dat.e
    varhat[i,4] <- ( t(dat.e)%*%kron%*%dat.e - t(tauhat[i,,4])%*%cma%*%tauhat[i,,4] ) 
    
    # tau = 0, rho_1 = rho, all other rho_i = 0
    
    dat.e <- dat 
    dat.e[w+1] <- dat[w+1] +rho 
    
    tauhat[i,,5] <- gcmaTddprkron %*% dat.e
    varhat[i,5] <- ( t(dat.e)%*%kron%*%dat.e - t(tauhat[i,,5])%*%cma%*%tauhat[i,,5] )
    
    # tau_1 = tau1, rho_1 = rho and all other tau_i, rho_i = 0
    
    dat.e <- dat
    dat.e[g] <- dat[g] +tau1 
    dat.e[w+1] <- dat.e[w+1] +rho 
    
    tauhat[i,,6] <- gcmaTddprkron %*% dat.e
    varhat[i,6] <- ( t(dat.e)%*%kron%*%dat.e - t(tauhat[i,,6])%*%cma%*%tauhat[i,,6] ) 
    
    varhat[i,] <- varhat[i,] * lgcmal
  }
  
  varhat <- varhat / fg 
                                                 # sigma2hat * l'C^+l            
  
  
  # Tidying up the results, storing results
  
  contrast <- tauhat[,1,] - tauhat[,trt,]               
                                                 # Estimates of l'tau = tau_1 -tau_t

  mod <- (6*n)%%5                                # The file is to have 5 entries per row, may need to fill up with NAs
  if(mod){ contrast<-c( contrast,rep(NA,5-mod) ) }    
  if(mod){ varhat<-c( varhat,rep(NA,5-mod) ) } 

  write( as.vector(contrast), file=where )
  write( as.vector(varhat),  file=where, append=TRUE )
  write( c(n, trt, b, k, fg, tau1, rho, rep(NA,3)), file=where, append=TRUE ) 
                                                 # Attach information about the design
      
}
"rand.design.azais" <-
function( design, dat, n, where, tau1, rho ) { 

  require(MASS)
  
  # Preliminary operations 
                                            
  if(!is.matrix(design) || !is.numeric(design)){stop("Please check your design matrix")}
  trt <- max(design) 
  if(any( sort(unique(as.vector(design))) != 1:length(unique(as.vector(design))))){stop("Please check your design matrix")}
  b   <- nrow(design)
  k   <- ncol(design)
  if(any( c(trt,b,k) == 1)){stop("Please check your design matrix")}
  if(length(design)!=length(dat)){stop("Length of data doesn't match number of plots")}
 
 
  Qt  <- Q.t(trt)                                # I_t - 1/t 1_t 1_t'                  
  kron<- kronecker( diag(b), Q.t (k) )           # Corrects for row and column effects 
  
  fg  <- b*(k-1)-trt+1                           # Model degrees of freedom

  tauhat    <- array(0,dim=c(n,trt,6))           # simulated tu_1 , ..., tu_t             
  varhat    <- matrix(0,ncol=6,nrow=n)           # simulated estimates of var(tau_1 - tau_t)
 

 
# Main Loop

  for (i in 1:n){
 
    d   <- random.azais(design)                  # randomized design (rows and tratment labels)
    dpr <- t(d)
    Tdd <- Td(d)                                 # treatment design matrix 
    Tddpr <- t(Tdd)
    
    cma <- round( Tddpr%*%kron%*%Tdd, 14)        # information matrix, rounded to 14 digits
    gcma <- ginv(cma)                            # Moore-Penrose generalized inverse of the information matrix
    lgcmal <- gcma[1,1] - 2*gcma[1,trt] + gcma[trt,trt]
                                                 # We are interested in the contrast l'tau= tau_1 - tau_t.
                                                 # lgcmal is l'C^+ l= c+_11 - 2c+_1t + c+_tt.
    gcmaTddprkron <- gcma %*% Tddpr %*% kron 
    
    g <- which(dpr==1)                           # Plots with treatment 1               
    w <- c( which(dpr==1)[which(dpr==1) %% k != 0],
          which(dpr==1)[which(dpr==1) %% k == 0]-k)   # The next plot has a residual effect of treatment 1
    a <- c( which(dpr==2)[which(dpr==2) %% k != 0],
          which(dpr==2)[which(dpr==2) %% k == 0]-k)   # The next plot has a residual effect of treatment 2
    
                                             
    # Visit the different combiations of treatment effect and neighbour effect we are interested
      
    # non main effects, no residual effects
    
    tauhat[i,,1] <- gcmaTddprkron %*% dat
    varhat[i,1] <- ( t(dat)%*%kron%*%dat - t(tauhat[i,,1])%*%cma%*%tauhat[i,,1] )  
                                                 # sigma2hat * fg
                                                                                                                                                            
    # tau_1 = tau1, all other tau_i = 0 and rho = 0
    
    dat.e <- dat
    dat.e[g] <- dat[g] +tau1 
    
    tauhat[i,,2] <- gcmaTddprkron %*% dat.e   
    varhat[i,2] <- ( t(dat.e)%*%kron%*%dat.e - t(tauhat[i,,2])%*%cma%*%tauhat[i,,2] ) 
    
    # tau = 0, rho_2 = rho, all other rho_i = 0
    
    dat.e <- dat
    dat.e[a+1] <- dat[a+1] +rho 
   
    tauhat[i,,3] <- gcmaTddprkron %*% dat.e 
    varhat[i,3] <- ( t(dat.e)%*%kron%*%dat.e - t(tauhat[i,,3])%*%cma%*%tauhat[i,,3] ) 
      
    # tau_1 = tau1, rho_2 = rho and all other tau_i, rho_i = 0
    
    dat.e <- dat
    dat.e[g] <- dat[g] +tau1 
    dat.e[a+1] <- dat.e[a+1] +rho 
    
    tauhat[i,,4] <- gcmaTddprkron %*% dat.e
    varhat[i,4] <- ( t(dat.e)%*%kron%*%dat.e - t(tauhat[i,,4])%*%cma%*%tauhat[i,,4] ) 
    
    # tau = 0, rho_1 = rho, all other rho_i = 0
    
    dat.e <- dat 
    dat.e[w+1] <- dat[w+1] +rho 
    
    tauhat[i,,5] <- gcmaTddprkron %*% dat.e
    varhat[i,5] <- ( t(dat.e)%*%kron%*%dat.e - t(tauhat[i,,5])%*%cma%*%tauhat[i,,5] ) 
    
    # tau_1 = tau1, rho_1 = rho and all other tau_i, rho_i = 0
    
    dat.e <- dat
    dat.e[g] <- dat[g] +tau1 
    dat.e[w+1] <- dat.e[w+1] +rho 
    
    tauhat[i,,6] <- gcmaTddprkron %*% dat.e
    varhat[i,6] <- ( t(dat.e)%*%kron%*%dat.e - t(tauhat[i,,6])%*%cma%*%tauhat[i,,6] )  
    
    varhat[i,] <- varhat[i,] * lgcmal      
                                                 # sigma2hat * fg * l'C^+l
  }
  
  varhat <- varhat / fg 
                                                 # sigma2hat * l'C^+l
  
    
  # Tidying up the results, storing results
  
  contrast <- tauhat[,1,] - tauhat[,trt,]               
                                                 # Estimates of l'tau = tau_1 -tau_t

  mod <- (6*n)%%5                                # The file is to have 5 entries per row, may need to fill up with NAs
  if(mod){ contrast<-c( contrast,rep(NA,5-mod) ) }    
  if(mod){ varhat<-c( varhat,rep(NA,5-mod) ) } 

  write( as.vector(contrast), file=where )
  write( as.vector(varhat),  file=where, append=TRUE )
  write( c(n, trt, b, k, fg, tau1, rho, rep(NA,3)), file=where, append=TRUE ) 
                                                 # Attach information about the design
      
}
"random.AZ" <-
function( d ){
  trt <- max(d)
  b   <- nrow(d)
  k   <- ncol(d)
  a   <- sample(trt)
  for(i in 1:b){
    d[i,] <- a[d[i,]]                       # Permutes treatment labels
    r <- sample(k,1) 
    if(r!=1){d[i,]<-c( d[i,r:k] , d[i,1:(r-1)] )} # Permutes order cyclically
    }
  d <- d[sample(b),]                        # Permutes rows
  list(d,a)}
"random.RC" <-
function( d ){
  trt <- max(d)
  b   <- nrow(d)
  k   <- ncol(d)
  a   <- sample(trt)                        
  for(i in 1:b){
    d[i,] <- a[d[i,]]                       # Permutes treatment labels (the lables 1:trt change to a)
  }
  d <- d[sample(b),]                        # Permutes rows
  list(d,a)}
"random.azais" <-
function( d ){
  trt <- max(d)
  b   <- nrow(d)
  k   <- ncol(d)
  a   <- sample(trt)
  for(i in 1:b){
    d[i,] <- a[d[i,]]                       # Permutes treatment labels
    r <- sample(k,1) 
    if(r!=1){d[i,]<-c( d[i,r:k] , d[i,1:(r-1)] )} # Permutes order cyclically
    }
  d <- d[sample(b),]                        # Permutes rows
  d}
"random.bailey" <-
function( d ){
  trt <- max(d)
  b   <- nrow(d)
  k   <- ncol(d)
  a   <- sample(trt)
  for(i in 1:b){
    d[i,] <- a[d[i,]]                       # Permutes treatment labels
  }
  d <- d[sample(b),]                        # Permutes rows
  d}
"redu" <-
function(a,b){
 
 la <- length(a)
 lb <- length(b)
 if( la<lb || lb<2 ){stop("Please check your polynomials.")}
 
 b1 <- b/b[1]            # divide by coefficient of highest power
  
 dummy <- rep(0,la)      # partial result to be subtracted
 
 for (i in 1:(la-lb+1)){
   dummy <- numeric(la)
   dummy[i:(i+lb-1)] <- a[i]*b1
   a <- a - dummy
 } 
 m <- a[(la-lb+2):la]
 m  
}
"redu.modp" <-
function(a,b,p){

 la <- length(a)
 lb <- length(b)
 b1 <- b/b[1]                # divide by coefficient of highest power
  
 dummy <- numeric(la)        # partial result to be subtracted 
 
 for (i in 1:(la-lb+1)){
   dummy <- rep(0,la)
   dummy[i:(i+lb-1)] <- a[i]*b1
   a <- (a - dummy)%%p
 } 
 a[(la-lb+2):la]  
}
"tcdf.plot" <-
function( empirical, n, nu, titel="", xaxis="", ltytheor=2, col1="red", col2="black", ... ){  
 
  x<-((1:n)-.5)/n                                # Compute quantiles at these values

  au <- .5/n                                     # Upper and lower values
  ao <- 1-.5/n
  bu <- min(empirical)
  bo <- max(empirical)

  plot( c( qt(au,nu)-1, qt(x,nu), qt(ao,nu)+1), c(0,x,1), 
    xlim=c( min(qt(au,nu),bu)-1, max(qt(ao,nu),bo)+1 ), 
    type="l", col = col1, xlab= xaxis, ylab="Cumulative distribution function", main=titel,lwd=2,lty=ltytheor, ...)  
                                                 # (theoretical) CDF

  lines( c(bu-1,sort(empirical),bo+1), c(0,x,1), type="l", col=col2,lwd=2 )  
                                                 # empirical CDF
  
  legend( min(qt(au,nu),bu)-.75, .95, c("empirical","t"),lty=c(1,ltytheor),lwd=2,col=c(col2,col1) )

}
"williams.BIB" <-
function(d){

  trt <- max(d)
  b   <- nrow(d)
  k   <- ncol(d)

  w   <- williams(k)
  if(!(k%%2)) 
    des <- matrix(0,b*k,k) 
  else 
    des <- matrix(0,2*b*k,k)
  
  if(!(k%%2))
    for (i in 1:b)
        des[ ((i-1)*k+1):((i-1)*k+k), ] <-  matrix(d[i,williams(k)],k,k) 
  else
    for (i in 1:b)
        des[ ((i-1)*2*k+1):((i-1)*2*k+2*k), ] <-  matrix(d[i,williams(k)],2*k,k) 
  des
}
"williams" <-
function(trt){

if( is.numeric(trt)==FALSE || any(length(trt)!=1, trt%%1!=0, trt<2)==TRUE ){stop("Number of treatments is not an integer >1.")} 
                                            # Checks for appropriate values of t (must be an integer larger than 1)

if( trt==2 ){ design <- matrix(c(1,2,2,1),2,2) }
                                            # for t=2, the williams design is matrix(c(1,2,2,1),2,2).
if( trt>2 ){ 

 gen.row <- c(0,rep(1,trt-1))
 a <- ifelse( (3:trt)%%2==0, -1, 1) 

 for(i in 3:trt){ gen.row[i] <- gen.row[i-1] + a[i-2]*(trt+1-i) }

 design <- rbind( gen.row, matrix(rep(0,trt*(trt-1)),ncol=trt) )
 row.names(design)<-NULL

 for(i in 2:trt){ design[i,] <- (design[i-1,] +1)%%trt }

 design <- design +1 

 if(trt%%2==1){design <- rbind ( design, t(apply(design,1,rev)) )}
 row.names(design)<-NULL

 }

design 

}
