Нужно перенести функцию из R в Rcpp ( C++)

Question

Мне нужно сильно ускорить свою функцию в R, я пытался сделать это векторизироваными методами но получил ускорение максимум до 10 раз , это очень мало для меня. Я знаю что можно внедрять С++ в код R через пакет Rcpp, я не знаком с С++ совсем, я пылся разобраться как с ним работать но мой код не на столько примитивен чтобы мне удалось его написать. Я знаю, такие вопросы нельзя задавать типа "сделай это для меня" но я надеюсь что кому то захочеться помочь.

Итак коротко о сути дела. Есть матрица с числовыми переменными , каждая колонка это переменная, у каждой переменной есть имя

set.seed(124)
 ro <- round(runif(n = 30,1,10),2)
 dat <- as.data.frame(matrix(data =ro,ncol = 3))
 colnames(dat) <- paste0("x" ,1:ncol(dat))

 dat
     x1   x2   x3
1  1.75 7.95 6.62
2  4.68 8.71 6.43
3  5.64 7.82 1.70
4  4.57 8.65 4.72
5  3.00 4.68 4.08
6  3.63 1.50 2.82
7  6.26 6.20 8.56
8  5.42 7.71 3.39
9  9.31 8.98 8.48
10 3.52 1.28 4.46

так же есть вектор с логическими правилами, их количество может быть разное, в данном примере правила три.

rule <- c("x1 > 5 & x2/2 > 2","x1 > x2*2", "x3!=4")

Задача в том что надо проверить отработали ли правила в матрице dat в той же последовательности как в векторе rule

Алгоритм такой,

мы идем по каждой строке матрицы и проверяем сработало ли текущее правило
если правило не сработало идем на след. строку

если правило сработало то след. правило ищем на след. строке.

И так пока не закончаться правила либо строки

Если все правила отработали в правильной последовательности функция возвращает TRUE иначе FALSE

Вот моя фунция которая делает все это

fu <- function(dat , rule , res.only=T){
  
  # создаю вектор "дебага" чтобы вписать в него точки где сработали правила
    debug.vec <- rep("no",nrow(dat)) 
 
  # rule.id эта переменная равна индексу правила
  # которое проверяеться в данный момент.
  # начинаем с проверки первого правила в векторе rule потому  rule.id = 1 
  rule.id <- 1 
 
       
    for(i in 1:nrow(dat)){
    # проверяем сработало ли правило "rule[rule.id]" в строке матрицы  dat[i,]
    current_rule <- with(data = dat[i,] , expr = eval(parse(text = rule[rule.id]))  )
    
    
    # если правило сработало
    if(current_rule){  
      
      # пишу  дебаг 
      debug.vec[i] <- rule[rule.id]
      
      # Если правил больше нет  то завершаем цикл
      if(  rule.id==length(rule)  ) break   
      
      # если правила есть идем к следующему правилу
      rule.id <- rule.id+1 
    }}  
  if(!res.only)  return(  cbind(dat,debug.vec)  )  
  return(  sum(debug.vec!="no")==length(rule)   )
}

Функция принимат dat матрицу с переменными и rule вектор с правилами, также есть флаг res.only показывать дебаг или нет

fu(dat = dat, rule = rule, res.only = T)
[1] TRUE

с флагом

fu(dat = dat, rule = rule, res.only = F)
     x1   x2   x3         debug.vec
1  1.75 7.95 6.62                no
2  4.68 8.71 6.43                no
3  5.64 7.82 1.70 x1 > 5 & x2/2 > 2
4  4.57 8.65 4.72                no
5  3.00 4.68 4.08                no
6  3.63 1.50 2.82         x1 > x2*2
7  6.26 6.20 8.56             x3!=4
8  5.42 7.71 3.39                no
9  9.31 8.98 8.48                no
10 3.52 1.28 4.46                no

Если у кого то найдеться время помочь с этим , буду благодарен

БЛОГ НА HUSL

Нужно перенести функцию из R в Rcpp ( C++)

Ответы (0 шт):