V6.4.0 dev zeyzul

NAMESPACE

@@ -155,6 +155,7 @@ importFrom(dplyr,mutate)
 importFrom(dplyr,select)
 importFrom(gamlss.dist,pST3)
 importFrom(gamlss.dist,qST3)
+importFrom(purrr,imap)
 importFrom(purrr,map)
 importFrom(purrr,set_names)
 importFrom(tibble,as_tibble)

R/subsetByClassHelper1.R

@@ -0,0 +1,41 @@
+#' 
+#' @title generates subsets vectors from a factor vector
+#' @description This is an internal function called by the function 'subsetByClassDS'.
+#' @details The function generates subsets if the input of 'subsetByClassDS' is a factor vector.
+#' @param xvect a vector of type factor.
+#' @param xname the name of the vector.
+#' @param filter the minimum number observation (i.e. rows) that are allowed.
+#' @return a list which contains the subsets.
+#' @keywords internal
+#' @noRd
+#' @author Gaye, A.
+#'
+subsetByClassHelper1 <- function(xvect=NULL, xname=NULL, filter=NULL){
+  vectname <- xname
+  subsets <- list()
+  names.of.subsets <- c()
+  categories <- levels(xvect)
+  for(i in 1:length(categories)){
+    indices <- which(xvect == as.numeric(categories[i]))    
+    if(!(length(indices) < filter)){
+      subsets[[i]] <- xvect[indices]
+      name.of.subD <- paste(vectname,".level_", categories[i], sep="")
+      names.of.subsets <- append(names.of.subsets, name.of.subD)
+    }else{
+      # if any one category has between 0 and 'filter' observation turn subset content into missing values
+      if(length(indices) == 0){
+        subsets[[i]] <-  xvect[-c(1:length(xvect))]
+        name.of.subD <- paste(vectname,".level_", categories[i], "_EMPTY", sep="")
+      }else{
+        temp1 <- xvect[indices]
+        temp1[1:length(temp1)] <- NA
+        subsets[[i]] <- temp1
+        name.of.subD <- paste(vectname,".level_", categories[i], "_INVALID", sep="")
+      }
+      names.of.subsets <- append(names.of.subsets, name.of.subD)
+    }
+    names(subsets) <- names.of.subsets
+    output <- subsets
+  }
+  return(output)
+}

R/subsetByClassHelper2.R

@@ -0,0 +1,64 @@
+#' 
+#' @title generates subset tables from a data frame
+#' @description This is an internal function called by the function 'subsetByClassDS'
+#' @details The function generates subsets if the input of 'subsetByClassDS' is a data frame 
+#' and if the number variables(columns) to subset by are greater than 1; i.e. this 
+#' function is called if the user specified more than one variable or no variable to subset by
+#' (if no variables are specified the function 'subsetByClassDS' produces a subset for each category
+#' in each variable).
+#' @param df a data frame.
+#' @param iter the indices of columns to loop trough.
+#' @param filter the minimum number of observations (i.e. rows) that are allowed.
+#' @return a list which contains the subsets, their names and an integer that indicates how many columns were
+#' not factors.
+#' @keywords internal
+#' @noRd
+#' @author Gaye, A.
+#'
+subsetByClassHelper2 <- function(df=NULL, iter=NULL, filter=NULL){
+  # various counters and temporary variables to hold info
+  subsets <- list()
+  names.of.subsets <- c()
+  count <- 0  
+  nonfactorvars <- 0
+  ncols <- length(colnames(df))
+  for(i in iter){
+    var <- df[,i]
+    varname <- colnames(df)[i]
+    if(is.factor(var)){        
+      # get the levels
+      categories <- levels(var)
+      # loop through the levels and generate a dataset for each level
+      # if the number of observations for that level > 0 and < 'filter'
+      for(j in 1:length(categories)){
+        indices <- which(var == as.numeric(categories[j]))
+        if(!(length(indices) < filter)){
+          count <- count+1
+          subD <- df[indices,]
+          subsets[[count]] <- subD
+          name.of.subD <- paste(varname,".level_", categories[j], sep="")
+          names.of.subsets <- append(names.of.subsets, name.of.subD)
+        }else{
+          # if any one category has between 1 and 'filter' number of observation turn subset content into missing values
+          count <- count+1
+          if(length(indices) == 0){
+            subsets[[count]] <- df[-c(1:dim(df)[1]),]
+            name.of.subD <- paste(varname,".level_", categories[j], "_EMPTY",sep="")
+          }else{
+            subD <- df[indices,]
+            subD[] <- NA
+            subsets[[count]] <- subD
+            name.of.subD <- paste(varname,".level_", categories[j], "_INVALID",sep="")
+          }
+          colnames(subsets[[count]]) <- colnames(df)
+          names.of.subsets <- append(names.of.subsets, name.of.subD) 
+        }
+      }
+      names(subsets) <- names.of.subsets
+    }else{
+      # if a variable is not a factor increment the below counter
+      nonfactorvars <- nonfactorvars + 1
+    }
+  }
+  return(list(subsets, nonfactorvars))
+}

