Share your functions & code

[Nathan G]

Thats what I use, but for the column names, I need subscripts and superscripts and the occasional equation which is translated by latex.

  library(xtable)

  #some code manipulating data into the format i like

    amscols(my.data.frame)    # <- formats column names from colname to $colname$

    mytable <-xtable(
        my.data.frame,
        caption="\\\\ \\textit{This is an example table with good latex formatting}", 
        label="tab:mytable", 
        align="cccccccccc",
        digits=2
    )
    print.xtable(
        mytable, 
        type="latex", 
        file="filepath.tex",
        include.rownames=F,
        table.placement="H",  
        size="small" , 
        caption.placement="top",
        sanitize.colnames.function=function(x){x}   # <- lifesaver
    )

 

[trinker]

Hey Nathan,

Sorry about the unwrap causing frustration. I wrote it early in my understanding of R and didn't consider other platforms. Most likely the adaptations you did to wrap should be generalizable to unwrap. I must admit I no longer use these functions and so didn't really develop them any further. Glad to have you contributing to the discussions at talkstats.

 

[Nathan G]

No apology needed. I like the challenge and it's good me for me to go back and decode.. I started using R dealing exclusively with data.frames with the plyr and reshape2 packages and without any clear understanding of how they worked. Unraveling other peoples code helps me learn different methods and forces me to go back to the basics and dig into the nuances of R.

 

[derksheng]

Extremely simple function that strips NAs from vectors. Has improved my efficiency a lot when working interactively with data.

noNA <- function(input)
{
	output <- input[!is.na(input)]
	return(output)
}

 

[Dason]

Extremely simple function that strips NAs from vectors. Has improved my efficiency a lot when working interactively with data.

noNA <- function(input)
{
	output <- input[!is.na(input)]
	return(output)
}

There is also na.omit and na.exclude but those do a little bit more so you'll probably be more comfortable with your self made function.

 

[trinker]

For you package makers here's one that generates basic roxygen framework for data sets that can be set to print to your package's main .R file. Here it is:

dat4rox <- function(..., file = NULL, append = FALSE) {
    dat.sets <- as.character(match.call(expand.dots = FALSE)[[2]]) 
    dat.list <- invisible(lapply(dat.sets, get))
    names(dat.list) <- dat.sets
    dat.file <- function(dat, name, file = "", append = FALSE) {
        is.enviroment <- function(x) class(x) == "environment"
        x <- "#'"
        what <- function(x) {
            if (is.data.frame(x)) {
                return("data frame")
            }
            if (is.list(x) & !is.data.frame(x)) {
                return("list")
            }
            if (is.vector(x)) {
                return("vector")
            }
            if (class(x) == "character") {
                return("character vector")
            }            
            if (is.environment(x)) {
                return("environment")
            }
        }
        type <- what(dat)
        if (type == "environment") {
            desc <- "#' A dataset containing an environment"
        } else {
            if (type == "data frame") {
                desc <- "#' A dataset containing"
            } else {
                if (type %in% c("character vector", "vector", "list")) {
                    desc <- paste("#' A dataset containing a", type)
                }
            }
        }
        if (is.data.frame(dat)) {
        	dets <- c("#' \\itemize{", paste("#'   \\item ", colnames(dat), ".", 
        	    sep = ""), "#' }")
        } else {
            if (is.vector(dat) | is.enviroment(dat) | class(dat) == "character") {
            	dets <- x
            } else {
                if (!is.data.frame(dat) && is.list(dat)) {
        	        dets <- c("#' \\describe{", paste("#'   \\item{", 
                        names(dat), "}{}", sep = ""), "#' }")
                }
            }
        }
        if (type == "data frame") {
            elems <- c(nrow(dat), "rows and", ncol(dat), "variables")
        } else {
            if (type %in% c("character vector", "vector")) {
                elems <- c(length(dat), "elements")
            } else {
                if (type == "list") {
                    elems <- c(length(dat), "elements")
                } else {
                    if (type == "environment") {
                        elems <- NULL
                    }
                }
            }    
        }
        out <- c("#'", x, desc, x, "#' @details",
            dets, x, "#' @docType data", "#' @keywords datasets",
            paste("#' @name", name), paste0("#' @usage data(", name, ")"),
            paste("#' @format A", type, "with", paste(elems, collapse = " ")), 
            "#' @references", "NULL\n")
        cat(paste(out, "\n", collapse=""), file = file, append = append)
    }
    invisible(lapply(seq_along(dat.list), function(i) {
        dat.file(dat.list[[i]], names(dat.list)[i])
    }))
    if (!is.null(file)) {
        apen <- rep(TRUE, length(dat.list))
        if (!append) {
            apen[1] <- FALSE
        }
        invisible(lapply(seq_along(dat.list), function(i) {
            dat.file(dat.list[[i]], names(dat.list)[i], file = file, append = apen[i])
        }))
    }
}


