R/development/advanced_toolkit.R

In bfatemi/ninjar: Data Science Utility Belt

##
## DURATION UTILS
##
durSecHour <- function(){
  x <- Sys.time()
  lubridate::minute(x)*60 + lubridate::second(x)
}

durSecDay <- function(){
  x <- Sys.time()
  lubridate::second(x) +
    lubridate::minute(x) * 60 +
    lubridate::hour(x)   * 60 * 60
}

days_in_qtr <- function(x){
  qtr <- quarter(x)
  tsx <- lubridate::now("UTC") - days(1)
  ts0 <- make_datetime(year(tsx), sec = .001, tz = "UTC")
  yday_q_strt <- which(lubridate::qday( ts0 + days(0:364) ) == 1)
  yday_q_stop <- c(yday_q_strt[-1], 365)
  (yday_q_stop - yday_q_strt)[qtr]
}

monthIndex <- function(yr = 2019, eom = FALSE){
  rbindlist(lapply(mnn, function(m){
    i <- make_date(yr, m, 1)
    data.table(
      lab = month.name[m],
      date = i,
      ddec = decimal_date(i),
      mdays = days_in_month(i),
      mqtr = quarter(i),
      mwk = week(i),
      msem = semester(i)
    )
  }))
}

mnn <- setNames(1:12, month.abb)

tsx <- Sys.time() #lubridate::now("UTC")
ts0 <- make_datetime(year(tsx), sec = .001, tz = "UTC")
tsN <- ts0 + years(1) - milliseconds(2)

dects <- lubridate::decimal_date(tsx)

tom <- tsx + days(1)
hour(tom) <- 0
minute(tom) <- 0
second(tom) <- .01
ts.eod <- tom - seconds(1)
as.numeric(difftime(tom, tsx, units = "hours"))


durSecHour() / (60*60)         #  hr % complete
durSecDay() / (24*60*60)       # day % complete
wday(tsx) / 7                  #  wk % complete
mday(tsx) / days_in_month(tsx) # mon % complete
qday(tsx) / days_in_qtr(tsx)   # qtr % complete
yday(tsx) / 365                #  yr % complete


##
## indexMaker (artkit)
##

##
## segment
##

vec <- 1:10

push.tail <- sapply(vec, seq2, from=vec[1])
push.head <- sapply(vec, seq, to=vec[1])
pop.head  <- sapply(vec, function(i, x) seq2_along(i, x), x = vec)
pop.tail  <- sapply(vec, function(i, x) rev(seq2_along(i, x)), x = vec)

push.tail
push.head
pop.head
pop.tail

rev(sapply(vec, seq2_along, x = vec))
sapply(rev(vec), seq2_along, x = vec)
sapply(rev(vec), function(i, x) rev(seq2_along(i, x)), x = vec)

sequence(vec)
sapply(vec, sequence)

plot(x = sequence(1:10), seq_along(sequence(1:10)))



##
## EXPERIMENTAL CLASS - GRAPH STRUCTURE
##

library(ocpuApp)
library(opencpu)
library(ocputils)
library(hpdsDB)
library(rstudioapi)
library(pryr)
library(rlang)



graph <- R6::R6Class(
  classname = "ddgraphr",
  public = list(
    "initialize" = function(pkgs = NULL, dir = NULL){
      private$packages <- pkgs
      private$graphDir <- dir
      private$TID <- private$termR(pkgs, dir)
      invisible(self)
    },
    "&=>" = function(...){
      nid <- private$termR(private$packages, private$graphDir)
      self$nodesId <- c(self$nodesId, nid)
      expr <- substitute(...)
      cmds <- stringr::str_replace_all(rlang::expr_text(expr), "^\\{|\\}$", "\n")
      rstudioapi::terminalClear(nid)
      rstudioapi::terminalSend(nid, cmds)
      return(self)
    },
    destroy = function(){
      lapply(c(private$TID, self$nodesId), terminalKill)
    },
    graphId = function() private$TID,
    nodesId = list()

  ),
  private = list(
    "termR" = function(pkgs=NULL, dir = NULL){
      termId <- rstudioapi::terminalExecute(
        workingDir = dir,
        command = 'R',
        show = FALSE
      )
      if(!is.null(pkgs)){
        sapply(pkgs, function(pkg){
          terminalSend(termId, paste0(rlang::expr_text(call("library", pkg)), "\n"))
          buf <- terminalBuffer(termId, stripAnsi = TRUE)
          detectErr <- stringr::str_detect(buf, "^Error")
          if(any(detectErr))
            stop(buf[which(detectErr)], call. = T)
          invisible(TRUE)
        })
      }
      return(termId)
    },
    "%link%" = function(...){
      expr <- substitute(...)
      cmds <- stringr::str_replace_all(rlang::expr_text(expr), "^\\{|\\}$", "\n")
      rstudioapi::terminalClear(private$TID)
      Sys.sleep(.5)
      rstudioapi::terminalSend(private$TID, cmds)
      Sys.sleep(.5)
      invisible(self)
    },
    "TID" = NULL,
    "packages" = NULL,
    "graphDir" = NULL
  )
)

data <- graph$new()
data$graphId()
data$nodesId

data$`>>>`()()()

data$destroy()

B <- graph$new(arg=2)
C <- graph$new(arg=3)

A$getID()
B$getID()
C$getID()