##
## https://mran.revolutionanalytics.com/documents/rro/reproducibility/doc-research/
##
#### utils:::assignInNamespace("q",function(save="no",status=0,runLast=TRUE) {
####                               .Internal(quit(save,status,runLast))
####                           }, "base")
#### utils:::assignInNamespace("quit",function(save="no",status=0,runLast=TRUE) {
####                               .Internal(quit(save,status,runLast))
####                           }, "base")

.vl_env <- new.env()
local({

.Last <- function() {
  if(interactive()) {
    try(utils::savehistory("~/.Rhistory"))
  }
}

.First <- function() {
  if(interactive()) {
    Sys.setenv(R_HISTSIZE=5000)
    ## Sys.setenv("_R_CHECK_LENGTH_1_CONDITION_"=TRUE) # See cond: argument in ?`if` ... no longer works 2024.12.10
    try(utils::loadhistory("~/.Rhistory"))
  }
}

qn <- function() quit('no')
cd <- function(dir="~") setwd(dir)
## print.data.frame <- data.table:::print.data.table ## data.table *is* data.frame so we use its print method which, IMO, is much more useful for printing data.frame too!!

#### ## saner printing of sf objects!
#### print.sf <- function(x, ..., n = ifelse(options("max.print")[[1]] == 99999, 20, options("max.print")[[1]])) {
####   geoms = which(vapply(x,function(col) inherits(col,"sfc"), TRUE))
####   nf = length(x) - length(geoms)
####   app = paste("and", nf, ifelse(nf == 1, "field", "fields"))
####   if (any(!is.na(st_agr(x))))
####     app = paste0(app,"\n","Attribute-geometry relationship: ", sf:::summarize_agr(x))
####   if (length(geoms) > 1)
####     app = paste0(app,"\n","Active geometry column: ", attr(x, "sf_column"))
####   print(st_geometry(x),n=0,what="Simple feature collection with",append=app)
####   if(is.data.table(x)) {
####     ## data.table:::print.data.table(x, ...)
####     NextMethod()
####   } else {
####     print.data.frame(x, ...)
####   }
####   ## print.data.frame(x, ...)
####   invisible(x)
#### }


# some handy aliases
cwd <- getwd
pwd <- getwd
h <- utils::help
## len <- length
lf <- list.files
home <- cd
hd <- utils::head
tl <- utils::tail
doff <- grDevices::dev.off

default_options <- options()

options(datatable.print.class=TRUE  ## causes problems with test.data.table()
      , datatable.print.nrows=30
      , datatable.print.topn=5
      , datatable.print.trunc.cols = TRUE
      ## , datatable.verbose=TRUE
      , defaultPackages=c(options()$defaultPackages, "tools")
      ## , digits=18 ## to catch issues with floating point rounding. Try log(1000)/log(10) with different values of digits to see how it gets printed.
      , digits.secs=2
      , editor="vim"
      ## , error=utils::recover
      , expressions=2000
      , help_type = "html"
      , help.try.all.packages=TRUE
      , locatorBell=FALSE
      ## , lubridate.fasttime=TRUE
      , max.print=500
      , mc.cores = parallel::detectCores()
      , Ncpus = parallel::detectCores() - 2
      # , prompt="R=> "  # Causes problems with ESS
      ## , repos=structure(c(CRAN="https://cloud.r-project.org/",
      ##                     INLA="https://inla.r-inla-download.org/R/stable"))
      , timeout = max(300, getOption("timeout")) ## INLA download timesout with default value! See ?download.file of why we need higher value here...
      , useFancyQuotes=FALSE # causes problems with LaTeX
      ## , warnPartialMatchArgs=TRUE  ## Causes lots of warnings!
      , warnPartialMatchAttr=TRUE     ## Comment if weird "repeatwithsimplewarning" error messages start popping up.
      , warnPartialMatchDollar=TRUE     ## Comment if weird "repeatwithsimplewarning" error messages start popping up.
      , xtable.booktabs=TRUE
      # , xtable.type="html"
      )

## http://andrewgelman.com/2010/10/29/could_someone_p/
## ?setHook and ?plot.new
### setHook('plot.new',function(...) graphics::par(mar=c(3,3,2,1),mgp=c(2,0.7,0),tck=-0.01))
### Above causes problems with raster::plot!

setHook(packageEvent("sp","onLoad"),
    function(...) {
      fn <- function(object) str(object,max.level=2)
      spclasses <- c("SpatialPoints", "SpatialPointsDataFrame",
                     "SpatialMultiPoints", "SpatialMultiPointsDataFrame",
                     "SpatialGrid", "SpatialGridDataFrame",
                     "SpatialLines", "SpatialLinesDataFrame",
                     "SpatialPolygons", "SpatialPolygonsDataFrame")
      for(spclass in spclasses) setMethod("show",spclass,fn)
    })
setHook(packageEvent("tuneR", "onLoad"), function(...) options(WavPlayer="/Users/vijay/code/R/playRWave"))

functions_to_learn_this_session <- local({
  last_seen <- NA ; fns_to_learn <- c()
  function() {
    if(is.na(last_seen) | Sys.Date() > last_seen) {
      fns_to_learn <<- sample(c(lsf.str("package:base"), lsf.str("package:utils"),
                                lsf.str("package:stats"), lsf.str("package:MASS")), 5)
    }
    last_seen <<- Sys.Date()
    cat("R-Trivia: Do you know the following?\n")
    invisible(cat(paste(seq_along(fns_to_learn), fns_to_learn, sep=". "), sep="\n"))
  }
})


}, env=.vl_env)
if( .Platform$OS.type == "unix" & !Sys.getenv("USER") == "root") {
  if (file.exists("~/code/R/utils.R")) {
    local(source("~/code/R/utils.R", local=.vl_env), envir=.vl_env)
  }
}
attach(.vl_env)
Sys.setenv(MAKEFLAGS = "-j4")

