### THIS IS FILE IS SOMEWHAT OLD ### use: ### ### ~/git/orch/src/chartio/Store_Avgs- NEW2 (no SC group).r ### #================ Store_Avgs.r .us() .us() setDBall() lib(forecast) lib(mi) verbose.dbcon.on() N.monthsBack <- 24 plotting <- FALSE projName <- "chartio" setScience(proj="chartio", create=TRUE, subl=FALSE) ## Load files from other projects itunes_544(out='DT') #OLD: source("~/git/orch/src/chartio/itunes_544.r") loadFromJesus("DT.stores", srcDir=gsub(projName, "TableBasics", srcDir), over=TRUE) loadFromJesus("DT.transacs", srcDir=gsub(projName, "TableBasics", srcDir), over=TRUE) ## Global variabls sc_groups <- c("Orchard", "RED", "Allegro", "SelectO") cpallete.sc_groups <- c(Orchard="#ff6e0b", RED="#c43a49", Allegro="#5dc685", SelectO="#5573c6") Q.storeavg <- "SELECT storeid as store, TRUNC(accounting_date) AS Date, transac_typeid, label_sc_group, sum(units) as units, sum(gross) as gross FROM aggregated_accounting WHERE (accounting_date BETWEEN sysdate - INTERVAL '24 MONTH' AND sysdate) GROUP BY 1, 2, 3, 4 " DT.storeavg <- runQry(Q.storeavg) ## Make label_sc_group a factor, with designated ordering DT.storeavg[, label_sc_group := factor(label_sc_group, levels=sc_groups)] DT.storeavg[, GPU := gross / units] kCols <- c("store", "transac_typeid", "label_sc_group") kColsDate <- c("date", kCols) setkeyIfNot(DT.storeavg, kColsDate) setcolorderpt(DT.storeavg, kColsDate) #================ Store_Avgs- GPU Calc.r ## putting date as the last column to order by. Different from kColsDate setkeyIfNot(DT.storeavg, c(kCols, "date")) ## If there are very few gross==0 (generally, just one store), drop those. if (nrow(DT.storeavg[gross==0]) / nrow(DT.storeavg) < .001) DT.storeavg <- DT.storeavg[gross!=0] ## Get all unique dates, then we will iterate over them, in reverse order AllDates <- DT.storeavg[, seq(min(date), max(date), by="month")] DT.storeavg[!is.finite(GPU), GPU := NA] for (D in rev(AllDates) ) { DT.storeavg[date <= D & !is.na(GPU) , `:=`( GPU_Est_Fore = if (length(GPU) < 3) NA_real_ else forecast(tail(GPU, 5), 1)[["mean"]], # GPU_Est_MA = {z <- mean(tail(GPU, 3), na.rm=TRUE); if(is.na(z)) NA_real_ else z} GPU_Est_MA = mean(tail(GPU, 3), na.rm=TRUE) ) , by=kCols ] } ## TODO: Move this to separate file if (plotting) { ### --------------------------- ## PLOTTING WHICH DATES AVAILABLE lib(ggplot) suppressWarnings(rm(dat)) alphaKnown <- .55 alphaUnknown <- .40 ## --- FIND PRATO ------ ## dat2014 <- DT.storeavg[date >= "2014-01-01" & label_sc_group=="Orchard"][!is.na(gross)] pratoLimit <- .85 dat.totalgross <- dat2014[, list(gross=sum(gross)), by=store][order(gross, decreasing=TRUE)] StoresPrato.id <- dat.totalgross[seq(min(which(cumsum(gross) / sum(gross) > pratoLimit))), store] StoresPrato.name <- DT.stores[.(StoresPrato.id)]$store_name_short ## Confirm via Verbose Output if (verbose) cat(sprintf("Just %i stores represent %s of the $ %s revenue thus far in 2014:\n %s\n", length(StoresPrato.id), fwp(dat2014[, sum(gross[store %in% StoresPrato.id]) / sum(gross)], 1), formnumb(dat2014[, sum(gross)]), pasteQand(StoresPrato.name, q=""))) stores_main <- c(StoresPrato.name, "Other_Store") ## --- END FIND PRATO ------ ## ## Take average dat <- dat2014[, list(units=median(units, na.rm=TRUE), gross=median(gross, na.rm=TRUE), GPU=median(GPU, na.rm=TRUE)), keyby=c(kCols)] ## Remove Aspiro, for poor data dat <- dat[store != 399] ## Remove NETFLIX, for odd licensing dat <- dat[store != 450] ## Remove 'Alexander Street Press' since no longer in a deal, and it is an outlier dat <- dat[store != 435] ## Remove negative Gross, only if there are very few of them if (sum(dat$gross < 0) <= 2) dat <- dat[gross >= 0] ## -------- add in meta data key.bak.dat <- key(dat) setkey(dat, transac_typeid) [DT.transacs, `:=`(transac_type=i.transac_type, transac_type_group=i.transac_type_group, stream_vs_download=i.stream_vs_download, album_vs_track=i.album_vs_track)] setkey(dat, store) [DT.stores, `:=`(store_name=i.store_name_short, store_group_less=i.store_group_less)] setkeyIfNot(dat, key.bak.dat, verbose=FALSE) rm(key.bak.dat) ## -------- end add in meta data dat[, store_group_lesser := ifelse(store_group_less %in% stores_main, store_group_less, "Other_Store")] dat[, store_group_lesser := factor(store_group_lesser, levels=stores_main)] dat[, alpha := ifelse(store_group_lesser=="Other_Store", alphaUnknown, alphaKnown)] cuts <- dat[gross >= 0, quantile(gross, seq(0, 1, by=.25))] cuts[-length(cuts)] <- selfRound(cuts[-length(cuts)], 2) cuts[length(cuts)] <- {function(x){ ex <- floor(log10(x))-1; ceiling(x / 10^ex)*10^ex}} (cuts[length(cuts)]) if (any(dat$gross < 0)) { cuts <- c(floor(min(dat$gross)), cuts) } ## Fancy format cuts.comma <- formnumb(abs(cuts)) ## If any negative values, wrap in parent cuts.comma[cuts <0] <- paste0("(", cuts.comma[cuts <0], ")") cuts.comma <- gsub("\\(( +) ", "\\1(", cuts.comma) ## Add dollar sign cuts.comma <- paste("$", cuts.comma) cut.labels <- paste(cuts.comma[-length(cuts.comma)], "~", cuts.comma[-1L]) dat[, gross_cut := cut(gross, breaks=cuts, labels=cut.labels)] dat[, size := round(as.numeric(factor(gross_cut))^1.5)] sizeScale <- setNames(nm=cut.labels, obj=scaleunif(seq(cut.labels), min=1+ifelse(any(cuts<0), .5, 1), max=8)) ## bump the last size up, just a bit sizeScale[length(sizeScale)] <- diff(tail(sizeScale, 2))/2 + tail(sizeScale, 1) # minPerc <- .3 # (P <- ggplot(data=dat[label_sc_group=="Orchard"] [gross > quantile(gross, minPerc)] [, store_group_less := reverseFactor(store_group_less)] , aes(x=GPU, y=store_group_less, size=gross, color=label_sc_group)) + geom_point(alpha=.75) + comma.x() + ylab("") + scale_size_continuous(range=c(2.7, 6)) + facet_wrap(stream_vs_download~., scales="free_x") ) ## --------------------- ## Color Palette ## --------------------- cbbPalette <- c(iTunes="#3d09ff", Spotify="#049710", Other_Store="#CC79A7", "#E65F00", "#56B4E9", "#663fa3", "#F0E442", "#0072B2", "#D55E00") cbbPalette <- c(iTunes="#3d09ff", Spotify="#049710", Other_Store="#444444", "#E65F00", "#56B4E9", "#663fa3", "#F0E442", "#0072B2", "#D55E00", "#CC79A7") cbbPalette.names <- unique(c(names(cbbPalette), stores_main)) cbbPalette.names <- cbbPalette.names[cbbPalette.names!=""] if (length(cbbPalette.names) > length(cbbPalette)) { warning ("Too many storenames for the color palette") } cbbPalette <- setNames(obj=cbbPalette[seq(cbbPalette.names)], nm=cbbPalette.names) ## --------------------- dat[!is.na(GPU), `:=`(gpu.sd = sd(GPU), gpu.mean = (sum(GPU)-max(GPU))/.N) , by=list(transac_type, stream_vs_download)] dat[, is.outlier := (GPU > gpu.mean + 2*gpu.sd)] dat[, y := as.numeric(factor(transac_type, levels=sort(unique(transac_type), decreasing=TRUE)) )] dat[, y.jit := y + {set.seed(1); runif(y, -0.2, 0.2)}] dat <- dat[][order(store_group_lesser, gross, decreasing=TRUE)] P.GPU_by_Store_Transac <- ggplot(dat, aes(x=GPU, y=y.jit, size=gross_cut, color=store_group_lesser, alpha=alpha)) + geom_point(color="white", shape=19) + geom_point(shape=20) + scale_y_continuous(breaks=dat$y, labels=dat$transac_type) + scale_x_continuous(labels=dollar) + facet_grid(.~stream_vs_download, scales="free") + scale_color_manual(values=cbbPalette) + scale_size_manual(values=sizeScale) + scale_alpha_continuous(guide=FALSE) + guides(size=guide_legend(title="Avg Monthly Revenue"), color=guide_legend(title="Store", override.aes=list(size=4.5, shape=15))) + relativetext() + angledtext() + labs(y="", x="GPU (Average $ per Unit)", title="Avg Gross $ Per Unit by Transaction Type and Store") + ## Add label for the outliers geom_text(data=dat[(is.outlier)][order(transac_type, GPU)][store_name=="Amazon DiskOnDemand",store_name:="Amazon \t \nDiskOnDemand "] , aes(label=ifelse(is.outlier, store_name, ""), y=y.jit+{set.seed(5); runif(y.jit, .1, .35)*(-1) ^ (seq(y.jit) %% 2)}, x=GPU+ifelse(stream_vs_download=="Stream", .01, .2)), alpha=.7, size=2) ggsave.out(P.GPU_by_Store_Transac, width=12, footnote="Orchard") } ## TODO Again, move this to separate file if (plotting) { ### -- PLOT 2 -- #### setkeyIfNot(DT.storeavg, c(kCols, "date"), verbose=FALSE) AllDates.CJ <- unique(setkey(DT.storeavg[, list(date=AllDates), by=kCols])) ## JOIN dat2 <- DT.storeavg[AllDates.CJ] ## We are only concerned with missing data AFTER we started receiving data for the given store. Anything NA's before the first data point should be ignored. ## Thus, find the first non-NA data point per store, and remove all previous NAs ## For each store, find the smallest date for which the gross is not NA, and only keep those rows for which the date is greater dat2 <- dat2[dat2[, date >= date[min(which(!is.na(gross)))], by=store]$V1, ] ## Make the factors numeric to allow for graphing dat2[, label_sc_group.numeric := as.integer(reverseFactor(label_sc_group))] ## -------- add in meta data key.bak.dat2 <- key(dat2) setkey(dat2, transac_typeid) [DT.transacs, `:=`(transac_type=i.transac_type, transac_type_abbr=i.transac_type_abbr, transac_type_group=i.transac_type_group, stream_vs_download=i.stream_vs_download, album_vs_track=i.album_vs_track)] setkey(dat2, store) [DT.stores, `:=`(store_name=i.store_name_short, store_group_less=i.store_group_less)] setkeyIfNot(dat2, key.bak.dat2, verbose=FALSE) rm(key.bak.dat2) ## -------- end add in meta data ## Set the levels of the abbreviation by that of transact_type. dat2[, transac_type_abbr := factor(transac_type_abbr, levels=unique(transac_type_abbr)[order(unique(transac_type))])] ## Create storeusing field, then set levels semi-manually, with known storenames first dat2[, storeusing := ifelse(store_group_less=="zOTHER STORESz", store, store_group_less)] storeusing.levels <- dat2[, unique(c("iTunes", "Spotify", "YouTube", extract("[A-Z][a-z]", unique(storeusing)), unique(storeusing) ))] dat2[, storeusing := factor(storeusing, levels=storeusing.levels)] setkey(dat2, storeusing, transac_type, label_sc_group, date) dat2[, fill := cpallete.sc_groups[as.character(label_sc_group)]] dat2[is.na(gross), fill := "#202030"] ## We want the smallest date. We add in a max(1, min()), in case there is no non-NA for the group invisible(suppressWarnings( dat2[dat2[, date < date[max(1, min(which(!is.na(gross))), na.rm=TRUE)], by=list(storeusing,transac_type,label_sc_group)]$V1 , fill := "grey80" ] )) ## Average Monthly Gross for 2014 dat2[label_sc_group=="Orchard" & !is.na(gross) & date >= "2014-01-01", monthly_avg_gross_2014 := mean(gross), by="storeusing,transac_type_abbr"] dat2[, monthly_avg_gross_2014 := unique(monthly_avg_gross_2014[!is.na(monthly_avg_gross_2014)]), by="storeusing,transac_type_abbr"] ## Calculate the percentage of gross represented grossPerc <- dat2[, unique(monthly_avg_gross_2014), keyby="storeusing,transac_type_abbr"][, list(storeusing, transac_type_abbr, grossPerc_avg=V1 / sum(V1, na.rm=TRUE))] setkeyIfNot(dat2, key(grossPerc)) dat2[grossPerc, grossPerc_avg := grossPerc_avg] ## Single string for graphing dat2[, monthly_avg_gross_2014.str := sprintf("$ %s\n%s", formatK(monthly_avg_gross_2014), ifelse(grossPerc_avg < 1e-05, "0 %", fwp(grossPerc_avg, 0)))] dat2[is.na(grossPerc_avg) & is.na(monthly_avg_gross_2014), monthly_avg_gross_2014.str := NA_character_] ## fill.group column and fill.dict specific for ggplot dat2[, fill.group := label_sc_group] dat2[fill=="#202030", fill.group := "Missing"] dat2[fill=="grey80", fill.group := ""] dat2[, fill.group := factor(fill.group, levels=c(sc_groups, "Missing", ""))] dat2[, fill.group := {levels(fill.group) <- paste0(levels(fill.group), " "); fill.group}] fill.dict <- dat2[, setNames(obj=unique(fill), nm=unique(fill.group))] ## we will add vertical lines at the end of each quarter for easier visualization alldates.vector <- AllDates.CJ[, sort(unique(date))] quarterMonths <- as.numeric(alldates.vector[month(alldates.vector) %% 3==1 & month(alldates.vector) %% 12 !=1 ]) - 16 yearMonths <- as.numeric(alldates.vector[month(alldates.vector) %% 12 ==1 ]) - 16 P.DataPresent_by_Store_Transac_SCgroup <- { ggplot(data=dat2, aes(x=date, y=label_sc_group.numeric)) + geom_tile(aes(fill=fill.group)) + # geom_tile(data=dat2[is.na(gross)], aes(x=date, y=label_sc_group.numeric), fill="#202030") + geom_vline(x=quarterMonths, color="red", linetype="dashed", size=2.8, alpha=.3) + geom_vline(x=yearMonths, color="dark red", linetype="solid", size=3.1, alpha=.3) + # scale_fill_manual(values=setNames(nm=dat2$fill), breaks=dat2$label_sc_group) + scale_fill_manual(values=fill.dict) + labs(x="", y="") + theme(legend.position="top", legend.title=element_blank()) + noaxis.y() + nogridminor() + relativefacettext(.7) + facet_grid(storeusing+transac_type_abbr+monthly_avg_gross_2014.str ~ .) } f.DataPresent_by_Store_Transac_SCgroup <- ggsave.out(P.DataPresent_by_Store_Transac_SCgroup, width=12, height=nrow(dat2[, 1, by="storeusing,transac_type_abbr"])/1.8, footnote="Orchard", limitsize=FALSE) if (interactive()) .o(f.DataPresent_by_Store_Transac_SCgroup) } ### ------------------------------------------------------ ## Add a month to the tail of DT.storeavg. ## do this by taking a two-month seq and banking just the last value ## then rbind'ing this to the original DT.storeavg ## We save it to a new table, to preserve the original DT.nextmonth <- setkey(DT.storeavg[, list(date=seq(max(date), length.out=2, by="month")[[-1L]]), keyby=kCols]) DT.storeavg2 <- setkeyv(rbind(DT.storeavg, DT.nextmonth, fill=TRUE), key(DT.storeavg)) ## Confirm that the last row in each store-trans is NA stopifnot(DT.storeavg2[, is.na(tail(GPU, 1)), by=kCols]$V1) ## Shift the ESTs down one row (ie, they are for the future, not for the present) DT.storeavg2[, GPU_Est_MA := c(NA, head(GPU_Est_MA, -1)), by=kCols] DT.storeavg2[, GPU_Est_Fore := c(NA, head(GPU_Est_Fore, -1)), by=kCols] ## Calculate the diff between estimates and stat DT.storeavg2[, `:=`(err.fore = (GPU - GPU_Est_Fore)/GPU, err.ma = (GPU - GPU_Est_MA) /GPU )] DT.storeavg2[, MA_better_than_Fore := abs(err.ma) <= abs(err.fore)] DT.storeavg2[ DT.storeavg2[date > Sys.Date() - 129 , list(use_MA = .5 <= sum(MA_better_than_Fore, na.rm=TRUE) / sum(!is.na(GPU)) | is.na(MA_better_than_Fore)) , keyby=kCols ] , use_MA := i.use_MA , allow.cartesian=TRUE ] ## CLEAN UP ANY NA's from Units DT.storeavg2[!is.finite(GPU_Est_MA), GPU_Est_MA := NA] DT.storeavg2[!is.finite(GPU_Est_Fore), GPU_Est_Fore := NA] ## Determine which GPU estimate to use DT.storeavg2[, GPU_estimate := ifelse(use_MA, GPU_Est_MA, GPU_Est_Fore)] DT.storeavg2[is.na(GPU_estimate), GPU_estimate := ifelse(!is.na(GPU_Est_MA), GPU_Est_MA, GPU_Est_Fore)] ## Use a blend of Forecast and MA DT.storeavg2[!is.na(GPU_Est_MA) & !is.na(GPU_Est_MA), GPU_blended := (2*GPU_Est_MA + 3*GPU_Est_Fore)/5 ] DT.storeavg2[!is.na(GPU_blended), GPU_estimate := GPU_blended] # -------------------------------------------------------------------- # GPU ESTIMATE -- # GPU ESTIMATE -- ## CREATE the GPU.EST data.table. This is what will ultimately make it into the DB # GPU ESTIMATE -- setkeyIfNot(DT.storeavg2, key(DT.nextmonth)) # GPU ESTIMATE -- DT.GPU.Est <- DT.storeavg2[DT.nextmonth][, list(date, store, transac_typeid, label_sc_group, GPU_estimate)] # GPU ESTIMATE -- # GPU ESTIMATE -- ## Some values are still NA. Take the last known value # GPU ESTIMATE -- ## ... find the NAs, order by date, take the last value. # GPU ESTIMATE -- DT.GPU.Fillers <- DT.storeavg2[ unique(DT.GPU.Est[is.na(GPU_estimate), list(store, transac_typeid)], by=NULL) # GPU ESTIMATE -- ][!is.na(GPU) # GPU ESTIMATE -- ][order(date) # GPU ESTIMATE -- , list(GPU_estimate_filler=tail(GPU, 1)) # GPU ESTIMATE -- , keyby=kCols] # GPU ESTIMATE -- # GPU ESTIMATE -- ## Match keys for filling # GPU ESTIMATE -- matchKey(DT.GPU.Est, DT.GPU.Fillers, key(DT.GPU.Fillers)) # GPU ESTIMATE -- # GPU ESTIMATE -- ## FILL by adding a column, then any NAs get filled, confirm all is good, then drop the column # GPU ESTIMATE -- DT.GPU.Est[DT.GPU.Fillers, GPU_estimate_filler := GPU_estimate_filler] # GPU ESTIMATE -- # GPU ESTIMATE -- DT.GPU.Est[is.na(GPU_estimate), GPU_estimate := GPU_estimate_filler] # GPU ESTIMATE -- ## Confirm there are no NAs for the estimates # GPU ESTIMATE -- stopifnot(DT.GPU.Est[, !is.na(GPU_estimate)]) # GPU ESTIMATE -- ## Drop the column added # GPU ESTIMATE -- DT.GPU.Est[, GPU_estimate_filler := NULL] # -------------------------------------------------------------------- #================ Store_Avgs - 2 Analytics.r lastDateInMonth <- function(x) { lubridate::ceiling_date(x+1, unit="month") - 1 } firstDateInMonth <- function(x) { lubridate::floor_date(x, unit="month") } iTunesDaysInMonth <- function(x) { ## Every 3rd month is 35 days, the rest are 28 days ifelse(data.table::month(x) %% 3, 35, 28) } ## key columns from previous file kCols <- c("store", "transac_typeid", "label_sc_group") kColsDate <- c("date", kCols) ## FORM QUERIES Qry.MonthlyAnalytics <- sprintf(" SELECT storeid AS store, transac_typeid, label_sc_group, download_accounting_month AS date, max(download_activity_date) as max_date, sum(units) as units FROM aggregated_analytics WHERE (download_activity_date BETWEEN sysdate - INTERVAL '24 MONTH' AND sysdate) %s AND NOT labelid is NULL GROUP BY 1, 2, 3, 4 ORDER BY store " , c(iTunes = "AND storeid = 1", OtherStores = "AND NOT storeid = 1") ) ## Add names to the QRY for lapply setattr(Qry.MonthlyAnalytics, "names", c("iTunes", "OtherStores")) ## EXECUTE QUERIES analytics() ## until I fix runQry. listOfDTs <- lapply(Qry.MonthlyAnalytics, runQry) ## Collapse into a single DT DT.MonthlyAnalytics <- rbindlist(listOfDTs) ## ----- CLEAN THE DATA ----- ## suppressWarnings(rm(DT.MonthlyAnalytics.bak)) ## Drop any missing label_sc_group if ("label_sc_group" %in% names(DT.MonthlyAnalytics)) DT.MonthlyAnalytics <- DT.MonthlyAnalytics[!is.na(label_sc_group)] ## Convert Dates from Strings dateCols <- c("date", "max_date") DT.MonthlyAnalytics[, (dateCols) := lapply(.SD, as.Date), .SDcols=dateCols] ## Apply the same max date across the whole store, regardless of group. Bank the old max_date, for inspection at some other time setnames(DT.MonthlyAnalytics, "max_date", "max_date_bygrp") DT.MonthlyAnalytics[, max_date := max(max_date_bygrp, na.rm=TRUE), by="store,date"] ## Set keys, prepare for merge setkeyIfNot(DT.MonthlyAnalytics, kCols) setcolorderpt(DT.MonthlyAnalytics, c(kCols, "date", "max_date")) ## ----- CLEAN THE DATA ----- ## ## -------------------------------------------- ## ## We will first add in the itunes start/end months ## then we will put in the regular start/end months setkeyIfNot(DT.iTunes544, "month", warnForColNameInEnv=FALSE, verbose=FALSE) setkeyIfNot(DT.MonthlyAnalytics, kColsDate, verbose=FALSE) # DT.MonthlyAnalytics[store==1 & date == '2013-10-01'] DT.MonthlyAnalytics[DT.iTunes544, `:=`(month_end=i.end, month_start=i.start), allow.cartesian=TRUE] DT.MonthlyAnalytics[(store != 'iTunes' & store != 1), `:=`(month_end=lastDateInMonth(date), month_start=firstDateInMonth(date) )] DT.MonthlyAnalytics[, days_present := as.numeric(max_date - (month_start-1) )] DT.MonthlyAnalytics[, days_missing := as.numeric(month_end - max_date)] ## When month is full, we will have max_date == month_end. No (-1) needed. ## Set keys, prepare for merge setkeyIfNot(DT.MonthlyAnalytics, kColsDate, verbose=FALSE) setcolorderpt(DT.MonthlyAnalytics, kColsDate) ## Calculate expected units, simple extrapolation by total number of days DT.MonthlyAnalytics[, units_expected := round(units * (1 + days_missing / days_present))] ## Take backup if (!exists("DT.MonthlyAnalytics.bak")) { message("Creating .bak object") DT.MonthlyAnalytics.bak <- copy(DT.MonthlyAnalytics) } ## -- FROM BACKUP ---- ## DT.MonthlyAnalytics <- copy(DT.MonthlyAnalytics.bak) #================ [NOT IN ANY OTHER FILE] ### DETERMINE What transaction types are missing from each DB, by store missing.minDate <- "2013-11-01" DT.missing <- merge(DT.MonthlyAnalytics[date >= missing.minDate & !is.na(units), list(in.analytics=TRUE), keyby=list(store, transac_typeid)], DT.storeavg[date>'2013-11-01' & !is.na(units), list(in.accounting=TRUE), keyby=list(store, transac_typeid)], all=TRUE) DT.missing[is.na(in.analytics), in.analytics := FALSE] DT.missing[is.na(in.accounting), in.accounting := FALSE] DT.missing[, store_in_analytics := any(in.analytics), by=store] DT.missing[, missing_from := ifelse(store_in_analytics & !in.analytics, "analytics", ifelse(!in.accounting, "accounting", NA))] key.bak.DT.missing <- key(DT.missing) setkey(DT.missing, transac_typeid) [DT.transacs, `:=`(transac_type=i.transac_type, transac_type_abbr=i.transac_type_abbr)] setkey(DT.missing, store) [DT.stores, `:=`(store_name=i.store_name_short)] setkeyIfNot(DT.missing, key.bak.DT.missing, verbose=FALSE) rm(key.bak.DT.missing) DT.missing ## OUTPUT { cat("\t\t**** The following store-transaction_type are missing (looking back to ",missing.minDate,") ****\n\t\t", pasteR(93), "\n", sep="") print(DT.missing[!is.na(missing_from)] [order(missing_from, decreasing=TRUE) , list(storeid = store, store_name, transac_typeid, transac_type_abbr, transac_type, missing_from)]) } ## ADD IN THE GPU. Use Estimates when we dont have the full month. ## Keys for merging setkeyIfNot(DT.MonthlyAnalytics , kColsDate, verbose=FALSE) setkeyIfNot(DT.storeavg2 , kColsDate, verbose=FALSE) ## MERGE IN THE GPU INFO ## DT.MonthlyAnalytics[DT.storeavg2, `:=`(GPU_using = i.GPU, GPU_is_estimate = FALSE)] DT.MonthlyAnalytics[DT.storeavg2, `:=`(GPU_estimate = i.GPU_estimate, GPU_is_estimate = FALSE)] ## If we have three or less days of info for the group AND the GPU_estimate is not NA, ## Then replace the using with the estimate, and set the "GPU_is_estimate" flag to true DT.MonthlyAnalytics[(max_date_bygrp - month_start < 4) & !is.na(GPU_estimate) , `:=`(GPU_using = GPU_estimate, GPU_is_estimate = TRUE) ] ## If GPU_using is NA and the Estimate is not NA, use the estimate DT.MonthlyAnalytics[(is.na(GPU_using)) & !is.na(GPU_estimate) , `:=`(GPU_using = GPU_estimate, GPU_is_estimate = TRUE) ] ## Lastly, if there are days_missing, we consider the GPU_using to be an estimate (because it will change) DT.MonthlyAnalytics[days_missing != 0, GPU_is_estimate := TRUE ] ## TAKE A BACKUP jesusForData(DT.MonthlyAnalytics, info="Prior to inserting imputed values") ### ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ### ### For now, the last month will take the previous month ### ### ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ### AprilValues <- DT.MonthlyAnalytics[date=="2014-04-01", list(LastMonthGPU=GPU_using), keyby=kCols] setkeyIfNot(DT.MonthlyAnalytics, kCols) DT.MonthlyAnalytics[AprilValues, `:=`( GPU_using = ifelse(date == "2014-05-01" & is.na(GPU_using), i.LastMonthGPU, GPU_using), GPU_is_estimate = (date == "2014-05-01" & is.na(GPU_using)) )] ## For now, drop any rows where the GPU is NA for the whole group DT.MonthlyAnalytics <- DT.MonthlyAnalytics[!DT.MonthlyAnalytics[, .N == sum(is.na(GPU_using)), by=kCols][(V1)]] setkeyIfNot(DT.MonthlyAnalytics, kColsDate) ## Take a manually moving average, removing NAs counter <- 4 while (counter > 0 && any(is.na(DT.MonthlyAnalytics$GPU_using))) { ## Expand greater at each iteration width <- {(-(2+(4-counter))):(3+(4-counter))} DT.MonthlyAnalytics[, c("GPU_using", "GPU_is_estimate") := { G <- GPU_using G_nas <- is.na(G) inds <- which(G_nas) G_notnas <- setdiff(seq(G), inds) if (length(inds)) G[inds] <- sapply(inds, function(i) ## Index from 3back to 4forward, intersecting with current seq. ## Note that mean() will return NaN when mean(G[ intersect(i + width, G_notnas) ]) ) list(G, (GPU_is_estimate | G_nas)) } , by=kCols] counter <- counter - 1 } ## Error check to see if there are any NA's remaining if (nrow(DT.missing <- DT.MonthlyAnalytics[is.na(GPU_using)])) { hr <- pasteR(65) message("\n", hr, "\n\t\tSome GPU_using are still NA\n", hr) print(DT.missing) message("\n", hr, "\n") } else rm(DT.missing) ### ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ### # skip for now # ## ---- IMPUTE ---- ### # skip for now # results_from_imputing <- mi(DT.MonthlyAnalytics[, list(date, store, transac_typeid, label_sc_group, GPU_using)], n.iter=5000, n.imp=6, max.minutes=15) # skip for now # imputedValues <- tail(results_from_imputing@imp, 1)[[1]] # skip for now # ## ---- IMPUTE ---- ### # skip for now # # skip for now # # skip for now # ## Check that it is the correct length # skip for now # if (length(imputedValues$GPU_using@random) == DT.MonthlyAnalytics[, sum(is.na(GPU_using))]) { # skip for now # ## Info for user # skip for now # message("Attempting to insert imputed values") # skip for now # nacount.prev <- DT.MonthlyAnalytics[, sum(is.na(GPU_using))] # skip for now # # skip for now # ## Adding an extra step of first creating it's own column so that I can double check that Ive lined them up right # skip for now # DT.MonthlyAnalytics[is.na(GPU_using), GPU_imputed := imputedValues$GPU_using@random] # skip for now # # skip for now # ## ERROR CHECK -- Exactly one column should be NA # skip for now # stopifnot(DT.MonthlyAnalytics[, all(xor(is.na(GPU_using), is.na(GPU_imputed)))]) # skip for now # # skip for now # ## Assign the value and note that it is an estimate and that it was imputed # skip for now # DT.MonthlyAnalytics[, GPU_was_imputed := FALSE] # skip for now # DT.MonthlyAnalytics[is.na(GPU_using) # skip for now # , `:=`(GPU_using = GPU_imputed, # skip for now # GPU_is_estimate = TRUE , # skip for now # GPU_was_imputed = TRUE # skip for now # )] # skip for now # # skip for now # ## Drop the column # skip for now # DT.MonthlyAnalytics[, GPU_imputed := NULL] # skip for now # # skip for now # nacount.post <- DT.MonthlyAnalytics[, sum(is.na(GPU_using))] # skip for now # message("Cleared ", nacount.prev - nacount.post, " NA values.\n\t ", nacount.post, " remain.") # skip for now # } if (DT.MonthlyAnalytics[, any(is.na(GPU_using))]) { print(DT.MonthlyAnalytics[is.na(GPU_using)]) stop("NA values remiain in DT.MonthlyAnalytics$GPU_using") } else { invisible(DT.MonthlyAnalytics[, GPU_estimate := NULL]) } jesusForData(DT.MonthlyAnalytics, info="After_MI") ## --------- DT.out <- copy(DT.MonthlyAnalytics) setnames(DT.out, "date", "download_accounting_month") setnames(DT.out, "store", "storeid") setnames(DT.out, tolower(names(DT.out))) cleanColNamesForSQL_ (DT.out) setkey(DT.out, # label_is_supplychain, label_sc_group, download_accounting_month, storeid, # country_code, transac_typeid ) QRY.list <- makeSQLtable(DT.out, encode="lzo", table.name="GPU", schema="DS_scratch", quiet=TRUE, numericDecimals=c(22, 9)) QRY.create <- QRY.list[["QRY.create"]] QRY.insert <- QRY.list[["QRY.insert"]] QRY.drop <- stringr::str_extract(QRY.create, "CREATE TABLE .+?\\s") QRY.drop <- gsub("CREATE", "DROP", QRY.drop) runQry(QRY.drop) runQry(QRY.create) runQry(QRY.insert, verbose=FALSE) ## ------------ ## ## Confirm same ## ## ------------ ## { QRY.confirm <- gsub("DROP TABLE ", "SELECT * FROM ", QRY.drop) DT.confirm <- runQry(QRY.confirm) setkey(DT.confirm) setkey(DT.out) stopifnot(names(DT.confirm) == names(DT.out)) stopifnot(mapply(all.equal, DT.confirm, DT.out, tolerance=10^(-6))) message("Confirmed written properly") rm(DT.confirm) } ## ------------ ## saveImageTo()