m2 <- function() clipCopy("3Ft8Ck") ## This file should reside in # ~/git/misc/rscripts/RickysRprofile.R # Then symlinked for each user that needs it # ln -s ~rsaporta/git/misc/rscripts/RickysRprofile.R ~rsaporta/.Rprofile # ln -s ~rsaporta/git/misc/rscripts/RickysRprofile.R ~rstudio/.Rprofile # ...etc.... ## Only output if not called from within a function if (is.null(sys.call())) cat(rep(" ", 6), "~~~~~~~~~~~~~~~ LOADING RICK'S PROFILE ~~~~~~~~~~~~~\n", sep="") ## Display warnings as they occur options(warn=1) # 0 is default (show at end); 2 is fail on warning ## Width options(width=120) ## Digits to display in 123456789.12345678901234 and 90.1234567 options(digits=6) # note, this is TOTAL digits, and increases to accomodate down to units ## To prevent CTRL+c from being hijacked by Java options (java.parameters = "-Xrs" ) ## Default Repo options("repos" = c(CRAN="http://cran.rstudio.com/", CMU="http://lib.stat.cmu.edu/R/CRAN/")) ## Only try to load package `colorout` if using terminal. The var defaults to NULL when the if clause is FALSE. colorout.load <- if ("TERM" %in% names(Sys.getenv()) && Sys.getenv('TERM') != '') { "colorout" } ## Default Packages. LIFO, for searching addlPkgs <- c("data.table", "magrittr") ## removed "sos" from default packages options(defaultPackages=unique(c(colorout.load, getOption("defaultPackages"), addlPkgs))) options(verbose2=TRUE) verbose <- getOption("verbose2") ## Avoid integer64 when possible options("datatable.integer64"="numeric") ## Load this function in case there is a an error loading the rest, this will be available if (!exists(".us")) .us <- function(..., update.lastran=FALSE) { source("~/git/misc/rscripts/utilsRS.r") if (exists("utilSource")) suppressPackageStartupMessages(utilSource(..., update.lastran=update.lastran, verbose=FALSE)) } ### ------------------------------------------------------------ ### ### .First() ### ### ------------------------------------------------------------ ### .First <- function(silent=FALSE) { ## for colorfuloutput try(suppressPackageStartupMessages ( library(colorout) ) , silent=TRUE) ## LOADING THIS PACKAGE EARLY SO THAT fresh() does not cause issues. try(suppressPackageStartupMessages ( library(sendmailR) ) , silent=TRUE) ## TODO: Consider putting these in the actual files that need them ## some needed packages for utilSource files suppressPackageStartupMessages ( library(utils) ) ## for setDefaultEmails() in EmailStatusUpdate.r suppressPackageStartupMessages ( library(stats) ) ## for .create_axis_functions() in gg_Helper_Funcs.r ## Quick access to which platform we are working on assign(".Pfm", Sys.info()[['sysname']], envir=.GlobalEnv) if (exists("srcDir")) message("srcDir exists and is set to '", srcDir, "'") # browser(text="in first() for debugging") ### ---------------------------------------------------------------------- ## If the baseDir option is set, use it. Otherwise, setit ### ---------------------------------------------------------------------- # if there is no baseDir currently set, each of these will be checked in turn for existence # and the first one to exist will be set as the baseDir baseDirTries <- c("~/git/misc/rscripts", "~rsaporta/git/misc/rscripts", "~rsaporta/git", getwd()) baseDir <- getOption("baseDir", default= { if (exists("baseDir")) baseDir else baseDirTries[ min(which(file.exists(baseDirTries))) ] }) options(baseDir=baseDir) options(utilsDir=file.path(getOption("baseDir"), "utils") ) if (!silent && exists("msgBox") && exists("pasteR")) # msgBox calls pasteR try(msgBox("baseDir (for utils) is ", baseDir, shiftLeft=13), silent=FALSE) else if (!silent) cat("baseDir (for utils) is ", baseDir, "\n") ### ---------------------------------------------------------------------- caught.utilsRS <- try(source(paste0(baseDir, "/utilsRS.r")), silent=TRUE) if (inherits(caught.utilsRS, "try-error")) warning(" utilsRS failed to load.\n") ## Load Additional utils if (exists("utilSource")) { ## take a copy of utilSource to compare and see if it changed orig.utilSource <- utilSource # caught <- try(utilSource(update.lastran=FALSE, warn.on.erros=FALSE, verbose=FALSE), silent=TRUE) caught <- utilSource(update.lastran=FALSE, warn.on.erros=TRUE, verbose=FALSE) ## if the utilSource changed, resource it if (!(body(orig.utilSource) == body(utilSource) && identical(formals(utilSource), formals(orig.utilSource)))) caught <- try(utilSource(update.lastran=FALSE, warn.on.erros=FALSE, verbose=FALSE), silent=TRUE) ## --- there is no need for this "else" portion. I am not even sure if I want to load utilSource() from .Frist ## but even if I do, there is no reason to force the issue if it is not found. ## ## rm 'else' ## If utilSource does not exist, manually load a few crucial files ## rm 'else' } else { ## rm 'else' if(!exists("as.path")) ## rm 'else' as.path = function(...) do.call(function(...) paste(..., sep="/"), list(...)) ## rm 'else' ## rm 'else' utilsToSource <- c("workspace.R", "ListTransforms.R", "memoryFunctions.R", "console_utils.R", "setScience.R") ## rm 'else' utilsFolder <- as.path(baseDir, "utils") ## rm 'else' utilsToSource <- as.path(baseDir, "utils", utilsToSource) ## rm 'else' ## rm 'else' caught <- list() ## rm 'else' for (fil in utilsToSource) ## rm 'else' caught[[as.character(fil)]] <- try(source(fil)) } ## // end if (exists("utilSource")) ## Output if(!silent) cat("\n", rep(" ", 26), " * FIRST WAS RAN\n", sep="") ## Check which failed if (! any(sapply(c(caught, caught.utilsRS), inherits, "try-error"))) { if(!silent) cat(rep(" ", 26), " * Utils were loaded on Startup\n\n", sep="") } else warning ("\n", rep(" ", 26), "* Some utils where not loaded\n") ## These aren't used for options, but are used in the ifelse statements below usingTerm <- isTRUE("TERM" %in% names(Sys.getenv())) usingRevo <- any(grepl("Revobase", getOption("defaultPackages") )) usingRStudio <- any(grepl("RSTUDIO", names(Sys.getenv()))) usingRGUI <- any(grepl("R_GUI_APP", names(Sys.getenv()))) ## Specify whether this is through an ssh connection or not options(isRemote=any(grepl("^SSH_", names(Sys.getenv()))) && "Darwin" != Sys.info()[['sysname']] ) # This is specific to Mac OSX options(Rapp = { if (!interactive()) "CronTab" else { .r.apps <- c("ITERM", "RSTUDIO", "R_GUI_APP", "TERM") .r.apps[min(which(colSums(sapply(.r.apps, grepl, names(Sys.getenv()))) > 0))] } }) if (exists(".r.apps")) try(rm(.r.apps)) options(Rvendor = { if (identical(getOption("Rapp"), "RSTUDIO")) "RStudio" else if (any(grepl("Revobase", getOption("defaultPackages") ))) "Revo" else "R" }) if (exists(".us")) try(.us(update.lastran=FALSE), silent=TRUE) if (exists("setPrompt")) setPrompt(quiet=FALSE) rm(".First", envir=.GlobalEnv) } .Last <- function() { ## ONCE CONFIRMED THIS IS WORKING PROPERLY if (exists(".First", envir=.GlobalEnv)) rm(.First, envir=.GlobalEnv) # For utils file options("utilsLoaded"=FALSE) ## Indicates that this file has been loaded } # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # ## SAVING FUNCTIONS. # Wrappers for quick exit qn <- quitn <- function() { ## quits R without saving work quit('no') } qy <- quity <- function(dir='~/', verbose=FALSE, rmFirst=TRUE) { ## quits R and saves the .RData and .Rhistory to dir ## First exectuing time stamp if (rmFirst) { e <- parent.frame() suppressWarnings(rm(.First, envir=e)) } setwd(dir) setSaveTime(verbose=verbose) if (verbose) { cat("\n") Sys.sleep(2.5) cat("\n") } quit("yes") } setSaveTime <- function(envir=.GlobalEnv, SaveObj=".time.image.last.saved", verbose=TRUE) { if (verbose) cat("\nSetting 'Time Last Saved' to:", format(Sys.time(), format="%l:%M %p"), "\n") assign(SaveObj, Sys.time(), envir=envir) } rmSaveTime <- function(envir=.GlobalEnv, SaveObj=".time.image.last.saved") { ## Returns NA if object not found. ## T if object found and removed ## F if object found and unremoved if (!exists(SaveObj, envir=envir)) return(invisible(NA)) ## ELSE rm(list=SaveObj, envir=envir) ## Object should no longer be found if (!exists(SaveObj, envir=envir)) return(invisible(TRUE)) ## ELSE error warning("Unable to remove '", SaveObj, "' from ", capture.output(envir), "\n") return(invisible(FALSE)) } getSaveTime <- function(envir=.GlobalEnv, SaveObj=".time.image.last.saved", verbose=TRUE) { if (!exists(SaveObj, envir=envir)) { warning("No there is no object called '", SaveObj, "' in ", capture.output(envir), "\n ", "Possible cause for this is that `setSaveTime()` was not called prior to save.\n") return(NULL) } ## ELSE datetime <- get(SaveObj, envir=envir) time <- format(datetime, format="%l:%M %p") date <- as.Date(datetime) ## Formatting if (verbose) { today <- Sys.Date() date.msg <- ifelse (date == today, "Today", ifelse(date==(today-1), "Yesterday", as.character(date))) cat("This image was last saved ON OR AFTER:", date.msg, "at" ,time, "\n") } return(invisible(datetime)) } save.image <- function(..., verbose=TRUE) { setSaveTime(verbose=FALSE) if (verbose) cat("Saving with time stamp of ", as.character(getSaveTime(verbose=FALSE)), "\n") ret <- base::save.image(...) rmSaveTime() return(ret) } load <- function(..., envir=.GlobalEnv, SaveObj=".time.image.last.saved", load.envir=parent.frame(pos), verbose=TRUE, pos=3, dont.use.jesus.load=FALSE) { # I was originally distinguishing between the envir in load(..) & the envir for SaveObbj (ie, all other calls with envir) # however I am not sure why I needed that distinction. # Either way, the call ti parent.frame is incorrect. So for now, they all go to teh same environment ## Check if previously existed, if so bank that value. If not, set to arb value, such as FALSE .saved.Time.Before.Loading <- { if (!exists(SaveObj, envir=envir)) FALSE else get(SaveObj, envir=envir) } ## Use loadImageOf if if (!missing(...) && length(list(...)) == 1 && grepl("(/ImageSaves/|_ImageSaves_)", list(...)[[1]])) return(loadImageOf(file=list(...)[[1]], verbose=verbose)) if (verbose) { cat("loading in to ", capture.output(envir), "\n") Sys.sleep(3) } ## If the backup to laod was explicitly given, load that. if (!missing("...")) { ret <- base::load(..., envir=envir) # Otherwise, look for .Rdata in the current dir then in the home dir. If not found, fail. } else { # check current dir if (file.exists(".RData")) { message("Loading .RData from '", getwd(), "/'") ret <- base::load(".RData", envir=envir) } else if (file.exists("~/.RData")) { message("Loading ~/.RData") ret <- base::load("~/.RData", envir=envir) } else { stop("No .RData was found. Please specify what to load.") } ## Indicate if there is a srcDir set if (exists("srcDir")) message("srcDir exists and is set to '", srcDir, "'") } ## Overwrite .Pfm variable, just in case assign(".Pfm", Sys.info()[['sysname']], envir=envir) if (exists("setPrompt")) try(setPrompt()) ## Check if exists now if (exists(SaveObj, envir=envir) && !identical(.saved.Time.Before.Loading, get(SaveObj, envir=envir))) { try(getSaveTime()) } return(invisible(ret)) } ### ------------------------------------------------------------ ### ### setPrompt() called in .First() ### ### ------------------------------------------------------------ ### ## If setPrompt() does not exist, try sourcing the file. ## If it still does not exist, create a simple one and throw a warning if (!exists("setPrompt")) try (source("~rsaporta/git/misc/rscripts/utils/setPrompt.r"), silent=TRUE) if (!exists("setPrompt")) setPrompt <- function(...) { message("setPrompt() function not yet loaded. run utilSource() then setPrompt()") } ## Installing a repo from disk. ## Specifically, R.oo new version does not work if (FALSE) { remove.packages("R.oo") Roo_pkg_location <- "https://cran.r-project.org/src/contrib/Archive/R.oo/R.oo_1.19.0.tar.gz" Roo_pkg_local_file <- "~rsaporta/R.oo_1.19.0.tar.gz" download.file(url=Roo_pkg_location, destfile=Roo_pkg_local_file) install.packages(Roo_pkg_local_file, repos=NULL) }