# Function to run the lm model
`runlm` <- function(i, formula, data, metadata) {
  tryCatch({
    fit <- suppressMessages(suppressWarnings(lm(formula, data=cbind(metadata,exprs=c(t(data[i,]))))))
    coef <- coefficients(summary(fit))
    co <- coef[-1,1]; names(co) <- paste("coef",rownames(coef)[-1],sep=".")
    se <- coef[-1,2]; names(se) <- paste("se",rownames(coef)[-1],sep=".")
    return(c(co,se))
  }, error = function(e) {
    return(NA)
  })
}

# lmROTS
`lmROTS` <- function(formula, data, metadata, B=100, K=NULL, seed=NULL, a1=NULL, a2=NULL, terms=NULL, BPPARAM=bpparam()) {
  if (is(data, "ExpressionSet"))
    data <- Biobase::exprs(data)
  
  # Check variables in formula
  formula <- as.formula(formula)
  if(!("exprs" %in% all.vars(formula))) {
    stop("Term 'exprs' missing from the formula.")
  }
  
  # Set bootstraps and permutations
  if(!is.null(seed)) {
    set.seed(seed, kind="default")
  }
  boot <- sapply(1:B, function(x) sample(1:nrow(metadata),nrow(metadata),replace=TRUE))
  perm <- sapply(1:B, function(x) sample(1:nrow(metadata),nrow(metadata),replace=FALSE))
  
  # Original
  message("Running initial model")
  lm.original <- bplapply(1:nrow(data), function(i) runlm(i, formula, data, metadata), BPPARAM=BPPARAM)
  names <- names(lm.original[[which.max(sapply(lm.original, length))]])
  for (i in 1:length(lm.original)) {
    lm.original[[i]] <- lm.original[[i]][names]
  }
  lm.original <- do.call("rbind", lm.original)
  colnames(lm.original) <- names
  rownames(lm.original) <- rownames(data)
  
  # Run over bootstraps
  message("Running bootstraps")
  lm.boot <- bplapply(1:B, function(x) {
    out <- lapply(1:nrow(data), function(i) runlm(i, formula, data[,boot[,x]], metadata[boot[,x],,drop=FALSE]))
    out[is.na(out)] <- list(rep(NA,ncol(lm.original)))
    out <- do.call("rbind",out)
    out <- out[,match(colnames(lm.original),colnames(out))]
    colnames(out) <- colnames(lm.original)
    return(out)
  }, BPPARAM=BPPARAM)
  
  # Run over permutations
  message("Running permutations")
  lm.null <- bplapply(1:B, function(x) {
    out <- lapply(1:nrow(data), function(i) runlm(i, formula, data, metadata[perm[,x],,drop=FALSE]))
    out[is.na(out)] <- list(rep(NA,ncol(lm.original)))
    out <- do.call("rbind",out)
    out <- out[,match(colnames(lm.original),colnames(out))]
    colnames(out) <- colnames(lm.original)
    return(out)
  }, BPPARAM=BPPARAM)
  
  # Optimize parameters
  ROTS.output <- optimizeModel(data=data, model.original=lm.original, model.boot=lm.boot, model.null=lm.null, B=B, K=K, seed=seed, a1=a1, a2=a2, terms=terms, BPPARAM=BPPARAM)
  class(ROTS.output) <- "regROTS"
  return(ROTS.output)
}
