Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Uses MTX data with denom as total_scripts and numer as high_dose_scripts #44

Merged
merged 2 commits into from
Jun 19, 2019
Merged

Uses MTX data with denom as total_scripts and numer as high_dose_scripts #44

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
4b30cd4
Uses MTX data with denom as total_scripts and numer as high_dose_scripts
b-sheppard Jun 18, 2019
0e29d20
Minor changes for merging
b-sheppard Jun 19, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 15 additions & 5 deletions inst/templates/TopPerformerGraph.r
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,8 +5,17 @@ library(pictoralist)
# Create Pie Chart (Top Performer)
run <- function(recip, data, spek){
color_set <- c(PT$DL_BLUE, PT$DL_LIGHT_BORDER, PT$DL_LIGHT_BORDER)
percentage <- "90%"
goal <- 17/20

print(spek.measure.comparator.value)
b-sheppard marked this conversation as resolved.
Show resolved Hide resolved
recip_data <- filter(data, data$practice == recip)
denom_colname <- 'total_scripts'
numer_colname <- 'high_dose_scripts'
data_denom <- sum(recip_data[denom_colname])
data_numer <- sum(recip_data[numer_colname])
b-sheppard marked this conversation as resolved.
Show resolved Hide resolved

percentage <- paste(floor(100*(data_numer / data_denom)), "%", sep="")
# Blocked by bitstomach `spec.measure.comparator.value``
b-sheppard marked this conversation as resolved.
Show resolved Hide resolved
goal <- .85

#Removes everything except circle and annotations
top_performer_theme <- function(){
Expand All @@ -28,8 +37,9 @@ run <- function(recip, data, spek){

# Background listed twice for small section left uncompleted
df <- data.frame(
id = recip,
group = c("background", "performance", "background"),
value = c(20, 18, 2),
value = c(data_denom, data_numer, data_denom - data_numer),
ring = c(58, 50, 50),
width = c(6,16,16)
)
Expand All @@ -44,8 +54,8 @@ run <- function(recip, data, spek){
coord_polar(theta="y", direction=-1) +
top_performer_theme() +
dl_annotate("text", x=10, y=0, label=percentage, size=10, color=PT$DL_BLUE, fontface=2) +
dl_annotate("text", x=5, y=.5, label="COUNSEL RATE", size=3, color=PT$DL_BLUE) +
dl_annotate("text", x=25, y=.5, label="18/20", size=4, color=PT$DL_BLUE, family=PT$DL_FONT) +
dl_annotate("text", x=7, y=.5, label="COUNSEL RATE", size=3, color=PT$DL_BLUE) +
dl_annotate("text", x=25, y=.5, label=paste(data_numer, data_denom, sep="/"), size=4, color=PT$DL_BLUE, family=PT$DL_FONT) +
dl_annotate("text", x=70, y=goal, label="GOAL", size=3, color=PT$DL_BLUE) +
dl_annotate("text", x=100, y=0, label="Congratulations!", size=6, color=PT$DL_BLUE) +
dl_annotate("text", x=85, y=0, label="YOU ARE A TOP PERFORMER", size=3, color=PT$DL_BLUE) +
Expand Down
22 changes: 21 additions & 1 deletion tests/testthat/test_integration_builtin_templates.r
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
context("Integration test of baked in templates")


test_that("Baked in templates work with mtx data",{
mtx_data <- read_data(spekex::get_data_path("mtx"))
mtx_spek <- spekex::read_spek(spekex::get_spek_path("mtx"))
Expand All @@ -12,3 +11,24 @@ test_that("Baked in templates work with mtx data",{
is_ggplot <- sapply(results, function(x){"ggplot" %in% class(x)})
expect_true(all(is_ggplot))
})

test_that("Data provided is used in baked in Top Performer Template", {
mtx_data <- read_data(spekex::get_data_path("mtx"))
mtx_spek <- spekex::read_spek(spekex::get_spek_path("mtx"))

templates <- load_templates()

denom_colname <- 'total_scripts'
numer_colname <- 'high_dose_scripts'

recip_data <- filter(mtx_data, mtx_data$practice == "E87746")
data_denom <- sum(recip_data[denom_colname])
data_numer <- sum(recip_data[numer_colname])

results <- lapply(templates, FUN=function(t, recip, data, spek){t$run(recip, data, spek)},
recip = "E87746", data=mtx_data, spek=mtx_spek)
template_denom <- results$TopPerformerGraph$data$value[1]
template_recip <- results$TopPerformerGraph$data$id[1]
expect_true(template_denom == data_denom)
expect_true(template_recip == "E87746")
})