## This is a collection of Spotify Partners (Vodafone, etc) that can appear in the Product Code on the accounting report SpotifyPartners <- c("Telia", "SFR France Hardbundle", "SFR France Standalone", "Virgin Hard Bundle", "KPN (Dutch) Soft Bundle", "KPN (Dutch) Hard Bundle", "40", "KSA", "KSAM", "10", "OHB", "OSA", "OSAM", "DT", "DTSA", "DTSAM", "DTHB3", "100", "TSA", "TSAM", "TFSB", "ECI", "TFSA", "1", "15", "VFHB", "VFSA", "CHB", "CSA", "VFSB", "SSB", "MSHB", "MHB", "MSA", "TSB", "TL", "T3") setSpotifyProductToFactor <- function(DT, descriptionCol="product_description") { levs.product <- c("A", "P", "PD", "U", "XX", "M", "CSA", "KSB", "KHB", "T", "TFSA", "TSA", "SHB") last.product <- c("ZZ") if ("product" %in% names(DT)) { if (descriptionCol %in% names(DT)) { levs.description <- unique(DT, by=c("product", descriptionCol))[, get(descriptionCol)[match(levs.product, product)] ] last.description <- unique(DT, by=c("product", descriptionCol))[, get(descriptionCol)[match(last.product, product)] ] levs.description <- removeNA(as.character(levs.description)) last.description <- removeNA(as.character(last.description)) DT[, (descriptionCol) := setFactorOrder(get(descriptionCol), ordering=levs.description, last=last.description)] } DT[, product := setFactorOrder(product, ordering=names(dict.levs), last=names(last), showWarnings=FALSE)] } return(invisible(DT)) } getDict.SpotifyProduct <- function() { ## TODO: Make sure this order is correct c(Daypass="D", Open="O", Free="F", Limited="L", DesktopBasic="U", Premium="P") } getDict.SpotifyTier <- function () { c( Daypass = "Pay-As-You-Go", D = "Pay-As-You-Go", Open = "FreeTier", O = "FreeTier", Free = "FreeTier", F = "FreeTier", 'Ad funded' = "FreeTier", A = "FreeTier", # 'U' is sometimes called Limited sometimes Unlimited. # I believe it is based on what it is relative to. # eg ("Limited relative to Premium (no mobile) but Unlimited relative to Free (no restrictions, on desktop)") Limited = "LimitedTier", L = "LimitedTier", DesktopBasic = "LimitedTier", Unlimited = "LimitedTier", U = "LimitedTier", Premium = "PremiumTier", P = "PremiumTier", ## THIRD PARTY Mobile = "ThirdPartyMobile", M = "ThirdPartyMobile", ## Other third party setNames(nm=SpotifyPartners, obj=rep("VariousPartners", length(SpotifyPartners))), ## To close the trailing comma NULL ) } getDict.SpotifyAccountingProduct <- function () { ## If it doesn't exist, try loading it if (!exists("DT.spotify_product_dict")) try (loadFromJesus("DT.spotify_product_dict", srcDir=srcOther("Spotify_Accounting_ETL")), silent=TRUE) ## If the above failed and still does not exist, try looking for it in the data.p(ftp) folder if (!exists("DT.spotify_product_dict")) { f.in <- max(dir(data.p("ftp_sync"), pattern="spotify-legend-for-theorchard", full=TRUE), "") if (nchar(f.in)) DT.spotify_product_dict <- fread(f.in) } ## If it now exists, return it (with a little clean up; not sure why I was doing this ceanup) if (exists("DT.spotify_product_dict")) return(DT.spotify_product_dict[product_description %ni% c("BOKU integrated billing Premium Discount", "Premium Student Discount", "Yoigo (Telia) Standalone", "Telia Standalone v3", "Telia Softbundle v3"), setNames(nm=product, obj=product_description)]) warning ("Full DT.spotify_product_dict could not be found. Using a hardcoded partial set") ## Otherwise, use this manual version ## ELSE c( D = "Daypass", A = "Ad funded", P = "Premium", M = "Mobile", U = "Unlimited", PD = "Premium Discount", # ?? = "Mobile Discount", T = "Telia", MD = "Mobile Discount", SHB = "SFR France Hardbundle", SSA = "SFR France Standalone", VHB = "Virgin Hard Bundle", KSB = "KPN (Dutch) Soft Bundle", KHB = "KPN (Dutch) Hard Bundle" ) } cleanSpotify_ <- function(DT, gender.scrub=FALSE, posix.to.date=FALSE, showWarnings=TRUE, verbose=TRUE) { ## Extract which cols to use for gender / birthyear cleaning of blanks by.col <- matchExtract(c("userid", "customerid", "customer_identifier"), names(DT), partial=FALSE, na.rm=TRUE) ## Verbose output verboseMsg(verbose, "Beginning cleanSpotify_() with by.col = c", pasteQ(by.col, C=", ") ,time=FALSE) if (!is.data.table(DT)) stop("DT must be a data.table") ## Product needs to be converted as per the dict if ("product" %in% names(DT)) { verboseMsg(verbose, "Converting product to factor" ,time=FALSE) ## --- ## We could do the conversion as a one-liner, but we want to check that ## the conversion has not already been done (ie, calling the function twice) ## since the second time around, it will not find the right factor levels and create NA's dict.product <- getDict.SpotifyProduct() if (any(names(dict.product) %in% head(DT[["product"]],1000) )) warning ("The product column has already been converted\n") else DT [, product := makeFactorUsingDict.quick(vec=product, dict=dict.product)] ## --- ## Create product_tier, only if not already exists if ("product_tier" %ni% names(DT)) { DT.Spot.Using [, product_tier := makeFactorUsingDict(vec=product, dict=getDict.SpotifyTier(), missing_to_NA=FALSE)] ## Create a numeric equivalent of the product_tier ## We add in a decimal portion so that roundTo <- 1 + ceiling(length(levels(DT.Spot.Using$product_tier))/10) DT.Spot.Using [, product_tier_num := round(product_tier_num - 1/product_tier_num, roundTo) ] } } #SLOWS DOWN FUTURE PROCESSES: ## Customerid / userid should ***NOT*** be a factor (Slows down horribly) #SLOWS DOWN FUTURE PROCESSES: verboseMsg(verbose, "Converting customerid/userid to factor" ,time=FALSE) #SLOWS DOWN FUTURE PROCESSES: if ("customerid" %in% names(DT)) #SLOWS DOWN FUTURE PROCESSES: DT [, customerid := factor(customerid)] #SLOWS DOWN FUTURE PROCESSES: if ("userid" %in% names(DT)) #SLOWS DOWN FUTURE PROCESSES: DT [, userid := factor(userid)] #SLOWS DOWN FUTURE PROCESSES: verboseMsg(verbose, "Converting country to factor" ,time=FALSE) #SLOWS DOWN FUTURE PROCESSES: if ("country" %in% names(DT)) #SLOWS DOWN FUTURE PROCESSES: DT [, country := factor(country)] ## mobile should be logical verboseMsg(verbose, "Converting mobile column" ,time=FALSE) if ("mobile" %in% names(DT)) DT [, mobile := as.logical(mobile)] ## Convert POSIX cols to Date if (posix.to.date) { cols.posix <- names(DT)[sapply(DT[1,], is.POSIX)] if (length(cols.posix) >= 1L) verboseMsg(verbose, "Converting", length(cols.posix), "posix columns to Date" ,time=FALSE) DT[, c(cols.posix) := lapply(.SD, function(dd) as.Date(strptime(dd, format="%Y-%m-%d"))), .SDcols=cols.posix] ## Todo: now use truncDate() } ## TODO clean gender if (gender.scrub) { verboseMsg(verbose, "Cleaning gender column" ,time=FALSE) genderCol <- matchExtract("gender", names(DT)) by.col <- matchExtract(c("userid", "customerid", "customer_identifier"), names(DT), partial=FALSE, na.rm=TRUE) if (!length(by.col)) stop ("Could not find a customerid column to use as by.col in gender.scrub") if (length(by.col) > 1) stop ("Found too many customerid columns to use as by.col in gender.scrub: ", by.col) if (!length(genderCol) && showWarnings) warning("No gender column found, so could not scrub that column") if (length(genderCol) > 1 && showWarnings) warning(warningCols("The following columns will be treated as gender columns: ", genderCol, endl=0)) ## Clean for (gCol in genderCol) cleanGenderColumn_ (DT, by.col=by.col, gender.col=gCol, convert.to.factor=TRUE , allow.by.col.to.be.null=FALSE, verbose=verbose) } ## End Gender Scrub ## Clean BirthYear and Add Age if ("birthyear" %in% names(DT)) { DT[, Age := as.numeric(birthyear)] DT[is.na(Age), Age := 0] DT[, Age := max(Age, na.rm=TRUE), by=by.col] DT[Age==0, Age := NA_real_] DT[, Age := as.numeric(format(Sys.Date(), "%Y")) - Age] } return(invisible(DT)) } # ------------------------------------------------ # 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)) } # ------------------------------------------------ #