#################################################################### #################################################################### ###### ###### MALARIA RDT COST AND QUALITY ANALYSIS ###### Rachel Wittenauer ###### Last updated: July 2nd 2021 ###### #################################################################### #################################################################### ###### ###### Contents: ###### I. Load packages and raw data ###### II. Data cleanup ###### III. Descriptive tables and stats ###### IV. Aim 1 analysis: market share ###### V. Aim 2 analysis: cost and quality ###### VI. Aim 3 analysis: HHI concentration index ###### #################################################################### #################################################################### ###### ###### I. Load Packages and raw data # Set working folder and load libraries # setwd(["insert own working drive folder here"]) library(tidyverse) # data manipulation library(lubridate) # working with dates library(kableExtra) # nice tables library(DescTools) # descriptive statistics library(multcomp) # regression model library(e1071) library(Kendall) # nice tables library(survival) library(maditr) library(patchwork) # two-axis plots library(sandwich) # for robust SE's library(lmtest) # for robust SE's library(hhi) #for hhi concentration index # Load raw data # Global Fund purchase data (price, quantities, country, date purchased, etc.) globalfund_df <- read.csv("globalfund_df.csv", header = TRUE, stringsAsFactors = FALSE) # WHO-FIND product evaluation data (PDS, heat stability, round evaluated, etc.) find_df <- read.csv("find_df.csv", header = TRUE, fileEncoding="latin1") # PDS adjustments to match lastes FIND evaluation round with year RDT purchased pds_adj_df <- read.csv("pds_adj_df.csv", header = TRUE, stringsAsFactors = FALSE) # WHO region to country matching who_region <- read.csv("who_region_df.csv", header = TRUE) #################################################################### #################################################################### ###### ###### II. Data cleanup # Joining raw data into one file---------------------------------------- ## join global fund data and FIND data by product name combined_df <- left_join(globalfund_df, find_df, by = "FINDname") ## put purchase dates and evaluation dates in readable format combined_df$Purchase.Order.Date <- as.Date(combined_df$Purchase.Order.Date, "%d-%b-%y") pds_adj_df$eval_data_start <- as.Date(pds_adj_df$eval_data_start, "%d-%b-%Y") pds_adj_df$eval_data_end <- as.Date(pds_adj_df$eval_data_end, "%d-%b-%Y") ## join PDS scores by evaluation round to full dataset data_adj <- full_join(combined_df, pds_adj_df, by = "FINDname") ## filter PDS scores for each purchase to the matching evaluation period and purchase date data_adj <- data_adj %>% filter(Purchase.Order.Date > eval_data_start & Purchase.Order.Date < eval_data_end) ## add observation ID data_adj$obs_id <- seq.int(nrow(data_adj)) ## PDS scores to numeric data_adj$pds_pf_adj <- as.numeric(data_adj$pds_pf_adj) data_adj$pds_pv_adj <- as.numeric(data_adj$pds_adj_pv) # Check other test quality variables besides PDS------------------------- ## false positive rate: use fpr_total. WHO recommended minimum standard FPR <10% table(data_adj$fpr_total_adj) ## non-Pf heatstability only started in Rd 6 -> decide to just use heat stability for 45C Pf line as indicator for heat stability of the test for all of the dataset. Note there is no WHO recommended minimum standard for heat stability. table(data_adj$heat_pf_45) table(data_adj$heat_pv_45) # Miscellaneous variables------------------------------------------------ ## if meets WHO minimum PDS threshold of 75.0 data_adj$who_criteria_bin <- ifelse(data_adj$who_criteria %in% "yes", 1, 0) ## Creating a variable for WHO regions: data_adj <- left_join(data_adj, who_region, by = "Country.Territory") ## Create variable for visually showing share of RDT quality over time cut_breaks <- c(0,74.9,79.9,84.9,89.9,94.9,Inf) cut_labels <- c("<75", "75-79.9", "80-84.9", "85-89.9", "90-94.9", ">95") data_adj$pds_pf_adj_cut <- cut(data_adj$pds_pf_adj, cut_breaks, cut_labels) data_adj$pds_pv_adj_cut <-cut(data_adj$pds_pv_adj, cut_breaks, cut_labels) ## order volume and order cost formats data_adj$Pack.Quantity <- as.numeric(data_adj$Pack.Quantity) data_adj$order_volume <- ifelse(!is.na(data_adj$Nb.of.Suom.in.Pack) & !is.na(data_adj$Pack.Quantity), (data_adj$Nb.of.Suom.in.Pack * data_adj$Pack.Quantity), NA) data_adj$Pack.Cost..USD. <- as.numeric(data_adj$Pack.Cost..USD.) data_adj <- data_adj %>% mutate(total_order_cost = Pack.Quantity*Pack.Cost..USD.) # Adjust cost data for inflation----------------------------------------- ## set up data frame to calculate adjustment factor for inflation: purchase_year <- c(2008:2018) deflator <- c(98.1, 98.848, 100, 102.089, 104.047, 105.873, 107.876, 109.029, 110.222, 112.317, 114.85) inflation_data <- data.frame(purchase_year, deflator) inflation_data$purchase_year <- as.numeric(inflation_data$purchase_year) inflation_data$adjustment_factor <- ifelse(inflation_data$purchase_year == 2018, 0, ifelse(inflation_data$purchase_year == 2017, (114.85 - inflation_data$deflator[purchase_year == 2017])/114.85, ifelse(inflation_data$purchase_year == 2016, (114.85 - inflation_data$deflator[purchase_year == 2016])/114.85, ifelse(inflation_data$purchase_year == 2015, (114.85 - inflation_data$deflator[purchase_year == 2015])/114.85, ifelse(inflation_data$purchase_year == 2014, (114.85 - inflation_data$deflator[purchase_year == 2014])/114.85, ifelse(inflation_data$purchase_year == 2013, (114.85 - inflation_data$deflator[purchase_year == 2013])/114.85, ifelse(inflation_data$purchase_year == 2012, (114.85 - inflation_data$deflator[purchase_year == 2012])/114.85, ifelse(inflation_data$purchase_year == 2011, (114.85 - inflation_data$deflator[purchase_year == 2011])/114.85, ifelse(inflation_data$purchase_year == 2010, (114.85 - inflation_data$deflator[purchase_year == 2010])/114.85, ifelse(inflation_data$purchase_year == 2009, (114.85 - inflation_data$deflator[purchase_year == 2009])/114.85, ifelse(inflation_data$purchase_year == 2008, (114.85 - inflation_data$deflator[purchase_year == 2008])/114.85, NA))))))))))) data_adj <- left_join(data_adj, inflation_data, by = "purchase_year") ## calculate inflation-adjusted order price in new column data_adj <- data_adj %>% mutate(total_order_cost = Pack.Quantity*Pack.Cost..USD.) data_adj <- data_adj %>% mutate(total_order_cost_adj = (total_order_cost)+(total_order_cost * adjustment_factor)) ## calculate price per test data_adj$cost_per_test <- data_adj$total_order_cost/data_adj$order_volume data_adj$cost_per_test_adj <- data_adj$total_order_cost_adj/data_adj$order_volume ### Two observations from DRC have data entry errors, the below code replaces the error with the correct value ### The error is that the field Pack.Cost contains the cost per test rather than the cost per pack, ### resulting in an incorrect calculation for our cost_per_test field (way too small) ### check with: table(data_adj$Country.Territory[data_adj$Pack.Cost..USD. == 0.23], data_adj$obs_id[data_adj$Pack.Cost..USD. == 0.23]) data_adj$cost_per_test[data_adj$obs_id %in% c(103,104)] <- 0.23 data_adj$cost_per_test_adj[data_adj$obs_id %in% c(103,104)] <- (0.23 + 0.23*inflation_data$adjustment_factor[inflation_data$purchase_year == 2017]) ### Manufacturer.x fix duplicate name for Span Diagnostics data_adj$Manufacturer.x <- ifelse(data_adj$Manufacturer.x %in% "Span Diagnostics", "Span Diagnostics Ltd.", data_adj$Manufacturer.x) # Outliers I am excluding from analysis--------------------------------- ## cost outliers: defining outlier to be adjusted cost per test > $5 per test. ## boxplot(data_adj$cost_per_test_adj) ## There are two observations far above the mean (>10*IQR) with values of $7.77 and $9.57 per test ## The order volume for these was tiny (800 and 2100 RDTs respectively), ## excluding these two from analysis data_adj$outlier_exclude <- ifelse(data_adj$cost_per_test_adj > 5, 1, 0) data_clean <- data_adj %>% filter(outlier_exclude == 0) ## PDS outliers prop.table(table(data_clean$num_test_lines, useNA = "always")) data_clean$pds_pv_adj <- as.numeric(data_clean$pds_pv_adj) # pf score of tests with pv <50 & >1 test line (pf pds of 92 and 96.2) table(data_clean$pds_pf_adj[data_clean$pds_pv_adj < 50 & data_clean$num_test_lines > 1], useNA = "always") # country of purchase for tests with pv <50 table(data_clean$Country.Territory[data_clean$pv_endemic.x == 1 & data_clean$pds_pv_adj < 50]) table(data_clean$Country.Territory[data_clean$pv_endemic.x == 0 & data_clean$pds_pv_adj < 50]) # change low-scoring PDS to NA in two scenarios: # A) pv<50, >1 test line, and pv-endemic == 0 data_clean$pds_pv_adj[data_clean$pds_pv_adj <50 & data_clean$num_test_lines > 1 & data_clean$pv_endemic.x == 0] <- NA # B) pf<50, >1 test line, and pv-endemic == 1 data_clean$pds_pf_adj[data_clean$pds_pf_adj < 50 & data_clean$num_test_lines > 1 & data_clean$pv_endemic.x == 1] <- NA # note pv-endemic country field was identified via World Malaria Report 2019 appendix "I" #################################################################### #################################################################### ###### ###### III. Descriptive tables and stats # Table 1 Characteristics of Sample by Product Type and WHO Region-- data_clean <- data_clean %>% mutate(product_evals = paste(FINDname, pds_pf_adj)) table1 <- data_clean %>% summarise(volume = sum(order_volume, na.rm = TRUE), number_of_orders = n(), unique_product_evals = n_distinct(product_evals), unique_manufacturers = n_distinct(Manufacturer.x)) table1_product <- data_clean %>% group_by(Product) %>% summarise(volume = sum(order_volume, na.rm = TRUE), number_of_orders = n(), unique_product_evals = n_distinct(product_evals), unique_manufacturers = n_distinct(Manufacturer.x)) %>% arrange(desc(volume)) table1_region <- data_clean %>% group_by(who_region) %>% summarise(volume = sum(order_volume, na.rm = TRUE), number_of_orders = n(), unique_product_evals = n_distinct(product_evals), unique_manufacturers = n_distinct(Manufacturer.x)) %>% arrange(desc(volume)) # Table 2 Median Unit Price and Median PDS by Product Type--------- ## median values table2 <- data_clean %>% group_by(Product) %>% summarise(volume = sum(order_volume, na.rm = TRUE), median(pds_pf_adj, na.rm = TRUE), median(pds_pv_adj, na.rm = TRUE), round(median(cost_per_test_adj, na.rm = TRUE),3)) %>% arrange(desc(volume)) ## get IQRs for table 2: summary(data_clean$cost_per_test_adj[data_clean$Product %in% "Malaria RDT: P.f."], na.rm = TRUE) summary(data_clean$pds_pf_adj[data_clean$Product %in% "Malaria RDT: P.f."], na.rm = TRUE) summary(data_clean$pds_pv_adj[data_clean$Product %in% "Malaria RDT: P.f."], na.rm = TRUE) summary(data_clean$cost_per_test_adj[data_clean$Product %in% "Malaria RDT: P.f/Pan"], na.rm = TRUE) summary(data_clean$pds_pf_adj[data_clean$Product %in% "Malaria RDT: P.f/Pan"], na.rm = TRUE) summary(data_clean$pds_pv_adj[data_clean$Product %in% "Malaria RDT: P.f/Pan"], na.rm = TRUE) summary(data_clean$cost_per_test_adj[data_clean$Product %in% "Malaria RDT: P.f./P.v"], na.rm = TRUE) summary(data_clean$pds_pf_adj[data_clean$Product %in% "Malaria RDT: P.f./P.v"], na.rm = TRUE) summary(data_clean$pds_pv_adj[data_clean$Product %in% "Malaria RDT: P.f./P.v"], na.rm = TRUE) summary(data_clean$cost_per_test_adj[data_clean$Product %in% "Malaria RDT: Pan"], na.rm = TRUE) summary(data_clean$pds_pf_adj[data_clean$Product %in% "Malaria RDT: Pan"], na.rm = TRUE) summary(data_clean$pds_pv_adj[data_clean$Product %in% "Malaria RDT: Pan"], na.rm = TRUE) summary(data_clean$cost_per_test_adj, na.rm = TRUE) summary(data_clean$pds_pf_adj, na.rm = TRUE) summary(data_clean$pds_pv_adj, na.rm = TRUE) #################################################################### #################################################################### ###### ###### IV. Aim 1 analysis: market share # Summary: Procured RDT by year, volume, and median PDS------------------- table4 <- data_clean %>% group_by(purchase_year) %>% summarise(volume = sum(order_volume, na.rm = TRUE), number_of_orders = n(), median(pds_pf_adj, na.rm = TRUE), median(pds_pv_adj, na.rm = TRUE)) %>% arrange(desc(purchase_year))%>% kable(format.args = list(big.mark = ","), col.names = c("Year of Purchase", "Order Volume", "Number of Orders", "Median PDS (P.f.)", "Median PDS (P.v.)")) %>% kable_styling(bootstrap_options = c("striped", "condensed")) table4 # Monotonic trend test on medians over time------------------------------ aim1 <- data_clean %>% group_by(purchase_year) %>% summarise(median_pf = median(pds_pf_adj, na.rm = TRUE), median_pv = median(pds_pv_adj, na.rm = TRUE), total_volume = sum(order_volume)) %>% arrange(desc(purchase_year)) mk_pf <- MannKendall(aim1$median_pf) mk_pv <- MannKendall(aim1$median_pv) # Figure 2. Market Share Over Time of RDTs by Quality-------------------- table2a <- data_clean %>% group_by(purchase_year, pds_pf_adj_cut) %>% summarise(total_volume = sum(order_volume, na.rm = TRUE)) plot2a <- ggplot(table2a, aes(x = purchase_year, y = total_volume, fill = pds_pf_adj_cut)) + geom_bar(stat = "identity", position = position_fill(reverse = TRUE)) + labs(title = "Market Share of RDT PDS scores (P.f.) Over Time", x = "Year Purchased", y = "Percent (%) of Procured RDT Volume", fill = "Panel Detection Score (200 P.f. parasites/ul)") + scale_fill_brewer(palette = "RdYlGn") + scale_y_continuous("Percent (%) of RDTs Procured", breaks = c(0,.2,.4, .6, .8, 1.0), labels = c("0%", "20%", "40%", "60%", "80%", "100%"))+ guides(fill = guide_legend(reverse = TRUE)) plot2a write.csv(table4a, "table2a.csv") table2b <- data_clean %>% filter(!is.na(pds_pv_adj_cut)) %>% group_by(purchase_year, pds_pv_adj_cut) %>% summarise(total_volume = sum(order_volume, na.rm = TRUE)) plot4b <- ggplot(table2b, aes(x = purchase_year, y = total_volume, fill = pds_pv_adj_cut)) + geom_bar(stat = "identity", position = position_fill(reverse = TRUE)) + labs(title = "Market Share of RDT PDS scores (P.v.) Over Time", x = "Year Purchased", y = "Percent (%) of Procured RDT Volume", fill = "Panel Detection Score (200 P.v. parasites/ul)") + scale_fill_brewer(palette = "RdYlGn") + scale_y_continuous("Percent (%) of RDTs Procured", breaks = c(0,.2,.4, .6, .8, 1.0), labels = c("0%", "20%", "40%", "60%", "80%", "100%"))+ guides(fill = guide_legend(reverse = TRUE)) plot2b write.csv(table2b, "table2b.csv") ## Proportion of Distribution by Year table2a_percents <- dcast(table2a, purchase_year ~ pds_pf_adj_cut, value.var = "total_volume") table2b_percents <- dcast(table2b, purchase_year ~ pds_pv_adj_cut, value.var = "total_volume") write.csv(table2a_percents, "table2a_percents.csv") write.csv(table2b_percents, "table2b_percents.csv") # Table 3 in discussion section, RDTs purchased in 2017/2018: table3 <- data_clean %>% filter(purchase_year %in% c(2017, 2018)) %>% group_by(FINDname, Manufacturer.x) %>% summarise(orders = n(), tot_vol = sum(order_volume, na.rm = TRUE), median_pds_pf = median(pds_pf_adj, na.rm = TRUE), median_pds_pv = median(pds_pv_adj, na.rm = TRUE), median_cost = median(cost_per_test_adj, na.rm = TRUE)) %>% arrange(desc(orders)) View(table3) #################################################################### #################################################################### ###### ###### V. Aim 2 analysis: cost and quality # Statistical model and analyses------------------------------------------- ## Regression models # create mean-centered PDS variables: pfpds_mean <- mean(data_clean$pds_pf_adj, na.rm = TRUE) pvpds_mean <- mean(data_clean$pds_pv_adj, na.rm = TRUE) data_clean <- data_clean %>% mutate(pds_pf_adj_c = pds_pf_adj - pfpds_mean, pds_pv_adj_c = pds_pv_adj - pvpds_mean) ### is PDS normally distributed? ## No, but doesn't lend itself to log transformation. Use robust SE's. plotxx <- data_clean %>% ggplot(aes(x = log(pds_pf_adj))) + geom_histogram() plotxx plotxy <- data_clean %>% ggplot(aes(x = pds_pf_adj)) + geom_histogram() plotxy ## Without manufacturer: ### model for PF panel tests mod1_pf <- lm(cost_per_test_adj~pds_pf_adj_c + order_volume + purchase_year + Product, data = data_clean) summary(mod1_pf) sjPlot::tab_model(mod1_pf, vcov.type = "HC3", pred.labels = c("Intercept", "Panel Detection Score (P.f.)", "Order Volume", "Purchase Year", "Product Type: P.f./Pv (vs. P.f.-only)", "Product Type: P.f./Pan (vs. P.f.-only)", "Product Type: Pan (vs. P.f.-only)"), dv.labels = "Cost Per Test", title = "Linear Regression Model Results: Cost per test vs. P.f. PDS", digits = 3) ### model for PV panel tests mod1_pv <- lm(cost_per_test_adj~pds_pv_adj_c + order_volume + purchase_year + Product, family = "gaussian", data = data_clean) summary(mod1_pv) sjPlot::tab_model(mod1_pv, vcov.type = "HC3", pred.labels = c("Intercept", "Panel Detection Score (P.v.)", "Order Volume", "Purchase Year", "Product Type: P.f./Pan (vs. P.f./P.v.)", "Product Type: Pan (vs. P.f./P.v.)"), dv.labels = "Cost Per Test", title = "Linear Regression Model Results: Cost per test vs. P.v. PDS", digits = 3) ## With manufacturer ### model for PF panel tests mod2_pf <- lm(cost_per_test_adj~pds_pf_adj_c + order_volume + purchase_year + Product + Manufacturer.x, family = "gaussian", data = data_clean) coeftest(mod2_pf, vcov. = vcovHC(mod1_pf, type = "HC3")) sjPlot::tab_model(mod2_pf, vcov.type = "HC3", digits = 3, title = "Linear Regression Model Results: Cost per test vs. P.f. PDS", dv.labels = "Cost Per Test", pred.labels = c("Intercept", "Panel Detection Score (P.f.)", "Order Volume", "Purchase Year", "Product Type: P.f./Pv (vs. P.f.-only)", "Product Type: P.f./Pan (vs. P.f.-only)", "Product Type: Pan (vs. P.f.-only)", "Manufacturer: Bionote (vs. AccessBio)", "Manufacturer: CTK Biotech (vs. AccessBio)", "Manufacturer: ICT Diagnostics (vs. AccessBio)", "Manufacturer: Orchid Biomedical (vs. AccessBio)", "Manufacturer: Premier (vs. AccessBio)", "Manufacturer: Span Diagnostics (vs. AccessBio)", "Manufacturer: Standard Diagnostics (vs. AccessBio)", "Manufacturer: Zephyr (vs. AccessBio)")) ### model for PV panel tests mod2_pv <- lm(cost_per_test_adj~pds_pv_adj_c + order_volume + purchase_year + Product + Manufacturer.x, family = "gaussian", data = data_clean) sjPlot::tab_model(mod2_pv, vcov.type = "HC3", digits = 3, title = "Linear Regression Model Results: Cost per test vs. P.v. PDS", dv.labels = "Cost Per Test", pred.labels = c("Intercept", "Panel Detection Score (P.v.)", "Order Volume", "Purchase Year", "Product Type: P.f./Pan (vs. P.f./P.v.)", "Product Type: Pan (vs. P.f./P.v.)", "Manufacturer: CTK Biotech (vs. AccessBio)", "Manufacturer: DiaMed/BioRad (vs. AccessBio)", "Manufacturer: Premier (vs. AccessBio)", "Manufacturer: Standard Diagnostics (vs. AccessBio)", "Manufacturer: Zephyr (vs. AccessBio)")) #### With manufacturer, but post-hoc sensitivity analysis excluding small manufacturers. # pf mod2_pf_TEST <- lm(cost_per_test_adj~pds_pf_adj_c + order_volume + purchase_year + Product + Manufacturer.x, family = "gaussian", data = data_clean %>% filter(Manufacturer.x %in% c("Standard Diagnostics, Inc.Giheung-ku, Republic of Korea", "Access Bio, Inc.", "Premier Medical Corporation Ltd (Daman and Sarigam, India)"))) coeftest(mod2_pf_TEST, vcov. = vcovHC(mod1_pf, type = "HC3")) sjPlot::tab_model(mod2_pf_TEST, vcov.type = "HC3", digits = 3, title = "Sensitivity Analysis-Linear Regression Model Results: Cost per test vs. P.f. PDS", dv.labels = "Cost Per Test", pred.labels = c("Intercept", "Panel Detection Score (P.f.)", "Order Volume", "Purchase Year", "Product Type: P.f./P.v.", "Product Type: P.f./Pan", "Product Type: Pan", "Manufacturer: Premier Medical Corporation (vs. AccessBio)", "Manufacturer: Standard Diagnostics (vs. AccessBio)")) # pv mod2_pv_TEST <- lm(cost_per_test_adj~pds_pv_adj_c + order_volume + purchase_year + Product + Manufacturer.x, family = "gaussian", data = data_clean %>% filter(Manufacturer.x %in% c("Standard Diagnostics, Inc.Giheung-ku, Republic of Korea", "Access Bio, Inc.", "Premier Medical Corporation Ltd (Daman and Sarigam, India)"))) sjPlot::tab_model(mod2_pv_TEST, vcov.type = "HC3", digits = 3, title = "Sensitivity Analysis- Linear Regression Model Results: Cost per test vs. P.v. PDS", dv.labels = "Cost Per Test", pred.labels = c("Intercept", "Panel Detection Score (P.v.)", "Order Volume", "Purchase Year", "Product Type: P.f./Pan", "Product Type: Pan", "Manufacturer: Premier Medical Corporation (vs. AccessBio)", "Manufacturer: Standard Diagnostics (vs. AccessBio)")) ## Model diagnostics # check for outliers boxplot(data_clean$pds_pf_adj) boxplot(data_clean$pds_pv_adj) boxplot(data_clean$cost_per_test_adj) # check if pds and cost are normally distributed # density plot for PDS P.f. plot(density(data_clean$pds_pf_adj, na.rm = TRUE), main="Density Plot: PDS P.f.", ylab="Frequency", sub=paste("Skewness:", round(e1071::skewness(data_clean$pds_pf_adj), 2))) # density plot for PDS P.v. plot(density(data_clean$pds_pv_adj, na.rm = TRUE), main="Density Plot: PDS P.v.", ylab="Frequency", sub=paste("Skewness:", round(e1071::skewness(data_clean$pds_pv_adj), 2))) # density plot for cost per test plot(density(data_clean$cost_per_test, na.rm = TRUE), main="Density Plot: Cost per test", ylab="Frequency", sub=paste("Skewness:", round(e1071::skewness(data_clean$cost_per_test), 2))) # none are normally distributed -> use robust se's #################################################################### #################################################################### ###### ###### VI. Aim 3 analysis: HHI concentration # need a dataframe [each year] with each row is 1 firm and a col for % market share hhi_all <- data_clean %>% group_by(Manufacturer.x) %>% summarise(totalrdt = sum(order_volume, na.rm = TRUE)) %>% dplyr::select(Manufacturer.x, totalrdt) hhi_all$marketshare <- hhi_all$totalrdt/sum(hhi_all$totalrdt)*100 hhi_all <- data.frame(hhi_all) hhi_all <- hhi(hhi_all, "marketshare") # results for each year HHI hhi_09 <- data_clean %>% filter(purchase_year == 2009) %>% group_by(Manufacturer.x) %>% summarise(totalrdt = sum(order_volume, na.rm = TRUE)) %>% dplyr::select(Manufacturer.x, totalrdt) hhi_09$marketshare <- hhi_09$totalrdt/sum(hhi_09$totalrdt)*100 hhi_09 <- data.frame(hhi_09) hhi_09 <- hhi(hhi_09, "marketshare") hhi_10 <- data_clean %>% filter(purchase_year == 2010) %>% group_by(Manufacturer.x) %>% summarise(totalrdt = sum(order_volume, na.rm = TRUE)) %>% dplyr::select(Manufacturer.x, totalrdt) hhi_10$marketshare <- hhi_10$totalrdt/sum(hhi_10$totalrdt)*100 hhi_10 <- data.frame(hhi_10) hhi_10 <- hhi(hhi_10, "marketshare") hhi_11 <- data_clean %>% filter(purchase_year == 2011) %>% group_by(Manufacturer.x) %>% summarise(totalrdt = sum(order_volume, na.rm = TRUE)) %>% dplyr::select(Manufacturer.x, totalrdt) hhi_11$marketshare <- hhi_11$totalrdt/sum(hhi_11$totalrdt)*100 hhi_11 <- data.frame(hhi_11) hhi_11 <- hhi(hhi_11, "marketshare") hhi_12 <- data_clean %>% filter(purchase_year == 2012) %>% group_by(Manufacturer.x) %>% summarise(totalrdt = sum(order_volume, na.rm = TRUE)) %>% dplyr::select(Manufacturer.x, totalrdt) hhi_12$marketshare <- hhi_12$totalrdt/sum(hhi_12$totalrdt)*100 hhi_12 <- data.frame(hhi_12) hhi_12 <- hhi(hhi_12, "marketshare") hhi_13 <- data_clean %>% filter(purchase_year == 2013) %>% group_by(Manufacturer.x) %>% summarise(totalrdt = sum(order_volume, na.rm = TRUE)) %>% dplyr::select(Manufacturer.x, totalrdt) hhi_13$marketshare <- hhi_13$totalrdt/sum(hhi_13$totalrdt)*100 hhi_13 <- data.frame(hhi_13) hhi_13 <- hhi(hhi_13, "marketshare") hhi_14 <- data_clean %>% filter(purchase_year == 2014) %>% group_by(Manufacturer.x) %>% summarise(totalrdt = sum(order_volume, na.rm = TRUE)) %>% dplyr::select(Manufacturer.x, totalrdt) hhi_14$marketshare <- hhi_14$totalrdt/sum(hhi_14$totalrdt)*100 hhi_14 <- data.frame(hhi_14) hhi_14 <- hhi(hhi_14, "marketshare") hhi_15 <- data_clean %>% filter(purchase_year == 2015) %>% group_by(Manufacturer.x) %>% summarise(totalrdt = sum(order_volume, na.rm = TRUE)) %>% dplyr::select(Manufacturer.x, totalrdt) hhi_15$marketshare <- hhi_15$totalrdt/sum(hhi_15$totalrdt)*100 hhi_15 <- data.frame(hhi_15) hhi_15 <- hhi(hhi_15, "marketshare") hhi_16 <- data_clean %>% filter(purchase_year == 2016) %>% group_by(Manufacturer.x) %>% summarise(totalrdt = sum(order_volume, na.rm = TRUE)) %>% dplyr::select(Manufacturer.x, totalrdt) hhi_16$marketshare <- hhi_16$totalrdt/sum(hhi_16$totalrdt)*100 hhi_16 <- data.frame(hhi_16) hhi_16 <- hhi(hhi_16, "marketshare") hhi_17 <- data_clean %>% filter(purchase_year == 2017) %>% group_by(Manufacturer.x) %>% summarise(totalrdt = sum(order_volume, na.rm = TRUE)) %>% dplyr::select(Manufacturer.x, totalrdt) hhi_17$marketshare <- hhi_17$totalrdt/sum(hhi_17$totalrdt)*100 hhi_17 <- data.frame(hhi_17) hhi_17 <- hhi(hhi_17, "marketshare") hhi_18 <- data_clean %>% filter(purchase_year == 2018) %>% group_by(Manufacturer.x) %>% summarise(totalrdt = sum(order_volume, na.rm = TRUE)) %>% dplyr::select(Manufacturer.x, totalrdt) hhi_18$marketshare <- hhi_18$totalrdt/sum(hhi_18$totalrdt)*100 hhi_18 <- data.frame(hhi_18) hhi_18 <- hhi(hhi_18, "marketshare") # Combine to one object for plot hhi_vector <- c(hhi_09, hhi_10, hhi_11, hhi_12, hhi_13, hhi_14, hhi_15, hhi_16, hhi_17, hhi_18) hhi_year <- c(2009:2018) hhi_plot <- data.frame(hhi_vector, hhi_year) hhi_plot$unconcentrated <- 1500 hhi_plot$high_conc <- 2500