Running 'testthat.R' [8s/9s]
Running the tests in 'tests/testthat.R' failed.
Complete output:
  > library(testthat)
  > library(Crossover)
  Loading required package: rJava
  Loading required package: CommonJavaJars
  Loading required package: JavaGD
  Loading required package: ggplot2
  > 
  > test_check("Crossover")
  Skipping design tests for v=2.
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
   at testthat/test-efficiency.R#30: 
   --- package (from environment) --- 
  Crossover
   --- call from context --- 
  design.efficiency.old(design)
   --- call from argument --- 
  if (class(design) == "CrossoverSearchResult") design <- design@design
   --- R stacktrace ---
  where 1 at testthat/test-efficiency.R#203: design.efficiency.old(design)
  where 2 at testthat/test-efficiency.R#217: test.eff()
  where 3: eval(code, test_env)
  where 4: eval(code, test_env)
  where 5: withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error)
  where 6: doTryCatch(return(expr), name, parentenv, handler)
  where 7: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 8: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 9: doTryCatch(return(expr), name, parentenv, handler)
  where 10: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 11: tryCatchList(expr, classes, parentenv, handlers)
  where 12: tryCatch(withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error), error = handle_fatal, 
      skip = function(e) {
      })
  where 13: test_code(NULL, exprs, env)
  where 14: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 15: force(code)
  where 16: doWithOneRestart(return(expr), restart)
  where 17: withOneRestart(expr, restarts[[1L]])
  where 18: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 19: with_reporter(reporter = reporter, start_end_reporter = start_end_reporter, 
      {
          reporter$start_file(basename(path))
          lister$start_file(basename(path))
          source_file(path, new.env(parent = env), chdir = TRUE, 
              wrap = wrap)
          reporter$.end_context()
          reporter$end_file()
      })
  where 20: FUN(X[[i]], ...)
  where 21: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
  where 22: force(code)
  where 23: doWithOneRestart(return(expr), restart)
  where 24: withOneRestart(expr, restarts[[1L]])
  where 25: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 26: with_reporter(reporter = current_reporter, results <- lapply(paths, 
      test_file, env = env, reporter = current_reporter, start_end_reporter = FALSE, 
      load_helpers = FALSE, wrap = wrap))
  where 27: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 28: test_dir(path = test_path, reporter = reporter, env = env, filter = filter, 
      ..., stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, 
      wrap = wrap)
  where 29: test_package_dir(package = package, test_path = test_path, filter = filter, 
      reporter = reporter, ..., stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 30: test_check("Crossover")
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function(design) {
    if (class(design)=="CrossoverSearchResult") design <- design@design
    if (class(design)=="CrossoverDesign") {
      #model <- design@model
      design <- design@design
    }
    #model <- getModelNr(model)
    design <- t(design)
    
    ## input
    ## nseq   is the number of sequences
    ## nper   is the number of periods
    ## ntrt   is the number of treatments
    ## nrep   is the nseq x 1 vector containing the number of subjects allocated to each sequence
    ## design is an nseq x nper array containing the nseq treatment sequences
    
    ## create the factors for groups, subjects, periods, treatments and carry-over effects
    
    nper <- dim(design)[2]
    nseq <- dim(design)[1]
    ntrt <- length(levels(as.factor(design)))	
    n<-rep(1,nseq)
    
    ## group factor
    group<-rep(1:nseq,nper*n)
    ##subject factor
    subject<-rep(1:sum(n), rep(nper,sum(n)))
    ##period factor
    per<-rep(1:nper,  sum(n))
    
    
    trt<-NULL
    for(i in 1:nseq){
      trt<-c(trt,rep(design[i,],n[i]))
    }
    ## treatment design matrix
    trt.mat<-matrix(trt,sum(n),nper,byrow=T)
    
    ## carry-over design matrix
    car.mat<-matrix(0,sum(n),nper,byrow=T)
    car.mat[,1]<-1
    car.mat[,2:nper]<-trt.mat[,1:(nper-1)]
    
    car<-NULL
    for(i in 1:sum(n)){
      car<-c(car,car.mat[i,])
    }
    
    
    ## create factors for design matrix
    nsubj<-sum(n)
    ndata<-nsubj*nper
    
    mean01<-matrix(1,ndata,1)
    subj01<-matrix(0,ndata,nsubj)
    per01<-matrix(0,ndata,nper)
    trt01<-matrix(0,ndata,ntrt)
    car01<-matrix(0,ndata,ntrt)
    ## subjects
    for(i in 1:nsubj){
      subj01[,i][subject==i]<-1
    }
    ##periods
    for(i in 1:nper){
      per01[,i][per==i]<-1
    }
    ## treatments
    for(i in 1:ntrt){
      trt01[,i][trt==i]<-1
    }
    ##carry-over
    car01[,1:ntrt][per==1]<-0
    for(j in 2:nper){
      car01[,1:ntrt][per==j]<-trt01[,1:ntrt][per==(j-1)]
    }
    
    ## X matrix without subjects - returned for use in simulating data - not used further here
    xmat.no.subjects<-matrix(cbind(mean01,per01,trt01,car01),ndata,(1+nper+2*ntrt),byrow=F)
    ## X matrix
    xmat<-matrix(cbind(mean01,subj01,per01,trt01,car01),ndata,(1+nsubj+nper+2*ntrt),byrow=F)
    ## X'X matrix
    xtx<-t(xmat)%*%xmat
    ## inverse of X'X matrix
    xtx.inv<-ginv(xtx)
    
    ## extract part of inverse for carry-over effects 
    n.cols.all<-1+nsubj+nper+2*ntrt
    n.cols.car.upp<-n.cols.all
    n.cols.car.low<-n.cols.car.upp-(ntrt-1)
    n.cols.trt.upp<-n.cols.car.low-1
    n.cols.trt.low<-n.cols.trt.upp-(ntrt-1)
    ## extract part of inverse for treatments adjusted for carry-over effects 
    xtx.inv.car.adj<-xtx.inv[n.cols.car.low:n.cols.car.upp,n.cols.car.low:n.cols.car.upp]
    xtx.inv.trt.adj<-xtx.inv[n.cols.trt.low:n.cols.trt.upp,n.cols.trt.low:n.cols.trt.upp]
    
    ## repeat the above for the model without carry-over effects
    ## X matrix
    xmat<-matrix(cbind(mean01,subj01,per01,trt01),ndata,(1+nsubj+nper+ntrt),byrow=F)
    ## X'X matrix
    xtx<-t(xmat)%*%xmat
    ## inverse of X'X matrix
    xtx.inv<-ginv(xtx)
    ## extract part of inverse for carry-over effects 
    n.cols.all<-1+nsubj+nper+ntrt
    n.cols.trt.upp<-n.cols.all
    n.cols.trt.low<-n.cols.trt.upp-(ntrt-1)
    ## extract part of inverse for treatments unadjusted for carry-over effects 
    xtx.inv.trt<-xtx.inv[n.cols.trt.low:n.cols.trt.upp,n.cols.trt.low:n.cols.trt.upp]
    
    ## variances of pairwise comparisons
    ## adjusted for carry-over effects
    var.trt.pair.adj<-matrix(0,ntrt,ntrt)
    for(i in 1:ntrt){
      for(j in 1:ntrt){
        if (i!=j) {
          var.trt.pair.adj[i,j]<-xtx.inv.trt.adj[i,i]+xtx.inv.trt.adj[j,j] - 2*xtx.inv.trt.adj[i,j]
        }}}
    ## variances of pairwise comparisons
    ## unadjusted for carry-over effects
    var.trt.pair<-matrix(0,ntrt,ntrt)
    for(i in 1:ntrt){
      for(j in 1:ntrt){
        if (i!=j) {
          var.trt.pair[i,j]<-xtx.inv.trt[i,i]+xtx.inv.trt[j,j] - 2*xtx.inv.trt[i,j]
        }}}
    
    ## efficiency calculations
    ## replication of each treatment in the design
    rep<-matrix(0,ntrt)
    for(i in 1:ntrt){
      rep[i]<-sum(trt.mat==i)
    }
    ## variances of pairwise comparisons in ideal design
    var.trt.pair.ideal<-matrix(0,ntrt,ntrt)
    for(i in 1:ntrt){
      for(j in 1:ntrt){
        if (i!=j) {
          var.trt.pair.ideal[i,j]<-1/rep[i] + 1/rep[j]
        }}}
    ## matrix of efficiencies for pairwise treatment comparisons unadjusted for carry-over effects
    eff.trt.pair<-matrix(0,ntrt,ntrt)
    for(i in 1:ntrt){
      for(j in 1:ntrt){
        if (i!=j) {
          eff.trt.pair[i,j]<-var.trt.pair.ideal[i,j]/var.trt.pair[i,j]
        }}}
    ## matrix of efficiencies for pairwise treatment comparisons adjusted for carry-over effects
    eff.trt.pair.adj<-matrix(0,ntrt,ntrt)
    for(i in 1:ntrt){
      for(j in 1:ntrt){
        if (i!=j) {
          eff.trt.pair.adj[i,j]<-var.trt.pair.ideal[i,j]/var.trt.pair.adj[i,j]
        }}}
    ## average efficiency of pairwise treatment comparisons unadjusted for carry-over effects
    av.eff.trt.pair<-sum(eff.trt.pair)/(ntrt*(ntrt-1))
    ## average efficiency of pairwise treatment comparisons adjusted for carry-over effects
    av.eff.trt.pair.adj<-sum(eff.trt.pair.adj)/(ntrt*(ntrt-1))
    
    return(list(xmat.no.subjects=xmat.no.subjects,
                var.trt.pair=var.trt.pair,eff.trt.pair=eff.trt.pair,av.eff.trt.pair=av.eff.trt.pair,
                var.trt.pair.adj=var.trt.pair.adj,eff.trt.pair.adj=eff.trt.pair.adj,av.eff.trt.pair.adj=av.eff.trt.pair.adj))
    
  }
  <environment: 0x5160708>
   --- function search by body ---
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1