made a lot of test_rpsftm work.

closes #14

Author: shug0131

R/asOneFormula.R

@@ -5,6 +5,7 @@ asOneFormula <- function (..., omit = c(".", "pi"))
   if (length(names)) 
     eval(parse(text = paste("~", paste(names, collapse = "+")))[[1]])
   else ~1
+  #environments are not preseved. reassign outside of the function call
 }
 
 

R/rpsftm.R

@@ -87,8 +87,10 @@ rpsftm <- function(formula, data, censor_time, subset, na.action,  test = survdi
   # renamed time, status, censor_time, rx, arm as appropriate
   special <- c("strata","cluster")
   formula_list <- one_becomes_three(formula)
+  all_var_formula <- asOneFormula(formula_list[1:3])
+  environment(all_var_formula) <- environment(formula)
 
-  mf$formula <- asOneFormula(formula_list[1:3])
+  mf$formula <- all_var_formula
 
   mf$formula <- if (missing(data)) {
     terms(mf$formula, special)
@@ -360,6 +362,7 @@ rpsftm <- function(formula, data, censor_time, subset, na.action,  test = survdi
       fit=fit, 
       CI=c(lower$root,upper$root),
       Sstar=Sstar, 
+      formula_list=formula_list,
       #rand=rand_object,
       ans=ans,
       eval_z=eval_z),

R/untreated.R

@@ -30,7 +30,7 @@ untreated <- function(psi, response,treatment_matrix, rand_matrix, censor_time,
 
 
   nontreatment <- 1-apply(treatment_matrix,1,sum)
-  treatment_matrix <- sweep(treatment_matrix,2, exp(psi), FUN="*")
+  treatment_matrix <- sweep(treatment_matrix,1, exp(psi), FUN="*")
   treatment <- apply(treatment_matrix,1, sum)
 
   u <- time * (nontreatment + treatment)

tests/testthat/test_rpsftm.R

@@ -4,6 +4,17 @@ context("Test the rpsftm() function")
 
 
 
+test_that("check of test that with mixed data sources",{
+  propX <- with(immdef,I(1-xoyrs/progyrs))
+  fit <- lm(progyrs~propX, data=immdef)
+  expect_is(fit$coefficients, "numeric")
+})
+
+test_that("first basict fit",{
+  fit <- rpsftm(Surv(progyrs, prog)~rand(I(1-xoyrs/progyrs)~imm),immdef, censyrs)
+  expect_is(fit$psi, "numeric")
+})
+
 
 test_that("first basict fit with mixed data sources",{
   propX <- with(immdef,I(1-xoyrs/progyrs))