From 3ceb18871b8b9a05792963bf5b80389ca877309e Mon Sep 17 00:00:00 2001 From: Paul Trowbridge Date: Mon, 2 May 2022 13:48:04 +0000 Subject: [PATCH] test --- Rplots.pdf | Bin 8963 -> 8659 bytes plain.r | 607 +++++++++++++++++++++++++++++++++++++++++++++++++++++ target.r | 36 ++-- 3 files changed, 622 insertions(+), 21 deletions(-) create mode 100644 plain.r diff --git a/Rplots.pdf b/Rplots.pdf index 46ab7977f524e060b5d8ee475aa1c89298ae84db..75b6ba6772e59a13cbbccb6bb085d18207618c0d 100644 GIT binary patch delta 4695 zcmZWsWmuG5*QF&Ch8jXzknS2lxvs{*+qsIR zvDRy3&E7r(%&uc>4AxAD1Dvf4U;D8(KAA0x3EmUae^FGsElAzyo$K7Zn)qIi_~!`` z+P2E>?6I%(E7llI90FYGlqGrcc#0-*|2^*nC)QB{y2SO0>l+VhT-m4-BAlgB zoKjDxblmeZ9JcusH5V98GbiO7!;A97E%Coe8un}+lE+#uI-MYZDmtY+GBS@dR0YM& zX=0T^ynh!*&0URXd7j~gfOcdM(Pv^3b!~c;P6H~n1vgMI_owe_o>!nxq%&*{yPM74 z)r>eQaxo${Q%83@>--U&JE%A+LUFYY0?NeCC`vVnS8*D(T(RS$l5e!^47RB!wD=gc z)gBbNa8{^k3mQ@Z6IyPulT=ixI$7o@RB9oDi_a}K?q5h_D56fA@c(S_FqJZ&qXFyE zaCO0tM9&!b(r}ILfX0m8ZMa;_)_ndHL!>th^yPRIWA?##o)|5EdS3PuH@MkaRp@Z6 zHDu5M+jRSuB561EHHyc9TW-bSUa&^|^KFZhFWD}bQ z{2t(FTy5z&)6(+4*oSLbetD{z`8iQ&vHUA35m?A$%zPm zQQ->Ju{WdWzuiVOP z|7n=^HhkKLAa!}JpXj@Q`@+u5^m!!tFRmI(dJQv;fbuHCovQPkEyEpD+p=NpMb2s; zYmH&CXK1TCvM<#aZN-6vitK(z3d+Eb?)0C7s-*(=%TOV)s$3T)ey4ZrQv zbdk4rXOETQ(w$vJF98LDOE5CLaFLjH!ZG{$KKShhx*)g>el>}8h(N<5IF>R6t9!)t zx{a#_|4sE=CDxzu;7*k7~L-S-t3}V4IF;yR>i0F_zQ)c_Dg9{C0O zcj3rjmM6a424W+>*e!aRzID>i{^U;;z@acY?H0jWaeMlE!?|YnBOg8S&2XlP`+{^x zTwU4sU$Id?pr-R#KHSdc4@H%^1BsQ|BB~o9F|en}$c6%~@POo0#UC&A)|Mk^SO$FU zW2V|*biq(lz`geQ^WYYE?MKsA8AeaNl=!X=Q@Y@rw+C69eli9R=OT2(T{_I_+~1rH zrN^IM_s&8ywW_;6;|J4x7vI?3r2~lIkFv%{h}la|non(a*9AXR!!R2nbq+Qed~D<2 zI~C8|4bFGt>CgkSQ~u5q8wa+-a7S}1Ybxq1H3&~A5Yck;+xc|GQ9kd^YCT)okt3-j zqhhpUk@<{6dBP69ZWQy^Yvg0P60M)oE&c5gaxdiOh&l_d#m6&COh}@Lhozq~<8{eK z>bs@_vK}hywB!QS@xGlSj^`O)gXV3*YT4Dj$|(*ma3#I0dRg%_#}$+)sp3+` zBO~)U@3K4akmzce>!9xZBZZIIFI6fL{Oc5KI#k)2xc&bcj@qarsJhJQnD3nZeS`K% zu7!=&9`uks4e;kc)t*AXiL zc~8VG)mJp(`{zEAbpNjfF;5gF5ob`(uYNlx5LHl4g!-V2Gj?eHg`idHkJyHlnnLl4 zO2MLpGMo6tigM3!9=nEA6CrTzJ)Bk_LEP@fS^^Bi&P-`H{d#DpB#ADf zIJV0xzf9q(IB%c&$-u1>MVnC2nJ96AF<691U?ifulB(h)qW^+3z@0mS)j#5`bw`y-sSJ$_uuV)@c9kohW zSMcFjVfxq50Q>t}O<#e2G!b(x=A8DF^hTs8RjQt9#^-31_J=9*0*z<+zKY@ou_|V4 zCHWxKS{eFTaGK;9ZllwME7hP%@0Sx^szJQqL_gVV0S|tMxk8UYSgM02yQ+#sNe{`h zmls5mnFioVH)#BQv}+*f38CfUWTe<(Sio_CHqX-#-Vtr;K_(!fS`bQ^^ud4#+}Bt& zhBSztS*&IsxIAH)Zw|dU+F+_H&S~B~lBm>ZYwrNpWGFlQatdR0qR%*fSzm3nmN2C8 zU`*J~j~>WHoix;IHfyHG**`2W!Z&H&d0FeD@z1p2ANBWY&>$8OfSNvie6gyn-R%5qCxbW5 zsAYiXo3pYg&&w|wI_}YDwE{ec?Rjg!s^BLf%%SJ4e;l`ZN)QjdqBn_oCN8gv?5-+)azXS8LqA&sI6# zO8F|yq;j{FlH;dX0;o%{i#VH@RuY9Gp_NBD64Q#K97$;9P?OYr@_8v<*F=cD@7|G! zAMgj=KES@TN`Hz@(4n*nkBWL?A-zgZLLq1yW(Gw0sq1fBI=R4paA3b@j|kmH2NAKq z=kxN8KKnk@rtKcv%TVn5N=rK-mlN?%x0cQ}p3mgmTU#;|nPV=QnvNeQmv%0vrcp|_ z#(KX7*V`1PS(iqljOw6VvTlv(ehu0RL&-`*b-=?U(L=(9P+wMN65^QS=9CjR;}XPR zPMo+!lz6;v%`KM((6fch{m`CRu?-v7UK(XDAB9X^jSC48=pG1dMMHJH%>lWkRtXTvWFZr%@_yTaThA67u~r{S7CH2Fhprk4`oB=an7+mSOq zz|A`XODq2Tv+E~H~=3rFFRs3KnfC5GCkg8bmIBapCI;A!Ukm|mQNmFfZ z3a#*;Qlo)lI*v$zBBymS%2x>a5|-C1uR9+@`F^qB-y3lF&&CT6Yus2e6B8JD}xLv#!F9( zWM0?zdXiyvSt~GLx@@#RkSVxB?kM>I(~DU5{x#O#rs5RDfd78ABBpdSYs3$cp}<0rC&}f#=35ed zo{U<>0htJaQINi7OcnKF(C4xCP1lu}%Gv$4aH5q{f^-U}p-SmjqibV@A7;|FPVXHW zbs)2h&UPBc)6EXog^^^7>Zi6ha}6_DbcYT=IL^WbIUidlQ}kGimqthRGUc4P?D(ks zWaq`ntdc?)XBs#-9_TU<1q!E=cwGxU#HVF4KR;cjiZqOreEw%Bn}&~(CU>vZ4c-;d zJOx;$m<(rBwCV)yggo^sR`E>{R(|`)7L|obt-e%JU)FwJbD@gQ^IIX_bYHw%QyV)n z6U(mt{6Lg?7MGEId^jiTLqtPTv{6bKHE$}{W~(pr{(1IE3V5gmCO37RJHP3OdL8&l z${T#np;$kZKayrtJ6oMrFD6}IS21{(NI17NM9Q<_O(oTA^}5lZSbD9cjsnAz>{_!{jS>gw$r<5Q+CxZkjN6 zMuCN}o&JJyW|6gi{a}7efDBqT{cLibAilWMT?a@N=3a1~vTe-3DEwvBFdlQdY1C#P z7tDmXRh*|32K=bRS1xGVIv9GwL*QNBTZyxnt5-|o?qtKM_6KCc@*NpR%RQ&9rHalS z@$(TDZ35#kUd(uz&Q;vXzryr=oaf^NJYq&T|e8yiK6$MlJ0edP8z2(q2#@V9Kb}oy4{Te^i zUn0EH3kXSlo)*h5!E{Lec=2p*U2<#x6$2x=Q+;L*I{r{t?H*vpXy;M|?J78jK)LNz zXRvzQ;bHMR*AD%A(?0AX+47oQ+$Am1u#aZz7TIV_NhaUyLZxD6sdjocx*Sc;-otXw z&iWKA$y9e@#j}TAeU$lz>5!2^7Cmoea!8?+&mr=OCfQF~tBUJP`eyyvl(nbn<0^hE zoU?HN8*!hwjYTiGyYtDz54~UC9BUnG?QC!OR)w>K0i!n*7Cy|KRU|Yg_mm_c5@Kv3 ze-E1%8|lA5L_$VP^1nGr5h;=XtxfL{v=Xf9k}{LUv_pq5 zba%Y_eZPO-vybCC?tNd^I@i7atud7_^#oZwacNNqLV@xBPV+fjDX3VIEH)QlY3|J; zRUI@{**?aO=}78ubbp)VU}h|6V1C>i=o+41+FX%xeSN(moD6Sb*0iz| zI+)VA2|7F#E-~KIt-U0_y@3Pyu6laHy4UybevRu~H{In5HR23ROpFSQk*2sM@A^!b zJH}Q-(4WkIv-UIc3?u+xFs#S+$=BVy<3{!dG@FF5+@Y3=-{qG+cD2O;!-suIbONL> z$8tR)uV={p7H`cEhdi6h5~lac3E`nNM#6NVg0$%iz2FdxnnHpgZCSa?XO)C-oZ1$e6mC;K2_Y82#BgO2g??5L zlG!i=Lw#%`wy+(V=!&TnvbkKCC5D$jK@ieRUz#KlDhR38RKs#@DVyLX!8?6~Bh8Oz z8f&?;mEJ4V4^W5rPH2X6kl>^LGLl!Ta?~n41V^idO+2~AGgbEKSI=>XR!o~V<{TZg z+s-vr*QQD2Q8j0!!qykoit;l`QW_tm&KH5W-uv%extu2`RPcd}q59;5e(HRcLPsj4 zPn0{Q#yUwH1)VlxQ3U#(gD28hVS*B*$^}}?+$2EUpGs6P#fDktk}c2erx~&*r`fO>%%^rPKZpxB3Tj5 zm75(56Y;*72j&xRjACTTw%si|Hco7;^NaB)nJY2avOVYdk`u=XSvW0Uy4dEHb1t%| zd6Ppb*s}Bpw`n)tr1{W0DVZZZ3VMD=e$4>5&c4;Zm`4+sN!Dk=%*kNZ1#jW|eH2iR zT6VgM!YnB)DWSqXMoRO~iEnk$2ACBG(RR}>{C~ui*KB{j=ry_NDwlCm^qxA!P5*)q zaT}ei8%cpAOX5IJe0j#4+WPLr`5K(`&6{@xr*|xCZi^agXXfGy@Rn_N>A7zynxq50 zd!JN7%5fQeiWol}`z#GeKz%CZ1_o5MwDOetwFZk)Fhum4wlG`c<{)!53isxGjD%#; zSK)?&9k~~&^^JzMF!Ui)^?GpaigR>yO$|SqYAJWBZocJNDk-9BLJuXm-)VS$PF}E1 z6r-{-AgNj(ASoC0gnNs*eDinu@-M(%OYN(>M7S$oNY&mTa>$7=ldNxqZtQd#_FRrT zeGzIm=d`sQ?6JWtH^6`nsSQqTe(@^C`L7p4oQm~}Dok!z=_QqR&Q@sL5TBR+mw`4j9d9b zOqUZ8p^J)52B|>B^y|(8%Iqd6rmBD5p&hzTchnV8 zT`e~iVzv}bGHrp)&r2psTej9FTv&tAHLn7JCDKV9-M9`p0DDH@WLx_rD!e82Dn1-C zZ?{7r<}sfg^rq##ZIG`w%A)dmmY;>VT(+zMpN5ascOe@EZPRCvBgiKc@bwmVE*ak_ z?zWF1XBmpwO1;B=58=&G|B;@-iMPaYi0N0Y?9+94ai+Q zys}e^St5ME!@}ho%R+nRcX>e5z80HA*0`!-lUdj3r7{Dm$qLnI`d!XC{=tdsk($?d za@Pu15O)c~k+C4NLyqBUx&K80^ZGJ}VFEARM40v_YMWl&?G2g4H2XU{JHEuv&Up#W zw(uZ~ccyPc7H&g;Vtv>OI`?exkDLE3hoP)gu7L<}VD>%DU%0&Cx4jpof!BhKm8f(S zzv-0B$}PBfe9WbbDZvGHlk){Uu$(uoB!V6CMvsjiZK#2Jt3o|S0^B8h$Gj_{2titc z$lY|XPKiDY*PLqxJc&o$f2?wv^5yEPOC&ku1xLdFx5lQs6Dyv0an9f;zxx0r%R*oH zB-;035MHUYIE6wFMOK9PV~1Q!oF9?fl?eU8!SPqp{*m>Dwr`cAXtjg$H7_rr{<2rU zhgP*-yLg2mQFXWDM>p!m! zj`59)gNHDM`UYtWc@D?T=~@ou>(N8S$i9_AhYQ2G; z7+7RWih7B~MR)A`ND8toa94ubDNrjKoDf&v2$wx5<;wFUTk6GU6L z_>;gV38oBz{S98)s;;-CRr&q|_r|kY#Y$ymR;g^ymWP3p?AGX@SKqAG6JK9k@BR%a z&R&?u*WJIoJcJkyi!V1w}P1k<|H_>TxW;aZh&6~$3pS|W)0=S;?`MTtXhZ0)SWhq+Cua1wu zTlv_k|G2+L2PU&xvav!MIXfdiOor-R{Vjo9#UVc<;+RKtWxK;hvQ(lDcJ-YfbeDCA zc9$XSqBOY(sFEUxIGxDiIi2EY)rOc^)rXk*W78l2G(HXTj8)XtgG1Eyi=y4+;uE{c zCkT+t14-p*O|D+*q=+aUCo*zgkkkfA7)Yk4L7DMN66 z_?7R=X_e%_6fb>_?)*aKkQc&0uY>n0@w;eI8daZCPi!NtA=nHs0=t!@^&z@Gyk#|b z?%B=VL#LtL+X(h+2m6KeP$kitvWhZs#h8Yv#F%o0(`$^AGtsNQ0xR(uz{*8Cc8z$U zzn+pk zf8Ql<;8EysAd7R3hTFO&9L+8)ov<7?{_ETjS>U6=Wq464(i*N8KFb??ka`?W{%|Rc z$awbnlb$KdJtNtH>XX>&Z&UHz-|}ZaJ}u4{i|+!8e^-#itYJfq?8n}fzKbg&^eTe= z%ri5oocg&}AugmRt-!$yg9KgKfLsW7p%-*akz=MBAC8L1{DD z#Hljbko_e^sxOlw36cn&b0G-&-Q!bBUm1TzPuWOn;MbQF;Fu1VQO0eO)rP#FcG}VT zj{Vem8LRLgP~zU;gxq}L8LMR)25lXyCG zqErH!yU21R!!@6Ju79&#tV_(98T?x`8T4LW(&}7IMA#=z7IrziQ;+9=lI9vy$)j|% zd^c&*>}jKJi8S(T+?%b zvQ5b#*SJHLx7Nh6XPZ`s`xY%lMmF)756VCA_jms>vOu)dwPBHV;o-{XKyW|X+-nLj zoKvLOYT`LNI8omaPdh`FLTEH3w68x?xP~1I27plSfvjMMS-N?3TqRRT*Jq9kC+Ina5<*3f$^b)W}jHG(apaC@*>mQE7cXSx|gVfe5F!i-K-CRg! z7hb8By8GaR`Y>p9E%5t-Qz&q+^2xeu<91yeXO{3%b;B(fh7MX?f+3Dj;5ry?HEgG} zd5Oz!MmWk^1+DLyz`EXNUZ9O~hmv=UZ8)YZmz=_fZYl(3%S4EP;vHfs0b*%BblGSp zuh`!8@Q40U#|%2JeshCHQ%pM%Ke|i=$|W@GEhP~4`VtwQLDx*XT%z!%My$UVLn0-B z8xvX+o{;oDWm;Nm_`pnOPcRD124!RNXfotvzt>QL=I*XwC}`HmlH`KG z=E(B8s*G%N&Av2Z#C=yVzNzhh;pE5{m#87ua8=zO2z(r<<0g!9u43duwUUV z!X^VRO!(`Oyl{N=(|&!~lJ0A4dOTb3<9AMU40UX4mmf-(5K$$S{PJFGe>$c-o!Z%$ z*(eL(SqJiL&fKqURcu5p_q`jDRVXxh?@Xq%Aoh&`BR(?kJ=;y=yT@;O10Ry5ZDj*p zi<*+@YacPsHYiMobl%Ipw$o8M=hKw0b2QU?jom3~;VfAH3SDxLFra|Fq!+vUl>_dF z#NwJ&qw!?v?7Q@2=Czm(;NlJajvWA`+4*tKG9CxPzz&uIb&kxi8my)Luk0~qa~`*B zJSi~6M$F8Y>5%=IT8KI{*+w!MsaJ6St1V8MG*p~h8}BXd@hw&lEu(rt*9v^JXxa`K zTd*>mSaZ=gLc5cZ8@gMZ&p+#^v{R(VCsTsdf6gQ<(Rly0vTyi0VEg*bp*2E<1*>L; z`j|`+A}S%tA@bjk!<~cpe?KA+F)`_XdE$~1|MsM%lE@xF6`>;1V*fvcic9>f2~ '13026') THEN 'ME' ELSE 'OTH' END terr + FROM + rlarp.osm o + LEFT OUTER JOIN colortier ct ON + ct.cltier = o.coltier + ----swap out channel names----- + LEFT OUTER JOIN xch x ON + x.chan = o.chan + ----build data segments-------- + LEFT OUTER JOIN ds ds ON + ds.colgrp = o.colgrp + AND ds.brand = substring(sizc,3,1) + LEFT OUTER JOIN pricequote.market_setavgprice t ON + t.chan = x.xchan + AND t.mold = substring(o.part,1,8) + AND t.data_segment = ds.dataseg + AND t.season = 2021 + LEFT OUTER JOIN rlarp.prm ON + prm.promo = o.promo + LEFT OUTER JOIN rlarp.priceg pg ON + pg.part_group = substring(o.part,1,8) + LEFT OUTER JOIN \"CMS.CUSLG\".itemm i ON + i.item = o.part + LEFT OUTER JOIN rlarp.qrh ON + qrh.qr = o.dsm + INNER JOIN regional r ON + r.code = o.bill_cust + LEFT OUTER JOIN pc ON + pc.jcpart = o.part + AND pc.jcplcd = r.plist + WHERE + o.part ~ '",mold,"' + AND o.colgrp ~ '",colgrp,"' + AND o.brnd ~ '",branding,"' + AND o.oseas >= 2020 + AND o.fs_line = '41010' + AND o.calc_status <> 'CANCELED' + AND o.version = 'ACTUALS' + AND o.odate <= '2021-01-22' + AND o.chan = 'WHS' + --AND i.aplnt <> 'I' + --AND o.ming <> 'B52' + --AND dsm in (select qr from rlarp.qrh where dir = 'Pierre' and qr <> '13026') + GROUP BY + CASE o.chan WHEN 'DRP' THEN o.shipgrp ELSE o.account END, + --o.geo, + o.chan, + CASE WHEN substring(o.bill_class,1,1) = 'R' THEN 'X' ELSE substring(o.chan,1,1) END, + substring(o.part,1,8), + o.sizc, + o.brnd, + COALESCE(i.accs_ps,''), + i.suffix, + i.uomp, + i.coltier, + o.colgrp, + o.dsm, + o.oseas, + prm.grp, + --x.xchan, + ds.dataseg, + t.target_price, + r.plist, + jcpric, + COALESCE(r.region,o.geo) + --,CASE WHEN o.geo = 'US WEST' then 'us west' ELSE 'elsewhere' END + --,CASE WHEN dsm in (select qr from rlarp.qrh where dir = 'Pierre' and qr <> '13026') THEN 'ME' ELSE 'OTH' END + HAVING + SUM(fb_qty) > 0 + AND SUM(fb_val_loc*r_rate) > 0 + AND CASE + WHEN SUM(o.fb_qty) = 0 THEN 0 + ELSE SUM(o.fb_val_loc*o.r_rate)/ SUM(o.fb_qty) + END BETWEEN .01 AND 100 + ",sep=""); + + con <- dbConnect(RPostgres::Postgres(),dbname = 'ubm', + host = 'usmidlnx01.gbl.hc-companies.com', + port = 5030, + user = 'report', + password = 'report') + + d <- dbGetQuery(con, sql) + + #d; + + dbDisconnect(con) + + #-----each graph is composed of 2 pieces when doing the facet() pivot, these 2 pieces make up the plot defition----- + #d$dim1 <- trimws(paste(d$mold,d$colgrp,d$brnd,$region)); + d$dim1 <- trimws(paste(d$mold,d$colgrp,d$brnd,d$plist)); + d$dim2 <- trimws(paste(d$chgrp,d$suffix)); + d$plot <- trimws(paste(d$dim1,d$dim2)); + #d$sub <- trimws(paste(d$coltier,d$kit,d$suffix,d$package)); + d$sub <- trimws(paste(d$oseas)); + #d$sub <- trimws(paste(d$geo)); + d$qty = d$qty/1000; + d$volmin = .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 = 6); + 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), + PriceMin = round(min(price),4), + PriceMax = round(max(maxprice),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, + 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) + ); + 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) + ); + plist <- ddply(d, .(dim1, dim2, plot,mold,chan,colgrp, brnd), summarise, + List=round(mean(listprice),4) + ); + + #targets; + + #-----------------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"); + + #create a single row for each plot that will hold relevant data + 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)); + + #merge in year 1 data + 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"; + + #merge in year 2 data + 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"; + + #merge in direct targes + anno <- merge(x = anno, y = dir_t[ , c("plot","Target")], by = "plot", all.x=TRUE); + names(anno)[names(anno)=="Target"] <- "t_dir"; + + #merge in drop ship targes + anno <- merge(x = anno, y = drp_t[ , c("plot","Target")], by = "plot", all.x=TRUE); + names(anno)[names(anno)=="Target"] <- "t_drp"; + + #merge in warehouse targes + anno <- merge(x = anno, y = whs_t[ , c("plot","Target")], by = "plot", all.x=TRUE); + names(anno)[names(anno)=="Target"] <- "t_whs"; + + #merge in pricelist + anno <- merge(x = anno, y = plist[ , c("plot","List")], by = "plot", all.x=TRUE); + names(anno)[names(anno)=="List"] <- "plist"; + + #anno; + #create a csv file of the anno table +# 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=sub)) + + 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","\n", + " | plist | change | % incr \n", + #----------price list----------------------------- + "PL (orange):", + str_pad( + format(" ", nsmall = 4), + width = 6, + side = "both", + pad = " "),"|", + str_pad( + format(round(plist,2), nsmall = 4), + width = 6, + side = "both", + pad = " "),"|", + str_pad( + format(round((plist-yr1_wa),3), nsmall = 4), + width = 6, + side = "both", + pad = " "),"|", + str_pad( + format(round((plist/yr1_wa-1),3)*100, nsmall = 1,width = 7), + width = 6, + side = "both", + pad = " "),"\n" + ) + ), + family="Courier", + size = 3 + ) + + 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_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=dir_t, aes(yintercept=Target),linetype="solid", size=.5, colour="blue") + + geom_hline(data=drp_t, aes(yintercept=Target),linetype="solid", size=.5, colour="yellow") + + geom_hline(data=whs_t, aes(yintercept=Target),linetype="solid", size=.5, colour="red") + + geom_hline(data=plist, aes(yintercept=List),linetype="solid", size=.5, colour="orange") + + #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$PriceMin, glob$PriceMax), 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; + #plist; diff --git a/target.r b/target.r index b80035d..41ade21 100644 --- a/target.r +++ b/target.r @@ -8,7 +8,20 @@ library(gridExtra) library(stringr); library(DBI); -prod_plot <- function(priceg, mold, colgrp, branding, outlier, xfact, yfact,xtrans, ytrans, lprice, uprice, pqty ) { +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', @@ -279,23 +292,4 @@ prod_plot <- function(priceg, mold, colgrp, branding, outlier, xfact, yfact,xtra 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 -); - - +#};