code to better get C variables

get_c_vars.R

@@ -0,0 +1,73 @@
+##' ---
+##' output: 
+##'   md_document:
+##'     variant: markdown_github
+##' ---
+
+#+ message=FALSE
+library(dplyr)
+library(magrittr)
+library(mrgsolve)
+
+x <- "double x = 2;long double a= 2;  bool foo_yak = 34 + pow(THETA1,THETA2);"
+
+a <- mrgsolve:::get_sep_tokens(x) %>% unlist
+
+
+
+fails <- '
+$PARAM CL = 0.3, VC = 1.5, wt = 5
+$CMT CENT
+$MAIN
+double a = 2;   localbool z= 1;int j  = 123; double m =2; double    zz = 2;
+double a=2 , bool zzz  = 2;
+double CL_i = CL*exp(ETA(1))*wt/5;
+double Vi = VC*exp(ETA(2));
+$ODE
+dxdt_CENT = 0;
+ double setinode = pow(a,b);
+$OMEGA
+0.1
+0.04
+$TABLE
+bool  IPRED = 2/3;
+double b = 2;
+$CAPTURE CL_i Vi wt
+'
+
+y <- strsplit(fails, "\n")[[1]]
+
+
+get_c_vars <- function(y) {
+
+  ## Lines matching 
+  m <- gregexpr("\\b(double|int|bool) \\s*\\w+\\s*=",y,perl=TRUE)
+  what <- regmatches(y,m)
+  keep <- lapply(what,length)
+  whic <- lapply(seq_along(keep), function(i) {
+    rep(i,length(what[[i]]))
+  }) %>% unlist
+
+  what <- unlist(what)
+  m2 <- gregexpr("(double|int|bool)", what,perl=TRUE)
+
+  remain <- regmatches(what,m2,invert=TRUE)
+  remain <- lapply(remain, `[`,2) 
+  remain <- lapply(remain, gsub, pattern="^\\s+", replacement="") %>% unlist
+  var <- gsub("\\s*=$", "", remain)
+  dec <- gsub("\\s*=$", "", what)
+  dec <- paste0(gsub("\\s+", " ",dec), ";")
+  data_frame(line = whic, from=what, to=remain,var=var, dec=dec)
+}
+
+
+x <- readLines("~/project.mrg/amg/416/script/model/model2.14.0.cpp")
+x <- x[!grepl("^\\s*//",x)]
+
+system.time({find <- get_c_vars(x)})
+
+library(metrumrg)
+system.time(mod <- mread("model2.14.0", project="~/project.mrg/amg/416/script/model/"))
+
+
+

rdev/R/RcppExports.R

@@ -49,3 +49,7 @@ get_tokens <- function(code) {
     .Call('mrgsolve_get_tokens', PACKAGE = 'mrgsolve', code)
 }
 
+get_sep_tokens <- function(code) {
+    .Call('mrgsolve_get_sep_tokens', PACKAGE = 'mrgsolve', code)
+}
+

rdev/R/utils.R

@@ -938,6 +938,7 @@ get_tokens <- function(x,unlist=FALSE) {
 }
 
 
+
 as_pack_mod <- function(model, project, PACKAGE) {
     x <- mread(model, project,compile=FALSE,udll=FALSE)
     code <- readLines(cfile(x),warn=FALSE)

rdev/inst/include/mrgsolve.h

@@ -66,6 +66,7 @@ void match_both(svec a, svec b, ivec& ai, ivec& bi);
 void match_one(svec a, svec b, ivec& ret);
 Rcpp::List map_data_set(Rcpp::NumericMatrix data);
 Rcpp::List get_tokens(Rcpp::CharacterVector code);
+Rcpp::List get_tokens_sep(Rcpp::CharacterVector code);
 //Rcpp::List tokens(Rcpp::CharacterVector x, Rcpp::CharacterVector sep_);
 
 

rdev/src/RcppExports.cpp

@@ -162,3 +162,14 @@ BEGIN_RCPP
     return __result;
 END_RCPP
 }
+// get_sep_tokens
+Rcpp::List get_sep_tokens(Rcpp::CharacterVector code);
+RcppExport SEXP mrgsolve_get_sep_tokens(SEXP codeSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject __result;
+    Rcpp::RNGScope __rngScope;
+    Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type code(codeSEXP);
+    __result = Rcpp::wrap(get_sep_tokens(code));
+    return __result;
+END_RCPP
+}

rdev/src/mrgsolve.cpp

@@ -13,6 +13,7 @@
 #include "boost/tokenizer.hpp"
 #include "boost/foreach.hpp"
 
+typedef boost::tokenizer<boost::escaped_list_separator<char> > so_tokenizer;
 
 double digits(double a, double b) {
   return std::floor(a*b)/b;
@@ -393,4 +394,38 @@ Rcpp::List get_tokens(Rcpp::CharacterVector code) {
 
 
 
+//[[Rcpp::export]]
+Rcpp::List get_sep_tokens(Rcpp::CharacterVector code) {
+
+  Rcpp::List ret(code.size());
+
+  std::string sep1("\\");
+  std::string sep2(";,");
+  std::string sep3("\"\'");//let it have quoted arguments
+  boost::escaped_list_separator<char>sep(sep1,sep2,sep3);
+  for(int i = 0; i < code.size(); i++) {
+    Rcpp::CharacterVector tokens;
+    std::string s = Rcpp::as<std::string>(code[i]);
+
+    so_tokenizer tok(s,sep);
+    for(so_tokenizer::iterator beg=tok.begin(); beg!=tok.end();++beg){
+      tokens.push_back(*beg);
+    }
+    ret[i] = tokens;
+  }
+
+
+  Rcpp::List ans;
+  ans["tokens"] = ret;
+  return ans;
+}
+
+
+
+
+
+
+
+
+