MaaniBeigy/DescObs
Versatile Exploration of Data

Package index
Search the MaaniBeigy/DescObs package
Vignettes
Functions
15
Source code
48
Man pages
13
Home
/
GitHub
/
MaaniBeigy/DescObs
/

In MaaniBeigy/DescObs: Versatile Exploration of Data 

knitr::opts_chunk$set(echo = TRUE)

Versatile Function for Removing Objects
The traditional rm function from base package is not a versatile function because it cannot handle exceptional objects or string patterns to skip or remove. Moreover, rm gives no warning before removing the objects and is not interactive. Also, the pattern argument of ls() function cannot handle multiple patterns or multiple regular expressions.

This function has been developed for sake of versatility, where you can determine exceptional objects and patterns for saving and/or removing objects. Also, you receive proper message regarding the final approval of removing objects. The search strategy of rm_versatile is based upon apropos function, which enables you to determine the type or storage mode of the objects (e.g., double, integer, character, etc.).

Examples

Let us experience such versatility by examples. First we need to make some objects in the environment:

rm_versatile <- function(
    save.objects = NULL,
    save.patterns = NULL,
    rm.objects = NULL,
    rm.patterns = NULL,
    modes = list("integer", "double", "character", "list"),
    envir = .GlobalEnv,
    inherits = FALSE,
    ...
) {
    if (is.null(save.objects)) {
        save.objects = NULL
    } else {
        save.objects = unlist(save.objects)
    }
    if (is.null(save.patterns)) {
        save.patterns = NULL
    } else {
        save.patterns = unlist(save.patterns)
    }
    if (is.null(rm.objects)) {
        rm.objects = NULL
    } else {
        rm.objects = unlist(rm.objects)
    }
    if (is.null(rm.patterns)) {
        rm.patterns = NULL
    } else {
        rm.patterns = unlist(rm.patterns)
    }
    mode <- match.arg(  # match the user's input with available methods
        arg = unlist(modes),
        choices = c(
            "logical", "integer", "double", "complex", "raw", "character",
            "list", "expression", "name", "symbol", "function"
        ),
        several.ok = TRUE
    )
    envir = envir
    inherits = inherits
    if (
        (is.null(save.patterns)) &&
        (is.null(save.objects)) &&
        (is.null(rm.objects)) &&
        (is.null(rm.patterns))
    ) {
        stop("You have selected neither save nor remove objects/patterns!")
    } else if ((!is.null(save.patterns)) ||
               (!is.null(save.objects))
    ) {
        if ("integer" %in% mode) {
            save.mode.integer <- unlist(lapply(
                save.patterns, apropos, mode = "integer")
            )
        } else if (!("integer" %in% mode)) {
            save.mode.integer <- NULL
        }
        if ("double" %in% mode) {
            save.mode.double <- unlist(lapply(
                save.patterns, apropos, mode = "double")
            )
        } else if (!("double" %in% mode)) {
            save.mode.double <- NULL
        }
        if ("character" %in% mode) {
            save.mode.character <- unlist(
                lapply(save.patterns, apropos, mode = "character")
            )
        } else if (!("character" %in% mode)) {
            save.mode.character <- NULL
        }
        if ("list" %in% mode) {
            save.mode.list <- unlist(
                lapply(save.patterns, apropos, mode = "list")
            )
        } else if (!("list" %in% mode)) {
            save.mode.list <- NULL
        }
        if ("logical" %in% mode) {
            save.mode.logical <- unlist(lapply(
                save.patterns, apropos, mode = "logical")
            )
        } else if (!("logical" %in% mode)) {
            save.mode.logical <- NULL
        }
        if ("complex" %in% mode) {
            save.mode.complex <- unlist(lapply(
                save.patterns, apropos, mode = "complex")
            )
        } else if (!("complex" %in% mode)) {
            save.mode.complex <- NULL
        }
        if ("raw" %in% mode) {
            save.mode.raw <- unlist(
                lapply(save.patterns, apropos, mode = "raw")
            )
        } else if (!("raw" %in% mode)) {
            save.mode.raw <- NULL
        }
        if ("expression" %in% mode) {
            save.mode.expression <- unlist(
                lapply(save.patterns, apropos, mode = "expression")
            )
        } else if (!("expression" %in% mode)) {
            save.mode.expression <- NULL
        }
        if ("name" %in% mode) {
            save.mode.name <- unlist(
                lapply(save.patterns, apropos, mode = "name")
            )
        } else if (!("name" %in% mode)) {
            save.mode.name <- NULL
        }
        if ("symbol" %in% mode) {
            save.mode.symbol <- unlist(
                lapply(save.patterns, apropos, mode = "symbol")
            )
        } else if (!("symbol" %in% mode)) {
            save.mode.symbol <- NULL
        }
        if ("function" %in% mode) {
            save.mode.function <- unlist(lapply(
                save.patterns, apropos, mode = "function")
            )
        } else if (!("function" %in% mode)) {
            save.mode.function <- NULL
        }
        save.formula = union(
            c(save.objects),
            c(save.mode.logical, save.mode.integer, save.mode.double,
              save.mode.complex, save.mode.raw, save.mode.character,
              save.mode.list, save.mode.expression, save.mode.name,
              save.mode.symbol, save.mode.function)
        )
        print(setdiff(ls(envir = .GlobalEnv), save.formula))
        ANSWER <- readline(
            "Are you a sure you want to remove these objects? [yes/no]"
        )
        if (substr(ANSWER, 1, 1) == "n") {
            cat("OK, change your patterns and exceptional objects")
        } else {
            rm(
                list = setdiff(ls(envir = .GlobalEnv), save.formula),
                envir = .GlobalEnv,
                inherits = inherits
            )
            message("Done!")
        }
    } else if (
        ((!is.null(rm.objects)) ||
        (!is.null(rm.patterns)))
    ) {
        if ("integer" %in% mode) {
            rm.mode.integer <- unlist(lapply(
                rm.patterns, apropos, mode = "integer")
            )
        } else if (!("integer" %in% mode)) {
            rm.mode.integer <- NULL
        }
        if ("double" %in% mode) {
            rm.mode.double <- unlist(lapply(
                rm.patterns, apropos, mode = "double")
            )
        } else if (!("double" %in% mode)) {
            rm.mode.double <- NULL
        }
        if ("character" %in% mode) {
            rm.mode.character <- unlist(
                lapply(rm.patterns, apropos, mode = "character")
            )
        } else if (!("character" %in% mode)) {
            rm.mode.character <- NULL
        }
        if ("list" %in% mode) {
            rm.mode.list <- unlist(
                lapply(rm.patterns, apropos, mode = "list")
            )
        } else if (!("list" %in% mode)) {
            rm.mode.list <- NULL
        }
        if ("logical" %in% mode) {
            rm.mode.logical <- unlist(lapply(
                rm.patterns, apropos, mode = "logical")
            )
        } else if (!("logical" %in% mode)) {
            rm.mode.logical <- NULL
        }
        if ("complex" %in% mode) {
            rm.mode.complex <- unlist(lapply(
                rm.patterns, apropos, mode = "complex")
            )
        } else if (!("complex" %in% mode)) {
            rm.mode.complex <- NULL
        }
        if ("raw" %in% mode) {
            rm.mode.raw <- unlist(
                lapply(rm.patterns, apropos, mode = "raw")
            )
        } else if (!("raw" %in% mode)) {
            rm.mode.raw <- NULL
        }
        if ("expression" %in% mode) {
            rm.mode.expression <- unlist(
                lapply(rm.patterns, apropos, mode = "expression")
            )
        } else if (!("expression" %in% mode)) {
            rm.mode.expression <- NULL
        }
        if ("name" %in% mode) {
            rm.mode.name <- unlist(
                lapply(rm.patterns, apropos, mode = "name")
            )
        } else if (!("name" %in% mode)) {
            rm.mode.name <- NULL
        }
        if ("symbol" %in% mode) {
            rm.mode.symbol <- unlist(
                lapply(rm.patterns, apropos, mode = "symbol")
            )
        } else if (!("symbol" %in% mode)) {
            rm.mode.symbol <- NULL
        }
        if ("function" %in% mode) {
            rm.mode.function <- unlist(lapply(
                rm.patterns, apropos, mode = "function")
            )
        } else if (!("function" %in% mode)) {
            rm.mode.function <- NULL
        }
        rm.formula = union(
            c(rm.objects),
            c(rm.mode.logical, rm.mode.integer, rm.mode.double,
              rm.mode.complex, rm.mode.raw, rm.mode.character,
              rm.mode.list, rm.mode.expression, rm.mode.name,
              rm.mode.symbol, rm.mode.function)
        )
        print(rm.formula)
        ANSWER <- readline(
            "Are you a sure you want to remove these objects? [yes/no]"
        )
        if (substr(ANSWER, 1, 1) == "n") {
            cat("OK, change your patterns and remove objects")
        } else {
            rm(
                list = rm.formula,
                envir = .GlobalEnv,
                inherits = inherits
            )
            message("Done!")
        }
    } else if (
        ((!is.null(save.patterns)) ||
         (!is.null(save.objects))) &&
        ((!is.null(rm.objects)) ||
         (!is.null(rm.patterns)))
    ) {
        if ("integer" %in% mode) {
            save.mode.integer <- unlist(lapply(
                save.patterns, apropos, mode = "integer")
            )
        } else if (!("integer" %in% mode)) {
            save.mode.integer <- NULL
        }
        if ("double" %in% mode) {
            save.mode.double <- unlist(lapply(
                save.patterns, apropos, mode = "double")
            )
        } else if (!("double" %in% mode)) {
            save.mode.double <- NULL
        }
        if ("character" %in% mode) {
            save.mode.character <- unlist(
                lapply(save.patterns, apropos, mode = "character")
            )
        } else if (!("character" %in% mode)) {
            save.mode.character <- NULL
        }
        if ("list" %in% mode) {
            save.mode.list <- unlist(
                lapply(save.patterns, apropos, mode = "list")
            )
        } else if (!("list" %in% mode)) {
            save.mode.list <- NULL
        }
        if ("logical" %in% mode) {
            save.mode.logical <- unlist(lapply(
                save.patterns, apropos, mode = "logical")
            )
        } else if (!("logical" %in% mode)) {
            save.mode.logical <- NULL
        }
        if ("complex" %in% mode) {
            save.mode.complex <- unlist(lapply(
                save.patterns, apropos, mode = "complex")
            )
        } else if (!("complex" %in% mode)) {
            save.mode.complex <- NULL
        }
        if ("raw" %in% mode) {
            save.mode.raw <- unlist(
                lapply(save.patterns, apropos, mode = "raw")
            )
        } else if (!("raw" %in% mode)) {
            save.mode.raw <- NULL
        }
        if ("expression" %in% mode) {
            save.mode.expression <- unlist(
                lapply(save.patterns, apropos, mode = "expression")
            )
        } else if (!("expression" %in% mode)) {
            save.mode.expression <- NULL
        }
        if ("name" %in% mode) {
            save.mode.name <- unlist(
                lapply(save.patterns, apropos, mode = "name")
            )
        } else if (!("name" %in% mode)) {
            save.mode.name <- NULL
        }
        if ("symbol" %in% mode) {
            save.mode.symbol <- unlist(
                lapply(save.patterns, apropos, mode = "symbol")
            )
        } else if (!("symbol" %in% mode)) {
            save.mode.symbol <- NULL
        }
        if ("function" %in% mode) {
            save.mode.function <- unlist(lapply(
                save.patterns, apropos, mode = "function")
            )
        } else if (!("function" %in% mode)) {
            save.mode.function <- NULL
        }
        save.formula = union(
            c(save.objects),
            c(save.mode.logical, save.mode.integer, save.mode.double,
              save.mode.complex, save.mode.raw, save.mode.character,
              save.mode.list, save.mode.expression, save.mode.name,
              save.mode.symbol, save.mode.function)
        )
        if ("integer" %in% mode) {
            rm.mode.integer <- unlist(lapply(
                rm.patterns, apropos, mode = "integer")
            )
        } else if (!("integer" %in% mode)) {
            rm.mode.integer <- NULL
        }
        if ("double" %in% mode) {
            rm.mode.double <- unlist(lapply(
                rm.patterns, apropos, mode = "double")
            )
        } else if (!("double" %in% mode)) {
            rm.mode.double <- NULL
        }
        if ("character" %in% mode) {
            rm.mode.character <- unlist(
                lapply(rm.patterns, apropos, mode = "character")
            )
        } else if (!("character" %in% mode)) {
            rm.mode.character <- NULL
        }
        if ("list" %in% mode) {
            rm.mode.list <- unlist(
                lapply(rm.patterns, apropos, mode = "list")
            )
        } else if (!("list" %in% mode)) {
            rm.mode.list <- NULL
        }
        if ("logical" %in% mode) {
            rm.mode.logical <- unlist(lapply(
                rm.patterns, apropos, mode = "logical")
            )
        } else if (!("logical" %in% mode)) {
            rm.mode.logical <- NULL
        }
        if ("complex" %in% mode) {
            rm.mode.complex <- unlist(lapply(
                rm.patterns, apropos, mode = "complex")
            )
        } else if (!("complex" %in% mode)) {
            rm.mode.complex <- NULL
        }
        if ("raw" %in% mode) {
            rm.mode.raw <- unlist(
                lapply(rm.patterns, apropos, mode = "raw")
            )
        } else if (!("raw" %in% mode)) {
            rm.mode.raw <- NULL
        }
        if ("expression" %in% mode) {
            rm.mode.expression <- unlist(
                lapply(rm.patterns, apropos, mode = "expression")
            )
        } else if (!("expression" %in% mode)) {
            rm.mode.expression <- NULL
        }
        if ("name" %in% mode) {
            rm.mode.name <- unlist(
                lapply(rm.patterns, apropos, mode = "name")
            )
        } else if (!("name" %in% mode)) {
            rm.mode.name <- NULL
        }
        if ("symbol" %in% mode) {
            rm.mode.symbol <- unlist(
                lapply(rm.patterns, apropos, mode = "symbol")
            )
        } else if (!("symbol" %in% mode)) {
            rm.mode.symbol <- NULL
        }
        if ("function" %in% mode) {
            rm.mode.function <- unlist(lapply(
                rm.patterns, apropos, mode = "function")
            )
        } else if (!("function" %in% mode)) {
            rm.mode.function <- NULL
        }
        rm.formula = union(
            c(rm.objects),
            c(rm.mode.logical, rm.mode.integer, rm.mode.double,
              rm.mode.complex, rm.mode.raw, rm.mode.character,
              rm.mode.list, rm.mode.expression, rm.mode.name,
              rm.mode.symbol, rm.mode.function)
        )
        print(union(setdiff(ls(envir = .GlobalEnv), save.formula), rm.formula))
        ANSWER <- readline(
            "Are you a sure you want to remove these objects? [yes/no]"
        )
        if (substr(ANSWER, 1, 1) == "n") {
            cat("OK, change your patterns and objects")
        } else {
            rm(
                list = union(
                    setdiff(ls(envir = .GlobalEnv), save.formula),
                    rm.formula
                ),
                envir = .GlobalEnv,
                inherits = inherits
            )
            message("Done!")
        }
    }
}

