Описание работы

В работе строится консенсусное дерево по таблице частотностей слов. Используется расстояние Manhattan и кластеризация average. Далее рассчитывается консенсус по 100 деревьям, каждое дерево строится на случайной подвыборке из 500 слов.

Код и результат

library(tidyverse)
library(ape)
library(ggsci)
library(phangorn)
library(TreeTools)

# 1) Читаем таблицу частотностей
file_path <- "table_with_frequencies.txt"

freq_words_x_texts <- read.table(
  file_path,
  header = TRUE,
  quote = "\"",
  check.names = FALSE
)

# 2) Трансформируем:
# строки = тексты, столбцы = слова
freq_texts_x_words <- as.data.frame.matrix(t(freq_words_x_texts))

# 3) Функция для построения одного дерева
get_tree <- function(df) {
  n_features <- min(500, ncol(df))
  
  X <- df[, sample(ncol(df), size = n_features, replace = FALSE)]
  
  # стандартизация
  X <- scale(X)
  
  # расстояние Manhattan + average linkage
  distmx <- dist(X, method = "manhattan")
  as.phylo(hclust(distmx, method = "average"))
}

set.seed(42)

# 4) Строим 100 деревьев
n_trees <- 100
trees_result <- purrr::map(1:n_trees, \(i) get_tree(freq_texts_x_words))

# 5) Консенсус простого большинства
cons <- consensus(trees_result, p = 0.5, rooted = FALSE)

# 6) Цвета по автору (часть имени до "_")
authors <- str_remove(cons$tip.label, "_.+")

col_tbl <- tibble(
  author = unique(authors),
  col = pal_d3()(length(unique(authors)))
)

tip_cols <- tibble(author = authors) |>
  left_join(col_tbl, by = "author")

# 7) Рисуем дерево
par(mar = c(0, 0, 3, 0))

plot.phylo(
  cons,
  type = "fan",
  tip.color = tip_cols$col,
  font = 1,
  cex = 0.8,
  main = "Консенсусное дерево (manhattan + average, 100 деревьев, по 500 слов)"
)

# 8) Подписываем значения консенсуса на узлах
if (!is.null(cons$node.label)) {
  nodelabels(
    round(as.numeric(cons$node.label), 2),
    frame = "c",
    cex = 0.7,
    bg = "white"
  )
}

Комментарий