R/subsetByClassHelper3.R

@@ -0,0 +1,59 @@
+#' 
+#' @title generates subset tables from a data frame
+#' @description This is an internal function called by the function 'subsetByClassDS'
+#' @details The function generates subsets if the input of 'subsetByClassDS' is a data frame 
+#' and if the number of variables (columns) to subset by is 1; i.e. this 
+#' function is called if the user specified one variable to subset by.
+#' @param df a data frame.
+#' @param indx1 the column index of the variable specified by the user.
+#' @param filter the minimum number of observations (i.e. rows) that are allowed.
+#' @return a list which contains the subsets, their names and an integer that indicates if
+#' the variable specified by user is a factor.
+#' @keywords internal
+#' @noRd
+#' @author Gaye, A.
+#'
+subsetByClassHelper3 <- function(df=NULL, indx1=NULL, filter=NULL){
+  # various counters and temporary variables to hold info
+  subsets <- list()
+  names.of.subsets <- c()
+  count <- 0
+  nonfactorvars <- 0
+  ncols <- length(colnames(df))
+  var <- df[,indx1]
+  varname <- colnames(df)[indx1]
+  if(is.factor(var)){
+    # get the levels
+    categories <- levels(var)
+    # loop through the levels and generate a dataset for each level
+    # if the number of observations for that level > 0 and < 'filter'
+    for(j in 1:length(categories)){
+      indices <- which(var == as.numeric(categories[j]))
+      if(!(length(indices) < filter)){
+        count <- count+1
+        subD <- df[indices,]
+        subsets[[count]] <- subD
+        name.of.subD <- paste(varname,".level_", categories[j], sep="")
+        names.of.subsets <- append(names.of.subsets, name.of.subD)
+      }else{
+        # if any one category has between 1 and 'filter' number of observations turn subset content into missing values
+        count <- count+1
+        if(length(indices) == 0){
+          subsets[[count]] <- df[-c(1:dim(df)[1]),]
+          name.of.subD <- paste(varname,".level_", categories[j], "_EMPTY",sep="")
+        }else{
+          subD <- df[indices,]
+          subD[] <- NA
+          subsets[[count]] <- subD
+          name.of.subD <- paste(varname,".level_", categories[j], "_INVALID",sep="")
+        }
+        colnames(subsets[[count]]) <- colnames(df)
+        names.of.subsets <- append(names.of.subsets, name.of.subD)
+      }
+    }
+    names(subsets) <- names.of.subsets
+  }else{
+    nonfactorvars <- 1
+  }
+  return(list(subsets, nonfactorvars))
+}

_pkgdown.yml

@@ -1,3 +1,4 @@
 template:
+  bootstrap: 5
   params:
     bootswatch: simplex

docs/404.md

@@ -0,0 +1,3 @@
+Content not found. Please use links in the navbar.
+
+# Page not found (404)