# R/support.R In rFSA: Feasible Solution Algorithm for Finding Best Subsets and Interactions

#### Documented in nextswapswaps

```#' Variables to include in first steip of an mth order interaction model determined from the Feasible Soution Alorithm.
#'
#' Finds the swaps available given a current position.
#' @param cur A vector of length greater than 2 of what current explantory varialbes are being used in the model.
#' @param n The number of explanatory variables in available to swap.
#' @param quad Whether to include quadratic terms. ie (x1*x1) as potential swaps.
#' @param yindex index of response variable.
#' @return a matrix with the possible forms by column.
#' @importFrom graphics par plot
#' @importFrom stats AIC anova as.formula cov fitted formula glm influence lm predict resid var
#' @importFrom utils capture.output tail
#' @export
m <- length(cur)
l <- (n - m) * m
possible <- matrix(rep(cur, l), nrow = l, byrow = T)
s <- 1:n
lapply(1:m, FUN = function(i) s <<- s[-which(s == cur[i])])
lapply(1:m, FUN = function(j) possible[((j - 1) * (n -
m) + 1):((j - 1) * (n - m) + (n - m)), j] <<- s)
}
l <- (n - 1) * m
possible <- matrix(rep(cur, l), nrow = l, byrow = T)
s <- 1:n
smat <- matrix(rep(0, (n - 1) * m), ncol = m)
lapply(1:m, FUN = function(i) smat[, i] <<- s[-which(s ==
cur[i])])
lapply(1:m, FUN = function(j) possible[((j - 1) * (n -
1) + 1):((j - 1) * (n - 1) + (n - 1)), j] <<- smat[,
j])
}
vec <- cbind(cur, t(possible))
vec<-unique(apply(vec, sort, MARGIN = 2), MARGIN = 2)
if(length(dim(vec))==0){vec<-t(vec)}
vec<-vec[,-which(apply(apply(X = vec,MARGIN = 1,function(x){x==yindex}),MARGIN = 1,FUN = any))]
if(length(dim(vec))==0){vec<-t(vec)}
return(vec)
}
#' Variables to include in the >1st step of an mth order interaction model determined from the Feasible Soution Alorithm.
#'
#' Finds the swaps available given a current position given previous picks.
#' @param curpos A vector of length greater than 2 of what current explantory varialbes are being used in the model.
#' @param n The number of explanatory variables in available to swap.
#' @param quad Whether to include quadratic terms. ie (x1*x1) as potential swaps.
#' @param prevpos A vector of previous best spots
#' @return a matrix with the possible forms by column.
#' @export
nextpos <- rep(FALSE,dim(swps))
for (i in 1:dim(swps)) {
nextpos <- nextpos + (swps[i,] %in% prevpos)
}

retSwps <- swps[,nextpos == (length(curpos) - 2)]
if (is.null(dim(retSwps))) {
retSwps <- t(t(retSwps))
}
return(list(nswaps = retSwps,prevpos = prevpos))
}

pos2key <- function(pos) { paste(pos,collapse = ",")}
key2pos <- function(key) { eval(parse(text=paste0("c(", key, ")")))}
```

## Try the rFSA package in your browser

Any scripts or data that you put into this service are public.

rFSA documentation built on July 1, 2020, 10:30 p.m.