dat4rox(mtcars, CO2, file = "new.txt") #print to new file
dat4rox(mtcars, CO2, file = "qdap-package.R", append = TRUE) #print to package.R file

This yields:

Spoiler

#' 
#' 
#' A dataset containing 
#' 
#' @details 
#' \itemize{ 
#'   \item mpg. 
#'   \item cyl. 
#'   \item disp. 
#'   \item hp. 
#'   \item drat. 
#'   \item wt. 
#'   \item qsec. 
#'   \item vs. 
#'   \item am. 
#'   \item gear. 
#'   \item carb. 
#' } 
#' 
#' @docType data 
#' @keywords datasets 
#' @name mtcars 
#' @usage data(mtcars) 
#' @format A data frame with 32 rows and 11 variables 
#' @references 
NULL
 
#' 
#' 
#' A dataset containing 
#' 
#' @details 
#' \itemize{ 
#'   \item Plant. 
#'   \item Type. 
#'   \item Treatment. 
#'   \item conc. 
#'   \item uptake. 
#' } 
#' 
#' @docType data 
#' @keywords datasets 
#' @name CO2 
#' @usage data(CO2) 
#' @format A data frame with 84 rows and 5 variables 
#' @references 
NULL

I threw it in a package on my github as well:

# install.packages("devtools")

library(devtools)
install_github("acc.roxygen2", "trinker")

EDIT 1: I am going to clean up acc.roxygen2 more and make it OS independent in the future.
EDIT 2: Added handling for environments, lists and vectors.

 

[Nathan G]

Here's a Caesar Cypher I whipped up in response to a question.. I told him he needed to do some diligence before answering, but if he finds it here, good for him.

crypt <- function(x,offset){
	Letters <- c(letters[],LETTERS[])
	stringlist <- substring(x, seq(1,nchar(x),1), seq(1,nchar(x),1))
	crypted <- lapply(stringlist, function(i)  ifelse(!is.na(match(i,Letters)), ifelse((match(i, Letters) + offset)<52,sub(i, Letters[match(i, Letters) + offset],i),sub(i, Letters[offset - (52 - match(i,Letters))],i)), i))
	return(paste(crypted,collapse=""))
}

decrypt <- function(x,offset){
	Letters <- c(letters[],LETTERS[])
	stringlist <- substring(x, seq(1,nchar(x),1), seq(1,nchar(x),1))
	decrypted <- lapply(stringlist, function(i)  ifelse(!is.na(match(i,Letters)), ifelse((match(i, Letters) - offset)>0,sub(i, Letters[match(i, Letters) - offset],i),sub(i, Letters[52 - (offset - match(i,Letters))],i)), i))
	return(paste(decrypted,collapse=""))
}

x <- "The quick brown foX jumped over the laZY dog."

test <- crypt(x,3)
detest <- decrypt(test, 3)

If you can do better, I would love any advice to improving my coding skills. I realize there are some messy one-liners in there.

