Nothing
#' A R6 Class to represent a timer.
#'
#' timer is a R6 Class that represent a timer.
#'
#' @docType class
#' @field time A POSIXct/POSIXlt value of your latest timing.
#' @field event A string of your latest timing.
#' @field eventTable A data frame that stores all timings.
#' @field verbose A printing setting that controls whether to print messages.
#' @section Public Methods:
#' \describe{
#' \item{\code{initialize(time,event,verbose,eventTable)}
#' }{Initialize a timer object. You can also use \code{createTimer()}
#' function to initialize a timer object.}
#' \item{\code{start(eventName)}
#' }{Start timing for a event, \code{eventName} should be a string}
#' \item{\code{stop(eventName)}
#' }{Stop timing for a event.}
#' \item{\code{getTimer()}
#' }{Get a data frame that stores all recordings.You can also use
#' \code{getTimer()} function to get the data frame.}
#' \item{\code{removeEvent(eventName)}
#' }{Remove an given row in the eventTable.}
#' \item{\code{toggleVerbose()}
#' }{Toggle between \code{TRUE} and \code{FALSE} for \code{verbose}}
#' \item{\code{getStartTime()}
#' }{Get start time for a selected event.}
#' \item{\code{getStopTime()}
#' }{Get stop time for a selected event.}
#' \item{\code{getTimeElapsed()}
#' }{Get time elapsed for a selected event.}
#' \item{\code{getComment()}
#' }{Get comment for a selected event.}
#' \item{\code{getEventf()}
#' }{Get entire row for a selected event.}
#' \item{\code{print()}
#' }{Custom print method for timer class. However, you don't need to use this
#' function to generate custom printing.
#' Custom printing is triggered by default.}
#' }
#' @section Private Methods:
#' \describe{
#' \item{\code{slprint(msg,flag = self$verbose)}
#' }{A function that controls whether to print extra message.}
#' }
#' @examples
#' timer <- createTimer(precision = "ms")
#' timer$start("event1")
#' # put some codes in between
#' timer$stop("event1")
#'
#' timer$start("event2")
#' # put some codes in between
#' timer$stop("event2",comment = "event 2 completed")
#'
#' table1 <- getTimer(timer)
#' timer$toggleVerbose() # set verbose to FALSE as default is TRUE
#'
#' table1 # print all records in a tibble(data frame)
#'
#' # get attributes for selected events
#' timer$getStartTime("event1")
#' timer$getStopTime("event1")
#' timer$getTimeElapsed("event1")
#' timer$getComment("event1")
#' timer$getEvent("event1")
#' @importFrom R6 R6Class
#' @export
timeR <- R6::R6Class(
classname = "timeR",
public = list(
#values
eventTable = data.frame(
event = character(),
start = character(),
end = character(),
timeElapsed = numeric(),
stringsAsFactors = FALSE,
comment = character()),
verbose = logical(),
precision = character(),
#initialize timeR
initialize = function(verbose=TRUE,precision="s"){
stopifnot(is.logical(verbose),!is.na(verbose))
stopifnot(precision %in% c("s","ms","us"))
self$verbose = verbose
self$precision = precision
},
#start a timeR for event
start = function(eventName){
if(!exists("eventName")){
stop("Please create a name for the event.")
}
theTable <- self$eventTable
verbose <- self$verbose
current_time = private$get_current_time(self$precision)
#create that record/row
newRow <- data.frame(event = eventName,
start = current_time,
end = character(1),
timeElapsed = numeric(1),
stringsAsFactors = FALSE,
comment = NA_character_)
#detect ifevent already exist
if (any(theTable$event %in% eventName) ){
out_msg <- paste0("Event: '",
eventName,
"' already exists.",
" Overwriting previous 'start'.\n")
private$slprint(out_msg)
#replace the row in dataframe with new row
boolTargetRow <- theTable$event == eventName
self$eventTable[boolTargetRow, ] <- newRow
} else {
#append new row
self$eventTable <- rbind(theTable,newRow)
}
invisible(self)
},
#stop timeR
stop = function(eventName,comment=NA_character_){
theTable <- self$eventTable
verbose <- self$verbose
current_time = private$get_current_time(self$precision)
#detect if event already exists
if (any(theTable$event %in% eventName)){
#detect if end time for event already exist
end_exist <- !is.na(as.character(
theTable[theTable$event ==eventName,][["end"]]))
if (end_exist){
out_msg <- paste0("Event: '",eventName,
"' already has a record.",
" Overwriting previous one.\n")
private$slprint(out_msg)
}
#modify the end anyway
isEventRow <- theTable$event == eventName
startTime <- self$eventTable[isEventRow, ][["start"]]
timeElapsed <- difftime(
lubridate::ymd_hms(current_time,tz = Sys.timezone()),
lubridate::ymd_hms(startTime,tz = Sys.timezone()),
units = "secs"
)
self$eventTable[isEventRow, ][["end"]] <- current_time
self$eventTable[isEventRow, ][["timeElapsed"]] <- timeElapsed
self$eventTable[isEventRow, ][["comment"]] <- comment
} else {
stop("Event: '",eventName,"'",
" doesn't exist. Record won't be created.\n")
}
out_msg <- paste0("For event: '",eventName,
"', ",round(timeElapsed,2),
" seconds elapsed.\n")
private$slprint(out_msg)
invisible(self)
},
getTimer = function(...){
return(self$eventTable)
},
removeEvent = function(eventName){
theTable <- self$eventTable
boolRow <- !(theTable$event == eventName)
if(all(boolRow)) {
out_msg <- paste0("Event '",eventName,
"' doesn't exist. No record is deleted.\n")
private$slprint(out_msg)
} else {
self$eventTable <- theTable[boolRow,]
}
invisible(self)
},
toggleVerbose = function(...){
self$verbose = !self$verbose
out_msg <- paste0("Verbose set to: ",as.character(self$verbose),
".\n")
writeLines(out_msg)
invisible(self)
},
getStartTime = function(eventName){
rowIndex <- which(eventName == self$eventTable$event)
if (length(rowIndex) == 0) {
stop("event doesn't exist.")
}
result <- self$eventTable[rowIndex,"start"]
return(result)
},
getStopTime = function(eventName){
rowIndex <- which(eventName == self$eventTable$event)
if (length(rowIndex) == 0) {
stop("event doesn't exist.")
}
result <- self$eventTable[rowIndex,"stop"]
return(result)
},
getTimeElapsed = function(eventName){
rowIndex <- which(eventName == self$eventTable$event)
if (length(rowIndex) == 0) {
stop("event doesn't exist.")
}
result <- self$eventTable[rowIndex,"timeElapsed"]
return(result)
},
getComment = function(eventName){
rowIndex <- which(eventName == self$eventTable$event)
if (length(rowIndex) == 0) {
stop("event doesn't exist.")
}
result <- self$eventTable[rowIndex,"comment"]
return(result)
},
getEvent = function(eventName){
rowIndex <- which(eventName == self$eventTable$event)
if (length(rowIndex) == 0) {
stop("event doesn't exist.")
}
result <- self$eventTable[rowIndex,]
return(result)
},
print = function(...){
writeLines("Your Table is:")
print(self$eventTable)
}
),
#function used to determine whether message is printed
private = list(
slprint = function(msg,flag = self$verbose){
if(flag) writeLines(msg)
},
get_current_time = function(precision){
if(self$precision == "s"){
current_time <- as.character(lubridate::now())
} else if (self$precision == "ms") {
current_time <- as.character(
lubridate::now(),
format = "%Y-%m%-%d %H:%M:%OS3"
)
} else if (self$precision == "us") {
current_time <- as.character(
lubridate::now(),
format = "%Y-%m%-%d %H:%M:%OS6"
)
}
return(current_time)
}
),
active = list(now = function(){
as.POSIXct(Sys.time(), format = "%Y-%m-%d %H:%M")
})
)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.