dropNA.AddRan <- TRUE Title.Weeks <- c(during = "Weeks 1 ~ 2 of release", after="Weeks 3 ~ 6 of release", total="Weeks 1 ~ 6 of release") SubTitle.Weeks <- c(during = "Adds ran during these two weeks", after="Adds ran preious two weeks", total="Adds ran first two weeks only") WeeksUsing <- c("total") for (WeeksUsing in names(Title.Weeks)) { # } cat("Processing week '", WeeksUsing, "'\n", sep="") genresDropping <- c("Audio Books", "Children's", "Christian", "Educational", "Video", "Spoken Word") DB.using.during <- DB.using.agg[if (dropNA.AddRan) {!is.na(SpotifyAddRan)} else TRUE ] [genre %ni% genresDropping & weeks==WeeksUsing , list(Count=total.count.by.upc, Impr1k=impr1k, formatOfAddProd=formatOfAddProd) , keyby=list(mkt_priority, genre, SpotifyAddRan, upc, artist, releaseDate, ctr, weeks) ] if (dropNA.AddRan) DB.using.during <- DB.using.during[!is.na(SpotifyAddRan)] ## Combine the priority & addran columns into one, for graphing later DB.using.during[order(SpotifyAddRan), Group := paste(mkt_priority, ifelse(SpotifyAddRan, "With Add", "No Add"))] ## COMBINE ALL GROUP C (Add / NoAdd) INTO ONE GROUP C.withAdd <- DB.using.during[, SpotifyAddRan & mkt_priority=="C"] if (sum(C.withAdd) < 3) { DB.using.during <- DB.using.during[!C.withAdd] DB.using.during[mkt_priority=="C", Group := "C"] invisible() } ## SORT THE GROUP LEVELS BY, first NoAdd, then Priority GroupLevs <- DB.using.during[order(SpotifyAddRan, mkt_priority), sort(unique(Group))] ## Reversing the ordering DB.using.during[, Group := factor(Group, levels=rev(GroupLevs))] ## There should not be any NAs, but just in case DB.using.during <- DB.using.during[!is.na(Count)] ## Knock out extreme CTR values ## keep those with NA ctrs. DB.using.during <- DB.using.during[(ctr > quantile(ctr, .03, na.rm=TRUE) & ctr < quantile(ctr, .95, na.rm=TRUE)) | is.na(ctr)] ## Order the genre according to the number of adds per genre genre.AddCounts <- DB.using.during[, sum(SpotifyAddRan, na.rm=TRUE), by=genre][order(V1, decreasing=TRUE)] DB.using.during[, genre := factor(genre, levels=genre.AddCounts[["genre"]])] ## Any genre with less than 2 adds ran, gets grouped as "OTHER" genre.AddCounts[, genre2 := ifelse(V1>1, as.character(genre), "Other")] genre.AddCounts[genre2 != "Electronic", genre2 := genreClean[genre2] ] matchKey(DB.using.during, genre.AddCounts, "genre") DB.using.during[genre.AddCounts, genre2 := genre2] ## Add character version of SpotifyAddRan variable, for cleaner graphs Sp.Levs <- c("No Advertising", "With Advertising") DB.using.during[, SpotifyAddRan.char := factor(ifelse(SpotifyAddRan, Sp.Levs[[2]], Sp.Levs[[1]]), levels=Sp.Levs)] ## Key first by genre, last by upc setkey(DB.using.during, genre, mkt_priority, upc) # - # -------------------------------------------------------- # # - # Plotting the number of releases per date # - # -------------------------------------------------------- # # - DB.using.during[, releaseCountPerDate := lunique(upc), by=releaseDate] # - ggplot(DB.using.during[order(releaseDate)]) + # - geom_line(aes(y=releaseCountPerDate, x=releaseDate, color=mkt_priority, alph=0.3)) # - # - ggplot(DB.using.during[order(releaseDate)]) + # - geom_line(aes(y=log(cumsum(releaseCountPerDate)), x=releaseDate, color=mkt_priority, alph=0.3)) # - # - ggplot(DB.using.during[order(releaseDate)]) + # - geom_line(aes(y=forecast::ma(log(releaseCountPerDate), 30), x=releaseDate, color=mkt_priority, alph=0.3)) # - # -------------------------------------------------------- # # -------------------------------------------------------- # # PLOT # # -------------------------------------------------------- # library(scales) library(ggplot2) library(RColorBrewer) # -------------------------------------------------------- # # REAL PLOTTING # # -------------------------------------------------------- # ## Filtering the datasets selectGenres <- c("Rock", "Electronic", "Hip-hop/Rap", "Metal", "Punk", "R&B", "Pop") filters <- list( P.all = TRUE # 1 , P.10 = DB.using.during[, Count>=10] # 2 , P.100 = DB.using.during[, Count>=100] # 3 , P.10.noC = DB.using.during[, Count>=10 & Group != "C"] # 4 , P.SelectGenres = DB.using.during[, genre %in% selectGenres] # 5 , P.10.SelectGenres = DB.using.during[, genre %in% selectGenres & Count >= 10] # 6 ) ## INSIGHTS: ## Ultimately, no apparent need to restrict to a subset of genres. ## But, yes, restrict to a min of 10 chosen <- "P.10" #for for (chosen in c(1, 6, 4, 2)) { #for } filter <- filters[[chosen]] nm.filters <- if (is.character(chosen)) chosen else names(filters)[[chosen]] tit <- paste0("Spotify Streams\n", Title.Weeks[WeeksUsing], "\n(", SubTitle.Weeks[WeeksUsing], ")") if (grepl("genre", nm.filters, ignore.case=TRUE)) tit <- paste0(tit, "\nRestricted to Genres:\n", pasteC(selectGenres, C=", ")) ## y limits ylims <- c(0.999, 1e6 + 1e4) if ({mx <- max(DB.using.during[filter][["Count"]])} > ylims[[2]]) ylims[[2]] <- round(mx * 1.05, -3) if ({mn <- min(DB.using.during[filter][["Count"]])} >= max(9, ylims[[1]])) ylims[[1]] <- max(ifelse (mn >= 100, 91, 9.1), ylims[[1]]) # Find those genres that have at least 2 Adds for at least two different market priorities genres.Main <- DB.using.during[filter][(SpotifyAddRan), .N, by=list(genre, mkt_priority)][N>=2][, .N, by=genre][N>=2, genre] # DB.Means <- DB.using.during[filter][genre %in% genres.Main, list(Mean.Count=mean(Count, na.rm=TRUE), SpotifyAddRan.char, mkt_priority), by=list(genre, Group)] # DB.Means <- unique(DB.Means, by=NULL) # DB.Means[, genre:= factor(paste(genre, "(Avg)"))] DB.using.during[filter & genre %in% genres.Main , `:=`(Mean.Count = mean(Count, na.rm=TRUE) , Median.Count = as.numeric(median(Count, na.rm=TRUE)) , yMin = as.numeric(-2/3) * mad(Count, na.rm=TRUE) + median(Count) , yMax = as.numeric(+2/3) * mad(Count, na.rm=TRUE) + median(Count) , N = .N ) , by=list(genre, Group)] ## Color Brew BLUES <- colorRampPalette(brewer.pal(7, "Blues" ))(7) GREENS <- colorRampPalette(brewer.pal(8, "Greens"))(7) ColorOptions <- c(BLUES[[3L]], GREENS[c(4L, 6L)]) ColorOptions <- c(ColorOptions, colorRampPalette(brewer.pal(8, "Accent"))(7)) color.nms <- DB.using.during[filter, unique(mkt_priority)] colors <- setNames(ColorOptions[seq(color.nms)], rev(color.nms)) colors <- c(colors, colors.genre[DB.using.during[, unique(genre2)]]) # Group Labels at the Top # Groups <- DB.using.during[filter, list(mkt_priority=unique(mkt_priority), SpotifyAddRan.char=unique(SpotifyAddRan.char), y=max(ylims)-100) , by=Group] # Groups <- Groups[Group != "C"] # Groups[, Group := factor(Group, levels=levels(DB.using.during[["Group"]]))] dim(DB.using.during[filter]) DB.using.during[filter, med := as.numeric(median(Count)), by=Group] DB.using.during[!is.na(med), med.char := center(formnumb(med, selfRound=TRUE))] P <- ggplot(DB.using.during[filter]) + aes(x=mkt_priority, y=Count, color=mkt_priority) + scale_y_log10(labels=comma, limits=ylims, breaks=seq.exp(1, ylims[[2]], by=2)) + xlab("Market Priority") + ylab("Total Streams for the time period\n(Scale is log 10)") + theme( axis.text.y = element_text(size=rel(.65), angle=15) , axis.text.x = element_text(size=rel(.70), angle=0) , title = element_text(size=rel(0.75)) , legend.position="none") + # facet_grid(~SpotifyAddRan.char, scales="free_x", space="free") + ggtitle(tit) + scale_x_reverse() + ## When legend is turned on, only genres.Main will have Mean bars scale_colour_manual(breaks=genres.Main, values=colors) + geom_jitter(alpha=.42, size=1.85, position = position_jitter(width = .008)) + geom_text(aes(y=max(ylims)-100, label=ifelse(mkt_priority != "C", paste0(mkt_priority,"'s"), "")), size=rel(8), show_guide=FALSE) + # geom_text(aes(y=max(ylims)-100, label=ifelse(mkt_priority != "C", "", "Everything\nElse")), size=rel(4), show_guide=FALSE) + guides(color = guide_legend(override.aes = list(alpha = 1))) ## Add Boxplot (or Violin plot) + line for P1 P1 <- ggInsertLayer(P, after=(-2), geom_line(color="black"), geom_boxplot(color="black", width=(.6), outlier.shape=NA)) + geom_text(aes(y = med, label=med.char), size = rel(6), vjust = -0.5, color="red") P2 <- ggInsertLayer(P, after=(-2), geom_violin(color="black", width=(.8), alpha=.75, scale="width")) # P3 is simply P2 Horizontally, with no Facets P3 <- P2 + coord_flip() + facet_null() P3$data[, Group := factor(Group, levels= levels(Group)[order(substr(levels(Group), 3,3))]) ] DB.using.during[, c("med", "med.char") :=NULL] ## P1.avg is hanging, so will not use. # ## Turn on the legend # P1.avg <- P1 + theme(legend.position="bottom", legend.title=element_text(vjust=1)) + labs(color="Genre Averages per Group") # # # ## Insert Horizontal bar at median # P1.avg <- # ggInsertLayer(P1.avg , -1, geom_point(aes(y=Median.Count, color=genre2), shape=95L, size=rel(8), show_guide=FALSE, alpha=.5) # , geom_text(aes(y=Median.Count, label=center(paste(genre2, " (Avg.)\n N = ", N), align="left", C="\n")), color="black", hjust=1, size=rel(1.8), alpha=0.8) ) ## ERROR BARS GIVE NO HELPFUL INFO # P1.avg + geom_errorbar(aes(y=Median.Count, color=genre2, ymin=yMin, ymax=yMax), size=rel(0.8), show_guide=FALSE, alpha=.5, position=position_dodge(width=0.15)) ## ADDING GEOM POINTS PER GENERE IS NOT HELPFUL # P1.avg + geom_point(aes(y=ifelse(is.na(Median.Count), NA, Count), color=genre2), show_guide=FALSE, alpha=.5) # , geom_text(aes(y=Median.Count, label=paste(genre2, " (Avg.)")), color="black", hjust=1, size=rel(2)) cat("Saving plots for ", nm.filters, "\n", sep="") nm <- gsub("P\\.", "", nm.filters) ggsave(as.path(outDir, "plots", paste("P1.boxplot", WeeksUsing, nm, sep="."), ext="png"), plot=P1, width=8, height=8) ggsave(as.path(outDir, "plots", paste("P2.violin", WeeksUsing, nm, sep="."), ext="png"), plot=P2, width=8, height=8) ggsave(as.path(outDir, "plots", paste("P3.horiz_violin", WeeksUsing, nm, sep="."), ext="png"), plot=P3, width=8, height=8) # ggsave(as.path(outDir, "plots", paste0("P1.boxplot+avg", nm), ext="png"), plot=P1.avg, width=8, height=8) # {{ } # // End inner for-loop (chosen) } # // End outer for-loop (weeks) # ----