# ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- # # -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- # # # # File Name : get_dim_x.r # # Last Updated Funclist : 16 Feb 2015, 1:54 AM (Monday) # # # # Author Name : Rick Saporta # # Author Email : RSaporta@TheOrchard.com # # Author URL : www.github.com/rsaporta # # # # Packages Called : NA # # Packages Used via NS : NA # # # # -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- # # # # get_dim_x ( x, key=NULL, tbl=paste0(gsub("^DT\\.", "", x), "_view"), schema="bi" # # , refresh=(.Pfm != "Darwin"), return.name=FALSE, assign.to.envir=TRUE # # , envir=parent.frame(), verbose=FALSE # # , cluster=getOption("db.defaultcluster.in"), ... ) # # get_dim_store ( refresh=(.Pfm != "Darwin"), x="DT.stores", assign.to.envir=TRUE # # , envir=parent.frame(), key=c("storeid", "store_name"), verbose=FALSE # # , dontChangeFullShort=FALSE, cluster=getOption("db.defaultcluster.in"), ... ) # # get_dim_country ( refresh=(.Pfm != "Darwin"), x="DT.country", assign.to.envir=TRUE # # , envir=parent.frame(), key=c("country_code"), verbose=FALSE # # , cluster=getOption("db.defaultcluster.in"), ... ) # # get_dim_period ( refresh=(.Pfm != "Darwin"), x="DT.periods", assign.to.envir=TRUE # # , envir=parent.frame(), key=c("periodid"), verbose=FALSE # # , cluster=getOption("db.defaultcluster.in"), ... ) # # get_dim_transacs ( refresh=(.Pfm != "Darwin"), x="DT.transacs", assign.to.envir=TRUE # # , envir=parent.frame() # # , key=c("transac_typeid", "transac_type_abbr"), verbose=FALSE # # , cluster=getOption("db.defaultcluster.in"), ... ) # # get_dim_transac ( refresh=FALSE, cluster=getOption("db.defaultcluster.in"), ... ) # # get_dim_.REFRESH_ALL_AND_SAVE ( use.CurrentProject=FALSE, envir=globalenv(), verbose=TRUE # # , dontRefresh.on.local=TRUE, cluster=getOption("db.defaultcluster.in") ) # # get_DT.EU ( DT.country=get_dim_country(assign=FALSE, refresh=FALSE) # # , EU.country_codes=c("AT", "CH", "DE", "ES", "FR", "GB", "IT", "NL", "BE", "LU", "SE", c("DK", "FI", "NO", "SE")) # , EU.region_groups=c("UK", "France", "Spain", "Italy", "Sweden", "Scandinavia", "GSA", "BeNeLux"), assign.to.envir=TRUE # # , refresh=TRUE, envir=parent.frame() ) # # get_DT.exchangerates ( assign.to="DT.exchangerates", minDate=NULL, maxDate=NULL, dropPeriodCols=TRUE # # , envir=globalenv() ) # # # # # # # # -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- # # ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- # ## get_dim_x.r ## TODO 2015-01-27 :: (1) Cleanup get_dim_x // country, where region_group is hardcoded sloppily ## TODO 2015-01-27 :: (2) Give option for store, country, etc to set as factors with preset orders get_dim_x <- function(x , key=NULL , tbl=paste0(gsub("^DT\\.", "", x), "_view") , whereIn=NULL , refresh=(.Pfm != "Darwin") , upc_to_idcol=FALSE , return.name=FALSE , assign.to.envir=!is.null(envir) , envir=parent.frame() , con=giveMeACon() , cluster = getOption("db.defaultcluster") , wh=getSnowflakeWH() , dbname=getSnowflakeDB() , schema="bi" , snowflake_inuse=getOption("snowflake_inuse", TRUE) , verbose=FALSE , ... ) { ## ... :: Additional arguments for specific modifications to DTs if (!exists("srcDir")) stop("srcDir does not exist.\nHINT:\n setScience('TableBasics', subl=FALSE, quiet=TRUE)") ## Assign any additional ... arguments (for specific DT modificaiton) for (arg in names(list(...))) { ## local assignment assign(arg, list(...)[[arg]]) } local.envir <- environment() load.envir <- if (assign.to.envir) envir else local.envir ## If the table exists, check that all values of the whereIn filter are in the DT ## Note that if any of the names(whereIn) is not a name in tmp.DT then a ## refresh will be forced. The logic here is that there is no ## way to know if the filter was hit if (!refresh && !is.null(whereIn) && exists(x, envir=load.envir)) { tmp.DT <- get(x, envir=load.envir) for (nm in names(whereIn)) ## the check on refresh is to speed things up if already determined FALSE if (!refresh && any(whereIn[[nm]] %ni% tmp.DT[[nm]])) refresh <- TRUE if (isTRUE(refresh)) message("will refresh ", x, " since the filters are not satisfied with current ", x) } if (.Pfm == "Darwin" && refresh) { warning ("Cannot refresh from the local computer. Will NOT loadFromJesus if present. (TODO)", call.=FALSE) ## TODO: Load from jesus .. checking first srcDir, then TableBasics refresh <- FALSE } if (!refresh) { ## REMINDER: If this fails it might be because a new dim table was added. Call get_dim_.REFRESH_ALL_AND_SAVE() if (!exists(x, envir=load.envir)) loadFromJesus(x, src=srcOther("TableBasics", path=srcDir), over=TRUE, verbose=FALSE, envir=load.envir) ret <- get(x, envir=load.envir) if (!is.data.table(ret)) warning("There is an object '", x, "' in the envir ", capture.output(load.envir), "\nHowever this object is NOT a data.table\n\nHINT: use refresh=TRUE or manually remove it using rm(", x, ")") else setkeyv(ret, key) ## ELSE: Requery } else { QRY <- makeQry(tbl=tbl, schema=schema, colsToPull="*", whereIn=whereIn, limit=NULL, aggFunc=NULL, expandStar=FALSE, snowflake_inuse=snowflake_inuse) ret <- runQry(QRY, verbose=verbose, results.not.expected=FALSE, cluster=cluster, con=con, wh=wh, dbname=dbname, snowflake_inuse=snowflake_inuse, msg_sf=FALSE, verbose.max.width=100, verbose.key=FALSE) ## SPECIFIC TABLE MODIFICATIONS ## if (x == "DT.transacs") { dict.trans_short <- getDict("dict.trans_short") ret[, transac_type_short := {short <- transac_type; for (nm in names(dict.trans_short)) short <- gsub(nm, dict.trans_short[[nm]], short); short }] } else if (x == "DT.stores") { if (!dontChangeFullShort && all(c("store_name", "store_name_full") %in% names(ret))) { setnames(ret, "store_name", "store_name_short") setnames(ret, "store_name_full", "store_name") } } else if (x == "DT.labels") { if ("label_sc_group" %in% names(ret)) { ## add logical "is_red" field ret[, label_is_red := label_sc_group == "RED"] ## reorder (names(ret) == "label_sc_group") %>% which %>% seq.int %>% {names(ret)[.]} %>% c("label_is_red") %>% setcolorderpt(x=ret, start=.) } } else if (x == "DT.country") { group_order <- get_region_group_ordering() if ("region_group" %in% names(ret)) { ret[, region_group := setFactorOrder(region_group, ordering=group_order, last="ROW", showWarnings=FALSE)] } else { ## Add the old region_group warning ("2015-09-15 The region_groups used in this part of get_dim_x() are very outdated\n\nFind the store_view file and mimic that", call.=FALSE) ret[country_code %in% c("SE", "NO", "DK", "FI"), region_group := "Scandinavia"] ret[country_code %in% c("BE", "NL", "LU"), region_group := "BeNeLux"] ret[country_code %in% c("DE", "CH", "AT"), region_group := "GSA"] ret[country_code %in% c("GB", "ES", "FR", "IT", "IE"), region_group := "Western Europe"] ret[country_code %in% c("AR", "BR", "MX", "UY", "CO", "CL"), region_group := "Latin America"] ret[country_code %in% c("PH", "SG", "TW", "HK", "MY"), region_group := "Asia"] ret[country_code %in% c("HR", "RO", "RS", "ME", "AL", "BA", "SI"), region_group := "Balkans"] ret[country_code %in% c("US", "CA"), region_group := "North America"] ret[country_code %in% c("AU", "NZ"), region_group := "Australia"] ret[, region_group := factor(region_group, levels=group_order)] ret[, region_group := setFactorOrder(region_group, ordering=group_order, last="ROW")] } ## There is an issue where the string "NA" is being treated as NA; This might be due to the querying ret[country_name == "Namibia", country_code := "NA"] } if (upc_to_idcol) { if ("upc" %in% names(ret)) ret[, upc := as.idcol(upc) ] if ("releaseid" %in% names(ret)) ret[, releaseid := as.idcol(releaseid) ] } setkeyv(ret, key) if (assign.to.envir) assign(x, ret, envir=envir) } ## Sometimes when loading from disk, data.table may need to be corrected if (truelength(ret) == 0) setDT(ret) if (return.name) return(x) ## ELSE return(invisible(ret)) } get_dim_store <- function( refresh=(.Pfm != "Darwin") , x="DT.stores" , whereIn=NULL , assign.to.envir=TRUE , envir=parent.frame() , key=c("storeid", "store_name") , dontChangeFullShort=FALSE , cluster = getOption("db.defaultcluster.in") , wh=getSnowflakeWH() , dbname=getSnowflakeDB() , snowflake_inuse=getOption("snowflake_inuse", FALSE) , verbose=FALSE , ... ) { ## On 20141120 I changed the traditional store_name to store_name_full and store_name_short to store_name ## This is useful for chartio. ## However, there are still many joins that rely on store_name in DT.stores. ## TODO: Figure out a way to clean this in the chartio tables without messing up the store_view ARGS <- collectArgs() tbl <- "store_view" schema <- "bi" do.call(get_dim_x, c(ARGS, tbl=tbl, schema=schema)) } get_dim_label <- function( refresh=(.Pfm != "Darwin") , x="DT.labels" , whereIn=NULL , assign.to.envir=TRUE , envir=parent.frame() , key=c("labelid", "label_name") , dontChangeFullShort=FALSE , cluster = getOption("db.defaultcluster.in") , wh=getSnowflakeWH() , dbname=getSnowflakeDB() , snowflake_inuse=getOption("snowflake_inuse", FALSE) , verbose=FALSE , ... ) { ## On 20141120 I changed the traditional label_name to label_name_full and label_name_short to label_name ## This is useful for chartio. ## However, there are still many joins that rely on label_name in DT.labels. ## TODO: Figure out a way to clean this in the chartio tables without messing up the label_view ARGS <- collectArgs() tbl <- "label_view" schema <- "bi" do.call(get_dim_x, c(ARGS, tbl=tbl, schema=schema)) } get_dim_release <- function( refresh=(.Pfm != "Darwin") , x="DT.releases" , whereIn=NULL , assign.to.envir=TRUE , envir=parent.frame() , key=c("releaseid", "release_name") , dontChangeFullShort=FALSE , cluster = getOption("db.defaultcluster.in") , wh=getSnowflakeWH() , dbname=getSnowflakeDB() , snowflake_inuse=getOption("snowflake_inuse", FALSE) , verbose=FALSE , ... ) { ARGS <- collectArgs() # tbl <- "release_view" ## old as of 2015-10-13 tbl <- "release_with_metadata_view" schema <- "bi" do.call(get_dim_x, c(ARGS, tbl=tbl, schema=schema)) } get_dim_artist <- function( refresh=(.Pfm != "Darwin") , x="DT.artists" , whereIn=NULL , assign.to.envir=TRUE , envir=parent.frame() , key=c("artistid", "artist_name") , dontChangeFullShort=FALSE , cluster = getOption("db.defaultcluster.in") , wh=getSnowflakeWH() , dbname=getSnowflakeDB() , snowflake_inuse=getOption("snowflake_inuse", FALSE) , verbose=FALSE , ... ) { ARGS <- collectArgs() tbl <- "artist_view" schema <- "bi" do.call(get_dim_x, c(ARGS, tbl=tbl, schema=schema)) } get_dim_country <- function( refresh=(.Pfm != "Darwin") , x="DT.country" , whereIn=NULL , assign.to.envir=TRUE , envir=parent.frame() , key=c("country_code") , cluster = getOption("db.defaultcluster.in") , wh=getSnowflakeWH() , dbname=getSnowflakeDB() , snowflake_inuse=getOption("snowflake_inuse", FALSE) , verbose=FALSE , ... ) { ARGS <- collectArgs() tbl <- "country_view" schema <- "bi" do.call(get_dim_x, c(ARGS, tbl=tbl, schema=schema)) } get_dim_track <- function( refresh=(.Pfm != "Darwin") , x="DT.tracks" , whereIn=NULL , assign.to.envir=TRUE , envir=parent.frame() , track_unique_id_included=TRUE , key=c("trackid") , cluster = getOption("db.defaultcluster.in") , wh=getSnowflakeWH() , dbname=getSnowflakeDB() , snowflake_inuse=getOption("snowflake_inuse", FALSE) , verbose=FALSE , ... ) { if (track_unique_id_included) { warning("track_unique_id_included has no effect. use get_dim_track_with_tuid() instead") rm(track_unique_id_included) } ARGS <- collectArgs() tbl <- "track_view" schema <- "bi" do.call(get_dim_x, c(ARGS, tbl=tbl, schema=schema)) } get_dim_track_with_tuid <- function( refresh=(.Pfm != "Darwin") , x="DT.tracks_with_tuid" , whereIn=NULL , assign.to.envir=TRUE , envir=parent.frame() , key=c("trackid", "track_unique_id") , cluster = getOption("db.defaultcluster.in") , wh=getSnowflakeWH() , dbname=getSnowflakeDB() , snowflake_inuse=getOption("snowflake_inuse", FALSE) , verbose=FALSE , ... ) { ARGS <- collectArgs() tbl <- "track_view" schema <- "bi" do.call(get_dim_x, c(ARGS, tbl=tbl, schema=schema)) } get_dim_period <- function( refresh=(.Pfm != "Darwin") , x="DT.periods" , whereIn=NULL , assign.to.envir=TRUE , envir=parent.frame() , key=c("periodid") , cluster = getOption("db.defaultcluster.in") , wh=getSnowflakeWH() , dbname=getSnowflakeDB() , snowflake_inuse=getOption("snowflake_inuse", FALSE) , verbose=FALSE , ... ) { ARGS <- collectArgs() tbl <- "period_view" schema <- "bi" do.call(get_dim_x, c(ARGS, tbl=tbl, schema=schema)) } get_dim_transacs <- function( refresh=(.Pfm != "Darwin") , x="DT.transacs" , whereIn=NULL , assign.to.envir=TRUE , envir=parent.frame() , key=c("transac_typeid", "transac_type_abbr") , cluster = getOption("db.defaultcluster.in") , wh=getSnowflakeWH() , dbname=getSnowflakeDB() , snowflake_inuse=getOption("snowflake_inuse", FALSE) , verbose=FALSE , ... ) { ARGS <- collectArgs() tbl <- "transactiontype_view" schema <- "bi" do.call(get_dim_x, c(ARGS, tbl=tbl, schema=schema)) } get_dim_isrc <- function( refresh=(.Pfm != "Darwin") , x="DT.isrcs" , whereIn=NULL , upc_to_idcol=FALSE , assign.to.envir=TRUE , envir=parent.frame() , key=c("isrc") , cluster = getOption("db.defaultcluster.in") , wh=getSnowflakeWH() , dbname=getSnowflakeDB() , snowflake_inuse=getOption("snowflake_inuse", FALSE) , verbose=FALSE , ... ) { ARGS <- collectArgs() tbl <- "dim_isrc" schema <- "production" do.call(get_dim_x, c(ARGS, tbl=tbl, schema=schema)) } ## TO RUN THE REFRESH SOURCE THIS FILE: ## source("~/git/orch/src/TableBasics/00 REFRESH_ALL TableBasics.r") ## If there is a porject set, it will save to that project ## Otherwise, it will save to project TableBasics get_dim_.REFRESH_ALL_AND_SAVE <- function(use.CurrentProject=FALSE, envir=globalenv(), dontRefresh.on.local=TRUE, force.save=FALSE, con=giveMeACon(snowflake_inuse=snowflake_inuse), cluster = getOption("db.defaultcluster") , wh=getSnowflakeWH() , dbname=getSnowflakeDB() , snowflake_inuse=getOption("snowflake_inuse", FALSE) , verbose=FALSE) { if (missing(con)) { force(snowflake_inuse) con <- giveMeACon(snowflake_inuse=snowflake_inuse) } ## Error check on use.CurrentProject if (!nchar(getProjName())) { if (use.CurrentProject) stop ("No project currently set to save to.\nHINT: Either set use.CurrentProject=FALSED or call setScience()") if (!use.CurrentProject) stop ("A project still must be set, even if use.CurrentProject (it's needed for srcOther())\nHINT:\n setScience('TableBasics', subl=FALSE, quiet=TRUE)") } not.using <- c("get_dim_.REFRESH_ALL_AND_SAVE", "get_dim_x", "get_dim_transac") funcs <- lsos("^get_(dim|DT)", type="function", functions.returned.normally=TRUE)[["Name"]] funcs <- setdiff(funcs, not.using) funcs <- rev(funcs) ## dont refresh if both of these are TRUE refresh <- (!(dontRefresh.on.local && getPfm() == "Darwin")) ret <- lapply(funcs, function(x) { verboseMsg(verbose, "Running ", x, "()", simple=TRUE, endl=1) # args <- list(refresh=refresh, return.name=TRUE, envir=envir, assign.to.envir=TRUE) # do.call(x, args=args) if (isConExpired(con)) con <- giveMeACon() tryCatch(match.fun(x)(refresh=refresh, return.name=TRUE, envir=envir, con=con, assign.to.envir=TRUE, verbose=FALSE) , error = function(e) NULL ) %>% removeNullsFromList }) # DT.EU <- get_DT.EU(refresh=refresh, envir=envir) # ret <- c(ret, "DT.EU") ## Save, only if we had previously refreshed. if (refresh || force.save) { dir <- jesusForData(objNames=ret, envir=envir, projName=ifelse(use.CurrentProject, getProjName(), "TableBasics"), sub=timeStamp("get_dim.refreshed"), verbose=TRUE) message("Locally, remember to run \n bringmeFolder('", dir$dir, "')\n" ) } return(unlist(ret)) } get_DT.EU <- function(DT.country=get_dim_country(assign=FALSE, refresh=FALSE) , EU.country_codes = c("AT", "CH", "DE", "ES", "FR", "GB", "IT", "NL", "BE", "LU", "SE", c("DK", "FI", "NO", "SE")) , EU.region_groups = c("UK", "France", "Spain", "Italy", "Sweden", "Scandinavia", "GSA", "BeNeLux") , assign.to.envir=TRUE , refresh = TRUE , return.name = FALSE , envir=parent.frame() , verbose=TRUE , con="Not Used in get_DT.EU" ) { ## refresh :: an unused argument for now EU.country_codes <- unique(EU.country_codes) EU.region_groups <- unique(EU.region_groups) DT.EU <- copy(DT.country[, list(country_code, country_name)]) setkeyIfNot(DT.EU, country_code, verbose=FALSE) DT.EU <- DT.EU[.(EU.country_codes)] setkeyIfNot(DT.EU, country_code, verbose=FALSE) DT.EU[country_name %in% EU.region_groups, region_group := country_name] DT.EU[.(c("DE", "CH", "AT")), region_group := "GSA"] DT.EU[.(c("BE", "NL", "LU")), region_group := "BeNeLux"] DT.EU[.(c("DK", "FI", "NO", "SE")), region_group := "Scandinavia"] DT.EU[.(c("GB")), region_group := "UK"] if (any(is.na(DT.EU[["region_group"]]))) warning ("some NAs remain in DT.EU") if (assign.to.envir) assign("DT.EU", DT.EU, envir=envir) if (return.name) return("DT.EU") return(DT.EU) } get_DT.exchangerates <- function(assign.to.envir=TRUE, refresh=getPfm() == "Linux", minDate=NULL, maxDate=NULL, dropPeriodCols=TRUE, envir=globalenv(), return.name=FALSE, con=giveMeACon(), verbose.qry=FALSE, verbose=FALSE) { if (refresh) { q <- makeQry(tbl="exchange_rates_from_mikeb", schema="bi", colsToPull="*", dateCol="accountingperiodid", aggFunc=NULL, minDate=minDate, maxDate=maxDate, limit=NULL) DT.exchangerates <- runQry(q, con=con, verbose=verbose.qry, verbose.max.width=100, verbose.key=FALSE) } else { loadFromJesus("DT.exchangerates", srcDir=srcOther("Currency_Exchange_Rates"), over=TRUE) } addDateCols.periodid_(DT.exchangerates, dropPeriodCols=dropPeriodCols, repl.for.nm="_month", showWarnings=FALSE) ## TODO: Fill the NAs if (any(is.na(DT.exchangerates$currency_rate))) warning("There are NAs in currency_rate") if (assign.to.envir) assign("DT.exchangerates", DT.exchangerates, envir=envir) if (return.name) return("DT.exchangerates") return(invisible(DT.exchangerates)) }