library(ggplot2)
library(dplyr)
library(pictoralist)
# Plots data
make_plot <- function(plot_data) {
plot_data %>% ggplot(aes(x=id, label=id)) +
leaderboard_theme() +
geom_col(mapping=aes(y=denom), fill=PT$DL_LIGHT_BLUE) +
geom_text(mapping=aes(y=denom - largest*0.07, label=declined_label),
color=PT$DL_FILL, family=PT$DL_FONT) +
geom_col(mapping=aes(y=numer), fill=PT$DL_BLUE) +
geom_text(mapping=aes(y=largest*0.07, label=numer),
color=PT$DL_FILL, family=PT$DL_FONT) +
geom_segment(mapping=aes(y=numer + 0.5*declined_label,
yend=denom*0.85, xend=id, color=show_line)) +
geom_text(mapping=aes(y=denom*0.80, label=declined_small),
color=PT$DL_FILL, family=PT$DL_FONT) +
scale_y_continuous(expand=c(0.1,0)) +
geom_text(mapping=aes(y=largest*-0.12, label=rate_label, fontface="bold"),
color=PT$DL_BLUE, family=PT$DL_FONT) +
scale_color_manual(values = c("show"=PT$DL_FILL, "noshow"=NA)) +
coord_flip()
}
# Removes grid and provides correct axis style
# (missing y-axis ticks on actual axis)
leaderboard_theme <- function(){
theme_classic() +
theme(axis.line=element_blank(),
axis.text.x=element_blank(),
axis.text.y=element_text(color=PT$DL_BLUE),
axis.ticks=element_blank(),
axis.title.x=element_blank(),
axis.title.y=element_blank(),
legend.position="none",
panel.background=element_blank(),
panel.border=element_blank(),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.background=element_blank(),
text = element_text(family=PT$DL_FONT))
}
# Avoids connection between one path to the next (lengths[4] -> lengths[5])
## Assemble components into input data
run <- function(recipient, data, spek){
denom_colname <- 'total_quantity'
numer_colname <- 'total_scripts'
top_performers <- data %>%
group_by(practice) %>%
summarise(total_scripts = sum(total_scripts), total_quantity = sum(total_quantity)) %>%
mutate(percentage = floor(100*total_scripts/total_quantity)) %>%
arrange(desc(total_scripts/total_quantity)) %>%
select(practice, percentage, total_scripts, total_quantity) %>%
head(7)
df <- data.frame(id=top_performers$practice,
numer=top_performers$total_scripts,
denom=top_performers$total_quantity)
declined <- top_performers$total_quantity - top_performers$total_scripts
declined_small <- ifelse(top_performers$percentage >= 85 &
top_performers$percentage != 100, declined, NA)
show_line <- ifelse(top_performers$percentage >= 85 &
top_performers$percentage != 100, "show", "noshow")
declined_large <- ifelse(top_performers$percentage < 85, declined, NA)
# Calculate additional columns data
df$rate_label <- mapply(paste, top_performers$percentage, "%")
df$accepted_label <- top_performers$total_scripts
df$declined_label <- top_performers$total_quantity - top_performers$total_scripts
df$declined_small <- declined_small
df$largest <- max(top_performers$total_quantity)
df$show_line <- show_line
df$id = reorder(df$id, top_performers$percentage)
# reorders data into descending order
df <- df %>% arrange(100 - top_performers$percentage)
make_plot(df)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.