1

I want to modify a specific function in R, called strata.bh, stratification package. I write the function in order to obtain the code:

> strata.bh

function (x, bh, n = NULL, CV = NULL, Ls = 3, certain = NULL, 
alloc = list(q1 = 0.5, q2 = 0, q3 = 0.5), takenone = 0, bias.penalty = 1, 
takeall = 0, takeall.adjust = TRUE, rh = rep(1, Ls), model = c("none", 
    "loglinear", "linear", "random"), model.control = list()) 
{
call.ext <- match.call()
out <- valid_args(obj_fct = as.list(environment()), call.ext = call.ext)
N <- out$N
findn <- out$findn
L <- out$L
rhL <- out$rhL
takenone <- out$takenone
takeall <- out$takeall
certain <- out$certain
xnoc <- out$xnoc
Nc <- out$Nc
Nnoc <- out$Nnoc
q1 <- out$q1
q2 <- out$q2
q3 <- out$q3
nmodel <- out$nmodel
beta <- out$beta
sig2 <- out$sig2
ph <- out$ph
pcertain <- out$pcertain
gamma <- out$gamma
epsilon <- out$epsilon
args <- out$args
out <- init_stat(obj_fct = as.list(environment()))
EX <- out$EX
EX2 <- out$EX2
EYc <- out$EYc
bhfull <- c(min(x), bh, max(x) + 1)
strata.bh.internal(bhfull = bhfull, takeallin = takeall, 
    takeall.adjust = takeall.adjust, obj_fct = as.list(environment()))

}

After this I paste the same code function, changing just the name:

> stratas.bh<-function ...

I create a vector x and I try to apply the 'new' function, but I get this error code:

> x<-c(1,2,3,4,5,6,7,8,9,10);

>stratas.bh(x, bh=c(2,7), CV=3)
Error in stratas.bh(x) : could not find function "valid_args"

Do I need to load another package?!

amonk
  • 1,769
  • 2
  • 18
  • 27
Aris
  • 15
  • 4
  • It's an issue of environment, if you do `stratas.bh <- strata.bh` it will work, but you probably want to tweak the function right ? I'm not very knowledgeable about environments, but I think if you assign your new function definition to the environment of the original function it may work – moodymudskipper Jun 22 '17 at 08:12
  • Yeah it worked! Can I also change the code before doing this? – Aris Jun 22 '17 at 08:15
  • unfortunately no... I can't think of any clean way of handling this... the environments of packages are locked, you could unlock them using this: https://stackoverflow.com/questions/25910778/unlockenvironment-implemented-via-rcpp-instead-of-inline/25922051#25922051 , then try `library(pryr);assign("stratas.bh",stratas.bh,envir=where("strata.bh"))`, you could rebuild the package yourself, or you could use debug and redefine in your global environment all the functions that you need, including valid_args. – moodymudskipper Jun 22 '17 at 08:30
  • These are all dirty hacks though. I suppose rebuilding the package is the cleanest of all three. To be more pragmatic though , what are you trying to achieve ? there may be another way. – moodymudskipper Jun 22 '17 at 08:30
  • I don't know if you are familiar with Neyman allocation, I just want to fix a minimal number for strata (=10). So if the function gives nh<10, than nh=10. If nh>=10 than it is OK. I hope I was clear! – Aris Jun 22 '17 at 08:35
  • This is the 'complete' code I think: https://rdrr.io/cran/stratification/src/R/strata.bh.R – Aris Jun 22 '17 at 08:39
  • OK I think it will be very simple in the end, can you try this ? `environment(stratas.bh) <- asNamespace('stratification')` – moodymudskipper Jun 22 '17 at 08:58
  • Yeah I tried but however, I can't modify the code. Maybe I should modify other functions, related with this function. I am not sure! – Aris Jun 22 '17 at 11:22
  • so you've tried to modify the code, then run the line I just gave you, then try to run the function, and it didn't work ? – moodymudskipper Jun 22 '17 at 12:01

1 Answers1

0

This is the line you should use AFTER modifying your function, whether you give it a new name or not: environment(stratas.bh) <- asNamespace('stratification')

Full example here

stratas.bh <- function (x, bh, n = NULL, CV = NULL, Ls = 3, certain = NULL, 
                        alloc = list(q1 = 0.5, q2 = 0, q3 = 0.5), takenone = 0, bias.penalty = 1, 
                        takeall = 0, takeall.adjust = TRUE, rh = rep(1, Ls), model = c("none", 
                                                                                       "loglinear", "linear", "random"), model.control = list()) 
{
  call.ext <- match.call()
  out <- valid_args(obj_fct = as.list(environment()), call.ext = call.ext)
  N <- out$N
  findn <- out$findn
  L <- out$L
  rhL <- out$rhL
  takenone <- out$takenone
  takeall <- out$takeall
  certain <- out$certain
  xnoc <- out$xnoc
  Nc <- out$Nc
  Nnoc <- out$Nnoc
  q1 <- out$q1
  q2 <- out$q2
  q3 <- out$q3
  nmodel <- out$nmodel
  beta <- out$beta
  sig2 <- out$sig2
  ph <- out$ph
  pcertain <- out$pcertain
  gamma <- out$gamma
  epsilon <- out$epsilon
  args <- out$args
  out <- init_stat(obj_fct = as.list(environment()))
  EX <- out$EX
  EX2 <- out$EX2
  EYc <- out$EYc
  bhfull <- c(min(x), bh, max(x) + 1)
  strata.bh.internal(bhfull = bhfull, takeallin = takeall, 
                     takeall.adjust = takeall.adjust, obj_fct = as.list(environment()))
  return("It works")
}

All I changed was add the last line : return("It works")

Now let's add the magical line and see what happens:

environment(stratas.bh) <- asNamespace('stratification')
x<-c(1,2,3,4,5,6,7,8,9,10);
stratas.bh(x, bh=c(2,7), CV=3) # used to return an error, now returns "It works"
moodymudskipper
  • 46,417
  • 11
  • 121
  • 167
  • as I mentioned, I want to fix a minimal number for strata (=10). So if the function gives nh<10, than nh=10. If nh>=10 than it is OK. I tried to add these commands in the end of the above code but it didn't work. It doesn't give me an error, either; the function does not change... – Aris Jun 23 '17 at 08:49
  • can you include your modified code at the end of the question ? – moodymudskipper Jun 23 '17 at 09:18
  • this is the last part of the code: takeall.adjust = takeall.adjust, obj_fct = as.list(environment())) { if (Nh[i]>=10 & nh[i]<10){ nh[i]=10 }}} – Aris Jun 23 '17 at 09:43
  • It doesn't make sense, i, Nh, and nh don't exist outside of the output – moodymudskipper Jun 23 '17 at 10:10
  • Moreover it seems that all you want to do is edit the output, there was really no need to create a copy of the function and do all this gymnastics for that, you just need to create a function that calls the first one, then edit the output with probably something like `output$nh[output$Nh>=10 & output$nh<10] <- 10` – moodymudskipper Jun 23 '17 at 10:13