Imvexxy/Bijuva 2020 projection

#
# An R script to visualize the sales trajectory of TherapeuticsMD's Imvexxy/Bijuva
#
# (c) 2019 Germain Garand <germain.garand@laposte.net>
#
# This is for information purposes only. Any calculation performed herein could be
# wrong and/or misrepresent reality. Use at your own risk.
#
# License: Creative Commons BY-NC 2.0

library(ggplot2)
library(scales)

Sys.setlocale("LC_TIME", "C")

a <- c(
  "2019/07/05", "2019/07/12", "2019/07/19", "2019/07/26",
  "2019/08/02", "2019/08/09", "2019/08/16", "2019/08/23", "2019/08/30",
  "2019/09/06", "2019/09/13", "2019/09/20", "2019/09/27",
  "2019/10/4","2019/10/11", "2019/10/18","2019/10/25",
  "2019/11/1","2019/11/8","2019/11/15", "2019/11/22", "2019/11/29",
  "2019/12/6", "2019/12/13", "2019/12/20", "2019/12/27",
  "2020/01/03", "2020/01/10", "2020/01/17", "2020/01/24", "2020/01/31",
  "2020/02/07", "2020/02/14"
)
a <- as.Date(a, "%Y/%m/%d")

aa <- seq(as.Date("2020/02/21"), as.Date("2020/12/25"), "week")
a <- c(a, aa)

b <- seq(as.Date("2019/07/01"), a[length(a)], "months")

imx <- c(
  10250, 8700, 9600, 10250,
  10050,14600, 11515, 10600,11800,
  9900, 9650, 10580, 13111,
  12420,11860,10000,8950,
  9870, 12570, 10400, 10410, 11240,
  8888, 11750, 12050, 11530,
  7896, 9650, 9609, 10057, 8830,
  10240, 9190,
  rep(10000, 8),
  rep(11000, 9),
  rep(12100, 9),
  rep(13310, 9),
  rep(14641, 9),
  rep(15000, 1)
# 620741 scipts in 2020
#rep(10000, 46)
)
bij <- c(
  1000, 750, 1100, 1250,
  1350, 1400, 1200, 1309, 1560,
  1160, 1170, 1450, 1710,
  1700, 1640, 1570, 1550,
  1710, 2010, 1820, 1830, 2080,
  1470, 2080, 2300, 2200,
  1491, 1860, 1881, 1961, 1760,
  1999, 1880,
rep(2090,3),
rep(2299,5),
rep(2528,4),
rep(2781,5),
rep(3059,4),
rep(3365,5),
rep(3702,5),
rep(4072,5),
rep(4480,4),
rep(4928,5)
# 165315
#rep(2000, 46)
)

e <- data.frame(a,imx,bij)
names(e) <- c("Week", "Imvexxy", "Bijuva")

e$Month <- as.Date(cut(e$Week, breaks = "month"))

e$BijNPU <- c(rep(31,13), rep(56,13), rep(66, 13), rep(75, 13), rep(82, 13), rep(86,13))
e$ImxNPU <- c(rep(35,13), rep(51,13), rep(62, 13), rep(66, 13), rep(68, 13), rep(70,13))

t = length(a)-1
cwgr = ( ((bij[t]+bij[t+1])/2) / ((bij[1]+bij[2])/2) )^(1/t)-1

options(scipen=10000)

png("imvexxy_bijuva.png", width=960)
plot(Imvexxy ~ Week, e, type = 'l', col='blue', main="Imvexxy/Bijuva", ylab="Scripts", sub=paste("Bijuva CWGR: ", round(cwgr*100),"%"), col.sub="red")
par(new=TRUE)
plot(Bijuva ~ Week, e, type='s', axes=FALSE, ann=FALSE,col='red')
axis(4, e$Bijuva, col='red', col.axis='red')
legend("top", inset=.05, c("Imvexxy","Bijuva"), fill=c("blue","red"))
dev.off()

png("imvexxy_monthly.png", width=1200)
imx_plot <- ggplot(data = e,
  aes(Month, Imvexxy*ImxNPU)) +
  stat_summary(fun.y = sum,
    geom = "bar") +
  scale_x_date(
    labels = date_format("%b"),
    breaks = "1 month") +
  scale_y_continuous(labels = comma) +
  ylab("Scripts*NPU (Dollars)") +
  ggtitle("Imvexxy Projected Revenue")

imx_plot_build <- ggplot_build(imx_plot)

cnt=0
for(i in imx_plot_build$data[[1]]$y) {
  cnt=cnt+1
  date = b[cnt]
  imx_plot <- imx_plot + annotate("text", x=date,
                y=i+200000,
                label=paste("$",i,sep=''),
                colour="green")
}
print(imx_plot)
dev.off()

png("bijuva_monthly.png", width=960)

bij_plot <- ggplot(data = e,
  aes(Month, Bijuva*BijNPU)) +
  stat_summary(fun.y = sum,
    geom = "bar") +
  scale_x_date(
    labels = date_format("%b"),
    breaks = "1 month") +
  scale_y_continuous(labels = comma) +
  ylab("Scripts*NPU (Dollars)") +
  ggtitle("Bijuva Projected Revenue")


bij_plot_build <- ggplot_build(bij_plot)
cnt=0
for(i in bij_plot_build$data[[1]]$y) {
  cnt=cnt+1
  date = b[cnt]
  bij_plot <- bij_plot + annotate("text", x=date,
                y=i+20000,
                label=paste("$",i,sep=''),
                colour="green")
}
print(bij_plot)
dev.off()