# ------------------------------------------------------------------------------------------------------------------------- # # ----------------------------------------------------------------------------------------------------------------------- # # # # File Name : TEST_find_funcs_parens.r # # Last Updated Funclist : 20 Feb 2014, 4:13 PM (Thursday) # # # # Author Name : Rick Saporta # # Author Email : RickSaporta@gmail.com # # Author URL : www.github.com/rsaporta # # # # Packages Called : RMySQL # # Packages Used via NS : NA # # # # ----------------------------------------------------------------------------------------------------------------------- # # # # qKill ( id, force=FALSE, verbose=TRUE, user=NULL, currentUser=mine, mine=FALSE ) # # cleanGenderColumn_ ( DT, by.col, gender.col="gender", convert.to.factor=TRUE, allow.by.col.to.be.null=FALSE # # , verbose=TRUE ) # # qCanRead ( tbl, user=NULL, schema=NULL, showWarnings=TRUE ) # # qShowTables ( where=NULL, prod.only=TRUE, namelike=NULL, showDetails=FALSE, verbose=FALSE ) # # qFindTable ( pattern, ignoreCase=ignore.case, ignore.case=TRUE # # , exact=any(grepl("\\%", pattern)), public.too=FALSE ) # # makeProperColName ( tbl, col, AS.prefix=tbl, AS.suffix=NULL, sep="_", verbose=FALSE ) # # getGenresForAllupcs ( id.col.AS="upc", dontExecute.justReturnQry=FALSE, verbose=TRUE # # , verbose.max.width=98L + (200 * dontExecute.justReturnQry) ) # # getReleaseDates ( values, id.col="releaseId", id.col.AS=id.col, numericValues=FALSE, sep="__" # # , origin="1970-01-01", genre=TRUE, dontExecute.justReturnQry=FALSE, verbose=TRUE # # , verbose.max.width=98L + (200 * dontExecute.justReturnQry), minimal=is.null(values) ) # # cleanReleaseDatesDT_ ( DT.releaseDates # # , id.col.AS=ifelse("upc" %in% names(DT.releaseDates), "upc", "releaseId"), minimal=FALSE # # , origin="1970-01-01", failOnMissingCols=!minimal, showWarnings=!minimal, verbose=FALSE ) # # infinitDBNotWorking.metas ( DT.nm ) # # # # # # # # ----------------------------------------------------------------------------------------------------------------------- # # ------------------------------------------------------------------------------------------------------------------------- # qKill <- function(id, force=FALSE, verbose=TRUE, user=NULL, currentUser=mine, mine=FALSE) { # mine : synonym for currentUser # currentUser : Logical value, indicating if we should restrict search to current user whoIsCalling <- qCurrUser() allQs <- qWhatsRunning(user=user, currentUser=currentUser) ## ALLOW MANUAL SELECTION OF WHICH id TO KILL: if (missing(id) || is.null(id)) { print(allQs) id <- readline("Which to kill? > ") # Manually quit with eXit/qUit/Cancel if (substr(tolower(id), 1,1) %in% c("x", "q", "c", "e")) { cat("\nNo action taken\n") return(invisible(NULL)) } id <- strsplit(id, ",| |;")[[1]] id <- suppressWarnings(unique(removeNA(as.numeric(id)))) invalid <- FALSE # No id's remain after strsplit and removals if (!length(id)) invalid <- TRUE # id can be a procpid or a row number. (It might accidentally be a usesysid or datid) # if it's a procpid, then all good, move on. Otherwise, try to match or throw an erro if (!invalid && !any(id %in% allQs[["procpid"]])) { if (all(id %in% seq(nrow(allQs)))) id <- allQs[id, procpid] else invalid <- TRUE } if (invalid) { cat("\nYou must enter a valid procpid or a row number corresponding to a procpid\nNo action taken\n") return(invisible(NULL)) } } # // end manual selection of id toKill <- allQs[allQs$procpid %in% id, ] cat("\n\n") cat("You are currently accessing the DB as user: \"", whoIsCalling, "\" \n", sep="") cat("The following processes will be killed\n\n") print(toKill) cat("\n\n") if (any(!(toKill$usename == whoIsCalling))) { cat("\n ", pasteR("!", 65), "\n\t\t\t\tWARNING:\n\tYou are killing processes for which you are not the user\n ", pasteR("!", 65), "\n\n", sep="") } areYouSure <- readline("Are you sure you want to proceed? (type \'yes\') > ") # give two tries if (areYouSure != "yes" && tolower(substr(areYouSure,1,1))=="y") { areYouSure <- readline("If you'd like to proceed, you must type exactly \'yes\' > ") } if (areYouSure != "yes") { cat("\nNo action taken\n") return(invisible(NULL)) } # else cat("Killing procpids ", paste(id, collapse=", "), ". . . \n" ) ## allow a second to frantically ctrl+esc even after the confirmation Sys.sleep(1.3) Q <- paste0("select pg_cancel_backend(", paste(id, collapse=", "), ")") # runQry(Q) cat("\t\tRICK'S NOTE:\nTEMPORARILLY NOT RUNNING THE QUERY UNTIL I AM CERTAIN THERE ARE NO BUGS.\nRUN THIS MANUALLY: \n\n ", paste0("runQry('", Q ,"')\n\n") ) return(invisible(NULL)) } qCanRead <- function(tbl, user=NULL, schema=NULL, showWarnings=TRUE) { if (!length(tbl)) stop("Invalid tbl argument") if (!is.null(schema)){ DontAddDot <- grepl("\\.$", schema) | !(nchar(schema)) schema <- ifelse(DontAddDot, schema, paste0(schema, ".")) tbl <- sapply(schema, paste0, tbl) } ## Check that Table Exists allTables <- qShowTables()[, unique(c(tablename, paste0(schemaname, ".", tablename)))] if (any(wh <- {!(tbl %in% allTables)})) { if (all(wh)) stop ("Table ", if(!is.null(schema)) "& schema combination ", "not found in the list of tables.\nWe searched for:\n ", paste(tbl, collapse=" "),"\n\n") if (showWarnings) warning("The following tables do not exist in the database: \n ", paste(tbl[wh], collapse=" "), "\n" ) tbl <- tbl[!wh] } if (length(user) > 1) return(sapply(user, function(u) qCanRead(tbl=tbl, user=u, schema=NULL))) Q <- paste("SELECT has_table_privilege(" , {if (!is.null(user)) paste0("\'", user, "\', ")} , paste0("\'", tbl, "\', ") , "\'select\');") ret <- sapply(Q, runQry, verbose=FALSE, to.dt=FALSE) ret <- setNames(unlist(ret, use.names=FALSE), tbl) return(ret) } # qShowTables() qShowTables <- function(where=NULL, prod.only=TRUE, namelike=NULL, showDetails=FALSE, verbose=FALSE) { # if `where` is a single word, treat it as `namelike` argument if (!is.null(where) && is.character(where) && !grepl(" ", where)) { namelike <- where where <- NULL } if (!is.null(namelike)) { if (!is.null(where)) stop("One of `where` and `namelike` must be NULL") where <- paste("tablename like (", paste0("'%", namelike, "%'"), ")\n") } Q.base <- "SELECT * FROM pg_catalog.pg_tables" if (!is.null(where)) Q <- paste(Q.base, "WHERE", gsub("^where", "", where)) else Q <- Q.base ret <- runQry(Q, verbose=verbose) # If no rows returned, and there was a where clause, try without it if (!nrow(ret) && (Q.base != Q)) { browser(text=".. THIS MIGHT BE INCOMPLETE... \n\n What is the difference between `found` & `ret` ?\n") ret <- runQry(Q.base, verbose=verbose) found <- ret[["tablename"]] %cont% namelike ret <- ret[tablename %cont% namelike] } if (!nrow(ret)) { warning("No rows returned. Query ran was:\n\n", verboseQry(Q, all=TRUE)) return(ret) } if (prod.only) ret <- ret[schemaname == "production"] if (!showDetails) ret[, c("schemaname", "tablespace", "hasindexes", "hasrules", "hastriggers") := NULL] setkey(ret, tablename) return(ret) } qFindTable <- function(pattern, ignoreCase=ignore.case, ignore.case=TRUE, exact=any(grepl("\\%", pattern)), public.too=FALSE) { # EG: qFindTable("staging") or qFindTable("zip") # public.too : if NOT TRUE, then tables from schema public. are not included if (ignoreCase) pattern <- regExUpperLower(pattern) if (!exact) { if (!grepl("^\\%", pattern)) pattern <- paste0("%", pattern) if (!grepl("\\%$", pattern)) pattern <- paste0(pattern, "%") } Q <- paste0("SELECT * FROM pg_catalog.pg_tables WHERE tablename SIMILAR TO \'", pattern , "\'") runQry(Q, verbose=FALSE)[if (public.too) TRUE else schemaname != "public"] } ## EG: # tbl <- c("staging_raw_itunes", "staging_raw_spotify") # schema <- c("", "production") # user <- c("mdrake", "rsaporta") # # qCanRead(tbl=tbl, user=user, schema=schema) # makeProperColName <- function(tbl, col, AS.prefix=tbl, AS.suffix=NULL, sep="_", verbose=FALSE) { ## end a column name in ' AS' and the alias name will automatically ## be created ## All other values will not be postpended. ## Note that this allows you to manually determine alias by ## simply filling in the value after the " AS" if (!is.null(AS.suffix) && missing(AS.prefix)) AS.prefix <- NULL ## append the sep dot, prior to the paste0 so that no extra sep's present if (!is.null(AS.prefix)) AS.prefix <- paste0(AS.prefix, sep) if (!is.null(AS.suffix)) AS.suffix <- paste0(sep, AS.suffix) if (verbose) cat("\n\tsuffix is ", AS.suffix, "\n\tprefix is ", AS.prefix, "\n\n") repl <- paste0("\\1\\2"," ", AS.prefix, "\\1", AS.suffix) col <- gsub("(.+)( AS)$", repl, col, perl=TRUE) ## < if needed > # noAlias <- !grepl(" AS ", col) # col[noAlias] <- paste0(col[noAlias], " AS ", col[noAlias]) paste0(tbl, ".", col) } ### SPECIFIC TO ORCH getGenresForAllupcs <- function(id.col.AS="upc", dontExecute.justReturnQry=FALSE, verbose=TRUE, verbose.max.width=98L+(200*dontExecute.justReturnQry)) { getReleaseDates(values=NULL, id.col="releaseId", id.col.AS=id.col.AS, minimal=TRUE , dontExecute.justReturnQry=dontExecute.justReturnQry, verbose=verbose) } getReleaseDates <- function(values, id.col="releaseId", id.col.AS=id.col , numericValues=FALSE, sep="__", origin="1970-01-01" , genre=TRUE , dontExecute.justReturnQry=FALSE, verbose=TRUE, verbose.max.width=98L+(200*dontExecute.justReturnQry) , minimal=is.null(values)) { force (minimal) if (length(genre) && !is.logical(genre)) stop ("genre should be a logical value") if (!isTRUE(genre)) # treat NULL / NA as FALSE genre <- FALSE quotes <- ifelse(numericValues, "", "\'") ## DROP NA's if (!is.null(values)) values <- unique(removeNA(values)) cols.rel <- c( paste(id.col, "AS", id.col.AS) , "releaseName AS 'release'", "releaseDate" , "artistId AS artistId" , "mkt_priority", "product_type_id" ) ## Some additional columns to include if (!minimal) cols.rel <- c(cols.rel, "vendor_catalog_number", "imprint" , "sale_start_date", "original_release_date" , "deletions", "manufacturer_upc", "version" , "subaccountId", "display_upc", "vendor_release_identifier" , "date_added AS", "last_updated AS", "date_created AS") cols.art <- c("artistName AS artist", "last_updated AS", "date_created AS") cols.label <- c("labelName AS label", "labelId", "priority AS label_priority") cols.genre <- c("genreName AS genre") cols.rel <- makeProperColName("R", cols.rel, AS.suffix="rel", verbose=FALSE, sep=sep) cols.art <- makeProperColName("A", cols.art, AS.suffix="art", verbose=FALSE, sep=sep) cols.label <- makeProperColName("L", cols.label, AS.suffix="label", verbose=FALSE, sep=sep) cols.genre <- makeProperColName("G", cols.genre, AS.suffix="genre", verbose=FALSE, sep=sep) ## IF adding columns from new tables, ## (a) append `select.what` and (ba) append the table name in the joins select.what <- c(cols.rel, cols.art, cols.label) if (genre) select.what <- c(select.what, cols.genre) if (minimal) { ## Drop meta-data dates select.what <- select.what[!grepl("created|updated|added", select.what)] ## Drop any foreign keys select.what <- select.what[!(grepl("Id$", select.what) & !grepl(paste0("AS ", id.col.AS, "$"), select.what))] } ## ------------ THE QUERY ------------ # Q <- paste( "SELECT ", paste(select.what, collapse=", ") , ", C1.country_code AS artist_country" , ", C2.country_code AS label_country" , "FROM dim_release R" , "LEFT JOIN dim_artist A ON R.artistId = A.artistId" , "LEFT JOIN dim_label L ON R.labelId = L.labelId" , "LEFT JOIN dim_country C1 ON C1.countryId = A.countryId" , "LEFT JOIN dim_country C2 ON C2.countryId = L.countryId" , if (genre) "LEFT JOIN dim_genre G ON R.genreId = G.genreId" , if (!is.null(values)) paste("WHERE", paste0("R.", id.col), "in", pasteQ(values, q=quotes)) # , "ORDER BY artistName" , sep=" " ) ## ------------ THE QUERY ------------ # ## Optionally, just output the Query if (dontExecute.justReturnQry) { if (verbose) cat("\n", verboseQry(Q, max.lines=35L, max.width=verbose.max.width, indentOr=TRUE), "\n", sep="") return(invisible(Q)) } ## Try to detach RPostgreSQL ## ------------------------------ ## try(dbDisconnect(con), silent=TRUE) try(detach(package:RPostgreSQL), silent=TRUE) require(RMySQL) ## ------------------------------ ## DT.releaseDates <- runQry(qry=Q, connex=getDB(drv.str="MySQL"), verbose.shortCircuit=FALSE) ## WRAPPING IN TRY SO AS TO NOT KILL THE WHOLE RUN IF FAILED succesfulRun <- FALSE try({ cleanReleaseDatesDT_(DT.releaseDates, minimal=minimal) succesfulRun <- TRUE }) if (!succesfulRun) warning("Qry was successful but this function failed at the point of cleaning the column types.\nPlease manually check") return(DT.releaseDates) } cleanReleaseDatesDT_ <- function(DT.releaseDates, id.col.AS=ifelse("upc" %in% names(DT.releaseDates), "upc", "releaseId") , minimal=FALSE , origin="1970-01-01" ,failOnMissingCols=!minimal, showWarnings=!minimal, verbose=FALSE) { idCols <- c( id.col.AS, "artistId", "product_type_id" , "subaccountId", "manufacturer_upc", "display_upc" , "vendor_release_identifier", "vendor_catalog_number") stringCols <- c( "artist", "release", "genre", "imprint" , "mkt_priority" , "artist_country", "label_country" , "version", "deletions" ) integerCols <- NULL dateCols <- c("releaseDate", "sale_start_date", "original_release_date") posixCols <- c("date_added__rel", "last_updated__rel", "date_created__rel" , "last_updated__art", "date_created__art") ## WRAPPING IN TRY SO AS TO NOT KILL THE WHOLE RUN IF FAILED fixColTypes_ (DT.releaseDates, character=stringCols, idcol=idCols , integer=integerCols, numeric=NULL, Date=dateCols , verbose=verbose, origin=origin , failOnMissingCols=failOnMissingCols, showWarnings=showWarnings) setattr(DT.releaseDates, "ReleaseDatesCleaned", TRUE) return(invisible(DT.releaseDates)) } infinitDBNotWorking.metas <- function(DT.nm) { # This is for use in TryCatch # error=function(e) {infinitDBNotWorking.metas("Some.DT.nm")} # where `Some.DT.nm` is probably `DB.Meta` or `DB.all.meta` fileToImport <- as.path(srcDir, "data_to_src", paste0(DT.nm, ".ManualExport.csv")) if (!file.exists(fileToImport)) stop("\nCould not fiind file '", fileToImport, "'\n") ## ELSE DT <- fread(fileToImport, colClass="character", na.strings=c("NA", "NULL")) cleanReleaseDatesDT_ (DT, "upc", minimal=TRUE, verbose=TRUE) return(setkey(DT, "upc")) } cleanGenderColumn_ <- function(DT, by.col, gender.col="gender", convert.to.factor=TRUE, allow.by.col.to.be.null=FALSE, verbose=TRUE) { ## The assumption is that ## Cleans up the gender.col by by.cols: ## It makes all values equal to the first value in the group, rather the lowercase version of it. ## If there are no non-blank values, then it is converted to NA. ## ## convert.to.factor : If TRUE, will convert to factors with levels (M, F, NA) # ## EXAMPLE WITH SAMPLE DATA # set.seed(1); N <- 30; # DT.Sample <- data.table(AA=sample(c("B", "E"), N, TRUE), BB=sample(c("C", "D"), N, TRUE), gender=sample(c("F", "M", "f", "m", "", "hello"), N, TRUE)) # by.col <- c("AA", "BB") # DT.Sample[, unique(gender), by=by.col] # cleanGenderColumn_(DT.Sample, by=by.col) ## Check input if (!length(gender.col) == 1L || !is.character(gender.col)) stop("'gender.col' should be a character vector of length exactly 1.") ## Check that by.col is valid. Especially, if NULL, this should be allowed. if(is.null(by.col)) { if (!allow.by.col.to.be.null) stop("by.col is NULL. This will cause the entire DT to have a single value for the gender.col. To allow this, use flag:\n 'allow.by.col.to.be.null=TRUE'") } else { ## If NOT NULL, check that it is a valid column if (!all(by.col %in% names(DT))) stop("The following 'by.col' values are not in names(DT): \n ", pasteQ(setdiff(by.col, names(DT)), wrap="")) } ## Check if the gender.col is an actual column of DT. (might not be. No need to fail.) if (!(gender.col %in% names(DT))) { verboseMsg(verbose, sprintf("There was no column named '%s' in '%s'", gender.col, capture.output(substitute(DT)))) } else { ## Proceed... verboseMsg(verbose, sprintf("Cleaning column '%s' by %s in '%s'", gender.col, pasteQ(by.col), capture.output(substitute(DT)))) ## THIS LINE IS THE ACTUAL CLEANING DT[, c(gender.col) := { .gcol <- get(gender.col); ## filter to only non-blank values; take the first element; take the first char; convert to upper. ## ## note: Deliberately using single brackets for [1L] which will return NA when X[X!=""] is 'character(0)' ## In other words, if X is all blanks, we will get a value of NA, which is what we want toupper(substr(.gcol[.gcol != ""][1L], 1, 1)) } , by=by.col ] ## Make factor if flagged if(convert.to.factor) DT[, c(gender.col) := factor(get(gender.col), levels=c("M", "F"))] } return(invisible(DT)) }