# --------------------------------------------------------------------------------------------------------------------------------------------------------- # # ------------------------------------------------------------------------------------------------------------------------------------------------------- # # # # File Name : storeid.fromname.r # # Last Updated Funclist : 16 Feb 2015, 1:56 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 # # # # ------------------------------------------------------------------------------------------------------------------------------------------------------- # # # # whichTransac ( transac, exact=FALSE # # , colToCompare=if (is.numeric(transac)) "transac_typeid" else if (nchar(transac) <= 3) "transac_type_abbr" else "transac_type" # # , DT.transacs=get_dim_transacs(refresh=FALSE, envir=parent.frame()), colsToIgnore=c() # # , includeDetails=FALSE, verbose=TRUE ) # # whichStore ( store, exact=FALSE, DT.stores=get_dim_store(refresh=FALSE, envir=parent.frame()) # # , colsToIgnore=c("is_store_itunesusa"), includeDetails=FALSE, verbose=TRUE ) # # storeid.fromname ( store_name, ..., col.in.DT.stores="store_name", dont.assign.DT.stores=FALSE # # , fail.if.not.matched=FALSE ) # # makeStoresFactor ( ... ) # # makeStoresFactor_ ( DT, storeCol="store_name" # # , storeOrder=c("iTunes", "Spotify", "YouTube", "Google Play", "Google", "Muve", "Amazon", "deezer", "rDio") ) # # makeSCFactor_ ( DT, sccol="label_sc_group", sc_order=c("Orchard", "RED", "Allegro", "SelectO", "Selecto") ) # # makeCountryCodeFactor_ ( DT, frontLevs=c("US", "GB", "SE", "DE", "FR", "ES", "MX", "BR", "CA"), tailLevs=c("ZZ") # # , col="country_code" ) # # # # # # # # ------------------------------------------------------------------------------------------------------------------------------------------------------- # # --------------------------------------------------------------------------------------------------------------------------------------------------------- # ## TODO: whichTransac is simply a copy of whichStore -- needs to be modified for the specifics of trans_type and trans_abbr whichTransac <- function(transac, exact=FALSE , colToCompare=if (is.numeric(transac)) "transac_typeid" else if (nchar(transac) <=3) "transac_type_abbr" else "transac_type" , DT.transacs = get_dim_transacs(refresh=FALSE, envir=parent.frame()) , colsToIgnore=c() ## Always ignore this one. Additionally ignore others if includeDetails = FALSE , includeDetails=FALSE , verbose=TRUE) { ## NOTE: This is mostly for interactive use. ## transacid.fromname is still useful in programs if (is.factor(transac)) transac <- as.character(transac) if (is.numeric(transac)) ret <- DT.transacs[transac_typeid %in% transac] else { if (!exact) ret <- DT.transacs[unique(sort(unlist(lapply(transac, function(s) grep(s, get(colToCompare), ignore.case=TRUE)))))] else ret <- DT.transacs[unique(sort(unlist(lapply(transac, function(s) which(s == get(colToCompare))))))] } if (!includeDetails) { colsToIgnore <- setdiff(names(DT.transacs), c("transac_typeid", "transac_type_abbr", "transac_type")) } colsToInclude <- setdiff(names(ret), colsToIgnore) if (verbose) print(ret[, colsToInclude, with=FALSE], nrow=200) return(invisible(ret)) } whichStore <- function(store, exact=FALSE , DT.stores = get_dim_store(refresh=FALSE, envir=parent.frame()) , colsToIgnore=c("is_store_itunesusa") ## Always ignore this one. Additionally ignore others if includeDetails = FALSE , includeDetails=FALSE , verbose=TRUE) { ## NOTE: This is mostly for interactive use. ## storeid.fromname is still useful in programs ## allow for the results of a quick query to be used if (is.data.table(store)) { store <- { if (store %cont% "storeid") store$storeid else if (store %cont% "store_name") store$store_name else if (length(store == 1)) store[[1]] else stop("whichStore() requires a vector or if a data.table, it must be either a single column or it must have a column named 'storeid' or 'store_name'\n'store' is a data.table but it is unknown which column you would like to interpret as the store column") } } if (is.factor(store)) store <- as.character(store) if (is.numeric(store)) ret <- DT.stores[storeid %in% store] else { if (!exact) ret <- DT.stores[unique(sort(unlist(lapply(store, function(s) grep(s, store_name, ignore.case=TRUE)))))] else ret <- DT.stores[unique(sort(unlist(lapply(store, function(s) which(s == store_name)))))] } if (!includeDetails) { colsToIgnore <- setdiff(names(DT.stores), c("storeid", "store_name", "store_name_short")) } colsToInclude <- setdiff(names(ret), colsToIgnore) if (verbose) print(ret[, colsToInclude, with=FALSE], nrow=200) return(invisible(ret)) } storeid.fromname <- function(store_name, ..., col.in.DT.stores="store_name", dont.assign.DT.stores=FALSE, fail.if.not.matched=FALSE) { ## This function differs from addStoreName.storeid_ in that it does not modify a data.frame, but simply returns a value. ## The former should use the latter dots <- unlist(list(...)) if (length(dots)) store_name <- c(store_name, dots) if (!length(store_name)) { warning("The 'store_name' argument used in storeid.fromname() has no length. Returning integer(0)") return(integer(0)) } if (any(is.na(store_name))) warning ("there are NAs in the 'store_name' argument used in storeid.fromname() ") if (!exists("DT.stores")) DT.stores <- get_dim_store(assign.to.envir=!dont.assign.DT.stores, envir=globalenv(), verbose=FALSE) if (!exists("DT.stores")) stop ("Could not find DT.stores even after calling get_dim_store()") if (col.in.DT.stores %ni% names(DT.stores)) stop ("'", col.in.DT.stores, "' is not a column name of DT.stores") ## There is a duplicate in Facebook / facebook. ## Check for these values, then remove from DT.stores if (any(grepl("faceboook", store_name, ignore.case=TRUE))) stop("'facebook' matches to more than one store in DT.stores -- ids are 597 & 800") stores.matched <- extractMatch(escapeRegEx(store_name), DT.stores[storeid != 800][[col.in.DT.stores]], showWarnings=FALSE) NAs.introduced <- is.na(stores.matched) & !is.na(store_name) if (any(NAs.introduced)) { msg <- sprintf("\nThe following values for 'store_name' could not be matched in DT.stores$%s:\n\t%s", col.in.DT.stores, commaSep(store_name[NAs.introduced])) if (fail.if.not.matched) stop(msg) else warning(msg) } ret <- setkeyIfNot(copy(DT.stores), col.in.DT.stores, verbose=FALSE)[.(stores.matched)][, storeid] setattr(ret, "names", store_name) return(ret) } ## EG: ## storeid.fromname("iTunes", "spotify", "youtube") makeStoresFactor <- function(...) { warning ("makeStoresFactor() has been deprecated. Use makeStoresFactor_ () -- with underscore") makeStoresFactor_(...) } makeStoresFactor_ <- function(DT, storeCol="store_name", storeOrder=c("iTunes", "Spotify", "YouTube", "Google Play", "Google", "Muve", "Amazon", "deezer", "rDio")) { ## Not all storeOrder will be in DT[[storeCol]] if (!is.data.table(DT)) stop ("DT must be a data.table") if (storeCol %ni% names(DT)) stop ("storeCol '", storeCol, "' is not a column of the DT") ## Preserve the key key.bak <- key(DT) ## Wrap in try to be able to put the key back try({ levs <- sort(as.character(unique(DT[[storeCol]]))) levs <- unique(c(intersect(storeOrder, levs), levs)) DT[, (storeCol) := factor(get(storeCol), levels=levs)] }) setkeyIfNot(DT, key.bak, verbose=FALSE) return(invisible(DT)) } makeSCFactor_ <- function(DT, sccol="label_sc_group", sc_order=c("Orchard", "RED", "Allegro", "SelectO", "Selecto")) { ## Not all sc_order will be in DT[[sccol]] if (!is.data.table(DT)) stop ("DT must be a data.table") if (sccol %ni% names(DT)) stop ("sccol '", sccol, "' is not a column of the DT") ## Preserve the key key.bak <- key(DT) ## Wrap in try to be able to put the key back try({ levs <- sort(as.character(unique(DT[[sccol]]))) levs <- unique(c(intersect(sc_order, levs), levs)) DT[, (sccol) := factor(get(sccol), levels=levs)] }) setkeyIfNot(DT, key.bak, verbose=FALSE) return(invisible(DT)) } makeCountryCodeFactor_ <- function(DT, frontLevs=c("US", "GB", "SE", "DE", "FR", "ES", "MX", "BR", "CA"), tailLevs=c("ZZ"), col="country_code") { if (is.factor(DT[[col]])) return(invisible(DT)) if (!is.character(DT[[col]])) warning ('col', "in DT is NOT a character, and makeCountryCodeFactor_(DT) has been called.") levs <- sort(unique(DT[[col]])) frontLevs <- intersect(frontLevs, levs) tailLevs <- intersect(tailLevs, levs) levs <- setdiff(levs, c(frontLevs, tailLevs)) levs <- c(frontLevs, levs, tailLevs) DT[, (col) := factor(get(col), levels=levs)] return(invisible((DT))) }