slowly pruning $rs_functions

DeclareDesign · Mar 21, 2018 · 5adda57 · 5adda57
1 parent 12b3a2d
commit 5adda57
Show file tree

Hide file tree

Showing 5 changed files with 10 additions and 5 deletions.
diff --git a/R/declare_ra.R b/R/declare_ra.R
@@ -143,7 +143,7 @@ declare_ra <- function(N = NULL,
 
   return_object <- list2env(all_args, parent = emptyenv())
 
-  return_object$ra_function = function() ra_function(return_object)
+  return_object$ra_function = function() ra_function(return_object) #todo
   return_object$ra_type = ra_type
   return_object$cleaned_arguments = input_check
 

diff --git a/R/declare_rs.R b/R/declare_rs.R
@@ -213,6 +213,8 @@ obtain_inclusion_probabilities <- function(declaration = NULL) {
   declaration$probabilities_vector
 }
 
+formals(obtain_inclusion_probabilities) <- c(formals(obtain_inclusion_probabilities), formals(declare_rs))
+
 #' @export
 print.rs_declaration <- function(x, ...) {
   S <- x$rs_function()

diff --git a/tests/testthat/test-custom-ra.R b/tests/testthat/test-custom-ra.R
@@ -11,7 +11,7 @@ test_that("custom RA yields inputs",{
   prob <- declaration_2$probabilities_matrix
   expect_equal(dim(prob), c(10,4))
 
-  Z <- declaration_2$ra_function()
+  Z <- conduct_ra(declaration_2)
 
   expect_identical(
     obtain_condition_probabilities(declaration = declaration_2, assignment = Z),

diff --git a/tests/testthat/test_assignment_declarations.R b/tests/testthat/test_assignment_declarations.R
@@ -3,9 +3,12 @@ context("Declarations: Complete Random Assignments")
 
 test_declaration <- function(declaration, esum, eprob, conditions){
   Z <- conduct_ra(declaration)
+
+  if(!is.null(declaration$N)) expect_length(Z, declaration$N)
+
   prob <- obtain_condition_probabilities(declaration = declaration, assignment = conditions)
 
-  expect_true(is.function(declaration$ra_function))
+  expect_true(is.numeric(prob))
 
   if(!is.na(esum))expect_equal(sum(Z), esum)
   if(!is.na(eprob))expect_true(all(prob == eprob))
@@ -192,6 +195,8 @@ test_that("blocks num_arms = 3 ",{
 
   declaration <- declare_ra(blocks=blocks, num_arms=3)
   test_declaration(declaration, NA, 1/3, "T1")
+
+  expect_true(all(table(conduct_ra(declaration), blocks) > 10))
 })
 
 test_that("block_m_each named",{

diff --git a/tests/testthat/test_sampling_declarations.R b/tests/testthat/test_sampling_declarations.R
@@ -4,8 +4,6 @@ test_declaration <- function(declaration, esum, eprob){
   S <- draw_rs(declaration)
   prob <- obtain_inclusion_probabilities(declaration = declaration)
 
-  expect_true(is.function(declaration$rs_function))
-
   if(!is.na(esum))expect_equal(sum(S), esum)
   if(!is.na(eprob))expect_true(all(prob == eprob))