a <- 1
b <- "female"
c <- FALSE
d <- 4:10
e <- 5
f <- 6
g <- 7
df1 <- 8
df2 <- 9
dfcol <- 10
dff1 <- 11
dfff3 <- 12
mydata1 <- 13
mymydata <- 14
dataframe1 <- data.frame(
    gender = c("F", "M", "M", "F"),
    score = c(10, 12, 14, 18)
    )
matrix.a <- matrix(1:10, nrow = 2, ncol = 5)
matrix2 <- matrix(1:100, ncol = 2)
x <- c("a", "b", "c", "d")
y <- c("d", "e", "f")

Suppose that we want to remove all objects except for "a", "b", and "c" objects and those with "df" and "data" string patterns. 

rm_versatile(
    save.objects = list("a", "b", "c"),
    save.patterns = list("df", "data")
)

Let us check what have we done:

ls()

Now, imagine that we want to remove objects "x" and "y" and those with "matrix" pattern. 

rm_versatile <- function(
    save.objects = NULL,
    save.patterns = NULL,
    rm.objects = NULL,
    rm.patterns = NULL,
    modes = list("integer", "double", "character", "list"),
    envir = .GlobalEnv,
    inherits = FALSE,
    ...
) {
    if (is.null(save.objects)) {
        save.objects = NULL
    } else {
        save.objects = unlist(save.objects)
    }
    if (is.null(save.patterns)) {
        save.patterns = NULL
    } else {
        save.patterns = unlist(save.patterns)
    }
    if (is.null(rm.objects)) {
        rm.objects = NULL
    } else {
        rm.objects = unlist(rm.objects)
    }
    if (is.null(rm.patterns)) {
        rm.patterns = NULL
    } else {
        rm.patterns = unlist(rm.patterns)
    }
    mode <- match.arg(  # match the user's input with available methods
        arg = unlist(modes),
        choices = c(
            "logical", "integer", "double", "complex", "raw", "character",
            "list", "expression", "name", "symbol", "function"
        ),
        several.ok = TRUE
    )
    envir = envir
    inherits = inherits
    if (
        (is.null(save.patterns)) &&
        (is.null(save.objects)) &&
        (is.null(rm.objects)) &&
        (is.null(rm.patterns))
    ) {
        stop("You have selected neither save nor remove objects/patterns!")
    } else if ((!is.null(save.patterns)) ||
               (!is.null(save.objects))
    ) {
        if ("integer" %in% mode) {
            save.mode.integer <- unlist(lapply(
                save.patterns, apropos, mode = "integer")
            )
        } else if (!("integer" %in% mode)) {
            save.mode.integer <- NULL
        }
        if ("double" %in% mode) {
            save.mode.double <- unlist(lapply(
                save.patterns, apropos, mode = "double")
            )
        } else if (!("double" %in% mode)) {
            save.mode.double <- NULL
        }
        if ("character" %in% mode) {
            save.mode.character <- unlist(
                lapply(save.patterns, apropos, mode = "character")
            )
        } else if (!("character" %in% mode)) {
            save.mode.character <- NULL
        }
        if ("list" %in% mode) {
            save.mode.list <- unlist(
                lapply(save.patterns, apropos, mode = "list")
            )
        } else if (!("list" %in% mode)) {
            save.mode.list <- NULL
        }
        if ("logical" %in% mode) {
            save.mode.logical <- unlist(lapply(
                save.patterns, apropos, mode = "logical")
            )
        } else if (!("logical" %in% mode)) {
            save.mode.logical <- NULL
        }
        if ("complex" %in% mode) {
            save.mode.complex <- unlist(lapply(
                save.patterns, apropos, mode = "complex")
            )
        } else if (!("complex" %in% mode)) {
            save.mode.complex <- NULL
        }
        if ("raw" %in% mode) {
            save.mode.raw <- unlist(
                lapply(save.patterns, apropos, mode = "raw")
            )
        } else if (!("raw" %in% mode)) {
            save.mode.raw <- NULL
        }
        if ("expression" %in% mode) {
            save.mode.expression <- unlist(
                lapply(save.patterns, apropos, mode = "expression")
            )
        } else if (!("expression" %in% mode)) {
            save.mode.expression <- NULL
        }
        if ("name" %in% mode) {
            save.mode.name <- unlist(
                lapply(save.patterns, apropos, mode = "name")
            )
        } else if (!("name" %in% mode)) {
            save.mode.name <- NULL
        }
        if ("symbol" %in% mode) {
            save.mode.symbol <- unlist(
                lapply(save.patterns, apropos, mode = "symbol")
            )
        } else if (!("symbol" %in% mode)) {
            save.mode.symbol <- NULL
        }
        if ("function" %in% mode) {
            save.mode.function <- unlist(lapply(
                save.patterns, apropos, mode = "function")
            )
        } else if (!("function" %in% mode)) {
            save.mode.function <- NULL
        }
        save.formula = union(
            c(save.objects),
            c(save.mode.logical, save.mode.integer, save.mode.double,
              save.mode.complex, save.mode.raw, save.mode.character,
              save.mode.list, save.mode.expression, save.mode.name,
              save.mode.symbol, save.mode.function)
        )
        print(setdiff(ls(envir = .GlobalEnv), save.formula))
        ANSWER <- readline(
            "Are you a sure you want to remove these objects? [yes/no]"
        )
        if (substr(ANSWER, 1, 1) == "n") {
            cat("OK, change your patterns and exceptional objects")
        } else {
            rm(
                list = setdiff(ls(envir = .GlobalEnv), save.formula),
                envir = .GlobalEnv,
                inherits = inherits
            )
            message("Done!")
        }
    } else if (
        ((!is.null(rm.objects)) ||
        (!is.null(rm.patterns)))
    ) {
        if ("integer" %in% mode) {
            rm.mode.integer <- unlist(lapply(
                rm.patterns, apropos, mode = "integer")
            )
        } else if (!("integer" %in% mode)) {
            rm.mode.integer <- NULL
        }
        if ("double" %in% mode) {
            rm.mode.double <- unlist(lapply(
                rm.patterns, apropos, mode = "double")
            )
        } else if (!("double" %in% mode)) {
            rm.mode.double <- NULL
        }
        if ("character" %in% mode) {
            rm.mode.character <- unlist(
                lapply(rm.patterns, apropos, mode = "character")
            )
        } else if (!("character" %in% mode)) {
            rm.mode.character <- NULL
        }
        if ("list" %in% mode) {
            rm.mode.list <- unlist(
                lapply(rm.patterns, apropos, mode = "list")
            )
        } else if (!("list" %in% mode)) {
            rm.mode.list <- NULL
        }
        if ("logical" %in% mode) {
            rm.mode.logical <- unlist(lapply(
                rm.patterns, apropos, mode = "logical")
            )
        } else if (!("logical" %in% mode)) {
            rm.mode.logical <- NULL
        }
        if ("complex" %in% mode) {
            rm.mode.complex <- unlist(lapply(
                rm.patterns, apropos, mode = "complex")
            )
        } else if (!("complex" %in% mode)) {
            rm.mode.complex <- NULL
        }
        if ("raw" %in% mode) {
            rm.mode.raw <- unlist(
                lapply(rm.patterns, apropos, mode = "raw")
            )
        } else if (!("raw" %in% mode)) {
            rm.mode.raw <- NULL
        }
        if ("expression" %in% mode) {
            rm.mode.expression <- unlist(
                lapply(rm.patterns, apropos, mode = "expression")
            )
        } else if (!("expression" %in% mode)) {
            rm.mode.expression <- NULL
        }
        if ("name" %in% mode) {
            rm.mode.name <- unlist(
                lapply(rm.patterns, apropos, mode = "name")
            )
        } else if (!("name" %in% mode)) {
            rm.mode.name <- NULL
        }
        if ("symbol" %in% mode) {
            rm.mode.symbol <- unlist(
                lapply(rm.patterns, apropos, mode = "symbol")
            )
        } else if (!("symbol" %in% mode)) {
            rm.mode.symbol <- NULL
        }
        if ("function" %in% mode) {
            rm.mode.function <- unlist(lapply(
                rm.patterns, apropos, mode = "function")
            )
        } else if (!("function" %in% mode)) {
            rm.mode.function <- NULL
        }
        rm.formula = union(
            c(rm.objects),
            c(rm.mode.logical, rm.mode.integer, rm.mode.double,
              rm.mode.complex, rm.mode.raw, rm.mode.character,
              rm.mode.list, rm.mode.expression, rm.mode.name,
              rm.mode.symbol, rm.mode.function)
        )
        print(rm.formula)
        ANSWER <- readline(
            "Are you a sure you want to remove these objects? [yes/no]"
        )
        if (substr(ANSWER, 1, 1) == "n") {
            cat("OK, change your patterns and remove objects")
        } else {
            rm(
                list = rm.formula,
                envir = .GlobalEnv,
                inherits = inherits
            )
            message("Done!")
        }
    } else if (
        ((!is.null(save.patterns)) ||
         (!is.null(save.objects))) &&
        ((!is.null(rm.objects)) ||
         (!is.null(rm.patterns)))
    ) {
        if ("integer" %in% mode) {
            save.mode.integer <- unlist(lapply(
                save.patterns, apropos, mode = "integer")
            )
        } else if (!("integer" %in% mode)) {
            save.mode.integer <- NULL
        }
        if ("double" %in% mode) {
            save.mode.double <- unlist(lapply(
                save.patterns, apropos, mode = "double")
            )
        } else if (!("double" %in% mode)) {
            save.mode.double <- NULL
        }
        if ("character" %in% mode) {
            save.mode.character <- unlist(
                lapply(save.patterns, apropos, mode = "character")
            )
        } else if (!("character" %in% mode)) {
            save.mode.character <- NULL
        }
        if ("list" %in% mode) {
            save.mode.list <- unlist(
                lapply(save.patterns, apropos, mode = "list")
            )
        } else if (!("list" %in% mode)) {
            save.mode.list <- NULL
        }
        if ("logical" %in% mode) {
            save.mode.logical <- unlist(lapply(
                save.patterns, apropos, mode = "logical")
            )
        } else if (!("logical" %in% mode)) {
            save.mode.logical <- NULL
        }
        if ("complex" %in% mode) {
            save.mode.complex <- unlist(lapply(
                save.patterns, apropos, mode = "complex")
            )
        } else if (!("complex" %in% mode)) {
            save.mode.complex <- NULL
        }
        if ("raw" %in% mode) {
            save.mode.raw <- unlist(
                lapply(save.patterns, apropos, mode = "raw")
            )
        } else if (!("raw" %in% mode)) {
            save.mode.raw <- NULL
        }
        if ("expression" %in% mode) {
            save.mode.expression <- unlist(
                lapply(save.patterns, apropos, mode = "expression")
            )
        } else if (!("expression" %in% mode)) {
            save.mode.expression <- NULL
        }
        if ("name" %in% mode) {
            save.mode.name <- unlist(
                lapply(save.patterns, apropos, mode = "name")
            )
        } else if (!("name" %in% mode)) {
            save.mode.name <- NULL
        }
        if ("symbol" %in% mode) {
            save.mode.symbol <- unlist(
                lapply(save.patterns, apropos, mode = "symbol")
            )
        } else if (!("symbol" %in% mode)) {
            save.mode.symbol <- NULL
        }
        if ("function" %in% mode) {
            save.mode.function <- unlist(lapply(
                save.patterns, apropos, mode = "function")
            )
        } else if (!("function" %in% mode)) {
            save.mode.function <- NULL
        }
        save.formula = union(
            c(save.objects),
            c(save.mode.logical, save.mode.integer, save.mode.double,
              save.mode.complex, save.mode.raw, save.mode.character,
              save.mode.list, save.mode.expression, save.mode.name,
              save.mode.symbol, save.mode.function)
        )
        if ("integer" %in% mode) {
            rm.mode.integer <- unlist(lapply(
                rm.patterns, apropos, mode = "integer")
            )
        } else if (!("integer" %in% mode)) {
            rm.mode.integer <- NULL
        }
        if ("double" %in% mode) {
            rm.mode.double <- unlist(lapply(
                rm.patterns, apropos, mode = "double")
            )
        } else if (!("double" %in% mode)) {
            rm.mode.double <- NULL
        }
        if ("character" %in% mode) {
            rm.mode.character <- unlist(
                lapply(rm.patterns, apropos, mode = "character")
            )
        } else if (!("character" %in% mode)) {
            rm.mode.character <- NULL
        }
        if ("list" %in% mode) {
            rm.mode.list <- unlist(
                lapply(rm.patterns, apropos, mode = "list")
            )
        } else if (!("list" %in% mode)) {
            rm.mode.list <- NULL
        }
        if ("logical" %in% mode) {
            rm.mode.logical <- unlist(lapply(
                rm.patterns, apropos, mode = "logical")
            )
        } else if (!("logical" %in% mode)) {
            rm.mode.logical <- NULL
        }
        if ("complex" %in% mode) {
            rm.mode.complex <- unlist(lapply(
                rm.patterns, apropos, mode = "complex")
            )
        } else if (!("complex" %in% mode)) {
            rm.mode.complex <- NULL
        }
        if ("raw" %in% mode) {
            rm.mode.raw <- unlist(
                lapply(rm.patterns, apropos, mode = "raw")
            )
        } else if (!("raw" %in% mode)) {
            rm.mode.raw <- NULL
        }
        if ("expression" %in% mode) {
            rm.mode.expression <- unlist(
                lapply(rm.patterns, apropos, mode = "expression")
            )
        } else if (!("expression" %in% mode)) {
            rm.mode.expression <- NULL
        }
        if ("name" %in% mode) {
            rm.mode.name <- unlist(
                lapply(rm.patterns, apropos, mode = "name")
            )
        } else if (!("name" %in% mode)) {
            rm.mode.name <- NULL
        }
        if ("symbol" %in% mode) {
            rm.mode.symbol <- unlist(
                lapply(rm.patterns, apropos, mode = "symbol")
            )
        } else if (!("symbol" %in% mode)) {
            rm.mode.symbol <- NULL
        }
        if ("function" %in% mode) {
            rm.mode.function <- unlist(lapply(
                rm.patterns, apropos, mode = "function")
            )
        } else if (!("function" %in% mode)) {
            rm.mode.function <- NULL
        }
        rm.formula = union(
            c(rm.objects),
            c(rm.mode.logical, rm.mode.integer, rm.mode.double,
              rm.mode.complex, rm.mode.raw, rm.mode.character,
              rm.mode.list, rm.mode.expression, rm.mode.name,
              rm.mode.symbol, rm.mode.function)
        )
        print(union(setdiff(ls(envir = .GlobalEnv), save.formula), rm.formula))
        ANSWER <- readline(
            "Are you a sure you want to remove these objects? [yes/no]"
        )
        if (substr(ANSWER, 1, 1) == "n") {
            cat("OK, change your patterns and objects")
        } else {
            rm(
                list = union(
                    setdiff(ls(envir = .GlobalEnv), save.formula),
                    rm.formula
                ),
                envir = .GlobalEnv,
                inherits = inherits
            )
            message("Done!")
        }
    }
}
a <- 1
b <- "female"
c <- FALSE
d <- 4:10
e <- 5
f <- 6
g <- 7
df1 <- 8
df2 <- 9
dfcol <- 10
dff1 <- 11
dfff3 <- 12
mydata1 <- 13
mymydata <- 14
dataframe1 <- data.frame(
    gender = c("F", "M", "M", "F"),
    score = c(10, 12, 14, 18)
    )