decrypt("Li wulqnhu uhdgv wklv, kh pxvw eh d Yhorfludswru.", 3)

 

[Nathan G]

Why did the statistician take Viagra?

decrypt("av yhpzl opz w-ChsBl!!", 7)

 

[bryangoodrich]

I don't have this function decrypt that you speak of

 

[Nathan G]

It's a couple posts previous on the same thread.

 

[trinker]

I created a package to assist in writing apa6 style reports and presentations.

Here's an introductory video: http://youtu.be/qBgsJG546gE
Here's the github website: https://github.com/trinker/reports

[YOUTUBE]qBgsJG546gE[/YOUTUBE]

 

[Nathan G]

Here's a nice little function that can rotate, shift, or circular shift matrices.

morph <- function(x, type, offset = 1, fill = 0, wrap = FALSE, dir = "col"){
	
	if (!is.matrix(x) & !is.data.frame(x))
		stop("Argument 'x' is not a matrix or data.frame.")
	if (offset != trunc(offset)) 
		stop("Argument 'offset' is not an integer.")

	if (type == "rot"){
		if(offset%%4 == 0)
			return(x)
		if(offset%%4 == 1)
			return( t(x[, ncol(x):1]) )			# rotate 90
		if(offset%%4 == 2)
			return( x[nrow(x):1, ncol(x):1] ) 	# rotate 180
		if(offset%%4 == 3)
			return( t(x[nrow(x):1, ]) )			# rotate 270
	}

	if (type == "shift" ){
		if(wrap){
			if (dir == "col")
				return( x[, ((1:ncol(x))-1-offset)%%ncol(x)+1] )
			if (dir == "row")
				return( x[((1:nrow(x))-1-offset)%%nrow(x)+1, ] )
		}
		if(!wrap){
			if(offset == 0)
				return(x)
			if (dir == "col"){
				if(offset < 0){
					return(morph(cbind(x[, 2:ncol(x)], N=rep(fill, nrow(x))), 
									 type, offset + 1, fill, wrap, dir))
				}	
				if(offset > 0){
					return(morph(cbind(N=rep(fill, nrow(x)), x[, 1:ncol(x) - 1]), 
									 type, offset - 1, fill, wrap, dir))
				}					
			}
			if (dir == "row"){
				if(offset < 0){
					return(morph(rbind(x[2:nrow(x), ], rep(fill, ncol(x))), 
									type, offset + 1, fill, wrap, dir))
				}	
				if(offset > 0){
					return(morph(rbind(rep(fill, ncol(x)), x[1:nrow(x) - 1, ]), 
									 type, offset - 1, fill, wrap, dir))
				}
			}
		}
	}
	stop("Invalid morph type or direction.")
}

For example:

(test <- matrix(1:16, 4))
#     [,1] [,2] [,3] [,4]
#[1,]    1    5    9   13
#[2,]    2    6   10   14
#[3,]    3    7   11   15
#[4,]    4    8   12   16
morph(test, 'rot')
#     [,1] [,2] [,3] [,4]
#[1,]   13   14   15   16
#[2,]    9   10   11   12
#[3,]    5    6    7    8
#[4,]    1    2    3    4
morph(test, 'rot', -1)
#     [,1] [,2] [,3] [,4]
#[1,]    4    3    2    1
#[2,]    8    7    6    5
#[3,]   12   11   10    9
#[4,]   16   15   14   13
morph(test, 'shift', 2, 'hi')
#     N    N           
#[1,] "hi" "hi" "1" "5"
#[2,] "hi" "hi" "2" "6"
#[3,] "hi" "hi" "3" "7"
#[4,] "hi" "hi" "4" "8"
morph(test, 'shift', -1, 'ho', dir='row')
#     [,1] [,2] [,3] [,4]
#[1,] "2"  "6"  "10" "14"
#[2,] "3"  "7"  "11" "15"
#[3,] "4"  "8"  "12" "16"
#[4,] "ho" "ho" "ho" "ho"
morph(test, 'shift', 1, wrap=TRUE)
#     [,1] [,2] [,3] [,4]
#[1,]   13    1    5    9
#[2,]   14    2    6   10
#[3,]   15    3    7   11
#[4,]   16    4    8   12
morph(test, 'shift', -2, wrap=TRUE, dir='row')
#     [,1] [,2] [,3] [,4]
#[1,]    3    7   11   15
#[2,]    4    8   12   16
#[3,]    1    5    9   13
#[4,]    2    6   10   14
#

 

