initial
This commit is contained in:
commit
2a0c510ade
BIN
Rplots.pdf
Normal file
BIN
Rplots.pdf
Normal file
Binary file not shown.
301
target.r
Normal file
301
target.r
Normal file
@ -0,0 +1,301 @@
|
||||
library(plyr)
|
||||
library(dplyr)
|
||||
library(ggdistribute)
|
||||
library(ggplot2)
|
||||
library(ggExtra)
|
||||
library(scales)
|
||||
library(gridExtra)
|
||||
library(stringr);
|
||||
library(DBI);
|
||||
|
||||
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;
|
||||
};
|
||||
|
||||
|
||||
|
||||
prod_plot(
|
||||
".*" # price group
|
||||
,"XTG154" # base part
|
||||
,".*" # color tier
|
||||
,".*" # branding
|
||||
,300 # outlier coefficent
|
||||
,5 # width factor
|
||||
,4 # high factor
|
||||
,"log2" # volume scale type
|
||||
,"log2" # price scale typec
|
||||
,.01 # filter min price
|
||||
,30 # filter max price
|
||||
,4590 # pallet quantity
|
||||
);
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user