library(plyr) library(dplyr) library(ggdistribute) library(ggplot2) library(ggExtra) library(scales) library(gridExtra) library(stringr); library(DBI); priceg = ".*" mold = "XTG154" colgrp = ".*" branding = ".*" outlier = 300 xfact = 4 yfact = 5 xtrans = "identity" ytrans = "identity" lprice = .01 uprice = 30.00 pqty = 2000 #prod_plot <- function(priceg, mold, colgrp, branding, outlier, xfact, yfact,xtrans, ytrans, lprice, uprice, pqty ) { sql = paste("SELECT * FROM rlarp.rlang_plot('",mold,"','",priceg,"','",colgrp,"','",branding,"',",lprice,",",uprice,") x",sep=""); con <- dbConnect(RPostgres::Postgres(),dbname = 'ubm', host = 'usmidlnx01', port = 5030, user = 'report', password = 'report') d <- dbGetQuery(con, sql) dbDisconnect(con) #-----each graph is composed of 2 pieces when doing the facet() pivot, these 2 pieces make up the plot defition----- d$f7 <- substring(d$mold,1,7) #d$dim1 <- trimws(paste(d$f7,d$v1ds)); #d$dim1 <- trimws(paste(d$f7,d$colgrp,d$brnd,d$package,d$suffix,d$kit)); d$dim1 <- trimws(paste(d$base_item,d$colgrp,d$brnd)); d$dim2 <- trimws(paste(d$chgrp)); d$plot <- trimws(paste(d$dim1,d$dim2)); d$sub <- trimws(paste("v1:",d$coltier,".",substring(d$brnd,1,1),".",d$package,".",d$suffix,".",d$kit)); #d$sub <- trimws(paste(d$oseas)); #d$sub <- trimws(paste(d$geo)); d$qty = d$qty/1000; #-----need to include credits------ d$volmin = 0.0001; d$season = factor(d$oseas); #-----build widths for how many scenarios are present---------------------------------------------------------------- dim1 <- data.frame(unique(d$dim1)); var.dim1 = nrow(dim1); dim2 <- data.frame(unique(d$dim2)); var.dim2 = nrow(dim2); #-----------need to do an aggregate to consolidate to single customer point d <- subset(d,chgrp != "X", promo != "Excess and Obsolete"); #-------------------------eliminate outliers------------------------------------------------------------------------- dx <- boxplot.stats(d$price, coef = outlier); ex <- data.frame(dx$out); #ex; #list the excluded outlier prices colnames(ex)[1] = "price"; outl <- inner_join(d,ex, by = "price"); outl; d <- anti_join(d,ex, by = "price"); #---------switch to log axis if there are still outliers with a coefficient 3---------------------------------------- var.trans = "identity" if (nrow(data.frame(boxplot.stats(d$price, coef = 3)$out)) >= 1){ var.trans = "log2" }; glob <- ddply(d, .(), summarise, Volume=round(sum(qty),0), Sales=round(sum(sales),0), WeightedAvg=round(sum(sales)/sum(qty),4), Mean=round(mean(price),4), StdDev=round(sd(price),4), Target=round(mean(target_price),4), AnyMax=round(max(c(price,target_price)),4), AnyMin=round(min(c(price,target_price)),4), PriceMin = round(min(price),4), PriceMax = round(max(price),4), VolumeMin = round(min(pmax(qty,volmin)),4), VolumeMax = round(max(qty),1), VolumeSD=round(sd(pmax(qty,volmin)),4) ); #targets <- ddply(d, .(dim1, dim2, plot,mold,chan,colgrp, brnd), summarise, targets <- ddply(d, .(dim2, v1ds, dim1, plot,mold,chan,colgrp, brnd), summarise, Volume=round(sum(qty),0), Sales=round(sum(sales),0), WeightedAvg=round(sum(sales)/sum(qty*1000),4), Mean=round(mean(price),4), StdDev=round(sd(price),4), Target=round(mean(target_price),4), HexCol = min(hex) ); seas <- ddply(d, .(dim1, dim2, plot, oseas), summarise, Volume=round(sum(qty),0), Sales=round(sum(sales),0), WeightedAvg=round(sum(sales)/sum(qty*1000),4), Mean=round(mean(price),4), StdDev=round(sd(price),4), Target=round(mean(target_price),4) ); #-----------------blank dataframe in case there is no data for a scenario----------------- blank <- glob blank$customer = 'NO DATA' blank$oseas = 2020 blank$season = '2020' blank$qty = blank$VolumeSD blank$price = blank$Mean #blank; yr1 <- subset(seas, oseas == 2020); yr2 <- subset(seas, oseas == 2021); dir_t <- subset(targets, chan == "DIR"); drp_t <- subset(targets, chan == "DRP"); whs_t <- subset(targets, chan == "WHS"); anno <- data.frame(unique(d[c("plot","dim2","dim1","mold","colgrp","brnd")])); anno <- data.frame(anno,qty=c(Inf),price=c(Inf),hjustvar = c(1),vjustvar = c(1)); anno <- merge(x = anno, y = yr1[ , c("plot","Mean","WeightedAvg", "StdDev","Volume")], by = "plot", all.x=TRUE); names(anno)[names(anno)=="Mean"] <- "yr1_mn"; names(anno)[names(anno)=="WeightedAvg"] <- "yr1_wa"; names(anno)[names(anno)=="StdDev"] <- "yr1_sd"; names(anno)[names(anno)=="Volume"] <- "yr1_vo"; anno <- merge(x = anno, y = yr2[ , c("plot","Mean","WeightedAvg", "StdDev","Volume")], by = "plot", all.x=TRUE); names(anno)[names(anno)=="Mean"] <- "yr2_mn"; names(anno)[names(anno)=="WeightedAvg"] <- "yr2_wa"; names(anno)[names(anno)=="StdDev"] <- "yr2_sd"; names(anno)[names(anno)=="Volume"] <- "yr2_vo"; anno <- merge(x = anno, y = dir_t[ , c("plot","Target")], by = "plot", all.x=TRUE); names(anno)[names(anno)=="Target"] <- "t_dir"; anno <- merge(x = anno, y = drp_t[ , c("plot","Target")], by = "plot", all.x=TRUE); names(anno)[names(anno)=="Target"] <- "t_drp"; anno <- merge(x = anno, y = whs_t[ , c("plot","Target")], by = "plot", all.x=TRUE); names(anno)[names(anno)=="Target"] <- "t_whs"; csv <- anno; csv <- subset(csv, select = c(mold, dim2, colgrp, brnd, yr1_mn, yr2_mn, yr1_wa, yr2_wa, t_dir, t_drp, t_whs)); csv$t_dir_rev = csv$t_dir; csv$t_drp_rev = csv$t_drp; csv$t_whs_rev = csv$t_whs; names(csv)[names(csv)=="dim2"] <- "chgrp"; csv; #write.csv(csv, file = paste("//home/ptrowbridge/pt_share/",file_name,"_TRG.csv",sep=""), row.names = FALSE); p=ggplot(d, aes(x=qty, y=price, color=v1ds)) + #scale_color_manual(values=c("#F44336", "#E91E63", "#9C27B0","#673ab7","#3f51b5","#2196f3","#03a9f4","#00bcd4","#009688","#4caf50","#8bc34a","#8bc34a","#ffeb3b","#ffc107")) + geom_point(size=2) + geom_text(data = anno, aes( x=qty,y=price, color = NULL, hjust=hjustvar,vjust=vjustvar, label=paste( " mean | wavg | stdd | vol \n", "-------|--------|--------|---------\n", "PY(black): ", #----------mean------------------------------- str_pad( format(round(yr1_mn, 4), nsmall = 4), width = 6, side = "both", pad = " "), "|", #----------weighted average------------------- str_pad( format(round(yr1_wa, 4), nsmall = 4), width = 6, side = "both", pad = " " ), #----------standard deviation----------------- "|", str_pad( format(round(yr1_sd, 4), nsmall = 4), width = 6, side = "both", pad = " "), "|", #----------volume----------------------------- str_pad( format(round(yr1_vo/1000, 4), nsmall = 4,width = 7), width = 6, side = "both", pad = " "), "\n", "CY(green): ", #----------mean------------------------------- str_pad( format(round(yr2_mn, 4), nsmall = 4), width = 6, side = "both", pad = " "), "|", #----------weighted average------------------- str_pad( format(round(yr2_wa, 4), nsmall = 4), width = 6, side = "both", pad = " " ), #----------standard deviation----------------- "|", str_pad( format(round(yr2_sd, 4), nsmall = 4), width = 6, side = "both", pad = " "), "|", #----------volume----------------------------- str_pad( format(round(yr2_vo/1000, 4), nsmall = 4,width = 7), width = 6, side = "both", pad = " "), "\n", #format(round(yr2_mn, 4), nsmall = 4),"|",format(round(yr2_wa, 4), nsmall = 4),"|",format(round(yr2_sd, 4), nsmall = 4),"|",format(round(yr2_vo/1000, 4), nsmall = 4,width = 7),"\n", " \n", " dir (b) | drp (y) | whs (r) \n", "-----------|-----------|-----------\n", "Targets: ", str_pad( format(round(t_dir, 4), nsmall = 4), width = 9, side ="both", pad=" "), "|", str_pad( format(round(t_drp, 4), nsmall = 4), width = 9, side = "both", pad = " "), "|", str_pad( format(round(coalesce(t_whs,0), 4), nsmall = 4), width = 10, side = "both", pad = " ") ) ), family="Courier", size = 3, #use check_overlap to avoid doubling up the price info print, it will print over top of itself based on the color=sub count of uniques check_overlap=TRUE ) + geom_text(aes(label=customer),size=3, vjust = 2, hjust = 0, check_overlap=TRUE) + facet_grid(dim2~dim1) + #facet_grid(chgrp~plot) + #facet_wrap(plot) + geom_hline(data=yr1, aes(yintercept=Mean),linetype="dashed", size=.5, colour="black") + #geom_hline(data=yr1, aes(yintercept=Mean - StdDev),linetype="dashed", size=.5, colour="black") + #geom_hline(data=yr1, aes(yintercept=Mean - StdDev * 2),linetype="dashed", size=.5, colour="black") + geom_hline(data=yr1, aes(yintercept=WeightedAvg),linetype="solid", size=.5, colour="black") + geom_vline(aes(xintercept = pqty/1000) ,linetype = "dashed",size = .5, colour = "orange") + #geom_vline(aes(xintercept = pqty/1000*8) ,linetype = "dashed",size = .5, colour = "grey") + geom_vline(aes(xintercept = pqty/1000*8) ,linetype = "dashed",size = .5, colour = "grey") + #geom_hline(data=yr2, aes(yintercept=Mean),linetype="dashed", size=.5, colour="green") + #geom_hline(data=yr2, aes(yintercept=Mean - StdDev),linetype="dashed", size=.5, colour="green") + #geom_hline(data=yr2, aes(yintercept=Mean - StdDev * 2),linetype="dashed", size=.5, colour="green") + #geom_hline(data=yr2, aes(yintercept=WeightedAvg),linetype="solid", size=.5, colour="green") + geom_hline(data=drp_t, aes(yintercept=Target, color=v1ds),linetype="solid", size=.5) + geom_hline(data=dir_t, aes(yintercept=Target, color=v1ds),linetype="solid", size=.5) + geom_hline(data=whs_t, aes(yintercept=Target, color=v1ds),linetype="solid", size=.5) + #scale_y_continuous(breaks=seq(0, 10, round(glob$StdDev * .5,2))) + scale_y_continuous( #breaks=seq(glob$PriceMin, glob$PriceMax, round(glob$StdDev * .5,4)), breaks = pretty_breaks(n=20), limits = c(glob$AnyMin, glob$AnyMax), trans = ytrans ) + scale_x_continuous( #breaks=seq(glob$VolumeMin, glob$VolumeMax, round(glob$VolumeSD * 1.0,4)), #breaks = pretty_breaks(n=10), limits = c(glob$VolumeMin, glob$VolumeMax*1.1), trans = xtrans ) + #scale_x_continuous(trans='log2') + #scale_x_continuous(breaks=seq(0,1000,round(glob$VolumeSD * 1,2)), trans = 'log2') + #geom_label(colour = "white", fontface = "bold") + #geom_text(aes(label=ds$ship_group),position = position_dodge(width=.9), size=2) + theme(legend.position="none"); cp_pvt = p + theme_bw(); #targets; options( repr.plot.width=var.dim1*xfact, repr.plot.height=var.dim2*yfact ); cp_pvt; #};