Создание простой филогенетической дендрограммы (дерева) из списка видов - PullRequest
Новая
       43

Создание простой филогенетической дендрограммы (дерева) из списка видов

5 голосов
/ 28 марта 2012

Я хочу сделать простое филогенетическое древо для курса морской биологии в качестве учебного примера.У меня есть список видов с таксономическим рангом: 

    Group <- c("Benthos","Benthos","Benthos","Benthos","Benthos","Benthos","Zooplankton","Zooplankton","Zooplankton","Zooplankton",
"Zooplankton","Zooplankton","Fish","Fish","Fish","Fish","Fish","Fish","Phytoplankton","Phytoplankton","Phytoplankton","Phytoplankton")
Domain <- rep("Eukaryota", length(Group))
Kingdom <- c(rep("Animalia", 18), rep("Chromalveolata", 4))
Phylum <- c("Annelida","Annelida","Arthropoda","Arthropoda","Porifera","Sipunculida","Arthropoda","Arthropoda","Arthropoda",
"Arthropoda","Echinoidermata","Chorfata","Chordata","Chordata","Chordata","Chordata","Chordata","Chordata","Heterokontophyta",
"Heterokontophyta","Heterokontophyta","Dinoflagellata")
Class <- c("Polychaeta","Polychaeta","Malacostraca","Malacostraca","Demospongiae","NA","Malacostraca","Malacostraca",
"Malacostraca","Maxillopoda","Ophiuroidea","Actinopterygii","Chondrichthyes","Chondrichthyes","Chondrichthyes","Actinopterygii",
"Actinopterygii","Actinopterygii","Bacillariophyceae","Bacillariophyceae","Prymnesiophyceae","NA")
Order <- c("NA","NA","Amphipoda","Cumacea","NA","NA","Amphipoda","Decapoda","Euphausiacea","Calanioda","NA","Gadiformes",
"NA","NA","NA","NA","Gadiformes","Gadiformes","NA","NA","NA","NA")                     
Species <- c("Nephtys sp.","Nereis sp.","Gammarus sp.","Diastylis sp.","Axinella sp.","Ph. Sipunculida","Themisto abyssorum","Decapod larvae (Zoea)",
"Thysanoessa sp.","Centropages typicus","Ophiuroidea larvae","Gadus morhua eggs / larvae","Etmopterus spinax","Amblyraja radiata",
"Chimaera monstrosa","Clupea harengus","Melanogrammus aeglefinus","Gadus morhua","Thalassiosira sp.","Cylindrotheca closterium",
"Phaeocystis pouchetii","Ph. Dinoflagellata")   
dat <- data.frame(Group, Domain, Kingdom, Phylum, Class, Order, Species)
dat

Я хотел бы получить дендрограмму (кластерный анализ) и использовать домен в качестве первой точки отсечения, Kindom в качестве второй, Phylum в качестве третьей и т. Д.Пропущенные значения следует игнорировать (без точки резания, вместо этого прямая линия).Группу следует использовать в качестве раскраски для надписей.

Я немного не уверен, как сделать матрицу расстояний из этого фрейма данных.Есть много пакетов филогенетического дерева для R, они, кажется, хотят новые данные / ДНК / другую сложную информацию.Таким образом, помощь в этом будет принята.

Ответы [ 2 ]

6 голосов
/ 30 марта 2012

Наверное, немного глупо отвечать на мой вопрос, но я нашел более простое решение. Может быть, это поможет кому-то однажды. 

library(ape)
taxa <- as.phylo(~Kingdom/Phylum/Class/Order/Species, data = dat)

col.grp <- merge(data.frame(Species = taxa$tip.label), dat[c("Species", "Group")], by = "Species", sort = F)

cols <- ifelse(col.grp$Group == "Benthos", "burlywood4", ifelse(col.grp$Group == "Zooplankton", "blueviolet", ifelse(col.grp$Group == "Fish", "dodgerblue", ifelse(col.grp$Group == "Phytoplankton", "darkolivegreen2", ""))))

plot(taxa, type = "cladogram", tip.col = cols)

Обратите внимание, что все столбцы должны быть факторами. Это демонстрирует рабочий процесс с R. Требуется неделя, чтобы что-то выяснить, хотя сам код - всего пара строк =)

enter image description here

3 голосов
/ 28 марта 2012

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

# Data: remove Group
dat <- data.frame(Domain, Kingdom, Phylum, Class, Order, Species)

# Start a new plot
par(mar=c(0,0,0,0))
plot(NA, xlim=c(0,ncol(dat)+1), ylim=c(0,nrow(dat)+1), 
  type="n", axes=FALSE, xlab="", ylab="", main="")

# Compute the position of each node and find all the edges to draw
positions <- NULL
links <- NULL
for(k in 1:ncol(dat)) {
  y <- tapply(1:nrow(dat), dat[,k], mean)
  y <- y[ names(y) != "NA" ]
  positions <- rbind( positions, data.frame(
    name = names(y),
    x = k,
    y = y
  ))
}
links <- apply( dat, 1, function(u) { 
  u <- u[ !is.na(u) & u != "NA" ]
  cbind(u[-length(u)],u[-1]) 
} )
links <- do.call(rbind, links)
rownames(links) <- NULL
links <- unique(links[ order(links[,1], links[,2]), ])

# Draw the edges
for(i in 1:nrow(links)) {
  from <- positions[links[i,1],]
  to   <- positions[links[i,2],]
  lines( c(from$x, from$x, to$x), c(from$y, to$y, to$y) )
}

# Add the text
text(positions$x, positions$y, label=positions$name)
...