Уменьшение числа узлов дерева, чтобы получить узлы с более чем одним дочерним узлом

следующее дерево:

enter image description here

было получено из следующей матрицы

> mat
7  23 47 41 31
7  23 53 41 31
7  23 53 41 37
7  29 47 41 31
7  29 47 41 37
7  29 53 41 31
7  29 53 41 37
11 29 53 41 31
11 29 53 41 37

принимая каждый столбец "мат" как уровень дерева. Если "данные" - это фрейм данных, в котором хранится матрица "mat"

V1 V2 V3 V4 V5
7  23 47 41 31
7  23 53 41 31
7  23 53 41 37
7  29 47 41 31
7  29 47 41 37
7  29 53 41 31
7  29 53 41 37
11 29 53 41 31
11 29 53 41 37

код, который производит выше дерева является следующим

> data$pathString<-paste("0", data$V1,data$V2,data$V3,data$V4,data$V5,sep = "/")
> p_tree <- as.Node(data)
> export_graph(ToDiagrammeRGraph(p_tree), "tree.png")

Я хотел бы изменить дерево следующим образом: (1) Если узел на уровне 'n', помеченный номером x, имеет только один дочерний узел на уровне "n+1", помеченном номером y, программа объединяет эти два узла в один узел, помеченный результатом произведения x*y; 2) Если узел на уровне "n+1" не имеет дочерних узлов, программа ничего не делает и запускается снова из другой ветви; 3) Если узел на уровне "n+1" имеет более одного дочернего узла, программа применяет точку (1) и запускается снова с каждого из дочерних узлов.

например, для дерева нашего примера, код следует:

  • замените узлы, обведенные красным цветом, узлом с надписью 31*41*47=59737
  • замените узлы, обведенные оранжевым цветом, узлом с меткой 53 * 41=2173
  • замените узлы, обведенные зеленым цветом, узлом, помеченным 47 * 41=1927
  • замените узлы, обведенные синим цветом, узлом с надписью 11*29*53*41=693187

enter image description here

1 ответов


попробуйте это:

  freq <- sapply(1:ncol(data), function(x) {
  df <- data[, 1:x, drop = FALSE]

  cc <- aggregate(df[, 1], as.list(df), FUN = length)
  merge(df, cc, by = colnames(df), sort = FALSE)[, "x"]
  })

data$pathString <- sapply(1:nrow(data), function(x) {
  g <- 1
  for(i in 2:ncol(freq)) g <- c(g, 
        if(freq[x, i] == freq[x, i - 1]) g[i - 1] else g[i - 1] + 1)

  paste0(c("0", tapply(unlist(data[x, , drop = TRUE]), g, prod)), collapse = "/")
})


p_tree <- as.Node(data)

plot(p_tree)

enter image description here