[trinker]

For Jake who requested a version of apply that takes a list of functions. I present japply (Jake apply):

japply <- function(X, MARGIN, FUN, simplify = TRUE, ...) {

    funs <- unlist(lapply(match.call()[[4]], function(x) {as.character(x)}))[-1]

    out <- lapply(FUN, function(x) apply(X = X, MARGIN = MARGIN, FUN = x, ...))

    nr <- sum(diff(sapply(out, function(x) nrow(data.frame(x))))) == 0
    nc <- sum(diff(sapply(out, function(x) ncol(data.frame(x))))) == 0
    if (simplify && nc && nr) {
        if (is.vector(out[[1]])) {
            out <- do.call(rbind, out)
            rownames(out) <- funs
        } else {
            out <- do.call(cbind, out)
            colnames(out) <- c(outer(funs, colnames(X), paste, sep = "."))
        }
    } else {
       names(out) <- funs
    }

    out
}

FUN <-  function(x) x+2
japply(mtcars, 2, list(FUN, scale))
japply(mtcars, 2, list(sd, mean, sum))
japply(mtcars, 2, list(sd, mean, sum), simplify = FALSE)

 

[spunky]

for those who are familiar with this, you all know i have been BEGGING Dason for an R function that would compare the covariance matrix of some data to a hypothesized matrix i come up with. i had been able to work out small instances of this (like testing the assumption of equi-correlation). but i had not been able to come up with a more general version of it..... UNTIL NOW!

because i like Structural Equation Modelling (SEM) and SEM's all about the vcov matrix, behold! behold an example of the method!

library(MASS)
library(lavaan)

## Just some data 
Sigma <- matrix(c(1,.8,.2,.8,1,.5,.2,.5,1),3,3)
mu <- c(0,0,0)

datum <- as.data.frame(mvrnorm(100,mu,Sigma))
colnames(datum) <- c("x1", "x2", "x3")



### The Null Hypothesis is that the covariance matrix of my data follows this pattern (which is the same as Sigma so p-value should ###be >.05

mod <- '

            f1 =~ NA*x1
            f2 =~ NA*x2
            f3 =~ NA*x3
            
              f1 ~~ 0.8*f2
	      f1 ~~ 0.2*f3
	      f2 ~~ 0.5*f3

	    f1 ~~ 1*f1
            f2 ~~ 1*f2
            f3 ~~ 1*f3'

##BEHOLD THE MAGIC!!!

sem(mod, datum)

 

[Dason]

I like the one that I gave you more.

 

[bryangoodrich]

CONWAY'S GAME OF LIFE

See wiki for details: http://en.wikipedia.org/wiki/Conway's_Game_of_Life

I plan to write this looping in C++ later, but I wanted to try a pure R implementation. This also isn't correct since each tick of the game is supposed to be complete. Instead, I'm processing cell-by-cell and updating at the same time. Thus, a neighbor is not seeing the current tick of the game to set the new value but looking at it in-process. I'll have to duplicate the matrix space and fill it accordingly. Then the previous matrix will get replaced with the new tick of the game.

I also wanted to toy around with some nice features, like closures I learned from Hadley: http://adv-r.had.co.nz/Functional-programming.html

You can see how I set the Rband and Cband functions as instances of the fixer function (fixes the corners of a 1-step band around the current matrix position). I do it this way so you can actually have a non-square matrix to control the game space (e.g., make it 1-D).

