R: рекурсивная оценка двоичного дерева, хранящегося в виде списка - PullRequest
Новая
       35

R: рекурсивная оценка двоичного дерева, хранящегося в виде списка

0 голосов
/ 07 мая 2020

У меня есть дерево под названием mytree, которое выглядит так:

enter image description here

Я храню его в виде списка: 

mytree <- list(list(structure(list(y = c(-10, 7, 8, -7), x = c(10, 20, 
25, 35), grad = c(-10.5, 6.5, 7.5, -7.5), sim_score = c(4, 4, 
4, 4), value = c(-1, -1, -1, -1)), row.names = c(NA, -4L), class = "data.frame")), 
    list(structure(list(y = -10, x = 10, grad = -10.5, sim_score = 110.25, 
        value = -10.5, gain = 120.333333333333, criterion = "x < 15"), row.names = 1L, class = "data.frame"), 
        structure(list(y = c(7, 8, -7), x = c(20, 25, 35), grad = c(6.5, 
        7.5, -7.5), sim_score = c(14.0833333333333, 14.0833333333333, 
        14.0833333333333), value = c(2.16666666666667, 2.16666666666667, 
        2.16666666666667), gain = c(120.333333333333, 120.333333333333, 
        120.333333333333), criterion = c("x >= 15", "x >= 15", 
        "x >= 15")), row.names = 2:4, class = "data.frame")), 
    list(NULL, NULL, structure(list(y = c(7, 8), x = c(20, 25
    ), grad = c(6.5, 7.5), sim_score = c(98, 98), value = c(7, 
    7), gain = c(140.166666666667, 140.166666666667), criterion = c("x < 30", 
    "x < 30")), row.names = 2:3, class = "data.frame"), structure(list(
        y = -7, x = 35, grad = -7.5, sim_score = 56.25, value = -7.5, 
        gain = 140.166666666667, criterion = "x >= 30"), row.names = 4L, class = "data.frame")), 
    list(NULL, NULL, NULL, NULL, structure(list(y = 7, x = 20, 
        grad = 6.5, sim_score = 42.25, value = 6.5, gain = 0.5, 
        criterion = "x < 22.5"), row.names = 2L, class = "data.frame"), 
        structure(list(y = 8, x = 25, grad = 7.5, sim_score = 56.25, 
            value = 7.5, gain = 0.5, criterion = "x >= 22.5"), row.names = 3L, class = "data.frame"), 
        NULL, NULL))

и это выглядит так: 

[[1]]
[[1]][[1]]
    y  x  grad sim_score value
1 -10 10 -10.5         4    -1
2   7 20   6.5         4    -1
3   8 25   7.5         4    -1
4  -7 35  -7.5         4    -1


[[2]]
[[2]][[1]]
    y  x  grad sim_score value     gain criterion
1 -10 10 -10.5    110.25 -10.5 120.3333    x < 15

[[2]][[2]]
   y  x grad sim_score    value     gain criterion
2  7 20  6.5  14.08333 2.166667 120.3333   x >= 15
3  8 25  7.5  14.08333 2.166667 120.3333   x >= 15
4 -7 35 -7.5  14.08333 2.166667 120.3333   x >= 15


[[3]]
[[3]][[1]]
NULL

[[3]][[2]]
NULL

[[3]][[3]]
  y  x grad sim_score value     gain criterion
2 7 20  6.5        98     7 140.1667    x < 30
3 8 25  7.5        98     7 140.1667    x < 30

[[3]][[4]]
   y  x grad sim_score value     gain criterion
4 -7 35 -7.5     56.25  -7.5 140.1667   x >= 30


[[4]]
[[4]][[1]]
NULL

[[4]][[2]]
NULL

[[4]][[3]]
NULL

[[4]][[4]]
NULL

[[4]][[5]]
  y  x grad sim_score value gain criterion
2 7 20  6.5     42.25   6.5  0.5  x < 22.5

[[4]][[6]]
  y  x grad sim_score value gain criterion
3 8 25  7.5     56.25   7.5  0.5 x >= 22.5

[[4]][[7]]
NULL

[[4]][[8]]
NULL

Первый индекс списка, то есть 1, 2, 3, 4, соответствует уровню или высоте дерева. Второй индекс соответствует индексу узла на данном уровне. Например, mytree[[1]][[1]] содержит root, у которого есть дочерние узлы в mytree[[2]][[1]] и mytree[[2]][[2]].

Если родительский узел хранится в mytree[[i]][[j]], его дочерние узлы хранятся в mytree[[i + 1]][[2 * j]] и mytree[[i + 1]][[2 * j -1]].

Я хочу написать функцию с именем eval_tree, которая при предоставлении нового экземпляра x будет проверять, в какой листовой узел x попадает, проверяя criterion разбиений, а затем выводит значение листа, которое хранится под value. Вот пример того, как я бы хотел, чтобы eval_tree работал: 

newdata <- data.frame(x = c(10, 20, 25, 35))
> eval_tree(tree = mytree, newdata = newdata)
[1] -10.5
[2] 6.5
[3] 7.5
[4] -7.5

Вот что у меня есть. К сожалению, это не работает ... и я думаю, что мне может потребоваться рекурсивная реализация функции, чтобы она была более эффективной. Может ли кто-нибудь указать мне правильное направление? 

eval_tree <- function(tree, newdata){
  if(length(tree) == 1){
    # If tree only has a root, return value of root
    return(tree[[1]][[1]]$value[1])
  }else if(length(tree) > 1){
    for (level in 2:length(tree)){
      for(ind in 1:length(tree[[level]]))
        if(eval(parse(text = tree[[level]][[ind]][["criterion"]]))){
          # Criterion is true, then go to child node
          # Check if there is child node
          if(is.null(tree[[level + 1]][[ind * 2]]) && is.null(tree[[level + 1]][[ind * 2 - 1]])){
            return(tree[[level]][[ind]]$value[1])
          }else if(eval(parse(text = tree[[level + 1]][[ind * 2]][["criterion"]]))){
            # Criterion is true, then go to childi node
            # I think this is where recursion would be more appropriate than all these nested loops
          }

        }
    }
  }
}

1 Ответ

0 голосов
/ 08 мая 2020

можно попробовать примерно так: 

index <- function(x,tree,e, i = 1, j = 1)
{
  if(nrow((tree[[i]][[j]])) == 1)
  {
    if(eval(parse(text=tree[[i]][[j]]$crite), list(x = x))) {
      if(is.null(e$a)){
        e$a <- i
        e$b <- tree[[i]][[j]]$val
      }
      else if(e$a > i)e$b <- tree[[i]][[j]]$val
      TRUE
    }
    else FALSE
  }
  else index(x, tree, e,i + 1,2*j-1) | index(x, tree,e,i+1, 2*j)
}

pred_tree <- function( tree,newdata){

 cbind(newdata,pred = sapply(newdata$x,function(x){
   e <- new.env()
   index(x,tree,e)
    e$b
   }))
}

pred_tree(mytree,data.frame(x = c(10,20,25,30,25)))
   x  pred
1 10 -10.5
2 20   6.5
3 25   7.5
4 30  -7.5
5 25   7.5
...