matrix.a <- matrix(1:10, nrow = 2, ncol = 5)
matrix2 <- matrix(1:100, ncol = 2)
x <- c("a", "b", "c", "d")
y <- c("d", "e", "f")

ls()
rm_versatile(
    rm.objects = list("x", "y"),
    rm.patterns = list("matrix")
)
ls()

Let us solve another practical example. Suppose that you have made many data frames (for instance 100 data frames) that share similar string pattern in their name e.g., "df". You want to remove these objects (which are of list type), and also all other data frames and matrices. One efficient way to do it is:

# make lots of data.frames and objects
id <- c(1,2,3,4)
gender <- c("male","female","female","male")
time <- c(2018,2019,2018,2017)
df <- data.frame(id, gender, time)
myvalues <- c(2017,2018,2019)
for (i in 1:100) {
    assign(paste0("dfy",i), df[df$time == myvalues[i],])
}
a <- 1
b <- "female"
c <- FALSE
d <- 4:10
e <- 5
f <- 6
g <- 7
df1 <- 8
df2 <- 9
dfcol <- 10
dff1 <- 11
dfff3 <- 12
mydata1 <- 13
mymydata <- 14
dataframe1 <- data.frame(
    gender = c("F", "M", "M", "F"),
    score = c(10, 12, 14, 18)
    )