I also try to use good coding practices, like giving definitions for LIVE and DEAD that define the state of the game, which are otherwise just names for 0 or 1, but it doesn't really matter (TRUE or FALSE could work, too). The point of this type of programming is to improve comprehension and can provide flexibility--such as building into a different type of simulation/game that has more steps, larger windows, different matrix space, etc.

There's a lot to play with, so have fun. Change the rules of the game so all cells die. You'll find that pools of cells will remain alive due to the birthing rule. Though, I may have messed up something with the rule[window] step (if LIVE the sum is 1 greater than the neighborhood sum that defines the rule for that point in space, so that's supposed to correct the 1-index that R uses while allowing for the rule to be a vector appropriating 0->DEAD, 1->DEAD, 2->LIVE, and so on. But looking at the pools of cells that remain alive on an all DEAD rule, it looks like they're staying alive on less than 3, but this may be because of the in-process changes I messed up.

tick <- function(x) {
    fixer <- function(n) {
        function(x) {
            b <- (x-1):(x+1)
            b <- ifelse (b == 0, n, b)
            b <- ifelse (b > n, 1, b)
            return(b)
        }
    }
    LIVE <- 1
    DEAD <- 0
    rule <- c(DEAD, DEAD, LIVE, LIVE, DEAD, DEAD, DEAD, DEAD, DEAD)

    
    ROWSIZE <- dim(x)[1]
    COLSIZE <- dim(x)[2]

    Rband <- fixer(ROWSIZE)
    Cband <- fixer(COLSIZE)

    newx <- x
    for (i in seq(ROWSIZE)) {
        for (j in seq(COLSIZE)) {
            window <- sum(x[Rband(i), Cband(j)])
            if (x[i,j] == LIVE) newx[i,j] <- rule[window]
            if (window == 3)  newx[i, j] <- LIVE
        }
    }
    return(x)
}


set.seed(666)
N <- 100
p <- 0.25
m <- sample(c(0, 1), N*N, replace=TRUE, prob=c(1-p, p))
dim(m) <- c(N, N)

for (foo in 1:500)
{
    image(m)
    m <- tick(m)
}

Added "newx" variable that is a copy of x (in tick) and swapped it for the assignment statements. I'm actually getting some pretty patterns that appear relatively stable. Interesting stuff!

 

[bryangoodrich]

Here's some Gliders for Spunky

glider <- matrix(inverse.rle(structure(list(lengths = c(1526L, 2L, 69L, 2L, 637L, 3L, 67L, 
1L, 3L, 1L, 65L, 1L, 5L, 1L, 64L, 1L, 5L, 1L, 67L, 1L, 68L, 1L, 
3L, 1L, 67L, 3L, 69L, 1L, 209L, 3L, 68L, 3L, 67L, 1L, 3L, 1L, 
136L, 2L, 3L, 2L, 705L, 2L, 69L, 2L, 1527L), values = c(0, 1, 
0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 
1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 
0)), .Names = c("lengths", "values"), class = "rle")), ncol = 78)

m <- glider
for (n in 1:500) {
    image(t(m))
    m <- tick(m)
    Sys.sleep(0.1)
}

I also found it interesting to display this using the Matrix class object. I wonder if there's any speed up possible this way. It also has a better image representation. Cool stuff, though.

Update: I made it easier to import the glider matrix and am mentioning that I'm fixing the fixer function (it should replace the RHS bleeding with 1 index, not 0).

 

[bryangoodrich]

Adding to my above creation, I give you High Life

tick <- function(x) {
    fixer <- function(n) {
        function(x) {
            b <- (x-1):(x+1)
            b <- ifelse (b == 0, n, b)
            b <- ifelse (b > n, 1, b)
            return(b)
        }
    }
    LIVE <- 1
    DEAD <- 0
    rule <- c(DEAD, DEAD, LIVE, LIVE, DEAD, DEAD, DEAD, DEAD, DEAD)

    
    ROWSIZE <- dim(x)[1]
    COLSIZE <- dim(x)[2]

    Rband <- fixer(ROWSIZE)
    Cband <- fixer(COLSIZE)
    
    newx <- x
    for (i in seq(ROWSIZE)) {
        for (j in seq(COLSIZE)) {
            window <- sum(x[Rband(i), Cband(j)])
            if (x[i,j] == LIVE) newx[i,j] <- rule[window]
            if (any(window %in%  c(3, 6)))  newx[i, j] <- LIVE
        }
    }
    return(newx)
}


set.seed(666)


N <- 100
p <- 0.03
m <- sample(c(0, 1), N*N, replace=TRUE, prob=c(1-p, p))
dim(m) <- c(N, N)

for (foo in 1:500)
{
    image(t(m), xaxt = 'n', yaxt = 'n', , col = c('blanchedalmond', 'darkgreen'))
    m <- tick(m)
}

This one is AWESOME. It starts from very little beginnings, but grows and grows and ... it's alive!!!

Where's Conway's game is defined by B3\S23, High Life is defined by B36\S23. This defines the rules, such that birthing requires a 3 or 6 and staying alive requires 2 or 3 neighbors, respectively. Since the rules are defined in this way, I might make a function (closure) that sets the rules based on these parameters, and deal with assignment in a similarly uniform way. This would also make it a lot easier to wrap this in a function call that lets the user change the game by changing a few simple things. Then I could probably do the assignment like ...

newx[i,j] <- ifelse(x[i,j] == LIVE), SA(window), B(window))

