Using internal functions of a package

Date last run: 07Feb2020

Update 2020-02-07

This is revised version of the original entry dated 25JAN2020.

Introduction

In a previous blog entry I mentioned that I would like to have some changes in the tabr package. The author Matt Leonawicz rejected the PR and therefore I wanted to see if they could be included in my package tabraux that contains some extensions on tabr that I think worthwhile.

Problem

I had made changes in three functions: is_note, phrase and _phrase. The latter two functions call a lot of tabr functions, most of them being internal to tabr . That means I can not just copy the three functions that I prepared for the PR to the tabraux package: I had to tell them to use the namespace of the tabr package. Googling I found how to do that in the GitHub answer by G. Grothendieck . At the same time these new functions also have to be found by the tabr functions.

Solutions

I will describe the solutions that I found.

• I would advise to use the first solution, based on the function assignInNamespace, when that works for you, because it is the simplest one. Only base-R functions are needed.
• The other solution, that is based on the trace facility, is given because it gives some background on programming with environments and the possibilities of the trace facility.

Solution based on assignInNamespace

I create a new function phrase2 with the three functions that were changed as inner functions with a new name (the original one with a suffix ‘_2’). The tree inner functions are given the correct environment. In phrase2 I use the original names to point to the changed functions (with the assignInNamespace function). At the end of the function phrase2 we ensure that the the original names point to the original function body again. To be able to do that we start with making copies of the original package functions (with as name the original one with a suffix ‘_3’). In schematic form:

phrase2 <- function(notes,info = NULL,string = NULL,bar = NULL) {
  is_note_3 <- tabr::is_note
  phrase_3  <- tabr::phrase
  .phrase_3 <- tabr:::.phrase
  on.exit(assignInNamespace("phrase", phrase_3, ns = "tabr"), add = T)
  on.exit(assignInNamespace(".phrase", .phrase_3, ns = "tabr"), add = T)
  on.exit(assignInNamespace("is_note", is_note_3, ns = "tabr"), add = T)
  
  is.note_2 <- function(x, na.rm = FALSE) {
    ...
  }
  environment(is.note_2) <- asNamespace("tabr")
  
  phrase_2 <- function(notes,
                     info = NULL,
                     string = NULL,
                     bar = NULL) {
    ...
  }
  environment(phrase_2) <- asNamespace("tabr")
  
  .phrase_2 <- function(notes, info, string) {
    ...
  }
  environment(.phrase_2) <- asNamespace("tabr")
  
  assignInNamespace("phrase", phrase_2, ns = "tabr")
  assignInNamespace(".phrase", .phrase_2, ns = "tabr")
  assignInNamespace("is_note", is_note_2, ns = "tabr")
  
  ...
  phrase_2(notes,info = NULL,string = NULL,bar = NULL)
}

This function phrase2 is included in version 0.0.3 of package tabraux.

Solution based on trace

As mentioned above the solution presented above is the simpler one but this solution is given to document the trials (and errors) I made.

The solution presented above works by letting the old names point to new functions . As an alternative I wanted to let the old functions call the new functions . I tried to do this by building a function replace_package_fun that makes use of the trace facility. By setting a trace at the start of function fn1 in a package ns I would make certain that function fn2 was called each time that fn1 is executed (with identical arguments). I would then call replace_package_fun with start=T to activate the trace and at the end I would call replace_package_fun with start=F to deactivate it.

A too simple trace

The first simple implementation I tried and that would call the function fn2 when calling fn1 was not working as I had expected:

# NB: this implementation is not working as expected
replace_package_fun <- function (fn1, fn2, ns, start = T) {
  if (start) {
    what_to_do <-  rlang::expr({
      call1 <- match.call()
      call1[[1]] <- as.symbol(!!fn2)
      return(eval(call1))
    })
    trace(
      fn1,
      what_to_do,
      print = FALSE, edit = FALSE,
      where = asNamespace(ns)
    )
  }
  else {
    untrace(fn1, where = asNamespace(ns))
  }
  invisible(NULL)
}

When calling replace_package_fun the function fn2 was indeed called but after that the original function fn1 was still executed. Looking at the body of fn1 after applying the ‘trace’ we see

body(fn1)
#> {
#>     .doTrace({
#>         call1 <- match.call()
#>         call1[[1]] <- as.symbol("fn2")
#>         return(eval(call1))
#>     })
#>     {
#>        original body
#>     }
#> }

