# TODO: This file fails at parseBackUpFile() # 1. # (notice that this file is the output from jesus() as opposed to jesusForData() ) # f <- "~rsaporta/git/orch/data/Acc_vs_Anal_2015/data_bak_20150204_0917/prediction75_len.RDS" # loadFromJesus(f) # parseBackUpFile(f) # # 2. # This file, once brought over, is not found. # Specifically, the ~root --> ~rsaporta change happens in bringme() but not in load__ () # f <- "~root/git/orch/data/Acc_vs_Anal_2015/prediction-20150204_0935-75_len.RDS" datetimeparse.simple <- function(x, possible_seps=c("-", "_"), tz=getOption("default.tz", "")) { ## ONLY USEFUL FOR THE FORMATS I GENERALLY USE ## returns a POSIXct # # full format is "%Y%m%d_%H%M%S" # possibilites are # YYYYMMDD # YYYYMMDD_hhmm # YYYYMMDD_hhmmss # NOT: YYMMDD # NOT: YYMMDDHHMM # NOT: YYMMDD_HHMM ## reminder to self on capitalization "%Y%m%d_%H%M%S" ## TODO: Look for tz in the string ## error check if (!length(x)) { warning("x in datetimeparse.simple() has no length") return(as.POSIXct(x)) ## No timezone here } if (all(is.na(x))) return(as.POSIXct(x)) ## No timezone here if (length(x) > 1) { return(as.POSIXct(sapply(x, datetimeparse.simple, possible_seps=possible_seps, USE.NAMES=!is.null(names(x))), origin=.origin.utc, tz=tz)) # stop("One at a time.") } ## identify which sep is being used wh.sep <- which(sapply(possible_seps, grepl, x=x)) if (length(wh.sep) > 1) stop ("more than one different type of sep detected") sep <- possible_seps[max(wh.sep, 1)] splat <- strsplit(x, sep)[[1]] if (length(splat) > 2) stop("ambiguous format (the sep '", sep, "' appeared more than once)") time_format <- { if (length(splat)==2) { nc.tt <- nchar(splat[[2]]) if (nc.tt == 4) "%H%M" else if (nc.tt == 6) "%H%M%S" else stop("ambiguous format (the time '", splat[[2]], "' portion has ", nc.tt, " chars -- should be 0, 4 or 6)") } else "" ## no time argument } ## // end time_format date_format <- { nc.dd <- nchar(splat[[1]]) if (nc.dd == 6) "%y%m%d" ## lowercase "Y" else if (nc.dd == 8) "%Y%m%d" ## uppercase "y" else stop("ambiguous format (the date '", splat[[1]], "' portion has ", nc.dd, " chars -- should be 6 or 8)") } ## // end date_format as.POSIXct(gsub(sep, "", x), format=paste0(date_format, time_format), tz=tz) } parseBackUpFile_extractForecastInfo <- function(fileString, sep=get_jesus_sep.major(), info.sep=get_jesus_sep.minor(), info.forecast_indicators=c("fakeToday", "forecasted", "simulated")) { #### IDEALLY WE WOULD HAVE THESE PIECES OF INFO WITH FORECAST ## ## forecast info: ## date_simulated ## date_executed ## git_commit ## method_label (if applicable) ## additional_info (eg, ) ## ## ... for now, we just have fakeToday-is-DATE and date_executed (assuming sames as date saved) require(stringr) # one ? ## TODO: test it, I dont think this needs to be one at a time # one ? if (length(fileString) > 1) # one ? stop ("One at a time! 'fileString' has length greater than 1") ## TODO: not sure how I want to indicate this just yet simulated.indicators <- intersect(c("fakeToday", "simulated"), info.forecast_indicators) ## ---- TEMPLATE FOR RET ---- ## ## template for what will be returned -- if we parse succesfully, fileString will be changed ret <- list(original=fileString, fileString_remaining=fileString, simulated_date=as.POSIXct(NA), executed_date=as.POSIXct(NA), git_commit=as.character(NA), isForecast=FALSE) ## Pattern for the forecast Info eg: "fakeToday...timestamp" or "forecast...timestamp", bookended by [minor...major] ## Important: major MUST trail this pattern, otherwise greedy regex will pickup the files timestamp ## timestamp will have a minimum of full date YYYYMMDD with optional hm or hms pat.forecast_datetimestamp <- "(19|20)\\d{6}(_\\d{4,6})?" # YYMMDD with optional 4 or 6 more digits for time # pat.forecast_datetimestamp <- "((19|20)\\d{6})+?(_\\d{4,6})?" # YYMMDD with optional 4 or 6 more digits for time pat.forecast <- sprintf("%s%s(.*%s)+?%s", escapeRegEx(info.sep), regOr(escapeRegEx(info.forecast_indicators)), pat.forecast_datetimestamp, escapeRegEx(sep)) ## (minor, "fakeToday", time, major) browser(expr=inDebugMode("parseBackUpFile_extractForecastInfo"), text="in parseBackUpFile_extractForecastInfo") ## extract the forecast info early, since the info might contain major sep in it forecastInfo <- str_extract(fileString, pat=pat.forecast) ## if NA, then nothing else to do if (all(is.na(forecastInfo))) return(as.data.table(ret)) ## ELSE continue parsing ## remove the forecastInfo from the fileString # one ? : if (FALSE) # one ? : ret$fileString_remaining <- paste(strsplit(fileString, escapeRegEx(forecastInfo))[[1]], collapse=sep) # one ? : else ret$fileString_remaining <- sapply(mapply(strsplit, x=fileString, split=escapeRegEx(forecastInfo), USE.NAMES=FALSE), paste, collapse=sep) ## NOTE TO SELF ... at some future point, I can expect forecastInfo to have multiple portions, each needing extraction / splitting. ## on second thought, those should probably have a tercerary sep ## extract simulated info, and then the date from the info. ## (currently, this is almost identical to forecastInfo, but at a future point, it will be only a portion) pat.date_simulated <- sprintf("%s(.*%s)+?", regOr(escapeRegEx(simulated.indicators)), pat.forecast_datetimestamp) simulated_info <- str_extract(forecastInfo, pat=pat.date_simulated) simulated_date <- str_extract(simulated_info, pat=pat.forecast_datetimestamp) simulated_date <- datetimeparse.simple(simulated_date) ret$simulated_date <- simulated_date ## extract the executed date ## (currently, this is simply the day file was saved -- extracting from fileString, in future might extract from forecastInfo) pat.date_executed <- sprintf(".*(%s)%s.*", pat.forecast_datetimestamp, regOr(c(escapeRegEx(sep), "\\.", "\\b"))) executed_date <- sub(pat.date_executed, "\\1", ifelse(grepl(pat.forecast_datetimestamp, fileString), fileString, NA)) ## There is something wrong with my regex, which keeps the trailing sep executed_date <- sub(paste0(regOr(c(escapeRegEx(sep), "\\.", "\\b")), "$"), "", executed_date) executed_date <- datetimeparse.simple(executed_date) ret$executed_date <- executed_date ## extract the git info ## (currently, not tracking) git_commit <- NA_character_ ret$git_commit <- git_commit ## There is forecast info present IFF original differs from fileString_remaining ret$isForecast <- (ret$original != ret$fileString_remaining) return(as.data.table(ret)) } parseBackUpFile <- function(fileString, MayContainPath=TRUE, sep=get_jesus_sep.major(), info.sep=get_jesus_sep.minor(), fsep=.Platform$file.sep , tz = getOption("default.tz", default="") , pat.time="^(\\d{8}_\\d{4,6})$", info.forecast_indicators=c("fakeToday", "forecasted", "simulated") , incl.original=TRUE, showWarnings=TRUE, sep.ext=".") { # sep: what string pattern sepearates the object infos ## for debugging, and for returning later fileString.bak <- copy(fileString) ## we can quickly grab the date_time stamp of the file using the following, then based on it, determine which method to use ## TODO: Consider shipping this fileString to the parseBackUpFile.pre_20140827() .tmp.time.pat <- sprintf(".*(%s)(%s).*", "(19|20)\\d{6}(_\\d{4,6})?", regOr(c(escapeRegEx(sep), "\\.", "\\b"))) .tmp.timestamp <- datetimeparse.simple( gsub(.tmp.time.pat, "\\1", grep(.tmp.time.pat, fileString, value=TRUE)) ) ## TODO: we could use file.info(fileString)$ctime but we would need the full path if (all(.tmp.timestamp < as.POSIXct("2014-01-01", origin=.origin.utc))) { if (showWarnings) warning ("using new parse method with a file older than 2014") } ## Pattern for the dim Info - it will either be 9999x99 or 999_len pat.dim <- "\\d{1,}(x\\d{1,}|\\d{1,}_len)" # update, why not: "\\d{1,}(x\\d{1,}|_len)" ## ERROR CHECK ## -------------------- # one ? : only one at a time # one ? : if (!length(fileString) == 1L) # one ? : stop ("Only one file at a time. (ie, fileString must have length 1)") # only basename ## -------------------- if (any(fileString != basename(fileString))) { if (!MayContainPath) stop ("fileString is not the basename of the file") else fileString <- basename(fileString) } ## This is the biggest change in Aug 2014. The rest is almost identical ## EXTRACT the forecast info DT.forecastedInfo <- parseBackUpFile_extractForecastInfo(fileString, sep=sep, info.sep=info.sep, info.forecast_indicators=info.forecast_indicators) setFactorsToChars_ (DT.forecastedInfo) ## drop the captured info from fileString fileString <- DT.forecastedInfo$fileString_remaining ## Split on sep splat <- strsplit(fileString, sep) ln <- sapply(splat, length) ## ERROR CHECK - All should have at least one element if (!all(ln>=1)) stop ("Something is not write. Executing\n\n strsplit(\"", fileString[which(ln<1)[[1]]], "\", \"", sep, "\")\n\n returned no result.") ## Split out the extension ## ------------------------- ## Note that it is possible that a fileString NOT have an extension. ## We need to check for this and pad in a blank ("") ## otherwise this will translate downstream to columns that do not line up. splat <- lapply(splat, function(x) { splatTail <- splitOnLast(string=tail(x, 1), splitOn=escapeRegEx(sep.ext)) [[1L]] splatTail <- padToLength(splatTail, len=2, showWarnings=TRUE) # length(splatTail) > 2 is buggy ## return c(head(x, -1), splatTail) }) ## Split out the object name based on info.sep ## ------------------------- ## We are splitting on FIRST instance of info.sep (the info text itself might sloppilly contain info.sep) ## and we are padding the splits to length 2 (ie, if there is no info text, use a blank) splat <- lapply(splat, function(x) { splatHead <- splitOnFirst(x[[1]], escapeRegEx(info.sep))[[1L]] splatHead <- padToLength(splatHead, len=2, showWarnings=TRUE) ## return c(splatHead, tail(x, -1)) }) ### NOW HERE COMES THE DIFFICULT PART -- WHICH COLUMN IS WHICH? ### -------------------------------------------------- ### If all columns are present, no big deal ### Difficulties arrise when some pieces are missing, especially ### from different fileString s ### ### We know that the first column is name, second is info, and last is ext ### We can then use pat.time/pat.dim to find the time/dim columns, respectively ### ### If any of these are missing, we can use a blank column ### If there are EXTRA columns though, ### then we need to pad ALL THE OTHER fileString s ### ## identify column locaiton ## ------------------------- objCol <- as.list(rep(1L, length=length(splat))) # first column infoCol <- as.list(rep(2L, length=length(splat))) # second column timeCol <- sapply(splat, grep, pat=pat.time) dimCol <- sapply(splat, grep, pat=pat.dim) extCol <- sapply(splat, length) # last column ## replace no matches to NA. Also simplify to vector timeCol <- unlist(ifelse(sapply(timeCol, length), timeCol, NA), use.names=FALSE) dimCol <- unlist(ifelse(sapply(dimCol, length), dimCol, NA), use.names=FALSE) ## Note that any NAs will be padded, therefore, ## the total number of columns is the number of cols plus the number of NAs totalCols <- is.na(timeCol) + is.na(dimCol) + extCol mxCols <- max(totalCols) inds <- cbind( objCol , infoCol , timeCol , dimCol , extCol) nms <- gsub("Col$", "", colnames(inds)) ## Debugging browser(expr=inDebugMode("parseBackUpFile", "jesus", skip="parseBackUpFile"), text="In parseBackUpFile() - right before ret.list definted.") ret.list <- lapply(seq(splat), function(i){ l <- length(splat[[i]]) ind <- unlist(inds[i, ], use.names=FALSE) ## grab the core columns core <- setNames(obj=splat[[i]] [ind], nm=nms) ## grab any missing columns addl <- splat[[i]] [-(removeNA(ind))] ## If mxCols is more than the number of cols here, add filler if (toFill <- (mxCols - length(core) - length(addl))) addl <- c(addl, rep("", toFill)) if (length(addl)) setattr(addl, "names", paste0("Addl", seq(addl))) ## Combine it altogether setDT(as.list(c(core, addl))) }) ret <- rbindlist(ret.list) ## TODO: something is breaking with regards to the self ref link. Not clear what ret <- copy(ret) # ret <- setFactorsToChars_ (ret) setFactorsToChars_ (ret) ## CLEAN UP THE COLUMNS ## --------------------------------------- ## Parse the dim col into rows x cols ## padToLength is necessary, since otherwise the single value will recylce ## older files might have an exclamation point in dim, clear it ret[, dim := gsub("\\!", "", dim) ] ## blank cols get a hyphen to indicate 'length'. NA cols indicate missing and are unchanged ret[, c("rows", "cols") := NA_character_] ret[!is.na(dim), c("rows", "cols") := sapplyt(strsplit(dim, "x|_"), padToLength, 2, pad.with="-")] ret[, c("rows", "cols") := lapply(.SD, function(x) as.num.nowarn(as.character(x)) ), .SDcols = c("rows", "cols")] ret[, dim := NULL] ## Clean up the time col ret[, time := as.POSIXct(datetimeparse.simple(time), origin=.origin.utc, tz=tz)] DT.ret <- setDT(as.list(ret)) DT.ret[, file := fileString.bak] setcolorderpt(DT.ret, c("file", "obj", "info", "rows", "cols", "ext", "time"), failOnMissingCols=FALSE, showWarnings=FALSE) ## Merge in the forecast info if relevant ## --------------------------------------- ## There is forecast info present IFF DT.forecastedInfo fileString is different from original if (any(DT.forecastedInfo[["isForecast"]])) DT.ret <- cbind(DT.ret, DT.forecastedInfo[, !c("original", "fileString_remaining"), with=FALSE]) return(DT.ret) }