diff --git a/NAMESPACE b/NAMESPACE index 7cf0027..1609e04 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -48,6 +48,7 @@ export(pinTips) export(pstMnp) export(randTree) export(readTree) +export(readTrmn) export(rmNdmtrx) export(rmTips) export(searchTxnyms) @@ -64,6 +65,7 @@ export(taxaResolve) export(unblncdTree) export(updateSlts) export(writeTree) +export(writeTrmn) exportClasses(Node) exportClasses(TreeMan) exportClasses(TreeMen) diff --git a/R/read-write-methods.R b/R/read-write-methods.R index fb74ebb..d45bfaf 100644 --- a/R/read-write-methods.R +++ b/R/read-write-methods.R @@ -196,5 +196,100 @@ readTree <- function(file=NULL, text=NULL, wndmtrx=TRUE, parallel=FALSE, tree } +#' @name writeTrmn +#' @title Write a .trmn tree +#' @description Write to disk a \code{TreeMan} object using the .trmn treefile +#' @details Write a single tree to file using the .trmn format. +#' It is faster to read and write tree files using treeman with the .trmn file format. +#' In addition it is possible to encode more information than possible with the +#' Newick, e.g. taxonomic information can be recorded as well. +#' @param tree TreeMan object +#' @param file file path +#' @seealso +#' \code{\link{readTrmn}}, +#' \code{\link{readTree}},\code{\link{writeTree}}, +#' \code{\link{randTree}}, +#' @export +#' @examples +#' library(treeman) +#' tree <- randTree(10) +#' writeTrmn(tree, file='test.trmn') +#' tree <- readTrmn('test.trmn') +#' file.remove('test.trmn') +writeTrmn <- function(tree, file) { + res <- data.frame(prind=tree@prinds) + res[['id']] <- names(tree@ndlst) + if(tree@wspn) { + res[['spn']] <- sapply(tree@ndlst, function(x) x[['spn']]) + } + if(tree@wtxnyms) { + res[['txnym']] <- sapply(tree@ndlst, + function(x) paste0(x[['txnym']], collapse='|')) + } + write.csv(res, file=file, quote=FALSE, row.names=FALSE) +} -# TODO: develop .trmn file format \ No newline at end of file +#' @name readTrmn +#' @title Read a .trmn tree +#' @description Return a \code{TreeMan} object from a .trmn treefile +#' @details Read a single tree from a file using the .trmn format. +#' It is faster to read and write tree files using treeman with the .trmn file format. +#' In addition it is possible to encode more information than possible with the +#' Newick, e.g. taxonomic information can be recorded as well. +#' @param file file path +#' @param wndmtrx T/F add node matrix? Default TRUE. +#' @seealso +#' \code{\link{writeTrmn}}, +#' \code{\link{readTree}},\code{\link{writeTree}}, +#' \code{\link{randTree}}, +#' @export +#' @examples +#' library(treeman) +#' tree <- randTree(10) +#' writeTrmn(tree, file='test.trmn') +#' tree <- readTrmn('test.trmn') +#' file.remove('test.trmn') +readTrmn <- function(file, wndmtrx=TRUE) { + .add <- function(i) { + nd <- vector("list", length=4) + names(nd) <- c('id', 'ptid', 'prid', 'spn') + nd[['id']] <- ids[i] + nd[['spn']] <- spns[i] + nd[['prid']] <- ids[prinds[i]] + nd[['ptid']] <- ptids[ptnds_pool == i] + nd + } + inpt <- read.csv(file, stringsAsFactors=FALSE) + prinds <- inpt[['prind']] + # all internal nodes should occur more than once (twice for bifurcating trees) + prind_test <- sum(prinds == 1:length(prinds)) == 1 + prind_test <- all(table(prinds) > 1) & prind_test + if(!prind_test) { + stop('Tree is corrupted, check node structure is hierarchical.') + } + ids <- inpt[['id']] + if('spn' %in% names(inpt)) { + spns <- inpt[['spn']] + } else { + spns <- rep(0 , length(ids)) + } + tinds <- which(!1:length(ids) %in% prinds) + root <- which(1:length(prinds) == prinds) + ptids <- ids[-root] + ptnds_pool <- prinds[-root] + ndlst <- lapply(1:length(ids), .add) + names(ndlst) <- ids + tree <- new('TreeMan', ndlst=ndlst, root=ids[root], + ndmtrx=NULL, wtxnyms=FALSE, + prinds=prinds, tinds=tinds) + tree <- updateSlts(tree) + if('txnym' %in% names(inpt)) { + txnyms <- strsplit(inpt[['txnym']], '\\|') + names(txnyms) <- ids + tree <- setTxnyms(tree, txnyms) + } + if(wndmtrx) { + tree <- addNdmtrx(tree) + } + tree +} \ No newline at end of file diff --git a/data/mammals.rda b/data/mammals.rda index 4b1a3c0..321fc7e 100644 Binary files a/data/mammals.rda and b/data/mammals.rda differ diff --git a/man/readTrmn.Rd b/man/readTrmn.Rd new file mode 100644 index 0000000..85d0d3d --- /dev/null +++ b/man/readTrmn.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/read-write-methods.R +\name{readTrmn} +\alias{readTrmn} +\title{Read a .trmn tree} +\usage{ +readTrmn(file, wndmtrx = TRUE) +} +\arguments{ +\item{file}{file path} + +\item{wndmtrx}{T/F add node matrix? Default TRUE.} +} +\description{ +Return a \code{TreeMan} object from a .trmn treefile +} +\details{ +Read a single tree from a file using the .trmn format. +It is faster to read and write tree files using treeman with the .trmn file format. +In addition it is possible to encode more information than possible with the +Newick, e.g. taxonomic information can be recorded as well. +} +\examples{ +library(treeman) +tree <- randTree(10) +writeTrmn(tree, file='test.trmn') +tree <- readTrmn('test.trmn') +file.remove('test.trmn') +} +\seealso{ +\code{\link{writeTrmn}}, +\code{\link{readTree}},\code{\link{writeTree}}, +\code{\link{randTree}}, +} diff --git a/man/writeTrmn.Rd b/man/writeTrmn.Rd new file mode 100644 index 0000000..0c1bf68 --- /dev/null +++ b/man/writeTrmn.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/read-write-methods.R +\name{writeTrmn} +\alias{writeTrmn} +\title{Write a .trmn tree} +\usage{ +writeTrmn(tree, file) +} +\arguments{ +\item{tree}{TreeMan object} + +\item{file}{file path} +} +\description{ +Write to disk a \code{TreeMan} object using the .trmn treefile +} +\details{ +Write a single tree to file using the .trmn format. +It is faster to read and write tree files using treeman with the .trmn file format. +In addition it is possible to encode more information than possible with the +Newick, e.g. taxonomic information can be recorded as well. +} +\examples{ +library(treeman) +tree <- randTree(10) +writeTrmn(tree, file='test.trmn') +tree <- readTrmn('test.trmn') +file.remove('test.trmn') +} +\seealso{ +\code{\link{readTrmn}}, +\code{\link{readTree}},\code{\link{writeTree}}, +\code{\link{randTree}}, +} diff --git a/tests/testthat/test-rw-methods.R b/tests/testthat/test-rw-methods.R index 66dc166..edd3ebd 100644 --- a/tests/testthat/test-rw-methods.R +++ b/tests/testthat/test-rw-methods.R @@ -28,6 +28,37 @@ test_that('writeTree() works', { t2_age <- getAge(t2) expect_that(t1_age, equals(t2_age)) }) +test_that('writeTrmn() works', { + t1 <- randTree(100) + writeTrmn(t1, 'test.trmn') + t2 <- readTrmn('test.trmn') + expect_that(t1['ntips'], equals(t2['ntips'])) + expect_that(t1['nnds'], equals(t2['nnds'])) + expect_that(t1['pd'], equals(t2['pd'])) + t1_age <- getAge(t1) + t2_age <- getAge(t2) + expect_that(t1_age, equals(t2_age)) + # test example with taxonomy + data(mammals) + ape_id <- getPrnt(mammals, ids=c('Homo_sapiens', 'Hylobates_concolor')) + tree <- getSubtree(mammals, id=ape_id) + writeTrmn(tree, file='test.trmn') + tree <- readTrmn('test.trmn') + expect_true(tree@wtxnyms) +}) +test_that('readTrmn() works', { + tree <- randTree(10) + writeTrmn(tree, 'test.trmn') + t1 <- readTrmn('test.trmn') + tree@wspn <- FALSE + writeTrmn(tree, 'test.trmn') + t2 <- readTrmn('test.trmn') + expect_true(t1@wspn) + expect_true(!t2@wspn) +}) if(file.exists('test.tre')) { file.remove('test.tre') +} +if(file.exists('test.trmn')) { + file.remove('test.trmn') } \ No newline at end of file