Apparently the return in the .doTrace block just returns that block and not the traced function.

A working (but more complex) trace solution

So apart from ensuring that the fn2 function gets the right environment (not handled yet by the replace_package_fun function) the .doTrace block should be modified.

After some experimenting I created the following replace_package_fun function that is included in the HOQCutil package:

HOQCutil::replace_package_fun
function (fn1, fn2, ns, envir=globalenv(), start = T) {

  fun_call <- paste('return(',fn2,'(',
                    paste(names(formals(fn1,envir=asNamespace(ns))),collapse=','),
                    '))',sep='')

  my_edit <- function (name, file = "", title = file, ...)
  {
    # default editor function changed at indicated places
    if (missing(name))
      return(.Call("rs_editFile", file, PACKAGE = "(embedding)"))
    if (is.null(file) || !nzchar(file)) {
      file <- tempfile("rstudio-scratch-", fileext = ".R")
      on.exit(unlink(file), add = TRUE)
    }
    # next block replace because of missing .rs.deparseFunction in rmarkdown env.
    # deparsed <- if (is.function(name))
    #   .rs.deparseFunction(name, useSource = TRUE, asString = FALSE)
    # else deparse(name)
    deparsed <- if (is.function(name))
      deparse(name)
    else deparse(name)
    # next line inserted: replace trace line by call to replacement function
    deparsed[grepl('doTrace',deparsed)]<-fun_call
    writeLines(deparsed, con = file)
    # next line commented: no need for manual editing
    # .Call("rs_editFile", file, PACKAGE = "(embedding)")
    #### eval(parse(file), envir = globalenv())
    eval(parse(file), envir = envir)
  }

  old_edit = options("editor"= my_edit)
  on.exit(options(old_edit),add=T)
  utils::capture.output(
    {
      if (start) {
        trace(
          fn1,
          browser,
          print = FALSE, edit = TRUE,
          where = asNamespace(ns)
        )
        HOQCutil::set_fun_env(fn2,ns,envir)
      }
      else {
        untrace(fn1, where = asNamespace(ns))
        HOQCutil::set_fun_env(fn2,envir,envir)
      }
    },type = "message")
  invisible(NULL)
}
<bytecode: 0x00000000186e39e8>
<environment: namespace:HOQCutil>

The function replace_package_fun replaces a (internal) function fn1 of package ns by a function fn2 from the global environment. The functions must have the same signature. The argument start indicates that the replacement should be done (TRUE) or undone (FALSE). The following steps are done :

• the character string fun_call is created with the call of fn2 that will be executed when fn1 is called. This character string will be used by the editor to replace the line .doTrace(browser(), "on entry")
• the function my_edit is defined that will replace the standard editor while replace_package_fun is running. Compared with the standard editor there are three changes:
  • the block with .rs.deparseFunction is replaced with the one with deparse
  • a line is inserted where .doTrace(browser(), "on entry") is replaced by fun_call
  • the interactive edit screen is not shown
• the my_edit function is set as the new standard editor and the old one is saved to be used again as such when exiting replace_package_fun
• when start==TRUE
  • the trace function inserts the browser line in the function fn1 of package ns . Because edit=TRUE the function my_edit is called that replaces the browser line with fun_call.
  • the environment of the replacement function is set with set_fun_env (also from the HOQCutil package)
• when start==FALSE
  • the untrace function restores the original contents of fn1
  • the environment of fn2 is reset to the original environment
    

The trace solution applied to the phrase problem

After some experimenting I still had problems when the replacement functions (for is_note, phrase and _phrase) where specified as inner functions in my new ‘phrase’ function. I could have this solved this by again using the assignInNamespace function as in the first solution but then there would be no need for the trace solution at all. I decided to simply temporarily copy the functions to the global environment. Of course this is not be necessary when the replacement functions are given as global functions (but I prefer them to be inner functions because they do not have an independent purpose) . I have included the new function phrase3 as a hidden function in package tabraux. The full function definition can be shown with tabraux:::phrase3 but in schematic form:

