From bf92033cf6db275ffa546bbf9531e9e2425fda91 Mon Sep 17 00:00:00 2001 From: Clara Bicalho Date: Wed, 23 May 2018 16:33:26 +0200 Subject: [PATCH 01/12] Call capture.output() instead of getSrcref() to read design code This generates the same output for code attribute as before, but does not depend on `keep_source` during package install to work. Shinyapps.io also doesn't seem to support options when building dependencies, so moving away from getSrcref() allows shinyapps to install and run designer functions without issues. --- R/helpers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/helpers.R b/R/helpers.R index 9c1a79a9..3f4feed1 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -10,7 +10,7 @@ get_design_code <- function(design){ #' @export construct_design_code <- function(designer, args){ # get the code for the design - txt <- as.character(getSrcref(designer)) + txt <- capture.output(designer) open <- grep("[{]{3}", txt) close <- grep("[}]{3}", txt) From bbd2e048bbe8f520867b74f57922bce4d2e8c8d0 Mon Sep 17 00:00:00 2001 From: Clara Bicalho Date: Thu, 24 May 2018 11:37:38 +0200 Subject: [PATCH 02/12] Use deparse() when srcref not available --- R/helpers.R | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index 3f4feed1..34d9e645 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -10,10 +10,21 @@ get_design_code <- function(design){ #' @export construct_design_code <- function(designer, args){ # get the code for the design - txt <- capture.output(designer) - - open <- grep("[{]{3}", txt) - close <- grep("[}]{3}", txt) + txt <- as.character(getSrcref(designer)) + if(length(txt)==0){ + txt <- capture.output(designer) + x <- grep("[{]", txt) + open <- x[which(diff(x) == 1)] + if(length(open)>3) stop("More than three consecutive `{` found in ", substitute(designer)) + open <- open[3]+1 + x <- grep("[}]", txt) + close <- x[which(diff(x) == 1)] + if(length(close)>2) stop("More than three consecutive `}` found in ", substitute(designer)) + close <- close[1] + }else{ + open <- grep("[{]{3}", txt) + close <- grep("[}]{3}", txt) + } if(length(open) != 1) stop("could not find opening tag in ", substitute(designer)) if(length(close) != 1) stop("could not find opening tag in ", substitute(designer)) From 2a55cd73118e510fffb28e96abd58a47f7f7291a Mon Sep 17 00:00:00 2001 From: Clara Bicalho Date: Thu, 24 May 2018 11:59:35 +0200 Subject: [PATCH 03/12] Change indexing in construct_design_code() --- R/helpers.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index 34d9e645..233d81e5 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -16,11 +16,11 @@ construct_design_code <- function(designer, args){ x <- grep("[{]", txt) open <- x[which(diff(x) == 1)] if(length(open)>3) stop("More than three consecutive `{` found in ", substitute(designer)) - open <- open[3]+1 + open <- max(open)+1 x <- grep("[}]", txt) close <- x[which(diff(x) == 1)] if(length(close)>2) stop("More than three consecutive `}` found in ", substitute(designer)) - close <- close[1] + close <- min(close) }else{ open <- grep("[{]{3}", txt) close <- grep("[}]{3}", txt) From 73c66f97afe4da741bc22ac604f73dcef380b4e9 Mon Sep 17 00:00:00 2001 From: Clara Bicalho Date: Thu, 24 May 2018 12:04:51 +0200 Subject: [PATCH 04/12] Use deparse() instead of capture.output() --- R/helpers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/helpers.R b/R/helpers.R index 233d81e5..293b96e8 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -12,7 +12,7 @@ construct_design_code <- function(designer, args){ # get the code for the design txt <- as.character(getSrcref(designer)) if(length(txt)==0){ - txt <- capture.output(designer) + txt <- deparse(designer) x <- grep("[{]", txt) open <- x[which(diff(x) == 1)] if(length(open)>3) stop("More than three consecutive `{` found in ", substitute(designer)) From 98fce90ca23ce29c81cb9c7f8a03c7ab562fca94 Mon Sep 17 00:00:00 2001 From: Lily Medina Date: Thu, 24 May 2018 12:11:54 +0200 Subject: [PATCH 05/12] get_design_code --- R/helpers.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/helpers.R b/R/helpers.R index 9c1a79a9..552f3510 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -4,7 +4,11 @@ #' @export #' get_design_code <- function(design){ - attr(design, "code") + out <- capture.output( cat(attr(design, "code"),sep = "\n")) + out <- gsub("\\{|\\}", "", out) + out <- gsub("\\\"#|\\\"\\}", " + #", out) + cat(out, sep = "\n") } #' @export From a19b234608a048fe69083470165e24bc25e315a8 Mon Sep 17 00:00:00 2001 From: Clara Bicalho Date: Thu, 24 May 2018 14:38:34 +0200 Subject: [PATCH 06/12] Correct open/close index More accurate indexing (only takes lines of code with whitespace and curly braces. Fixes break with regression_discontinuity_designer(). --- R/helpers.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index 293b96e8..d81f0700 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -13,11 +13,11 @@ construct_design_code <- function(designer, args){ txt <- as.character(getSrcref(designer)) if(length(txt)==0){ txt <- deparse(designer) - x <- grep("[{]", txt) + x <- grep("^[[:blank:]]*[{]", txt) open <- x[which(diff(x) == 1)] if(length(open)>3) stop("More than three consecutive `{` found in ", substitute(designer)) open <- max(open)+1 - x <- grep("[}]", txt) + x <- grep("^[[:blank:]]*[}]", txt) close <- x[which(diff(x) == 1)] if(length(close)>2) stop("More than three consecutive `}` found in ", substitute(designer)) close <- min(close) From 04206b4e1ada15010d4237626859dd231c5aa590 Mon Sep 17 00:00:00 2001 From: Jasper Cooper Date: Thu, 24 May 2018 11:41:34 -0400 Subject: [PATCH 07/12] Added a new test that evaluates the get_design_code output - at the moment it is running in both builds (with source and without) --- tests/testthat/test_designers.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/tests/testthat/test_designers.R b/tests/testthat/test_designers.R index 2b381957..5feb8e9f 100644 --- a/tests/testthat/test_designers.R +++ b/tests/testthat/test_designers.R @@ -44,6 +44,12 @@ for(designer in designers){ expect_true(any(grepl("declare_design|/",design_attr$code))) }) + testthat::test_that( + desc = paste0(designer, "'s default design code runs without errors"), + code = { + expect_error(eval(parse(text = get_design_code(one_design))), NA) + }) + testthat::test_that( desc = paste0("Code inside ",designer, " runs and creates an appropriately named design object."), code = { From dd81b23d4bcfe73b6dcddb38f3157636270c5d44 Mon Sep 17 00:00:00 2001 From: Clara Bicalho Date: Tue, 29 May 2018 14:37:19 +0200 Subject: [PATCH 08/12] Triple bracket using function tree Cleans `{{{` using expression rather than regex on string. --- R/helpers.R | 40 +++++++++++++++++++++++++--------------- 1 file changed, 25 insertions(+), 15 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index d81f0700..e15cc564 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -7,30 +7,40 @@ get_design_code <- function(design){ attr(design, "code") } +#' @export +find_triple_bracket <- function(f){ + + pred <- function(expr, depth=3) { + (depth == 0) || ( + length(expr) > 1 && + expr[[1]] == as.symbol('{') && + Recall(expr[[2]], depth - 1) + ) + } + + clean <- function(ch, n=length(ch)-1) ch[2:n] + + ret <- Filter(pred, body(f)) + + if(length(ret) == 0) "" else clean(deparse(ret[[1]][[2]][[2]])) + +} + #' @export construct_design_code <- function(designer, args){ # get the code for the design txt <- as.character(getSrcref(designer)) if(length(txt)==0){ - txt <- deparse(designer) - x <- grep("^[[:blank:]]*[{]", txt) - open <- x[which(diff(x) == 1)] - if(length(open)>3) stop("More than three consecutive `{` found in ", substitute(designer)) - open <- max(open)+1 - x <- grep("^[[:blank:]]*[}]", txt) - close <- x[which(diff(x) == 1)] - if(length(close)>2) stop("More than three consecutive `}` found in ", substitute(designer)) - close <- min(close) + txt <- find_triple_bracket(designer) }else{ open <- grep("[{]{3}", txt) close <- grep("[}]{3}", txt) + + if(length(open) != 1) stop("could not find opening tag in ", substitute(designer)) + if(length(close) != 1) stop("could not find opening tag in ", substitute(designer)) + txt <- txt[seq(open + 1, close - 1)] } - - if(length(open) != 1) stop("could not find opening tag in ", substitute(designer)) - if(length(close) != 1) stop("could not find opening tag in ", substitute(designer)) - - txt <- txt[seq(open + 1, close - 1)] - + indentation <- strsplit(txt[1], "")[[1]] indentation <- indentation[cumprod(indentation == " ") == 1] indentation <- paste0("^", paste(indentation, collapse="")) From 69ee1ab99eced336882cee35a4f0002b47503bbd Mon Sep 17 00:00:00 2001 From: Jasper Cooper Date: Mon, 4 Jun 2018 16:05:26 +0200 Subject: [PATCH 09/12] Updated documentation for find_triple_bracket --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index 44aa54a5..5c1804a0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ export(block_cluster_two_arm_designer) export(cluster_sampling_designer) export(construct_design_code) export(crossover_designer) +export(find_triple_bracket) export(get_design_code) export(match.call.defaults) export(mediation_analysis_designer) From 8303a34fb888fe1ce173740797e430f041a62c22 Mon Sep 17 00:00:00 2001 From: Jasper Cooper Date: Mon, 4 Jun 2018 16:13:36 +0200 Subject: [PATCH 10/12] Updated tests --- tests/testthat/test_designers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test_designers.R b/tests/testthat/test_designers.R index 5feb8e9f..2c507203 100644 --- a/tests/testthat/test_designers.R +++ b/tests/testthat/test_designers.R @@ -29,7 +29,7 @@ for(designer in designers){ testthat::test_that( desc = paste0(designer,"'s default design runs."), code = { - expect_is(diagnose_design(one_design,sims = 5,bootstrap = F)$diagnosands,"data.frame") + expect_is(diagnose_design(one_design,sims = 5,bootstrap_sims = F)$diagnosands,"data.frame") }) testthat::test_that( From 59397dffd5887c79b5c1066ac2822a20ae9451b9 Mon Sep 17 00:00:00 2001 From: Jasper Cooper Date: Mon, 4 Jun 2018 16:28:29 +0200 Subject: [PATCH 11/12] Travis install DD from github --- .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index 59c9b42e..510fa793 100644 --- a/.travis.yml +++ b/.travis.yml @@ -13,6 +13,7 @@ env: - secure: vgaDWtCNkBANvIyhfL0/x4O3+s4NgcsIp0hKZmbRh3lo5uUl0bmvureGclBmeM3LEK+ER8K3uzdzCrfjARYU016EM4Q0g2RS4Q+jMO4bUJgAtqODeiPBc8cHHUD2wFU9MRWwRm/U1e/NnjprgN35OAPBjuLh3xswN1AwoYVFXF61F4/hMcs9GzPGqwWFY4AxxmaCGYAaR93VchA8aSZdzc4LdcUfVs8jU/UxM7CHS+r8w/rjZx+vtEmm3vSn7RI60OBevq7N/FM4xRasn0KxgnaUrvRjrbwIHHSzUZ/siIfJPtpfPooQo5RjYc7qoGHiwF4m21Ave9A7P3Ugq3FZKzpyOtJ2Sk2vd4Rr0uFWk/uJWJXHlOgwSCRpzK/dT7omdstyvCxbSfWXUEBdx59LWX5arB1S4+ivshXiMsxC6BDfCk3fy0f/2J4Whz0PFj4Zd5HXAzTLDTLy7+t0XXeeHhX4nsNkYqCwnuYzfm4Y89cmmGp7ZutuEkzowtSzdc7ov4miBfFRxNPPODHmgmclMwPCzL94aQyQirQ4GYmIxPu/9SlN5wieeclISDb6Tf/sis0dlBMwyu6FSvNtQwOok+vOeC2H3qLbsuAonw+h9CGF0UckdJgU9RiIzw6b17Ad6OhE2aQvSC7mfoj272PFIj1QYgpED4s08eKPJnAQAtI= r_github_packages: - DeclareDesign/DDtools +- DeclareDesign/DeclareDesign after_success: - Rscript -e DDtools::after_build r_packages: From 390becc35cb818c5018ea0e9848b3fd56bf4947c Mon Sep 17 00:00:00 2001 From: Jasper Cooper Date: Mon, 4 Jun 2018 16:53:48 +0200 Subject: [PATCH 12/12] Commenting out code for working on later --- R/helpers.R | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index 79049e8e..d1ad9103 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -4,11 +4,10 @@ #' @export #' get_design_code <- function(design){ - out <- capture.output( cat(attr(design, "code"),sep = "\n")) - out <- gsub("\\{|\\}", "", out) - out <- gsub("\\\"#|\\\"\\}", " - #", out) - cat(out, sep = "\n") + out <- attr(design, "code") + # out <- gsub("\\{|\\}", "", out) + # out <- gsub("\\\"#|\\\"\\}", "\n#", out) + out } #' @export