if (interactive()) {
    ## if (ispkginstalled("fortunes")) print(fortunes::fortune())  ## Slows down R!
    suppressPackageStartupMessages(require(compiler))
    suppressPackageStartupMessages(require(fastmatch))
    match <- fmatch ## faster matching!
    ## suppressPackageStartupMessages(require(fasttime))
    suppressPackageStartupMessages(compilePKGS(TRUE))  ## ?compiler::compile
    setCompilerOptions(suppressUndefined=TRUE)  ## ?compiler::compile
    suppressPackageStartupMessages(require(MASS))
    suppressPackageStartupMessages(require(Matrix))
    suppressPackageStartupMessages(require(parallel))
    suppressPackageStartupMessages(require(bit64))
    suppressPackageStartupMessages(require(RSQLite))
    suppressPackageStartupMessages(require(data.table))
    suppressPackageStartupMessages(require(ggplot2)); ## theme_set(theme_vl())
    suppressPackageStartupMessages(require(utils))
    suppressPackageStartupMessages(require(sf))
    ## suppressPackageStartupMessages(require(knitr))
    ## suppressPackageStartupMessage(require(ff))
    ## invisible(enableJIT(3))  ## ?compiler::compile ## causes problems!  2015.11.14
    functions_to_learn_this_session()
    if(isTRUE(any(grepl("^(linux|darwin)",R.version$os,ignore.case=TRUE)))) options(width=system("tput cols",intern=TRUE))
}

## if(ispkginstalled("rstan")) rstan::rstan_options(auto_write=TRUE)

# http://reasoniamhere.com/2013/09/23/7-r-tips-rescued-from-the-vault/
makeActiveBinding(".", function() .Last.value, .GlobalEnv) # ?makeActiveBinding
## Sys.setenv(TZ="America/New_York") ## Weird warnings on mac!! 2017.11.14

## All packages needed in scripts have to be explicitly stated!!