# parent counter object
counter <- R6::R6Class("counter",
private = list(
..start = NULL,
..end = NULL,
..count = NULL,
..increment = NULL,
..pad = NULL,
..status = "ON"
),
public = list(
counter = function() {
if (private$..increment == "add") {
private$..count <- private$..count + 1
} else if (private$..increment == "subtract") {
private$..count <- private$..count - 1
}
if (private$..count == private$..end) {
private$..status <- "OFF"
}
},
display = function() {
stringr::str_c(stringr::str_pad(private$..count, private$..pad, pad = "0"))
},
finalize = function() {
}
),
active = list(
status = function() {
private$..status
}
)
)
# child add counter object
counter_add <- R6::R6Class("counter_add",
inherit = counter,
public = list(
initialize = function(limit) {
private$..end <- limit
private$..start <- 0L
if (nchar(as.character(limit)) < 4) {
private$..pad <- 4
} else {
private$..pad <- nchar(as.character(limit))
}
private$..count <- private$..start
private$..increment <- "add"
message(paste0(self$display(), " tally counter"))
}
)
)
# child subtract counter object
counter_subtract <- R6::R6Class("counter_add",
inherit = counter,
public = list(
initialize = function(limit) {
private$..end <- 0L
private$..start <- limit
if (nchar(as.character(limit)) < 4) {
private$..pad <- 4
} else {
private$..pad <- nchar(as.character(limit))
}
private$..count <- private$..start
private$..increment <- "subtract"
message(paste0(self$display(), " tally counter"))
}
)
)
#' tally_counter
#'
#' This function initiates a new tally counter with the count limit set to the number of rows in the data frame
#' used to interate over. The counter can either increase from zero to the number of rows set or
#' decrease from the number of rows to zero based on the type argument.
#'
#' @param data a data frame to be used in the iteration
#' @param ... character string argument named type indicating type of counter to use, either adding or subtracting counts
#'
#' @return the data frame is returned so that the function is pipe friendly
#' @export
#'
#' @examples
#'
#' # Use default decreasing count setting
#' iris_three<- iris[1:3, ]
#' tally_counter(iris_three)
#'
#' # Set increasing count setting
#' iris_three <- iris[1:3, ]
#' tally_counter(iris_three, type = "add")
#'
tally_counter <- function(data, ...) {
# get function arguements
arg_list <- list(...)
if (any(class(data) == "data.frame")) {
max_limit <- nrow(data)
} else {
max_limit <- length(data)
}
# create counter object in new counter_env environment
assign("counter_env", new.env(parent = emptyenv()), envir = globalenv())
if (!length(arg_list)) {
assign("counter_obj", counter_subtract$new(limit = max_limit), envir = counter_env, inherits = FALSE)
} else if (arg_list$type == "add") {
assign("counter_obj", counter_add$new(limit = max_limit), envir = counter_env, inherits = FALSE)
} else if (arg_list$type == "subtract") {
assign("counter_obj", counter_subtract$new(limit = max_limit), envir = counter_env, inherits = FALSE)
} else {
stop("Incorrect tally counter type, type must be either add or subtract")
}
# return data frame allowing use in piping
invisible(data)
}
#' click
#'
#' This function adds or subtracts one from the counter depending on the tally counter type used, defined within the
#' tally_counter function. It returns the number padded to a minimum of four characters. Once counter has finished
#' the environment and counter object are removed.
#'
#' @export
#'
#' @examples
#' # Use default decreasing count setting
#' iris_three <- iris[1:5, ]
#' tally_counter(iris_three)
#' sepal_length <- function(x) {
#' message(paste0(click(), ": The sepal length is ", as.numeric(x[, "Sepal.Length"])), " cm")
#' Sys.sleep(0.25)
#' }
#' sepal_length(iris_three[1, ])
#' sepal_length(iris_three[2, ])
#' sepal_length(iris_three[3, ])
click <- function() {
# get counter object
counter_obj <- get("counter_obj", envir = counter_env)
# increment counter object and check current counter status
counter_obj$counter()
# display current counter count
count <- counter_obj$display()
# remove counter object and enviromnent if counter finished
if (counter_obj$status == "OFF") {
rm(counter_obj, envir = counter_env)
rm(counter_env, envir = globalenv())
gc()
}
return(count)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.