R: алгоритм рекурсивного дерева со случайным разбиением

Question

Мне интересно написать алгоритм рекурсивного двоичного дерева. Учитывая следующие данные, в которых я уже отсортировал ковариату x

mydata <- data.frame(x = c(10, 20, 25, 35), y = c(-10.5, 6.5, 7.5, -7.5))
> mydata
   x     y
1 10 -10.5
2 20   6.5
3 25   7.5
4 35  -7.5

Предположим, что мое окончательное дерево выглядит примерно так:

          [-10.5, 6.5, 7.5, -7.5]
                /         \
          [-10.5]        [6.5, 7.5, -7.5]
                            /      \
                    [6.5, 7.5]       [ -7.5]

Мне нужен окончательный результат моей функции чтобы вернуть список, содержащий все узлы:

> final_tree
[[1]]
[[1]][[1]]
   x     y
1 10 -10.5
2 20   6.5
3 25   7.5
4 35  -7.5


[[2]]
[[2]][[1]]
   x     y
1 10 -10.5


[[2]][[2]]
   x     y
1 20   6.5
2 25   7.5
3 35  -7.5


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

[[3]][[2]]
NULL

[[3]][[3]]
   x     y
1 20   6.5
2 25   7.5


[[3]][[4]]
   x     y
1 35  -7.5

Я разбиваю свое дерево на каждом узле случайным образом, используя best_split_ind. Если best_split_ind = 1, то это означает, что 1-й экземпляр в node_parent окажется в node_left, а остальные окажутся в node_right. Если best_split_ind = 3, то это означает, что первые три экземпляра в node_parent окажутся в node_left, а остальные в node_right.

Вот что у меня есть на данный момент:

# Initialize empty tree
create_empty_tree <- function(max_height) sapply(1:max_height, function(k) replicate(2**(k-1),c()))

# Create empty tree with max_height = 3
tree_struc <- create_empty_tree(max_height = 3)

grow_tree <- function(node_parent, max_height, tree_struc, height){
  # Sort x
  sorted_x <- sort(node_parent$x)

  # Determine best split 
  best_split_ind <- sample(1:(nrow(node_parent) - 1), 1)

  # Assign instances to left or right nodes
  group <- ifelse(node_parent$x <= node_parent$x[best_split_ind], "left", "right")
  node_left <- node_parent[which(group == "left"), ]
  node_right <- node_parent[which(group == "right"), ]

  # Recursive call on left and right nodes
  if(height < max_height){
  tree_struc[[height]] <- node_parent
  tree_struc[[height + 1]][[1]] <- grow_tree(node_parent = node_left, max_height = max_height, tree_struc = tree_struc, height = height + 1)
  tree_struc[[height + 1]][[2]] <- grow_tree(node_parent = node_right, max_height = max_height, tree_struc = tree_struc, height = height + 1)
  }

  return(tree_struc)
}

grow_tree(node_parent = mydata, max_height = 3, tree_struc = tree_struc, height = 1)

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

Answer 1

Может быть, вы можете попробовать приведенный ниже код, где другая настраиваемая функция rndsplit была определена в grow_tree:

create_empty_tree <- function(max_height) sapply(1:max_height, function(k) replicate(2**(k-1),c()))
grow_tree <- function(node_parent,max_height = nrow(node_parent)) {
  rndsplit <- function(x) {
    if (is.null(x) || nrow(x) <= 1) return(list(c(),c()))
    ind <- sample(nrow(x)-1,1)
    list(x[1:ind,],x[-(1:ind),])
  }
  tree_struc <- create_empty_tree(max_height)
  tree_struc[[1]][[1]] <- node_parent
  for (i in 2:max_height) {
    tree_struc[[i]] <- unlist(lapply(tree_struc[[i-1]], rndsplit),recursive = FALSE)
  }
  tree_struc
}

Пример

> grow_tree(mydata,3)
[[1]]
[[1]][[1]]
   x     y
1 10 -10.5
2 20   6.5
3 25   7.5
4 35  -7.5


[[2]]
[[2]][[1]]
   x     y
1 10 -10.5
2 20   6.5

[[2]][[2]]
   x    y
3 25  7.5
4 35 -7.5


[[3]]
[[3]][[1]]
   x     y
1 10 -10.5

[[3]][[2]]
   x   y
2 20 6.5

[[3]][[3]]
   x   y
3 25 7.5

[[3]][[4]]
   x    y
4 35 -7.5

и

> grow_tree(mydata)
[[1]]
[[1]][[1]]
   x     y
1 10 -10.5
2 20   6.5
3 25   7.5
4 35  -7.5


[[2]]
[[2]][[1]]
   x     y
1 10 -10.5

[[2]][[2]]
   x    y
2 20  6.5
3 25  7.5
4 35 -7.5


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

[[3]][[2]]
NULL

[[3]][[3]]
   x   y
2 20 6.5

[[3]][[4]]
   x    y
3 25  7.5
4 35 -7.5


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

[[4]][[2]]
NULL

[[4]][[3]]
NULL

[[4]][[4]]
NULL

[[4]][[5]]
NULL

[[4]][[6]]
NULL

[[4]][[7]]
   x   y
3 25 7.5

[[4]][[8]]
   x    y
4 35 -7.5

Answer 2

Возможно, я вас неправильно понял, но вы можете немного упростить здесь, используя две функции, которые рекурсивно вызывают друг друга. Нет необходимости создавать начальный контейнер.

Первая функция - это функция, которую нам даже не нужно вызывать вручную, но она будет вызываться изнутри нашей grow_tree функции. Он просто проверяет, что оно не достигло максимальной глубины дерева и что осталось достаточно элементов для разделения. Если это так, он вызывает grow_tree для своего содержимого. В противном случае он возвращает свое содержимое без изменений:

conditional_split <- function(df, depth, max_depth)
{
  if(nrow(df) == 1 | depth == max_depth) return(df)
  else grow_tree(df, depth + 1, max_depth)
}

Наша основная функция может безопасно разделить данный фрейм данных и рекурсивно вызвать conditional_split с lapply:

grow_tree <- function(df, depth = 1, max_depth = 3)
{
  break_at <- sample(nrow(df) - 1, 1)
  branched <- list(left = df[1:break_at,], right = df[-seq(break_at),])
  lapply(branched, conditional_split, depth, max_depth)
}

Я думаю это делает то, что вы ищете:

grow_tree(mydata, max_depth = 3)
#> $left
#>    x     y
#> 1 10 -10.5
#> 
#> $right
#> $right$left
#> $right$left$left
#>    x   y
#> 2 20 6.5
#> 
#> $right$left$right
#>    x   y
#> 3 25 7.5
#> 
#> 
#> $right$right
#>    x    y
#> 4 35 -7.5

И вы можете изменить максимальную глубину дерева так же легко, как:

grow_tree(mydata, max_depth = 2)
#> $left
#> $left$left
#>    x     y
#> 1 10 -10.5
#> 
#> $left$right
#>    x   y
#> 2 20 6.5
#> 3 25 7.5
#> 
#> 
#> $right
#>    x    y
#> 4 35 -7.5