library(ggplot2) library(scales) library(RColorBrewer) ## Add Dummy Variable DB.using.agg[mkt_priority %in% c("A", "B") , dmkt := ifelse(mkt_priority=="A", 1, 0)] ## Basic Linear model M <- DB.using.agg[weeks=="total" & mkt_priority!="C"][!is.na(impr1k), lm(total.count.by.upc ~ impr1k + dmkt) ] # Impressions ABOVE imprMax will be dropped imprMax <- Inf # 1500 # Counts ABOVE outlierMin will be marked as outlier on the graph outlierMin <- 3e5 # -------------------------------------------------------------------------------------------------------------------------------------------------------------------- # ## ## ## Basic Linear Model, NO OUTLIERS ## M.o <- DB.using.agg[weeks=="total" & mkt_priority!="C" & total.count.by.upc < outlierMin][!is.na(impr1k), lm(total.count.by.upc ~ impr1k + dmkt) ] coef.dts <- data.table(rbind(coef(M), coef(M.o))) coef.dts <- cbind(coef.dts, CJ(P=c("A", "B"), M=c("All", "No Outlier"))) coef.dts[, I := `(Intercept)` + ifelse(P=="A", dmkt, 0)] coef.dts[, S := impr1k] coef.dts[, Group := paste0(M, " - ", P)] # coef.dts[, Group := factor(Group, levels=Group[order(M)]) ] # coef.dts <- coef.dts[, list(Group, I, S)] colors.b <-colorRampPalette(brewer.pal(7,"Blues"))(4)[-c(1)] colors.r <-colorRampPalette(brewer.pal(7,"Reds"))(5)[-c(1, 5)] colors <- c(colors.b, colors.r)[c(1,3,6,4,2,5)] ggplot() + geom_point(aes(x=impr1k, y=total.count.by.upc), alpha=0.5, shape=4, size=2.6 , data=DB.using.agg[weeks=="total" & mkt_priority!="C" & !is.na(impr1k) & total.count.by.upc > outlierMin]) + geom_point(aes(x=impr1k, y=total.count.by.upc, color=mkt_priority), data=DB.using.agg[weeks=="total" & mkt_priority!="C" & !is.na(impr1k)]) + geom_abline(aes(intercept=I, slope=S, color=Group), data=coef.dts) + scale_y_continuous(labels=comma) + scale_color_manual(values=colors, breaks=c("A", "B", "All - A", "All - B", "No Outlier - A", "No Outlier - B")) + abs(x="Impressions (in 1,000's')", y="Total Streams\n(outliers marked with x)", title="First Six Weeks of Release\n(Assuming same intercept for A & B's)") # + # scale_x_log10(labels=comma, limits=c(1e2, 1e4)) # # # # -------------------------------------------------------------------------------------------------------------------------------------------------------------------- # ------ filter <- DB.using.agg[, weeks=="total" & mkt_priority!="C" & !is.na(impr1k) & total.count.by.upc > 0] filter.imp <- DB.using.agg[, filter & (impr1k < imprMax) ] # -------------------------------------------------------------------------------------------------------------------------------------------------------------------- # cat("Here is some analysis of `formatOfAddProd`. Come back to this later, with more data\n") ## Side analysis with inclusion of formatOfAdd. Too few datapoints for now to include. M.exp.formatOfAdd <- DB.using.agg[filter, lm(log(total.count.by.upc) ~ 0 + formatOfAddProd) ] summary(M.exp.formatOfAdd) M.exp.formatOfAdd <- DB.using.agg[filter, lm(log(total.count.by.upc) ~ 0 + formatOfAddProd+ dmkt) ] summary(M.exp.formatOfAdd) M.exp.formatOfAdd <- DB.using.agg[filter, lm(log(total.count.by.upc) ~ impr1k + formatOfAddProd+ dmkt) ] summary(M.exp.formatOfAdd) anova(M.exp.formatOfAdd) # -------------------------------------------------------------------------------------------------------------------------------------------------------------------- # # -------------------------------------------------------------------------------------------------------------------------------------------------------------------- # cat("Here is an analysis of a power relationship. Not as strong as an exponential") # M.pow <- DB.using.agg[filter, lm(log(total.count.by.upc) ~ log(impr1k) + dmkt) ] summary(M.pow) ------- M.pow.A <- DB.using.agg[filter][dmkt==1, lm(log(total.count.by.upc) ~ log(impr1k))] M.pow.B <- DB.using.agg[filter][dmkt==0, lm(log(total.count.by.upc) ~ log(impr1k))] summary(M.pow.A) summary(M.pow.B) M.exp <- DB.using.agg[filter, lm(log(total.count.by.upc) ~ impr1k + dmkt) ] summary(M.exp) M.exp <- DB.using.agg[filter.imp, lm(log(total.count.by.upc) ~ impr1k + dmkt) ] summary(M.exp) ------- # filter <- DB.using.agg[, filter & impr1k < 2000] M.exp.A <- DB.using.agg[filter][dmkt==1, lm(log(total.count.by.upc) ~ impr1k)] M.exp.B <- DB.using.agg[filter][dmkt==0, lm(log(total.count.by.upc) ~ impr1k)] summary(M.exp.A) summary(M.exp.B) M.exp <- DB.using.agg[filter][, lm(log(total.count.by.upc) ~ impr1k + dmkt)] M.exp.inter <- DB.using.agg[filter][, lm(log(total.count.by.upc) ~ impr1k : dmkt)] M.exp.cross <- DB.using.agg[filter][, lm(log(total.count.by.upc) ~ impr1k * dmkt)] M.exp.flip <- DB.using.agg[filter][, lm(log(total.count.by.upc) ~ impr1k : dmkt + dmkt + impr1k)] summary(M.exp) summary(M.exp.inter) summary(M.exp.cross) anova(M.exp.cross) summary(M.exp.flip) anova(M.exp.flip) y.calc.exp <- function(x, coefs) exp(coefs[[2]]*x + coefs[["(Intercept)"]]) yrange <- DB.using.agg[filter & total.count.by.upc >0, range(total.count.by.upc)] xrange <- DB.using.agg[filter & impr1k >0, range(impr1k)] xvals <- seq(from=xrange[[1]], to=xrange[[2]], length.out=25) yvals.A <- y.calc.exp(xvals, coef(M.exp.A)) yvals.B <- y.calc.exp(xvals, coef(M.exp.B)) regr.data.exp <- data.table(x=c(xvals, xvals), y=c(yvals.A, yvals.B), Group=rep(c("A", "B"), each=length(xvals))) regr.data.exp <- regr.data.exp[y < max(yrange) & x < max(xrange)] ggplot() + geom_point(aes(x=impr1k, y=total.count.by.upc, color=mkt_priority), data=DB.using.agg[filter]) + geom_line(aes(x=x, y=y, color=Group), data=regr.data.exp) + labs(x="Impressions (in 1,000's')", y="Total Streams\n(log scale, base 10)", title="Streams per Add-Impression\n(First Six Weeks of Release)") + scale_y_log10(labels=comma) #, limits=c(1e2, 1e4)) P.Scatter.plus2K <- ggplot(aes(x=impr1k, y=total.count.by.upc, color=mkt_priority), data=DB.using.agg[filter]) + geom_point()+ geom_smooth(method="lm") + labs(color="Release\nPriority", x="Impressions (in 1,000's)", y="Total Streams\n(log scale, base 10)", title="Streams per Add-Impression\n(First Six Weeks of Release)") + scale_y_log10(labels=comma) #, limits=c(1e2, 1e4)) P.Scatter <- ggplot(aes(x=impr1k, y=total.count.by.upc, color=mkt_priority), data=DB.using.agg[filter][impr1k < 2e3]) + geom_point()+ geom_smooth(method="lm", alpha=0.25) + labs(color="Release\nPriority", x="Impressions (in 1,000's)", y="Total Streams\n(log scale, base 10)", title="Streams per Add-Impression\n(First Six Weeks of Release)") + scale_y_log10(labels=comma) #, limits=c(1e2, 1e4)) ggsave.out(P.Scatter.plus2K) ggsave.out(P.Scatter) printModel <- function(coefs) { coefs <- coef(coefs) (raw <- paste0("e ^ ",formnumb(coefs[["(Intercept)"]], selfRound=TRUE), " + e ^ (", formnumb(coefs[[2]], selfRound=TRUE), " * x )" )) (form2 <- paste0(formnumb(exp(coefs[["(Intercept)"]]), selfRound=TRUE), " + e ^ (", formnumb(coefs[[2]], selfRound=TRUE), " * x )" )) return(form2) } png(as.path(outDir, "Plots", "ModelSummary", ext="png"), width=800, height=800) gplots::textplot(capture.output(cat(paste("A : ", printModel(M.exp.A)), paste("B : ", printModel(M.exp.B)), "\n\t===========================", cbind(c(capture.output(summary(M.exp.A, signif.stars=FALSE))) , capture.output(summary(M.exp.B, signif.stars=FALSE))), sep="\n") )) dev.off() # + scale_color_manual(values=colors, breaks=c("A", "B", "All - A", "All - B", "No Outlier - A", "No Outlier - B")) ----------- M.exp.interaction <- DB.using.agg[filter][, lm(log(total.count.by.upc) ~ impr1k*mkt_priority)] summary(M.exp.interaction) summary (DB.using.agg[filter][, lm(log(total.count.by.upc) ~ impr1k*dmkt)]) summary (DB.using.agg[filter][, lm(log(total.count.by.upc) ~ impr1k*mkt_priority)]) summary (DB.using.agg[filter][, lm(log(total.count.by.upc) ~ impr1k*factor(mkt_priority, levels=c("B", "A")))]) summary (DB.using.agg[filter][, lm(log(total.count.by.upc) ~ impr1k*factor(mkt_priority, levels=c("A", "B")))]) summary (DB.using.agg[filter][, lm(total.count.by.upc ~ impr1k*mkt_priority)]) summary (DB.using.agg[filter.imp][, lm(log( total.count.by.upc) ~ impr1k*mkt_priority)]) ---------- Keeping in mind, that I want to solve for x, where x is the number of impressions so if I have y = a * b^x log(y) = A + B * x y = a * b^x, where A = log(a) & B = log(b) Thus, an increase of one unit in x has an effect of a b-fold increase in y x y 1 ab 2 ab*b 3 ab*b*b 4 ab*b*b*b from x=2 to x=3, y increased b-fold from abb to abbb abbb - abb = abb(b - 1) abb - ab = ab(b - 1) ab^4 - ab^3 = ab^3(b - 1) log(count) = A + B * (Impr1k) # solve for Impr1k Impr1k = (log(count) - A) / B "The constant term tells us that if both of the independent variables were equal to zero, we would expect 4.28 deaths due to political instability in a country. "