Then SA and B can be defined as closures based on passed parameters. **** closures are nice!

 

[bryangoodrich]

I get different results, but I've added closures for dealing with the rules. I'll have to look into this, but everything seems to work correctly.

tick <- function(x, birth = c(3, 6), stay = c(2, 3)) {
    # Constants
    LIVE    <- 1
    DEAD    <- 0
    ROWSIZE <- dim(x)[1]
    COLSIZE <- dim(x)[2]
    
    
    
    # Closures
    fixer <- function(n) {
        function(x) {
            b <- (x-1):(x+1)
            b <- ifelse (b == 0, n, b)
            b <- ifelse (b > n, 1, b)
            return(b)
        }
    }
    
    rule <- function(r) {
        function(x) ifelse (any(x %in% r), LIVE, DEAD)
    }
    
    Rband <- fixer(ROWSIZE)
    Cband <- fixer(COLSIZE)
    B     <- rule(birth)
    SA    <- rule(stay)
    
    
    
    newx <- x
    for (i in seq(ROWSIZE)) {
        for (j in seq(COLSIZE)) {
            window    <- sum(x[Rband(i), Cband(j)])
            newx[i,j] <- ifelse (x[i,j] == LIVE, SA(window-1), B(window))
        }
    }
    return(newx)
}


set.seed(666)
N <- 100
p <- 0.1
m <- sample(c(0, 1), N*N, replace=TRUE, prob=c(1-p, p))
dim(m) <- c(N, N)

for (foo in 1:500)
{
    image(t(m), xaxt = 'n', yaxt = 'n', , col = c('blanchedalmond', 'darkgreen'))
    m <- tick(m)
}

 

[bryangoodrich]

So I created a regex wrapper recently: http://www.talkstats.com/showthread.php/52850-R-and-reading-data-from-a-xml-html-file

The code is simple, but it separates in the formal arguments what is pattern matched, what is lookback, and what is lookahead--i.e., what is required in the match before/after the pattern, but not included in the resultant match. The snippet is

match_between <- function(x, lookback, lookahead, pattern = ".*") {
    regex <- "(?<=__LOOKBACK__)__PATTERN__(?=__LOOKAHEAD__)"
    regex <- gsub("__LOOKBACK__", lookback, regex)
    regex <- gsub("__LOOKAHEAD__", lookahead, regex)
    regex <- gsub("__PATTERN__", pattern, regex)
    regmatch <- gregexpr(regex, x, perl = TRUE)
    regmatches(x, regmatch)
}