phrase3 <- function(notes, info = NULL, string = NULL, bar = NULL){
# specify the replacement function (suffix '_2')
is_note_2 <- function(x, na.rm = FALSE){
  ...
}
phrase_2 <- function(notes, info = NULL, string = NULL, bar = NULL){
  ...
}
.phrase_2 <- function(notes, info, string){
  ...
}
# copy the replacement function to global environment with 'random' prefix to avoid name collusion
# (to be absolutely sure, use "ls(envir=globalenv())" to check for collusion )
  assign('HOQC1181_phrase',phrase_2,envir=globalenv())
  assign('HOQC1181_.phrase',.phrase_2,envir=globalenv())
  assign('HOQC1181_is_note',is_note_2,envir=globalenv())
# create abbreviation for the global environment
  e=globalenv()
# reset original package functions when leaving function
  on.exit(HOQCutil::replace_package_fun("phrase", "HOQC1181_phrase", 
                                        ns = "tabr",envir=e,start='F'), add = T)
  on.exit(HOQCutil::replace_package_fun(".phrase", "HOQC1181_.phrase", 
                                        ns = "tabr",envir=e,start='F'), add = T)
  on.exit(HOQCutil::replace_package_fun("is_note", "HOQC1181_is_note", 
                                        ns = "tabr",envir=e,start='F'), add = T)
# delete copy of replacement functions when leaving function
  on.exit(rm(list=c('HOQC1181_phrase','HOQC1181_.phrase','HOQC1181_is_note'),
             envir=e,inherits=F), add = T)
# replace original package functions by copy of replacement functions
  HOQCutil::replace_package_fun("phrase", "HOQC1181_phrase", 
                                ns = "tabr",envir=e,start='T')
  HOQCutil::replace_package_fun(".phrase", "HOQC1181_.phrase", 
                                ns = "tabr",envir=e,start='T')
  HOQCutil::replace_package_fun("is_note", "HOQC1181_is_note", 
                                ns = "tabr",envir=e,start='T')
# remove redundant whitespece from notes and info arguments
  notes = trimws(gsub("\\s\\s+", " ",notes))
  if (!is.null(info)) info =  trimws(gsub("\\s\\s+", " ",info))
# do call: looks like original call but functions are replaced
  tabr::phrase(notes, info = info, string = string, bar = bar)
}

And does it work ?

We now compare the original and the adapted ‘phrase’ function when we apply them on a note string with an anchor point and they work as expected: the original function does not support anchor points and the other two do:

notes <- "e3 ^2 f g"
info  <- "8 1 8 8"
tabr::phrase(notes,info,bar= ":|.")       # expect error
#> Error: Invalid notes or chords found.
tabraux::phrase2(notes,info,bar= ":|.")   # expect success
#> <Musical phrase>
#> <e>8 ^2 <f>8 <g>8 \bar ":|."
tabraux:::phrase3(notes,info,bar= ":|.")  # expect success
#> <Musical phrase>
#> <e>8 ^2 <f>8 <g>8 \bar ":|."

Session Info

This document was produced on 07Feb2020 with the following R environment:

  #> R version 3.6.0 (2019-04-26)
  #> Platform: x86_64-w64-mingw32/x64 (64-bit)
  #> Running under: Windows 10 x64 (build 18362)
  #> 
  #> Matrix products: default
  #> 
  #> locale:
  #> [1] LC_COLLATE=English_United States.1252 
  #> [2] LC_CTYPE=English_United States.1252   
  #> [3] LC_MONETARY=English_United States.1252
  #> [4] LC_NUMERIC=C                          
  #> [5] LC_TIME=English_United States.1252    
  #> 
  #> attached base packages:
  #> [1] stats     graphics  grDevices utils     datasets  methods   base     
  #> 
  #> loaded via a namespace (and not attached):
  #>  [1] Rcpp_1.0.3       crayon_1.3.4     assertthat_0.2.1 digest_0.6.23   
  #>  [5] HOQCutil_0.1.16  dplyr_0.8.3      R6_2.4.1         magrittr_1.5    
  #>  [9] evaluate_0.14    pillar_1.4.3     rlang_0.4.3      stringi_1.4.5   
  #> [13] tabr_0.4.1       rmarkdown_2.0    tools_3.6.0      stringr_1.4.0   
  #> [17] glue_1.3.1       purrr_0.3.3      tabraux_0.0.3    xfun_0.10       
  #> [21] compiler_3.6.0   pkgconfig_2.0.3  htmltools_0.4.0  tidyselect_0.2.5
  #> [25] knitr_1.27       tibble_2.1.3