matrix.a <- matrix(1:10, nrow = 2, ncol = 5)
matrix2 <- matrix(1:100, ncol = 2)
x <- c("a", "b", "c", "d")
y <- c("d", "e", "f")
# list the objects first
ls()
# let us remove the data frames
rm_versatile(
    rm.patterns = list("df", "matrix", "dataframe"),
    modes = list("list")
)
# check the remaining objects
ls()

* Note that the type of matrix objects is not list. Matrices are stored as integer, hence are not removed from the environment. But we do not want to change the modes argument because there are various integer type vectors in our environment that are needed. One way to get rid of them is:

id <- c(1,2,3,4)
gender <- c("male","female","female","male")
time <- c(2018,2019,2018,2017)
df <- data.frame(id, gender, time)
myvalues <- c(2017,2018,2019)
for (i in 1:100) {
    assign(paste0("dfy",i), df[df$time == myvalues[i],])
}
a <- 1
b <- "female"
c <- FALSE
d <- 4:10
e <- 5
f <- 6
g <- 7
df1 <- 8
df2 <- 9
dfcol <- 10
dff1 <- 11
dfff3 <- 12
mydata1 <- 13
mymydata <- 14
dataframe1 <- data.frame(
    gender = c("F", "M", "M", "F"),
    score = c(10, 12, 14, 18)
    )
matrix.a <- matrix(1:10, nrow = 2, ncol = 5)
matrix2 <- matrix(1:100, ncol = 2)
x <- c("a", "b", "c", "d")
y <- c("d", "e", "f")

rm_versatile(
    rm.objects = list("matrix.a", "matrix2"),
    rm.patterns = list("df", "matrix", "dataframe"),
    modes = list("list")
)
# check the remaining objects
ls()


MaaniBeigy/DescObs documentation built on May 23, 2019, 9:37 a.m.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.

Close