From 4b30cd446ddd1a7bef1760072eb3609087499deb Mon Sep 17 00:00:00 2001 From: bshepp Date: Tue, 18 Jun 2019 15:34:53 -0400 Subject: [PATCH 1/2] Uses MTX data with denom as total_scripts and numer as high_dose_scripts --- inst/templates/TopPerformerGraph.r | 20 ++++++++++++----- .../test_integration_builtin_templates.r | 22 ++++++++++++++++++- 2 files changed, 36 insertions(+), 6 deletions(-) diff --git a/inst/templates/TopPerformerGraph.r b/inst/templates/TopPerformerGraph.r index c51f455..1135d80 100644 --- a/inst/templates/TopPerformerGraph.r +++ b/inst/templates/TopPerformerGraph.r @@ -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) + 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]) + + percentage <- paste(floor(100*(data_numer / data_denom)), "%", sep="") + # Blocked by bitstomach `spec.measure.comparator.value`` + goal <- .85 #Removes everything except circle and annotations top_performer_theme <- function(){ @@ -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) ) @@ -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) + diff --git a/tests/testthat/test_integration_builtin_templates.r b/tests/testthat/test_integration_builtin_templates.r index 0be5b43..9b0fbdc 100644 --- a/tests/testthat/test_integration_builtin_templates.r +++ b/tests/testthat/test_integration_builtin_templates.r @@ -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")) @@ -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") +}) From 0e29d20bd4958ba12c1a6e859c04f882f17481a6 Mon Sep 17 00:00:00 2001 From: bshepp Date: Wed, 19 Jun 2019 15:04:16 -0400 Subject: [PATCH 2/2] Minor changes for merging --- inst/templates/TopPerformerGraph.r | 3 +-- tests/testthat/test_integration_builtin_templates.r | 11 +++++++---- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/inst/templates/TopPerformerGraph.r b/inst/templates/TopPerformerGraph.r index 1135d80..41f4548 100644 --- a/inst/templates/TopPerformerGraph.r +++ b/inst/templates/TopPerformerGraph.r @@ -6,7 +6,6 @@ library(pictoralist) run <- function(recip, data, spek){ color_set <- c(PT$DL_BLUE, PT$DL_LIGHT_BORDER, PT$DL_LIGHT_BORDER) - print(spek.measure.comparator.value) recip_data <- filter(data, data$practice == recip) denom_colname <- 'total_scripts' numer_colname <- 'high_dose_scripts' @@ -14,7 +13,7 @@ run <- function(recip, data, spek){ data_numer <- sum(recip_data[numer_colname]) percentage <- paste(floor(100*(data_numer / data_denom)), "%", sep="") - # Blocked by bitstomach `spec.measure.comparator.value`` + # Blocked by Display-Lab/bit-stomach#37 goal <- .85 #Removes everything except circle and annotations diff --git a/tests/testthat/test_integration_builtin_templates.r b/tests/testthat/test_integration_builtin_templates.r index 9b0fbdc..64ac2a8 100644 --- a/tests/testthat/test_integration_builtin_templates.r +++ b/tests/testthat/test_integration_builtin_templates.r @@ -25,10 +25,13 @@ test_that("Data provided is used in baked in Top Performer Template", { 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] + tpg_env <- templates$TopPerformerGraph + result <- tpg_env$run("E87746", mtx_data, mtx_spek) + + template_denom <- result$data$value[1] + template_recip <- result$data$id[1] expect_true(template_denom == data_denom) expect_true(template_recip == "E87746") }) + +