0

From the TMB tutorial, one defines objective functions in a .cpp file, such that parameter names and names of model data structures are shared between the C++ function and what is called from R. For example, the tutorial.cpp file:

#include <TMB.hpp>                                // Links in the TMB libraries

template<class Type>
Type objective_function<Type>::operator() ()
{
  DATA_VECTOR(x);                                 // Data vector transmitted from R
  PARAMETER(mu);                                  // Parameter value transmitted from R
  PARAMETER(sigma);                               //                 

  Type f;                                         // Declare the "objective function" (neg. log. likelihood)
  f = -sum(dnorm(x,mu,sigma,true));               // Use R-style call to normal density

  return f;
}

After compilation and dyn.load one can call this function from R, however, you need to know that the data vector is named x, and that there are two parameter values mu and sigma. Is it possible to retrieve the names of these required objects some how from R?

Alex
  • 15,186
  • 15
  • 73
  • 127
  • I propose removing the rcpp tag from all (or most of) your questions as this is pretty much unrelated to Rcpp -- you just use it to get to your particular library of interest, here TMB, – Dirk Eddelbuettel Mar 15 '17 at 11:28
  • 1
    There is no `TMB` tag at the moment, maybe this could be useful to better identify these questions. I do not have enough reputation for now to do so. – Sébastien Rochette Aug 03 '17 at 09:13

2 Answers2

3

I am not aware of a function in the package that does this, but the function below might help you out;

    TMBsearch = function(path,what='parameter',class=FALSE){

    if(!missing(what) | length(what)>1) stop("What should be of length one")
    if(!(what %in% c('parameter','data','report','sdreport')))  stop("What should be parameter, data, report or sdreport")

     text = paste0(paste0(readLines(path), collapse = "\n"), "\n") # read the text from the cpp file
     start = unlist(gregexpr(pattern =toupper(what),text)) # starting position
     end.poss = unlist(gregexpr(pattern =')',text)) # possible end positions
     end = rep(NA,length(start))
     for(i in 1:length(start)){end[i] = end.poss[(end.poss-start[i]) > 0][1]} # actual end position
     textsub = substring(text,first=start,last=end) # extract the full PARAMETER/DATA_x(...) 
     found = gsub("[\\(\\)]", "", regmatches(textsub, gregexpr("\\(.*?\\)", textsub))) # get rid of the brackets

     if(class & what %in% c('parameter','data')){
       dataclass=tolower(gsub("_", "",gsub(".*PARAMETER\\s*|\\(.*", "", textsub)))
       dataclass[dataclass=='']="single value"
       names(found)=datatype
     }

     return(found)
}

TMBsearch(path=paste0(filename,'.cpp'), what='parameter')

"what" can either be 'parameter', 'data', 'report' or 'sdreport' but by default I made it parameter.

ADDITION: if class==TRUE than for parameter and data the class (matrix, array, etc.) is given as the name of each object.

Wave
  • 1,216
  • 1
  • 9
  • 22
  • in my edit, the combination of `function(..., what = c("parameter", "data", "report", "sdreport")` and `what = match.arg(what)` does what you are doing with your `if ... stop ...` code, and defaults to `"parameter"` if nothing is supplied, but up to you what you want to do. Also `!missing(what)` is superfluous in your first if statement. – Alex Aug 03 '17 at 22:56
  • Sorry, I didn't know who changed it and why exactly. I wasn't familiar with match.arg. Go ahead if you feel like it's better your way, it is indeed cleaner. I just thought that the error message would be a little vague and I like the idea the options are given in the error. – Wave Aug 04 '17 at 12:05
1

Thank you @Wave for your useful function. I just improved it a little to retrieve all types in a list if what has multiple arguments. I also had some remaining spaces in my names, so that I also added a gsub. 

TMBsearch <- function(path, what = c('parameter', 'data', 'report', 'sdreport')) {
  res <- lapply(what, function(what) {
    # what <- match.arg(what)
    text <- paste0(paste0(readLines(path), collapse = "\n"), "\n") # read the text from the cpp file
    start <- unlist(gregexpr(pattern = toupper(what), text)) # starting position
    end.poss <- unlist(gregexpr(pattern = ')', text)) # possible end positions
    end <- rep(NA,length(start))
    for (i in 1:length(start)) {end[i] <- end.poss[(end.poss - start[i]) > 0][1]} # actual end position
    textsub <- substring(text, first = start, last = end) # extract the full PARAMETER/DATA_x(...) -> might be handy to now whether array or vector or...
    found <- gsub("[\\(\\)]", "", regmatches(textsub, gregexpr("\\(.*?\\)", textsub))) # get rid of the brackets
    found_nospace <- gsub(" ", "", found) # get rid of the spaces if some left
    return(found_nospace)
  })
  names(res) <- what
  res
}
Sébastien Rochette
  • 6,536
  • 2
  • 22
  • 43