As I'm learning about functional programming and closures lately, it occurred to me, what if somebody doesn't want the resultant values but the matches? The easiest and probably most apparent solution would be "add another parameter."

match_between <- function(x, lookback, lookahead, pattern = ".*", value = TRUE) {
    regex <- "(?<=__LOOKBACK__)__PATTERN__(?=__LOOKAHEAD__)"
    regex <- gsub("__LOOKBACK__", lookback, regex)
    regex <- gsub("__LOOKAHEAD__", lookahead, regex)
    regex <- gsub("__PATTERN__", pattern, regex)
    regmatch <- gregexpr(regex, x, perl = TRUE)
    if (!value) regmatch else regmatches(x, regmatch)
}

Now dependent upon whether you want the values returned or the matches, the function will give you that based on a parameter. However, this is the typical procedural approach. With closures, we can instead modify this function to be a "function generator" that encloses the parameter, allowing us to define the two possible functions from it.

match_between <- function(value) {
    function(x, lookback, lookahead, pattern = ".*") {
        regex <- "(?<=__LOOKBACK__)__PATTERN__(?=__LOOKAHEAD__)"
        regex <- gsub("__LOOKBACK__", lookback, regex)
        regex <- gsub("__LOOKAHEAD__", lookahead, regex)
        regex <- gsub("__PATTERN__", pattern, regex)
        regmatch <- gregexpr(regex, x, perl = TRUE)
        if (!value) regmatch else regmatches(x, regmatch)
    }
}

regex_values  <- match_between(TRUE)
regex_matches <- match_between(FALSE)

To understand what is going on, regex_values and regex_matches are both functions as defined by match_between. However, as functions they have their own environment (variable scope). Specifically, they contain the formal arguments provided by match_between--namely, "value." When we define regex_values and regex_matches, we're specifying the value of that variable, as can be seen here.

as.list(environment(regex_values))
# $value
# [1] TRUE

as.list(environment(regex_matches))
# $value
# [1] FALSE

Thus, when the function executes, it is just like the earlier version with the parameter, except that isn't something we require the end-user to specify. Instead, we simply provide them two separate functions that perform the designated action. When the function executes, it does so with "value" in its scope equal to TRUE or FALSE, appropriately.

Is this approach better? Not necessarily, but I have found it to be a lot easier to (a) prototype and expand a suite of commands I am developing, and (b) it should be a lot easier to manage what is possible by what is given.

Not that this is an appropriate style of programming, but just imagine that you have a parameter that can take on one of 20 possible values, but you only want a user to be able to use 10 of them. Thus, with this style you can create 10 separate functions giving them the functionality they require but protecting them from doing something stupid with your code.

The point, however, isn't to be tyrannical in your programming. The real power of using closures I've seen in the examples Hadley provides (http://adv-r.had.co.nz/ see functional programming sections) and that I've seen elsewhere, is that you can simplify the processing that modules are supposed to do (and you should be modular in your procedures) because you can enclose a specific environment in which that function operates, but you can also simplify a lot of that complexity to a specific type of environment that it specifies. In addition, you are able to make more specific semantics in your functions, because modules are very explicit about what they do, the name should be very clear about what it does. Add to that using function operators like lapply (see http://adv-r.had.co.nz/Function-operators.html), you can really start to control not only the environments of functionals, but manage what they do, manipulate or respond to inputs, or alter outputs to conditions, among other things.

To me, I've programmed in a procedural frame, with an eye on OOP. When I finished writing the above function in the other thread, I thought "the return object should be flexible." The first response is the most obvious: add the appropriate parameter. However, with what I've learned the past few weeks, that may not be the most ideal approach, and it is no more difficult for me to create functionals vs making one function more complex.