Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
add wrapper for complete.cases()
  • Loading branch information
rdrr1990 committed Apr 22, 2020
1 parent 7ba8996 commit d083b81
Show file tree
Hide file tree
Showing 5 changed files with 17 additions and 10 deletions.
2 changes: 1 addition & 1 deletion NAMESPACE
Expand Up @@ -15,5 +15,5 @@ importFrom(RSpectra,eigs)
importFrom(utils,data)
importFrom(stats,glm,alias,as.formula,binomial,coefficients,
cor,cov,formula,lm,model.matrix,prcomp,
predict,sd,relevel)
predict,sd,relevel,complete.cases)
importFrom(utils,combn,timestamp)
1 change: 1 addition & 0 deletions R/FSR.R
Expand Up @@ -25,6 +25,7 @@ FSR <- function(Xy,

if(!is.matrix(Xy) && !is.data.frame(Xy))
stop("Xy must be a matrix or data.frame. Either way, y must be the final column.")
Xy <- complete(Xy)
if(pTraining <= 0 || pTraining > 1)
stop("pTraining should all be between 0 and 1.")
pValidation <- 1 - pTraining
Expand Down
1 change: 1 addition & 0 deletions R/getPoly.R
Expand Up @@ -20,6 +20,7 @@ getPoly <- function(xdata = NULL, deg = 1, maxInteractDeg = deg,
message("getPoly() expects a matrix or a data.frame. The input will be coerced to a data.frame but you may wish to stop and provide one directly.\n\n")
}
W <- as.data.frame(W, stringsAsFactors=TRUE)
W <- complete(W, noisy=noisy)

if(standardize){
to_z <- which(unlist(lapply(W, is_continuous)))
Expand Down
14 changes: 12 additions & 2 deletions R/helper_functions.R
Expand Up @@ -20,7 +20,7 @@ N_distinct <- function(x) if(ncol(as.matrix(x)) == 1) length(unique(x)) else unl
#is_continuous <- function(x) if(is.numeric(x)) N_distict(x) > 2 else FALSE
is_continuous <- function(x) unlist(lapply(x, is.numeric)) & N_distinct(x) > 2
mod <- function(m) paste0("model", m)
complete <- function(x) !is.null(x) && sum(is.na(x)) == 0
complete_vector <- function(x) !is.null(x) && sum(is.na(x)) == 0
match_arg <- function(arg, choices){if(is.null(arg)) arg else match.arg(arg, choices)}


Expand Down Expand Up @@ -364,7 +364,7 @@ ols <- function(object, Xy, m, train = TRUE, y = NULL, y_test = NULL){

object[[mod(m)]][["coeffs"]] <- tcrossprod(XtX_inv, X) %*% y

if(complete(object[[mod(m)]][["coeffs"]])){
if(complete_vector(object[[mod(m)]][["coeffs"]])){

object$models$estimated[m] <- TRUE

Expand Down Expand Up @@ -499,4 +499,14 @@ applyPCA <- function(x, pcaMethod, pcaPortion) {
return(list(xdata=xdata,xy.pca=xy.pca,k=k))
}

complete <- function(xy, noisy=TRUE){
n_raw <- nrow(xy)
xy <- xy[complete.cases(xy),]
n <- nrow(xy)
if(noisy & n != n_raw)
message(n_raw - n,
" rows dropped due to missingness. You may be interested in library(toweranNA), a non-imputational apporoach to missing data for prediction and classification.\n")
return(xy)
}


9 changes: 2 additions & 7 deletions R/polyFit.R
Expand Up @@ -44,13 +44,8 @@ polyFit <- function(xy, deg, maxInteractDeg=deg, use = "lm", pcaMethod=NULL,
if (!use %in% c('lm','glm','mvrlm'))
stop('"use" must be "lm", "glm", or "mvrlm"')

n_raw <- nrow(xy)
xy <- xy[complete.cases(xy),]
n <- nrow(xy)
if(noisy & n != n_raw)
message(n_raw - n,
" rows dropped due to missingness. You may be interested in library(toweranNA), a non-imputational apporoach to missing data for prediction and classification.\n")

xy <- complete(xy, noisy=noisy)

doPCA <- !is.null(pcaMethod)
xdata <- xy[,-ncol(xy)]

Expand Down

0 comments on commit d083b81

Please sign in to comment.