# ------------------------------------------------------------------------------------------------------------------------- # # ----------------------------------------------------------------------------------------------------------------------- # # # # File Name : setScience.R # # Last Updated Funclist : 19 Feb 2015, 12:52 PM (Thursday) # # # # Author Name : Rick Saporta # # Author Email : RickSaporta@gmail.com # # Author URL : www.github.com/rsaporta # # # # Packages Called : data.table # # Packages Used via NS : NA # # # # ----------------------------------------------------------------------------------------------------------------------- # # # # scienceProjectToDesktop ( projName=getProjName(), to.parent="~/desktop" ) # # openSublimeWorkspace ( projName, dir="~/git/!Projects", ext="\\.sublime-workspace", verbose=FALSE ) # # getGoScienceASCII ( ) # # getsubProj ( pos=1, MainToBlank=TRUE, envir=parent.frame(pos) ) # # getSubProj ( pos=1, MainToBlank=TRUE, envir=parent.frame(pos) ) # # setProjName ( projName, envir=globalenv() ) # # setSubProj ( subProj, envir=globalenv() ) # # getProjName ( appendImgSave=FALSE, fresh=FALSE, pos=2, subProj.instead=FALSE, envir=parent.frame(pos) ) # # setScienceIfNot ( projName, loadImage=FALSE, subProj=NULL, envir.load=globalenv(), pos=1, verbose=TRUE ) # # setScience ( wrkDir, pos=1, mkdir=TRUE, projName=NULL, subProj=NULL, loadImage=!is.null(subProj) # # , create.if.not.exist=FALSE, subl=TRUE, ingestIn_gitData=FALSE, testDirs=TRUE # # , dontSourceSupportFns=FALSE, quiet=FALSE, envir.load=globalenv() ) # # setProject ( wrkDir, pos=1, mkdir=TRUE, projName=NULL, subProj=NULL, loadImage=!is.null(subProj) # # , create.if.not.exist=FALSE, try.up.one.dir=TRUE, subl=TRUE, testDirs=TRUE # # , dontSourceSupportFns=FALSE, ingestIn_gitData=TRUE, quiet=FALSE # # , envir.load=globalenv() ) # # checkS ( sel ) # # outputProjectistAsOptions ( projectslist, max.cols=5, showOutput=TRUE, useMax=FALSE ) # # getProjectsFromFolders ( folder, recursive=FALSE ) # # clearDos ( pos=1, envir=parent.frame(pos) ) # # dosDir ( wrkDir, gitData=FALSE, mkdir=FALSE, pos=1, ingestIn_gitData=TRUE, supportFns=TRUE # # , projName="", forceSubProject=FALSE, showWarnings=TRUE, silent=!showWarnings # # , testDirs={Sys.info()[["sysname"]] == "Linux"}, envir.load=parent.frame(pos) ) # # # # # # # # ----------------------------------------------------------------------------------------------------------------------- # # ------------------------------------------------------------------------------------------------------------------------- # ## TODO: For CREATE NEW give the option for eg "Orch/Intro" ie create subdir #%% TODO: Merge this file with workspace.R and clean both up with proper use cases %%# # -------------------------------------------------------------------------------------------- # # # # These functions are a compliment to the "workspace.R" functions, # # but could be justified in their own file (for now) # # # # -------------------------------------------------------------------------------------------- # # -------------------------------------------------------------------------------------------------------- # options(dos.grp=list("data", "out", "src", "sublws", "ingest", "ImageSaves", "notes", "plots", "log")) # -------------------------------------------------------------------------------------------------------- # scienceProjectToDesktop <- function(projName=getProjName(), to.parent="~/desktop") { if (!exists(".Pfm") || .Pfm != "Darwin" ) stop ("It looks like you're not on your Mac") grp <- getOption("dos.grp", default=list("data", "out", "src", "sublws", "ingest", "ImageSaves", "notes", "plots", "log")) grpDir <- paste0(grp, "Dir") folders <- sapply(grpDir, function(x) if (exists(x)) get(x) else NA) folders <- folders[!is.na(folders)] folders <- folders[sapply(folders, file.exists)] if (!length(folders)) stop("No folders exist for '", projName, "'") if (!file.exists(to.parent)) stop("'", to.parent, "' does not exist") parentFolder <- as.path(to.parent, projName) dir.create(parentFolder, showWarnings=FALSE) folders.to <- as.path(parentFolder, grpDir) # gsub(dirname(folders[[1]]), to.parent, folders) for (i in seq(folders)) { if (!file.exists(folders.to[[i]])) system( paste("ln -s", folders[[i]], folders.to[[i]]) ) } return(parentFolder) } # -------------------------------------------------------------------------------------------------------- # rmScienceProject <- function(projName, are_you_sure, base_folder="~/git/orch") { ## This does not actually remove the folders. Just outputs the commands to run pat.fold <- "^_?[A-Za-z0-9\\.]" get_subfolders <- . %>% dir(recursive=FALSE, include.dirs=TRUE, full=TRUE, pattern=pat.fold) get_files <- . %>% dir(recursive=FALSE, include.dirs=FALSE, full=TRUE) %>% {.[!isdir(., showWarnings=FALSE)]} get_NumberOfFilesTwoDeep <- function(f) {get_subfolders(f) %>% c(f) %>% get_files %>% length} folders <- base_folder %>% get_subfolders %>% as.path(projName) %>% sapply(file.exists) %>% nwhich if (!length(folders)) { sprintf("No folders matching '%s' found in the subfolders of '%s'", projName, base_folder) %>% message } else { f <- folders[[2]] file_counts <- sapply(folders, get_NumberOfFilesTwoDeep) names(file_counts) %<>% {gsub(paste0(path.expand(base_folder), "/?"), "./", .)} catf <- . %>% cat(paste0(pasteR(" ", n=20), pasteR("-", n=35)), sep="\n") sprintf("%50s [%s files]", names(file_counts), file_counts%>%formnumb) %>% c("Note how many files per folder\n", .) %>% catf cmd <- folders %>% shellClean %>% sprintf("rm -rf %s", .) %>% c("\nRun these in terminal:\n",., "") %>% catf } return(invisible(folders)) } # -------------------------------------------------------------------------------------------------------- # setScienceIfNot <- function(projName, loadImage=FALSE, subProj=NULL, envir.load=globalenv(), pos=1, verbose="auto") { needsSetting <- !identical(getProjName(envir=envir.load), projName) || !exists("srcDir") ## allow for other values of verbose besides TRUE/FALSE if (verbose == "auto") verbose <- needsSetting if (!is.logical(verbose) || is.na(verbose)) verbose <- TRUE if (verbose) cat("Project ", ifelse(needsSetting, " will be set to ", " does not need setting; it is already "), "'", projName, "'\n", sep="") ## RETURN setScience() if the change is needed if (needsSetting) return(setScience(projName=projName, loadImage=loadImage, subProj=subProj, envir.load=envir.load, subl=FALSE, create=FALSE, pos=2)) ## reload the support functions sourceSupportFns(showWarnings=FALSE) ## OTHERWISE, check the subProj, and set if needed if (!identical(getSubProj(warnOnBlanks=FALSE, envir=envir.load), subProj)) setSubProj(subProj) ## If no other changes are needed, reset the prompt else setPrompt(quiet=TRUE) return(invisible(NULL)) } setScience <- function(wrkDir, pos=1, mkdir=TRUE, projName=NULL, subProj=NULL, loadImage=FALSE, create.if.not.exist=FALSE, subl=create.if.not.exist, ingestIn_gitData=FALSE, testDirs=TRUE, dontSourceSupportFns=FALSE, quiet=FALSE, envir.load=globalenv()) { ## Wrapper for setProject, where wrkDir is set to correct location for NBS, based on platform. "NOTE ON 'pos': pos is still needed, specifically for wrkDir A lot of this was written before I really started using projects. Consider if I still need wrkDir, and if so why? If not, get rid of it. " # If there is an unnamed argument, we will allow it to be wrkDir or projName (assuming that neigther is explicitly given) missing.wrkDir <- missing(wrkDir) missing.projName <- missing(projName) # If wrkDir is given, but not projName, we will check if wrkDir is a valid directory. # If not, we will assume the user intent to be that value as a project name, and wrk directory as default if ( (missing.projName && !missing.wrkDir) && !file.exists(wrkDir) ) { projName <- wrkDir missing.wrkDir <- TRUE # message("Using '", projName, "' as projName.\n") } if (missing.wrkDir) wrkDir <- assign("wrkDir", "~/git/orch", envir=parent.frame(pos)) if (missing(subl) && !missing(projName)) { ## Set subl to TRUE if we are switching projects subl <- !exists("srcDir") || !grepl(projName, srcDir) } setProject(wrkDir=wrkDir, pos=pos+1, mkdir=mkdir, projName=projName, subProj=subProj, loadImage=loadImage, create.if.not.exist=create.if.not.exist, subl=subl, ingestIn_gitData=ingestIn_gitData, testDirs=testDirs, dontSourceSupportFns=dontSourceSupportFns, quiet=quiet, envir.load=envir.load) } # -------------------------------------------------------------------------------------------------------- # ## TODO: ## Set an option for defaultWrkDir = "~/git" that other users can change setProject <- function(wrkDir, pos=1, mkdir=TRUE, projName=NULL, subProj=NULL, loadImage=!is.null(subProj), create.if.not.exist=FALSE, try.up.one.dir=TRUE, subl=create.if.not.exist, testDirs=TRUE, dontSourceSupportFns=FALSE, ingestIn_gitData=TRUE, quiet=FALSE, envir.load=globalenv()) { # try.up.one.dir : if TRUE and projName is explicit, but not found, it checks up on e level. # # Note to self, setup is as follows: # * wrkDir is my "root". ie ~/git/nbs/ | ~/NBS-R/Ricks/ # Within wrkDir I have: src, out, data # Within each of those, I have folders for each Project. # thus: # wrkDir/src/projName # wrkDir/out/projName # wrkDir/data/projName require(data.table) # Clear screen, slightly. if (quiet) ## verbose is not yet used in this function verbose <- FALSE else cls(8) # initialize. This is the number of attempts to find or create the project maxTries <- 3 # If there is an unnamed argument, we will allow it to be wrkDir or projName (assuming that neigther is explicitly given) missing.wrkDir <- missing(wrkDir) missing.projName <- missing(projName) # If wrkDir is given, but not projName, we will check if wrkDir is a valid directory. # If not, we will assume the user intent to be that value as a project name, and wrk directory as default if ( (missing.projName && !missing.wrkDir) && !file.exists(wrkDir) ) { projName <- wrkDir missing.wrkDir <- TRUE message("Using '", projName, "' as projName.\n") } if (missing.wrkDir) ## OLD: ## wrkDir <- "~/git" ## New as of 2015-04-15 wrkDir <- "~/development" if (missing(subl) && !missing(projName)) { ## Set subl to TRUE if we are switching projects subl <- !exists("srcDir") || !grepl(projName, srcDir) } ## if .Pfm object DNE, create it. if (!exists(".Pfm")) assign(".Pfm", Sys.info()[['sysname']], envir=globalenv()) # THIS FUNCTION SERVES TO ALLOW FOR INPUT ENDING IN "S", INDICATING TO GO INTO SUBFOLDERS # ------------------------------------------------------------------------------------- # SUBFOLDER <- FALSE; en.working<-environment() checkS <- function(sel) { if (!grepl("S$", sel, ignore.case=TRUE)) return(sel) #else assign("SUBFOLDER", TRUE, envir=en.working) return(as.numeric(substr(sel, 1, nchar(sel)-1))) } # ------------------------------------------------------------------------------------- # # GET LISTS OF PROJECT NAMES, ie LIST OF FOLDER NAMES AND CREATE projectslist assign("Projects", getProjectsFromFolders(wrkDir), envir=envir.load) projectslist <- data.table(OPT=seq_along(Projects[[1]]), as.data.table(Projects), key="OPT") # ------------------------------------------------------- # # If projName is explicit, no selection needed # # ------------------------------------------------------- # # if (a non-NULL value) projName has been given as an argument if (! missing(projName) && !is.null(projName)) { if (! projName %in% projectslist$PROJECTS) { if (create.if.not.exist) { cat("\n\nNew Project '", projName, "' will be created in folder: \n\n ", wrkDir, "\n\n", sep="") ## Calling dosDir() here for the use of wrkDir. Note that we call it again later for parts outside of this specific if clause dosDir(wrkDir, pos=pos+1, gitData=(.Pfm=="Darwin"), ingestIn_gitData=ingestIn_gitData, mkdir=mkdir, showWarnings=FALSE, projName=projName, testDirs=testDirs, envir.load=envir.load) # TODO: confirm that the path here is correct for both sub-style and non-sub-style projects projectslist <- rbind(data.table(OPT=9999L, PROJECTS=as.character(projName), FOLDERS=as.path(wrkDir, "src")), projectslist) } else { if (try.up.one.dir) return(setProject(wrkDir=as.path(wrkDir, ".."), try.up.one.dir=FALSE, pos=pos+1, mkdir=mkdir, projName=projName, loadImage=loadImage, create.if.not.exist=create.if.not.exist, envir.load=envir.load)) stop ("projName '", projName, "' not found. Rerun & set `create.if.not.exist=TRUE` to create it.") } } selection <- projectslist[PROJECTS==projName, OPT] tries <- 1 ## Else, proceed with the user-selection } else { # ------------------------------------------------------- # # SELECTION # # ------------------------------------------------------- # # check if projName exists. Output an introduction sentance if (exists("projName") && !is.null(projName)) { projectslist <- rbind(c(0, projName, wrkDir), projectslist) cat("\nCurrent projName is\n\n\t", projName, "\n\nOther projName folders available in\n wrkDir = ",wrkDir, ": \n\t") } else { cat("\nNo projName currently set. Projects available are: \n") } ## add option to create a new projName # --------------------------------------------------------- # ## TEMP UNTIL rbind BUG IS FIXED # --------------------------------------------------------- # projectslist <- as.data.table(projectslist) if(all(substr(names(projectslist), 1, 1) == "X")) setnames(projectslist, c("OPT", "PROJECTS", "FOLDERS")) projectslist <- projectslist[, lapply(.SD, as.character)] projectslist[, OPT := as.numeric(as.character(OPT))] # --------------------------------------------------------- # browser(expr=inDebugMode(c("jesus", "science", "setScience", "setProject")), text="in setProject()\n\nRight Before rbind'ing projectslist.") # note: If no rows in the projectList, need slightly different line. if (nrow(projectslist) == 0L) { ### when bug in rbind.data.table fixed, use: ## projectslist <- rbind(projectslist, list(99, "[CREATE NEW PROJECT]", wrkDir)) ### For now use the following instead projectslist <- rbind(projectslist, setnames(as.data.table(list(99, "[CREATE NEW PROJECT]", wrkDir)), names(projectslist))) } else { projectslist <- rbind(projectslist, list(99, "[CREATE NEW PROJECT]", projectslist[, names(which.max(table(FOLDERS)))])) } ## OFFER USER OPTIONS TO SELECT # old: cat("", apply(projectslist[, list(OPT, PROJECTS) ], 1, paste, collapse=":\t"), sep="\n\t") outputProjectistAsOptions(projectslist, useMax=isTRUE(quiet)) tries <- 1 selection <- checkS(readline(paste0("Please select a projName or 'x' to eXit [ ", paste(projectslist[,range(OPT)], collapse=":")," ] >") )) # check for valid input. while (!selection %in% projectslist$OPT && tries <= maxTries && ! isQuit(selection)) { cat("\nInvalid selection") selection <- checkS(readline(paste0("Please select a projName in the range of (",paste(projectslist[,range(OPT)], collapse=" to "),"). >") )) tries <- tries + 1 } } if (SUBFOLDER) { if (selection %in% c(0, 99)) stop("Can't use subfolder selection with 0 or 99") wrkDir <- as.path(wrkDir, projectslist[OPT==selection, PROJECTS]) return(setProject(wrkDir=wrkDir, pos=pos+1, mkdir=mkdir, subProj=subProj)) } ## If user selected "x" or exceeded number of attempts, then quit. if (isQuit(selection) || tries > maxTries) { cat("\n\n", if (tries > maxTries) "Too many invalid selections. ", "Exiting without setting project.\n", "(Did not assigning `projName` nor dosDir variables.)\n\n") return(invisible(NULL)) } # If selection was invalid, even after attempts, then quit and do nothing more: if (!selection %in% projectslist$OPT) { warning("\nNo valid project selected. Defaulting to .") suppressWarnings(rm("projName", envir=envir.load)) return(invisible(NULL)) # creates dataDir } # else: Selection WAS valid ## CREATE VARIABLES # if user selected to create a new project: if (selection==99) { if (!(is.null(subProj) || subProj == "")) warning ("subProj was set as '", subProj, "', but will be ignored when creating a new proj") selection2 <- readline("Please input a name for the new project. > ") if("x" == tolower(selection2)) { cat("\n\nExiting without creating new project, assigning `projName` or dosDir variables.\n\n") return(invisible(NULL)) } projectslist[OPT==99, PROJECTS := selection2 ] cat("\n\nNew Project `", selection2, "` will be created in folder: \n\n ", wrkDir, "\n\n", sep="") } # Assign the projName variable, and create the folder variables projName <- projectslist[OPT==selection, PROJECTS] ## TODO 2015-09-15 -- this throws warning about subProj not set setProjName(projName, envir=envir.load) setSubProj(subProj, envir=envir.load) dosDir(wrkDir, pos=pos+1, gitData=(.Pfm=="Darwin"), ingestIn_gitData=ingestIn_gitData, mkdir=mkdir, showWarnings=FALSE, projName=projName, testDirs=testDirs, envir.load=envir.load) # Check if there are viable images to load from back up if(!any(grepl(paste0("^", projName), loadImageOf("?")))) { cat("\n\nNo back Images exist yet for this project.\nDon't forget: Jesus Saves!\n\n") } else { # check if loadImage has been flagged TRUE if (is.logical(loadImage)) { selection <- ifelse(loadImage, "y", "n") } else { selection <- readline(paste0("\nLoad Image for { ", projName, " } ? [y / N] >") ) } # if chosen yes, then load if ("y" == tolower(substr(selection,1,1))) loadImageOf(projName, subProj=subProj, verbose=FALSE, pos=pos+1, envir=envir.load) } # set working directory, data directorie variables, etc assign("wrkDir", wrkDir, envir=envir.load) setwd(wrkDir) ## source in support functions if (!dontSourceSupportFns) sourceSupportFns(srcDir, fail.on.missing=FALSE, showWarnings=FALSE, verbose=FALSE) ## Open up sublime Project... this is shaky if (.Pfm=="Darwin" && subl) openSublimeWorkspace(projName=projName) ## Fancy pants output if (!quiet) { gosci <- strsplit(paste(sample(getGoScienceASCII(), 1), collapse="\n"), "\n")[[1]] cat(paste(" ", gosci), sep="\n") cls(5) } return(invisible(TRUE)) } # -------------------------------------------------------------------------------------------------------- # outputProjectistAsOptions <- function(projectslist, max.cols=5, showOutput=TRUE, useMax=FALSE) { ## Creates a matrix output of the "OPT: PROJECTS" of a projectslist options <- projectslist[, sprintf("%3i : %s", OPT, PROJECTS)] nr <- length(options) ## Calculate how many columns cols <- ifelse (useMax, max.cols, ceiling(nr/25)) # if (nr <= 20) 1 else if (nr <= 50) 2 else if (nr <= 75) 3 else if (nr <= 100) 4 else 5 cols <- min(cols, max.cols) ## pad in any neccessary blanks, to avoid recycling ## Put them at the bottom of the columns ## count-down the cols from the end, count as many as there are pad pads.needed <- (cols - nr) %% cols fill.row <- (pads.needed == 0 && sum(projectslist[["OPT"]]==99)==1) if (fill.row) { for (colNo in seq(cols)) options <- insert(options, "", at=ceiling(nr/cols)*colNo) } ## Move #opt 99 to end of first row Opt99 <- projectslist[, which(OPT==99)] if (length(Opt99) == 1) { options <- insert(options[-Opt99], options[Opt99], at=ceiling(nr/cols)) } if (pads.needed) for (colNo in rev(rev(seq(cols))[ 1:pads.needed ]) ) options <- insert(options, "", at=ceiling(nr/cols)*colNo+fill.row ) ## matrix() will automatically order the elements top-to-bottom then left-to-right mat <- matrix(options, ncol=cols) ## Count how many characters in each column, and create a format string for sprintf using %-Xs format frmt <- paste0("%-", apply(nchar(mat), 2, max), "s", collapse=" ") ## sprintf each row into a single line out <- apply(mat, 1, function(x) do.call(sprintf, as.list(c(fmt=frmt, x)))) if (showOutput) cat(out, "", sep="\n") return(invisible(out)) } # -------------------------------------------------------------------------------------------------------- # getProjectsFromFolders <- function(folder, recursive=FALSE) { # GET LISTS OF PROJECT NAMES, IE LIST OF FOLDER NAMES MINUS ANY FOLDERS EXPLICITY NOTED AS NOT BEING A PROJECT # A running list of folders that are to be ignored as projects notProjects <- c("sql", "supportFns", "dicts", "-OLD?-From science", "-OLD-From science", "Zarchive", "StackExchange", ".git", "data.table vs data.frame" ) # these are prohects, but for now, no need to see them tmpRemove <- c("198_535_Pattern", "960_586_Inter_Data_I", "960_563_Regression") if (!exists("%ni%")) `%ni` <- function() negate(`%in%`) folders <- list.dirs(folder, full.names = TRUE, recursive=recursive) projects <- basename(folders) # old: sapply(strsplit(folders, "/"), tail, 1) # keep only the base folder name folders <- dirname(folders) # old: unname(unlist(mapply(strsplit, folders, paste0(projects,"$")))) # '$' is for regex, not for DF # if "src" is one of the folders, then get the projects from within that folder if (any(grepl("^src$", projects)) && !recursive) return(getProjectsFromFolders( as.path(folder, "/src") )) # else: indx <- projects %ni% c(notProjects, tmpRemove) ## Porjects = folders - notProjects. (assigned to the parent environment) return(list(PROJECTS=projects[indx], FOLDERS=folders[indx])) } # -------------------------------------------------------------------------------------------------------- # clearDos <- function(pos=1, envir=parent.frame(pos)) { grp <- getOption("dos.grp", default=list("data", "out", "src", "ingest", "ImageSaves", "notes", "plots", "gitdata")) grp <- paste0(grp, "Dir") assign("wrkDir", "~/git", envir=envir) suppressWarnings(rm(list=grp, envir=envir)) setwd("~/git") } # -------------------------------------------------------------------------------------------------------- # dosDir_createLinks <- function(projName=getProjName(), subFolder="__OtherDirs", src=TRUE, data=TRUE, out=TRUE, log=TRUE, plots=TRUE, notes=TRUE, ingest=TRUE, sublws=TRUE, ImageSaves=FALSE, verbose=TRUE) { ## this function that creates the intra-folder links if (is.null(proj)) stop("project cannot be NULL") ARGS <- collectArgs(except=c("projName", "subFolder","verbose")) dir_nms <- ARGS %>% {.[sapply(., isTRUE)]} %>% unlist %>% which %>% names dirs <- dir_nms %>% sprintf("%sDir", .) %>% sapply(get) %>% setNames(nm=dir_nms) verboseMsg(verbose, "Creating symlinks in", length(dirs), "folders") browser(expr=TRUE, text = "dosDir_createLinks -- this is the function that creates the intra-folder links") ## nm <- "data" sapply(dir_nms, function(nm) { func <- nm %>% sprintf("%s.p", .) %>% match.fun others <- setdiff(dir_nms, nm) # links <- others %>% sprintf("__%s", .) %>% func() %>% shellClean links <- others %>% func(subFolder, .) %>% shellClean dests <- others %>% {dirs[.]} %>% shellClean cmd <- paste("ln -s", dests, links) %>% pasteC(";") try(system(cmd)) }) return(invisible(dirs)) } dosDir <- function(wrkDir , gitData=FALSE, mkdir=FALSE, pos=1 , ingestIn_gitData=TRUE , supportFns=TRUE , projName="", forceSubProject=FALSE , showWarnings=TRUE, silent=!showWarnings , testDirs=isTRUE(Sys.info()[['sysname']]=="Linux") , envir.load = parent.frame(pos) ) { ## TODO: Change silent to showWarnings # makes data, out, src directory inside the directory wrkDir # and creates variables with full path to these directories # in the parent environment (the environment that called this func) # # Note to self, setup is as follows: # * wrkDir is my "root". ie ~/git/nbs/ ~/git/958-565 Time Series ~/NBS-R/Ricks/ # * projNames are things like Concerts HW04 # Within wrkDir I have: src, out, data # Within each of those, I have folders for each Project. # thus: # wrkDir/src/projName # wrkDir/out/projName # wrkDir/data/projName if (!missing(silent)) warning("The argument `silent` is being replaced by `showWarnings`. Please adjust code accordingly.") # error check. no allowance for windows platforms if (gitData && .Platform$file.sep != "/") stop("gitData only allowed for non-windows systems") # remove current vars, especially gitdataDir, which may not be re-created. ## OLD: suppressWarnings(rm(list=c("gitdataDir", "dataDir", "srcDir", "outDir"), envir=envir.load)) clearDos(envir=envir.load) if(missing(wrkDir)) # first see if one exists in the parent.frame. If not, check options for a baseDir. If not there, use `getwd()` wrkDir <- ifelse(exists("wrkDir", envir=envir.load), get("wrkDir", envir=envir.load), getOption("baseDir", getwd()) ) ## check if `projName` is already in the calling environment if (missing(projName) && exists("projName", envir=parent.frame())) { projName <- get("projName", envir=parent.frame()) if (showWarnings) warning("`projName` was not set explicitly but did exist in the parent frame so we are using that value. To leave blank, explicitly set `projName=NULL`\n\nCurrent project is: '", projName, "'\n") } browser(expr=inDebugMode("dosDir"), text="in dosDir()\n\nRight about to setwd(wrkDir)\nThen setting vars & vals\n") setwd(wrkDir) grp <- getOption("dos.grp", default=list("data", "out", "src", "ingest", "ImageSaves", "notes")) # create vars (+'Dir') and vals (paths) vars <- paste0(grp, "Dir") if (nchar(projName)) { # if the wrkDir has a folder called `src`, then the project goes in there, # else, the project gets its own set of `src` `out` `data` folders # Alternatively, user can falg to `forceSubProject` if(file.exists(as.path(wrkDir, "src")) || forceSubProject) { grp <- as.path(grp, projName) symdata <- as.path(wrkDir, c("data", "ImageSaves") ) } else grp <- as.path(projName, grp) symdata <- as.path(wrkDir, projName, c("data", "ImageSaves")) } vals <- mapply(as.path, wrkDir, grp, MoreArgs=list(expand=FALSE), USE.NAMES=FALSE) ## if gitData is TRUE AND we are making the directory, ## then we symlink from data to gitdata and the var dataDir points to data ## if we gitdata and we are NOT making the directory, ## then dataDir simply points to gitdata. (note that if it is symlinked, then same effect) as changing dataDir variable. ## ## 1. check for both ## 1. create gitdata ## 2. if data exists and is not a symlink, issue warning ## 3. if data exists and is symlinked back to git data, then done ## 2. if gitdata, but not mkdir ## 1. change the value of dataDir to gitdata  ## 3. if mkdir but not gitdata ## 1. proceed as normal # if using gitData, create a symlink if (gitData && mkdir) { to_gitData <- c("data", "ImageSaves", if (ingestIn_gitData) "ingest") # find which elements of grp contain the vals that need to be changed d.indx <- grepl(paste0("(^|/)", regOr(to_gitData)), grp) # save the original value, for symlinking d.virtual <- vals[d.indx] # replace /git/ with /gitData/ vals[d.indx] <- sub("/git/", "/gitData/", vals[d.indx] ) # create the dirs, including gitdata, but not data sapply(path.expand(vals), dir.create, showWarnings=FALSE, recursive=TRUE) # for symlinks, remove any trailing project names pat <- paste0("(/", projName, "/?)$") from <- sub(pat, "", vals[d.indx] ) to <- sub (pat, "", d.virtual ) # for symlinks, escape any white spaces from <- gsub(" ", "\\\\ ", from ) to <- gsub(" ", "\\\\ ", to ) # check if plain data directory exists. If not, symlink to it. If so, warning. for (i in seq_along(d.virtual)) { if(file.exists(d.virtual[[i]])) { ##% TODO: Double check this test. ##% # check if file is a symlink, if not, issue warning ##% if(! system(paste("test -L", to )) ) ##% warning("In dosDir(.), `gitData` & `mkdir` are both flagged to TRUE,\nbut regular `data` dir already exists.\nCannot symlink to it.\n") } else { # create the symlink command cmd <- paste("ln -s", from[[i]], to[[i]] ) # try to create a symlnk and issue warning if failed caught.symlink <- try(system(cmd), silent=TRUE) if (inherits(caught.symlink, "try-error") || caught.symlink==1) warning("Attempt to create symlink failed. Attempted symlink was\n FROM: ", vals[d.indx][[i]] , "\n TO : ", d.virtual[[i]], "\n\n") } } # // end for # // end '(gitData && mkdir)' } else if (mkdir) { sapply(path.expand(vals), dir.create, showWarnings=FALSE, recursive=TRUE) } else if (gitData) { d.indx <- grepl("(^|/)(data|ImageSaves)", grp) d.virtual <- vals[d.indx] # banking this in case creating dirs. vals[d.indx] <- sub("/git/", "/gitData/", vals[d.indx] ) } if (mkdir && supportFns) { ## srcDir not created yet. extract it from vals srcDir <- grep("(^|/)src(/|$)", vals, value=TRUE) if (length(srcDir) == 1) dir.create(as.path(srcDir, "supportFns"), showWarnings=FALSE) else warning ("could not create supportFns.\nSomething may be wrong with srcDir or there might be more than one folder with 'src' as a parent folder") } ## TEST THAT WE CAN WRITE TO THE DIRECTORIES if (testDirs) { browser(expr=inDebugMode(c("testDirs", "dosDir")), text="in dosDir() at testDirs") write.results <- c() for (d in vals) { ff <- shellClean(as.path(d, ".testRconnection.txt")) ## if file not found, the command will return a non-0 status write.results[[d]] <- suppressWarnings(is.null(attr(system(paste("touch", ff), intern=TRUE), "status"))) ## if write was successful, clean up by removing the file if (write.results[[d]]) system(paste("rm", ff)) } if (any(!write.results)) { stop("\nDir variables *NOT* created.\n\nFailed to write to the following ", plrl("directories", sum(!write.results)) ,":\n ",paste(names(which(!write.results)), collapse="\n "), "\n\nadditional output from console:\n") } } # assign vals to appropriate var names in the calling environment output <- mapply(assign, vars, vals, MoreArgs=c(pos=envir.load)) # Set as option too (migrating to this) do.call(options, as.list(setNames(vals, vars))) # return the variables with folders they point to in a nice DF data.frame(FOLDER=output, stringsAsFactors=FALSE) } isNULLorBlank <- function(x) { !length(x) || !nchar(x) } # ~/git/orch/subl/ if (FALSE) { setScience("Looker", create=TRUE, subl=FALSE, quiet=TRUE) setScience("z Test Project", create=TRUE, subl=FALSE, quiet=TRUE) projName <- "z Test Project" sublime_projectname_from_current_project() } sublime_projectname_from_current_project <- function(default="UNTITILED") { p <- getProjName() s <- getSubProj(showWarnings=FALSE) if (nchar(s)) s <- paste0("+", s) ret <- paste0(p, s) if (!nchar(ret)) return(default) return(ret) } .getSublBlankWorkspace <- function(name_of_subl_proj=sublime_projectname_from_current_project(), expanded_folders=valueIfErr(c(srcDir, notesDir, plotsDir, outDir)) ) { if (!length(name_of_subl_proj) || !nchar(name_of_subl_proj)) { stop("name_of_subl_proj cannot be blank") return("") } if (!is.null(names(expanded_folders))) nms <- names(expanded_folders) else if (all(grepl("/orch/", expanded_folders))) nms <- sprintf("[%sDir] %s", basename(dirname(expanded_folders)), basename(expanded_folders)) else nms <- basename(expanded_folders) expanded_folders <- path.expand(expanded_folders) %>% unique fmt.ws <- "{\n\"expanded_folders\":\n[%s\n],\n\"project\": %s,\n\"settings\":\n{\n},\n\"show_minimap\": true,\n\"show_open_files\": true,\n\"show_tabs\": true,\n\"side_bar_visible\": true,\n\"side_bar_width\": 225.0,\n\"status_bar_visible\": true,\n\"template_settings\":\n{\n}\n}" folders.ws <- paste0("\n \"", expanded_folders, "\"", collapse=",") subl_projs <- sprintf("\"%s.sublime-project\"", name_of_subl_proj) ws <- sprintf(fmt.ws, folders.ws, subl_projs) fmt.prj <- "{\n\t\"folders\":\n\t[%s\n\t]\n}" folders.prj <- paste(sprintf("\n\t\t{\n\t\t\t\"path\": \"%s\",\n\t\t\t\"name\": \"%s\"\n\t\t}", expanded_folders, nms), collapse=",") prj <- sprintf(fmt.prj, folders.prj) return(list(prj=prj, ws=ws)) } # lapply(.getSublBlankWorkspace(), cat, "\n\n\n") openSublimeWorkspace <- function(name_of_subl_proj=sublime_projectname_from_current_project(default=projName), dir.default=c("~/git/!Projects"), ext="sublime-workspace", projName=getProjName(), showWarnings=TRUE, verbose=FALSE) { ## Opens the Sublime Workspace if exists if (name_of_subl_proj == "") { verboseMsg(showWarnings, "'name_of_subl_proj' sent to openSublimeWorkspace() is blank. No action taken.", call.=FALSE) return(invisible(NULL)) } pat.nm <- name_of_subl_proj %>% escapeRegEx %>% paste0("^", .) sublProjFiles <- character(0L) try({ sublProjFiles <- extractFilesFromFolder(sublws.p(proj=projName), pattern=pat.nm, ext=ext, full=TRUE, showWarnings=FALSE) }, silent=TRUE) if (!length(sublProjFiles)) sublProjFiles <- extractFilesFromFolder(dir.default, ext=ext, pattern=pat.nm, full=TRUE, showWarnings=FALSE) ## If there ARE files, open the most recent one if (length(sublProjFiles)) { times <- file.info(sublProjFiles)$mtime file_to_open <- sublProjFiles[order(times, decreasing=TRUE)][[1]] ## OTHERWISE, CREATE THE FILE } else if (exists("sublwsDir") && exists("sublws.p")) { ll.blanks <- .getSublBlankWorkspace() files.subl <- setNames(nm=c("ws", "prj"), obj = sublws.p(proj=projName, name_of_subl_proj, ext=c(ws="sublime-workspace", prj="sublime-project")) ) dir.create(dirname(files.subl[[1]]), recursive=TRUE, showWarnings=FALSE) for (nm in names(ll.blanks)) { file <- files.subl[[nm]] if (!file.exists(file)) write(x=ll.blanks[[nm]], file=file, sep="@@@@$$$$$") else warning ("file ", file, " already exists") } file_to_open <- files.subl[["ws"]] ## NOTHING TO OPEN } else { warning("Could not find a sublime-workspace to open and was unable to create a new one due to a missing sublwsDir") file_to_open <- "" } if (nchar(file_to_open)) { subl(file_to_open) } return(file_to_open) } getGoScienceASCII <- function() { list( lettersBin = "..######....#######......######...######..####.########.##....##..######..######## .##....##..##.....##....##....##.##....##..##..##.......###...##.##....##.##...... .##........##.....##....##.......##........##..##.......####..##.##.......##...... .##...####.##.....##.....######..##........##..######...##.##.##.##.......######.. .##....##..##.....##..........##.##........##..##.......##..####.##.......##...... .##....##..##.....##....##....##.##....##..##..##.......##...###.##....##.##...... ..######....#######......######...######..####.########.##....##..######..######## 01000111.01101111...01010011.01100011.01101001.01100101.01101110.01100011.01100101 " , small= " _.............................................................._ || Go Science!! || +..............................................................+" , lettersBin2 = " ........................................................................................ ........................................................................................ .....######....#######......######...######..####.########.##....##..######..########... ....##....##..##.....##....##....##.##....##..##..##.......###...##.##....##.##......... ....##........##.....##....##.......##........##..##.......####..##.##.......##......... ....##...####.##.....##.....######..##........##..######...##.##.##.##.......######..... ....##....##..##.....##..........##.##........##..##.......##..####.##.......##......... ....##....##..##.....##....##....##.##....##..##..##.......##...###.##....##.##......... .....######....#######......######...######..####.########.##....##..######..########... ........................................................................................ ...01000111.01101111...01010011.01100011.01101001.01100101.01101110.01100011.01100101... ........................................................................................ ", lettersBin3 = " ........................................................................................ ........................................................................................ .....______...._______......______...______..____.________.__....__..______..________... ....__....__..__.....__....__....__.__....__..__..__.......___...__.__....__.__......... ....__........__.....__....__.......__........__..__.......____..__.__.......__......... ....__...____.__.....__.....______..__........__..______...__.__.__.__.......______..... ....__....__..__.....__..........__.__........__..__.......__..____.__.......__......... ....__....__..__.....__....__....__.__....__..__..__.......__...___.__....__.__......... .....______...._______......______...______..____.________.__....__..______..________... ........................................................................................ ...01000111.01101111...01010011.01100011.01101001.01100101.01101110.01100011.01100101... ........................................................................................ " )} ## ------------------------------------------------------------------------ ## ## projName subProj setters and getters ## ------------------------------------------------------------------------ ## # getsubProj <- function(pos=1, MainToBlank=TRUE, envir=parent.frame(pos)) { # force(pos) # warning("getsubProj() has been deprecated. New function name uses capital 'S' \n getSubProj() ") # getSubProj(pos=pos+1, MainToBlank=MainToBlank, envir=envir) # } getSubProj <- function(pos=1, MainToBlank=TRUE, warnOnBlanks=showWarnings, showWarnings=TRUE, envir=parent.frame(pos)) { ## TODO: USe options instead of local variable force(pos) ret <- getProjName(subProj.instead=TRUE, appendImgSave=FALSE, fresh=FALSE, warnOnBlanks=warnOnBlanks, pos=pos+1, envir=envir) ## Blank out 'MAIN' if (MainToBlank && toupper(ret) == "MAIN") ret <- "" return(ret) } setProjName <- function(projName, envir=globalenv()) { ## Beginning to move to use 'options' instead options(projName = projName) ## also use assign to maintain compatibility assign("projName", projName, envir=envir) setPrompt() return(invisible(projName)) } setSubProj <- function(subProj, envir=globalenv()) { ## Beginning to move to use 'options' instead options(subProj = subProj) ## also use assign to maintain compatibility assign("subProj", subProj, envir=envir) setPrompt(quiet=TRUE) return(invisible(subProj)) } getProjName <- function(appendImgSave=FALSE, fresh=FALSE, use_old_behavior_isntead_of_options=FALSE , warnOnBlanks=showWarnings, showWarnings=TRUE , pos=2, subProj.instead=FALSE, envir=parent.frame(pos) ) { ## ## TODO :: USE options instead of a local object ## ## Checks the previous environment for the var `projName` ## returns that value if found. ## Also appends 'ImageSave' if appropriate ## NOTE: pos should be 2, not 1, since we might use newFunc <- function(projName = getProjName()) ## ## !!!!!!!!! ## ~~~~ This function changed behavior in 2015-06-15 ~~~~~~~~~~~ ## Instead of searching for the object pojName, we use the options browser(expr=inDebugMode("proj"), text="in getProjName(), right before setting proj.string") if (!isTRUE(use_old_behavior_isntead_of_options)) { projName <- getOption("projName") subProj <- getOption("subProj") if (isTRUE(subProj.instead) && is.null(subProj)) { verboseMsg(warnOnBlanks, "subProj not set. Please run setScience(), setProject(), or setSubProj()", func="warning", call.=FALSE) subProj <- "" } if (is.null(projName)) { if (appendImgSave) stop("Check the new behavior in getProjName() -- how should it be handled when projName is blank, but appendImgSave is TRUE?\nShould this return just the string 'ImageSave'") verboseMsg(warnOnBlanks, "projName not set. Please run setScience(), setProject(), or setProjName()", func="warning", call.=FALSE) projName <- "" } if (appendImgSave && !grepl("ImageSave", projName) && !fresh) projName <- paste(projName, "ImageSave", sep=ifelse(nchar(projName), "_", "")) if (isTRUE(subProj.instead)) return(subProj) return(projName) } ## ~~~~~~~~~~~~~ BELOW HERE IS THE ORIGINAL BEHVAIOR -- THIS SHOULD BE DEPRECATED SOON ~~~~~~~~~~~~~~ ## force(pos) if (is.null(subProj.instead) || is.na(subProj.instead)) subProj.instead <- FALSE if (!is.logical(subProj.instead)) stop("`subProj.instead` should be a logical value.") ## allows for `projName` or `subProj` proj.string <- ifelse(isTRUE(subProj.instead), "subProj", "projName") # check the parent environments if (exists(proj.string, envir=envir)) { ret <- get(proj.string, envir=envir) } else{ ret <- "" } # append suffix to ret if (appendImgSave && !grepl("ImageSave", ret) && !fresh) ret <- paste(ret, "ImageSave", sep=ifelse(nchar(ret), "_", "")) # use a sep only if projName has a value already ## Do not return NULL, return an empty string if (is.null(ret)) ret <- "" return(ret) } ## ------------------------------------------------------------------------ ##