## Two plots here: ## (2) How much data do we have per store. ## (1) GPU per store ## Clearly, it is the GPU plot that is important ### --------------------------- --------------------------- --------------------------- ### ### --------------------------- --------------------------- --------------------------- ### ### PLOTTING WHICH DATES AVAILABLE ### ### --------------------------- --------------------------- --------------------------- ### ### --------------------------- --------------------------- --------------------------- ### lib(ggplot) suppressWarnings(rm(dat)) alphaKnown <- .55 alphaUnknown <- .40 addl_special_stores <- c(463, 447) # Google Play & Xbox ## --- FIND PRATO ------ ## dat2014 <- DT.storeavg[date >= "2014-01-01"][!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.id <- c(StoresPrato.id, addl_special_stores) StoresPrato.name <- DT.stores[.(StoresPrato.id)]$store_name_short if (length(StoresPrato.name) != length(StoresPrato.id) || any(is.na(StoresPrato.name))) warning("Some 'main' stores not found -- check StoresPrato.name and StoresPrato.id") else setattr(StoresPrato.name, "names", StoresPrato.id) ## 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(paidunits=median(paidunits, 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)][store_name=="Amazon DiskOnDemand",store_name:="Amzn-DOD "] setkeyIfNot(dat, key.bak.dat, verbose=FALSE) rm(key.bak.dat) ## -------- end add in meta data dat[, store_group_lesser := ifelse(store_name %in% stores_main, store_group_less, "Other Store")] dat[store_group_lesser == "Other_Store", store_group_lesser := "Other Store"] dat[, store_group_lesser := factor(store_group_lesser, levels=stores_main)] dat[, alpha := ifelse(store_group_lesser=="Other Store", alphaUnknown, alphaKnown)] # OLD 20141002 : cuts <- dat[gross >= 0, quantile(gross, seq(0, 1, by=.20))] cuts <- dat[gross >= 0, quantile(gross, c(0, .25, .5, .65, .8, .9, 1))] cuts <- dat[gross >= 0, quantile(gross, c(0, .25, .5, .65, .8, .9, 1))] 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)]) cuts <- c(0, 5e5, 1e6, 2e6, 4e6, 6e6) cuts <- c(0, 1e4, 1e5, 1e6, 2.5e6, 5e6) cut_scale <- 1000 # we will divide by this number for display purposes if (any(dat$gross < 0)) { cuts <- c(floor(min(dat$gross)), cuts) } ## Fancy format cuts.comma <- formnumb(abs(cuts)/1000) ## 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 <- cbind(sprintf("$%7s to %7s", 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) ## --------------------- ## Color Palette ## --------------------- cbbPalette <- c(iTunes="#3d09ff", Spotify="#049710", "Other Store"="#444444" , YouTube="#E65F00", Amazon="#56B4E9", Google="#663fa3", Muve="#F0E442" , Xbox="#CC79A7", "#0072B2", "#D55E00") 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.25, 0.25)}] dat[store_group_less == "Xbox", store_group_lesser := "Xbox"] dat <- dat[][order(store_group_lesser, gross, decreasing=TRUE)] P.GPU_by_Store_Transac <- { dat.crop <- dat[(stream_vs_download == "Stream" & GPU < .125) | (stream_vs_download == "Download" & GPU < 10)] dat.crop[store_group_lesser == "Other Store", store_group_lesser == "Other Store"] dat.crop[, store_group_lesser := factor(store_group_lesser, levels=c("iTunes", "Spotify", sort(setdiff(store_group_lesser, c("iTunes", "Spotify", "Other Store"))), "Other Store"))] # dat.crop[store_name %like% "Google", store_name := "Google"] ggplot(dat.crop, aes(x=GPU, y=y.jit, size=gross_cut, color=store_group_lesser, alpha=alpha)) + geom_point(color="white", shape=19, alpha=.26) + geom_point(shape=20) + scale_y_continuous(breaks=dat.crop$y, labels=dat.crop$transac_type) + dollar(axis="x") + # 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\n in $1,000") , 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\nBy Transaction Type and Store") + ## Add label for the outliers geom_text(data=dat.crop[(is.outlier)][order(transac_type, GPU)] , aes(label = ifelse(is.outlier, store_name, "") , y = y.jit+{set.seed(51); runif(y.jit, .18, .35)*(-1) ^ (seq(y.jit) %% 2)} , x = GPU + ifelse(stream_vs_download=="Stream", .01, .2) ) , alpha=.7, size=2) + geom_text(data=dat.crop[store %in% addl_special_stores] , aes(label = store_name , y = y.jit+{set.seed(15); runif(y.jit, .18, .35)*(-1) ^ (seq(y.jit) %% 2)} , x = GPU + ifelse(stream_vs_download=="Stream", .01, .2) ) , alpha=.85, size=2) } f.out.GPU_by_Store_Transac <- ggsave.out(P.GPU_by_Store_Transac, width=12, footnote=NULL) ### -- 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, ] ## -------- 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, date) dat2[, fill := "#4cc4b1"] 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)]$V1 , fill := "grey80" ] )) ## Average Monthly Gross for 2014 dat2[!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 := "Present"] dat2[fill=="#202030", fill.group := "Missing"] dat2[fill=="grey80", fill.group := ""] dat2[, fill.group := factor(fill.group, levels=c("Present", "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 <- { ggplot(data=dat2, aes(x=date, y=1)) + geom_tile(aes(fill=fill.group)) + 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=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.out.DataPresent_by_Store_Transac <- ggsave.out(P.DataPresent_by_Store_Transac, width=12, height=nrow(dat2[, 1, by="storeusing,transac_type_abbr"])/1.8, footnote="Orchard", limitsize=FALSE) if (interactive()) .o(f.out.DataPresent_by_Store_Transac) ### --------------------------- --------------------------- --------------------------- ### ### END PLOTTING WHICH DATES AVAILABLE ### ### --------------------------- --------------------------- --------------------------- ### ### --------------------------- --------------------------- --------------------------- ###