# 03 Cleanup of DB data.r # GIVEN DB.raw STOP.FOR.DUP.ROWS <- TRUE foreignThresh <- 0.005 # ----------------------- # ## TODO: # (1) CHECK PROMO CODE -- What is C? # (2) What is attributable_purchase ? # (3) What is the diff between vendor_identifier & vendor_offer_code ? { cls() # ------------------------------------------- # # IDENTIFY COLUMNS # # ------------------------------------------- # # ------------------------------------------- # cat(" ~~~~~ BEFORE ~~~~~ \n") are(DB.raw) ## THESE COLUMNS ARE BEING DROPPED royaltyCols <- grep("royalty", names(DB.raw), ignore.case=TRUE, value=TRUE) # ----------------------------- # dateCols <- getDateColNames(DB.raw) # c("download_date") idcols <- c("vendor_identifier", "vendor_offer_code", "upc", "isrc", "artist", "title", "record_company", "product_type_identifier") salescols <- c( "units", "customer_price", "sale_return" ) # Customer & Order cols customercols <- c( "postal_code", "order_id", "promo_code", "country_code", "customer_identifier", "promo_code" ) currencyCols <- c("customer_currency", "royalty_currency") dontKnow.cols <- c("parent_id", "isan") ## THESE COLUMNS ARE BEING IGNORED FOR NOW # -------------------------------------- # ignoreTheseForNow <- c("primary_genre", "attributable_purchase", "belongs_to_ioda", "cma", "asset", "grid") royaltyCols <- grep("royalty", names(DB.raw), ignore.case=TRUE, value=TRUE) otherDroppedCols <- c("season_pass", "preorder", "vendor_offer_code") # -------------------------------------- # droppedCols <- c(otherDroppedCols, currencyCols, ignoreTheseForNow, royaltyCols) ALLCOLS <- c(idcols, dateCols, salescols, customercols, currencyCols, dontKnow.cols) unusedCols <- setdiff(names(DB.raw), c(ALLCOLS, droppedCols)) missingCols <- setdiff(c(ALLCOLS, droppedCols), names(DB.raw)) if (length(unusedCols)) warning("\nThe following cols are not being used:\n", paste_l(unusedCols, preline="\t", sameWidth=FALSE, eol=TRUE, spacer=", "), "\n") if (length(missingCols)) warning("\nThe following cols are missing (not in DB.raw but are in a col group):\n", paste_l(missingCols, preline="\t", sameWidth=FALSE, eol=TRUE, spacer=", "), "\n") # ------------------------------------------- # ## MISSING DATA DB.raw[vendor_identifier=="", vendor_identifier := paste0(vendor_offer_code, "_MISSING_vID")] # ------------------------------------------- # # CLEAN COLUMNS # # ------------------------------------------- # # ------------------------------------------- # ## `sale_return` to factor with easier levels. ## On the NBS DB there was a third level (cannot recall right now) ## The extra if section is to capture any additional such levels SR_levs <- c("S", "R") SR_labels <- c("Sale", "Return") if (length({.tmp <- setdiff(DB.raw[["sale_return"]], SR_levs)})) { warning("Addition SR Levels: ", paste(.tmp, collapse=", ")) SR_levs <- c(SR_levs, .tmp) .tmp <- ifelse(.tmp %in% c(SR_labels), .tmp, paste0(.tmp, "_", seq_along(.tmp))) SR_labels <- c(SR_labels, .tmp) rm(.tmp) } DB.raw[, sale_return := factor(sale_return, levels=SR_levs, labels=SR_labels) ] if (anyDuplicated(levels(DB.raw[["sale_return"]]))) DB.raw[, sale_return := factor(sale_return, levels=unique(levels(sale_return)))]# := factor(sale_return, levels=SR_levs, labels=SR_labels) ] ### TODO: make a function out of above (eg "expectedLevels") ## Product Type DB.raw[, product := factor(product_type_identifier, levels=c("H", "I"), labels=c("Track", "Album"))] ## Promo_code to factor DB.raw[, promo_code := suppressWarnings(factor(factor(promo_code, levels=unique(c("", "C", "F", "FREE", unique(promo_code))), labels=c("NORMAL", "C (?)", "FREE", "FREE")))) ] ## Date Columns DB.raw[, (dateCols) := lapply(.SD, as.Date), .SDcols=dateCols] ## Logical Columns DB.raw[, belongs_to_ioda := (belongs_to_ioda != "N")] ## Character Columns DB.raw[, (idcols) := lapply(.SD, as.character), .SDcols=idcols] ## Numeric Columns numeric.cols <- c("royalty_price", "customer_price", "units") allPossibleNumerics <- nwhich(DB.raw[, lapply(.SD, isNumberAll, ignore.general=TRUE)]) explicitlyNonNumeric <- c("upc", "order_id", "customer_identifier") # these guys I know I dont want as numeric. if (length(addl.num.cols <- setdiff(allPossibleNumerics, c(numeric.cols, explicitlyNonNumeric) ))) warning(warningCols("Additional Possible Numeric Columns:",addl.num.cols)) DB.raw[, (numeric.cols) := lapply(.SD, as.numeric), .SDcols=numeric.cols] ## Fix parent_id / vendor_offer_code offset DB.raw[trunc(log(as.num.nowarn(vendor_offer_code), 10))==5 & parent_id=="" , c("parent_id", "vendor_offer_code") := list(vendor_offer_code, NA_character_)] ## CLEAN THE TITLE, TAKING THE LONGEST DB.raw[, title := title[which.max(nchar(title))], by=list(upc=as.character(upc), isrc, vendor_identifier, artist)] ## DROP FOREIGN CURRENCTY foreign <- DB.raw[["customer_currency"]] != "USD" if ( {f.rows <- nrow(DB.raw[foreign]) / nrow(DB.raw)} < foreignThresh && {f.units <- sum(DB.raw[foreign][["units"]]) / sum(DB.raw[["units"]])} < foreignThresh && {f.orders <- lunique(DB.raw[foreign][["order_id"]]) / lunique(DB.raw[["order_id"]])} < foreignThresh && f.rows != 0 ) { cat("Foreign-currency transactions represent\n\t ", fwp(f.orders, 3), "of orders; ", "\t ", fwp(f.units, 3), "of units; ", "\t ", fwp(f.rows, 3), "of data rows.\n") message("Dropping foreign currency rows.") DB.raw <- DB.raw[!foreign] ## Drop also currency info message("Dropping foreign currency columns ", pasteQ(currencyCols, collapse=", ")) DB.raw[, (currencyCols) := NULL] } else if (sum(foreign)){ cat("Foreign-currency transactions represent\n\t ", fwp(f.orders, 3), "of orders; ", "\t ", fwp(f.units, 3), "of units; ", "\t ", fwp(f.rows, 3), "of data rows.\n") warning("FOREIGN CURRENCY\nThere are ", sum(foreign), " rows with foreign currency, but too much value to discard.") } rm(foreign) ## MAKE RETURNS NEGATIVE invisible({ count.cols <- c("customer_price", "units") DB.raw[sale_return=="Return", c(count.cols) := .SD * (-1), .SDcols=count.cols] }) ## TODO: Distinguish between albums / tracks ## ADD NEW COLUMNS DB.raw[, wasFree := !(customer_price)] ## MANUAL DB.raw[title=="The Blower\\'s Daughter", title := "The Blower's Daughter"] # ------------------------------------------- # # DROP COLUMNS # # ------------------------------------------- # # ------------------------------------------- # ### IF THESE COLUMNS ARE ALL-BLANKS, DROP toDrop <- intersect(otherDroppedCols, names(DB.raw)) if (length(toDrop)) t(DB.raw[, setNames(obj=lapply(names(.SD), function(nm) if (all(.SD[[nm]]=="")) {DB.raw[, (nm) := NULL] ; c(dropped=TRUE)} else c(dropped=FALSE)), nm=paste0("'",toDrop, "'_was_dropped:")) , .SDcols=toDrop]) ## DROP ROYALTY COLUMNS toDrop <- intersect(royaltyCols, names(DB.raw)) if (length(toDrop)) DB.raw[, c(toDrop) := NULL] # DROP ALL OF THE DROPPING COLUMNS toDrop <- intersect(droppedCols, names(DB.raw)) if (length(toDrop)) DB.raw[, c(toDrop) := NULL] ## CHECK THAT ROWS ARE STILL UNIQUE howManyDups <- sum(duplicated(DB.raw, by=names(DB.raw))) if (howManyDups) { if (STOP.FOR.DUP.ROWS) stop ("Non Unique Rows in DB.raw") else { warning("There are ", howManyDups, " duplicate rows. Making them unique.") DB.raw <- unique(DB.raw, by=names(DB.raw)) } } # ------------------------------------------- # cat("\n ~~~~~ AFTER ~~~~~ \n") are(DB.raw) }