.2bg7TXi Ml0 Wյ)7A;' ,9L U` "o^6+&N%fV\r28Zf :L/o#E뭒1\Qjqz({`⏋qiJuꢞzd
[Aɔ~ȥ/?NG $? o< iA)yj AvD/&UI㉡vD'[XBPrϦYuWXZQ*O*i|lU ,"ߴHI:B
(ζ⎬?mT=D7Lm'u4h)3*T":s!- ?D9]95j[ujV+vD߮( 8ϳ/md sQGeÿ#$7[NH} _>s#! @Fý,9*3!}E˙-~*aPcK=%˯ٖΠZ K 骸V`EvaʞW{KBz e_S9x*t8t3m=MQ `5̆$~x"e}
!.]J#dn
wKFΝ 5XVAɝ&9&ZWBS2vR7Lig<e@E?GPB,eP`U5H }3
Z]km>n =1kFI-L\V!ra9r$&M7Q!@2JMz^\ [ڤ;dMX 'L:n !bILlp!c>B%rJWσ"d2w\;n0Ӛ a}tE*nk@ Aq> dI0"9p,^
B >M1!D;N/@J]U L7%݃[RP -Fzx8 S|p%\Gm(羿Z?Qa+PtTZ2 N\2"SVFs0Q5>QqZj cJŌ nPDg/f4Qݚ -2>3
F"-GtP]{nd\P2m#)2F, E@&еzVڣD1ȑ " {6-)G=AR0
zV_C0wU %j@\ r
K@_?CiK^AtU`k#J nP*1g~ϩ˄ax%썕$q ԭNd l-o^9NΣ[wiDOP^e
*S&5 Hd,?dwJ\ sޖR
:%dƎtsBf\𨂳hT
@
MDMfo7k>4s=lhDUvZT|}ጋ5,?yqŶbԤzﵴkx)\rD =)RO9Ԩ6N'FlYM lrֻr"n[;P*x`ח[ac)ũ w#mL]q F=Z߲~U]E5Б2"H@p[IoX zYX$qX\U.}D-Վm 8E]תY4Q MכqҔ.3 m l]Ye
WBz[eAۡ+9FJ &O~XUϥ4 DU^P>7,SD%fe
x=é7h~4/3/~Hoe̍ 9k
<.0 $~HxO(c9
!ܦD|S VՕ{&%D`*kD2@R"(>J ;.
n{6FG:'9T`fAѲV
ͺ]NVq!s ͧ%<.Yo RPnO9c-2u ш <@G
I'~PqzQ v ióp@Fn,Y4u+)]TQ AR.؏J1,jv$2xS˞w8+#&p_'O wjr1;sa+8Vn4hk-|oDM4+K*/Uߋ43j"z '*4&H FL('N,puޤg/̙bBnk}
Y%" mPҋ ,$xoΈ [bf:Y^^6K^]
imZ.aS-EUMחJ p`nɡ3SLG]?uZ&r!ײmo_ 1zmIZCfoq͂ "TwZv(_jb%JrJ.%##6 x
ka_V])Z'19B*\^y-ksg(\+1ku.7hjM<`;(4~V!ja"rc0+.qrIγmyQ1me*$$)B
I%L^G֊3e]ywg9݂ߎ8 D[84x
5K >n6W;cK0 o,j `֖Zٳ O!X?^ ;Adv!Gjci!gnoOZgdjV漁|e9-q5?^ǺXe) B{t:ɢ 8m(>.@Ke^]hwү҄cTZE t3ߧ(aOt&CzhcwJ= g
C霁˟S~^΅wߨb9P]6;+%2۫974[YsX錴/xo80M0#u1 ~ chsѩIR"bw5.^+ Yj| xP:H}_Su}?3Aq▍t - Y,:6ܳe\h &m@KF2-KcӶ4ߖ6@noZbKL1
UKCl!cz @su5uQa *jpRBMn s67)$y:v3zU3Ch@9#KW:+o2Vk{xyxF(ώ8tǂ ^[ X$ EyPT.n)@&S66^T&#Av֊s<-86? ɉ Ɏ+
Z 7N p3}Z0ȈԇW4~/Fm;5,@rX;_22xHNX>Aפ=Ʉ9a\AfS^"t1ɩ"1,q}
uBH \ @7
פf^g nytRHEv4N ל 1w@ OzeWeg`b]zŬc@hE|[k6U|Fb dC`
mR4t|H˵t=<7ۉH\|'U (T|d'NR|~`=mʐxw o`Ox]t˨ܐQ͞|ަg " $^B$w3T& 9 ٌdqa= fk b殉1\ _]&aỳ3%lb ?yunUJ@W5~0&Y[&$ d 2ܺkSԎjllMTPC,UJ?3})$n'52X7>%<\"rR%F`dbe&h Ojnن!&u? R8 ƞK&JIݴR xeow!_pS%-,.pV5䇔 %AI93E~joxιW{Hȳv f= q|gs%j s7
A ;~Ћ% SRVw)v=JI'5c֔øn"+IVn^ѺKkPdG}ָ;8z`3הg[0V,~y7l7+j8fO+@X ϵ6ߴCbiN.(\= }hnw 6gU,Z$Rony#wBؽ.o;Pq {wuOcǞnM
~ڕXHuW YR EOڏڝۙgb[ 4#1/S]fo+pOKpӴfej{7\L ^TlkL A~^giWk;Ӥ{ xϏ43.zPu,ީݔ g Wk<"
$a . OdT%j}F>0{FBGmX&1SpHV<>}J}Ҳː&y$jD⒱(}tN|T|B+dIds5WL ( )2I"JCzdxZ 7A}J97a^R:9&ofȞJ I_8E˸ ( gIq^ˮIH ;Ϥqy5(u1kBK,z'g<
QsUUtX y2 >9n> ^oͨuev(EemQ[
O*+03> ,
I к[= IUT9Yg汞SM$@M K~B^(X1p4%|WIO0N#,/yS`j{I
Sk@6(4uD
?~6Bm O $iSj<G ]_({. )ٰL!%,rt L a Vn3<h^E[v!T 'J HVA'ib'I@@8 A?g ġ,:ĭ'0Wr.*+4OZ}PGĐ_`$Q^'ES>c_.UA̪-͢cY#K
*mMY ֟ 4308%} "2 r];n>/ 11 \ԛ b>0
YZ RNeXML/R/ 0000755 0001762 0000144 00000000000 12734324011 011515 5 ustar ligges users RNeXML/R/get_level.R 0000644 0001762 0000144 00000010170 12641021656 013613 0 ustar ligges users
## Should be all element names (unless they are also attribute names!), since we only want attribute names
## (alternately we should define to only grab possible attribute names..)
SKIP = c("meta", "children", "member", "row", "cell", "seq", "matrix", "format", "names")
#' get_level
#'
#' get a data.frame of attribute values of a given node
#'
#' @param nex a nexml object
#' @param level a character vector indicating the class of node, see details
#'
#' @return Returns the attributes of specified class of nodes as a data.frame
#'
#' @details level should be a character vector giving the path to the specified node
#' group. For instance, `otus`, `characters`, and `trees` are top-level blocks (e.g.
#' child nodes of the root nexml block), and can be specified directly. To get metadata
#' for all "char" elements from all characters blocks, you must specify that `char` nodes
#' are child nodes to `character` nodes: e.g. `get_level(nex, "characters/char")`,
#' or similarly for states: `get_level(nex, characters/states)`.
#'
#' The return object is a data frame whose columns are the attribute names of the elements
#' specified. The column names match the attribute names except for "id" attribute, for which the column
#' is renamed using the node itself. (Thus would be rendered in a data.frame with column
#' called "otus" instead of "id"). Additional columns are
#' added for each parent element in the path; e.g. get_level(nex, "otus/otu") would include a column
#' named "otus" with the id of each otus block. Even though the method always returns the data frame
#' for all matching nodes in all blocks, these ids let you see which otu values came from which
#' otus block. This is identical to the function call `get_taxa()`.
#' Similarly, `get_level(nex, "otus/otu/meta")` would return additional columns 'otus' and
#' also a column, 'otu', with the otu parent ids of each metadata block. (This is identical to a
#' function call to `get_metadata`). This makes it easier to join data.frames as well, see examples
#'
#' @export
#' @importFrom dplyr select
get_level <- function(nex, level){
lvl <- strsplit(level, "/")[[1]]
out <- recursion(1, lvl)(nex) %>%
dplyr::select_(quote(-nexml))
## drop columns that are all-na?
# all_na <- sapply(out, function(x) all(is.na(x)))
# out <- out[!all_na]
out
}
## Trick to apply nodelist_to_df iteratively
closure <- function(level, fun)
function(node) nodelist_to_df(node, level, fun)
recursion <- function(i, level){
if(i < length(level))
closure(level[i], recursion(i+1, level))
else
closure(level[i], attributes_to_row)
}
## Assumes slot(node, element) is a list
#' @importFrom lazyeval interp
#' @importFrom dplyr bind_rows mutate_ %>%
nodelist_to_df <- function(node, element, fn){
dots <- setNames(list(lazyeval::interp(~x, x = node_id(node))), class(node))
nodelist <- slot(node, element)
if(is.list(nodelist)){ ## node has a list of elements
nodelist %>%
lapply(fn) %>%
dplyr::bind_rows() %>%
dplyr::mutate_(.dots = dots) -> out
} else { ## handle case when node has only one element
fn(nodelist) %>%
dplyr::mutate_(.dots = dots)
}
}
node_id <- function(node){
if("id" %in% slotNames(node))
slot(node, "id")
else
"root"
}
attributes_to_row <- function(node){
who <- slotNames(node)
## Avoid things that are not attributes:
types <- sapply(who, function(x) class(slot(node,x)))
who <- who[ types %in% c("character", "integer", "numeric", "logical") ]
if("names" %in% who)
who <- who[!(who %in% "names")]
## Extract attributes, use NAs for numeric(0) / character(0) values
tmp <- sapply(who, function(x) slot(node, x))
tmp[sapply(tmp,length) < 1] <- NA
## Coerce into a row of a data.frame & rename id column to match class
out <- data.frame(as.list(tmp), stringsAsFactors=FALSE)
if("id" %in% who)
out <- dplyr::rename_(out, .dots = setNames("id", class(node)))
out
}
## Depricated method, still in use in some other functions
setxpath <- function(object){
tmp <- tempfile()
suppressWarnings(saveXML(object, tmp))
doc <- xmlParse(tmp)
unlink(tmp)
doc
}
RNeXML/R/classes.R 0000644 0001762 0000144 00000056362 12641021656 013317 0 ustar ligges users
setGeneric("fromNeXML", function(obj, from) standardGeneric("fromNeXML"))
setGeneric("toNeXML",
valueClass="XMLInternalElementNode",
function(object, parent)
standardGeneric("toNeXML"))
# Rather verbose methods definitions manually reading and writing each class...
# Rather than just slot matching names, we explicitly map each attribute...
##############################
setClass("Base",
slots = c('xsi:type' = "character"))
setMethod("toNeXML",
signature("Base", "XMLInternalElementNode"),
function(object, parent){
type <- slot(object, "xsi:type")
if(length(type) > 0){
#if(is.na(pmatch("nex:", type))) # nex or relevant namespace should come from default anyway
# type <- paste0("nex:", type)
addAttributes(parent,
"xsi:type" = type,
suppressNamespaceWarning=TRUE) # We always define xsi namespace in the header...
}
parent
})
setMethod("fromNeXML",
signature("Base", "XMLInternalElementNode"),
function(obj, from){
if(!is.null(xmlAttrs(from))){
if(!is.na(xmlAttrs(from)["type"])) ## FIXME use [["type"]] or ["type"]
slot(obj, "xsi:type") <- as.character(xmlAttrs(from)["type"])
if(!is.na(xmlAttrs(from)["xsi:type"])) ## Shouldn't be necessary but seems to be for first test in test_inheritance.R...
slot(obj, "xsi:type") <- as.character(xmlAttrs(from)["xsi:type"])
}
obj
}
)
#########################
setClass("Meta",
slots = c(children = "list"),
contains = "Base")
setMethod("fromNeXML",
signature("Meta", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
}
)
setMethod("toNeXML",
signature("Meta", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
})
#########################
setClass("LiteralMeta",
slots = c(id = "character",
property = "character",
datatype = "character",
content = "character"),
contains="Meta")
setMethod("fromNeXML",
signature("LiteralMeta", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
attrs <- xmlAttrs(from)
obj@property <- attrs[["property"]]
if(!is.na(attrs["datatype"]))
obj@datatype <- attrs[["datatype"]]
if(!is.na(attrs["content"]))
obj@content <- attrs[["content"]]
if(!is.na(attrs["id"]))
obj@id <- attrs[["id"]]
obj
}
)
setMethod("toNeXML",
signature("LiteralMeta", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
attrs <- c(id = unname(object@id),
property = unname(object@property), # required
datatype = unname(object@datatype), # optional
content = unname(object@content)) # required
attrs <- plyr::compact(attrs)
addAttributes(parent, .attrs = attrs)
})
setAs("XMLInternalElementNode", "LiteralMeta", function(from) fromNeXML(new("LiteralMeta"), from))
setAs("LiteralMeta", "XMLInternalElementNode", function(from) toNeXML(from, newXMLNode("meta")))
setAs("LiteralMeta", "XMLInternalNode", function(from) toNeXML(from, newXMLNode("meta")))
##############################################
setClass("ResourceMeta",
slots = c(id = "character",
rel = "character",
href = "character"),
contains="Meta")
setMethod("fromNeXML",
signature("ResourceMeta", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
attrs <- xmlAttrs(from)
obj@href <- attrs[["href"]]
if(!is.na(attrs["id"]))
obj@id <- attrs[["id"]]
if(!is.na(attrs[["rel"]]))
obj@rel <- attrs[["rel"]]
obj
}
)
setMethod("toNeXML",
signature("ResourceMeta", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
attrs <- c(id = unname(object@id),
href = unname(object@href),
rel = unname(object@rel))
attrs <- plyr::compact(attrs)
addAttributes(parent, .attrs = attrs)
})
setAs("XMLInternalElementNode", "ResourceMeta", function(from) fromNeXML(new("ResourceMeta"), from))
setAs("ResourceMeta", "XMLInternalElementNode", function(from) toNeXML(from, newXMLNode("meta")))
setAs("ResourceMeta", "XMLInternalNode", function(from) toNeXML(from, newXMLNode("meta")))
##############################################
setClass("meta",
contains=c("LiteralMeta", "ResourceMeta"))
setAs("XMLInternalElementNode", "meta", function(from){
type <- xmlAttrs(from)["type"]
if(is.na(type)) ## FIXME This is CRUDE
type <- xmlAttrs(from)["xsi:type"]
if(is.na(type)) # if still not defined...
fromNeXML(new("meta", from))
else {
type <- gsub(".*:", "", type) ## FIXME This is CRUDE
fromNeXML(new(type[1]), from)
}
})
setAs("meta", "XMLInternalElementNode", function(from){
if(length( slot(from, "xsi:type") ) > 0 ){
if(grepl("LiteralMeta|ResourceMeta", slot(from, "xsi:type")))
m <- as(from, slot(from, "xsi:type"))
}
else
m <- from
toNeXML(m, newXMLNode("meta", .children = from@children))
})
setAs("meta", "XMLInternalNode", function(from)
as(from, "XMLInternalElementNode"))
# Methods inherited automatically?
###############################################
setClass("ListOfmeta", slots = c(names="character"), contains = "list")
###############################################
setClass("Annotated",
slots = c(meta = "ListOfmeta",
about = "character"),
contains = "Base")
setMethod("fromNeXML",
signature("Annotated", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
kids <- xmlChildren(from)
if(length(kids) > 0)
obj@meta <- new("ListOfmeta",
lapply(kids[names(kids) == "meta"],
as, "meta"))
if(!is.null(xmlAttrs(from)))
if(!is.na(xmlAttrs(from)["about"]))
obj@about <- xmlAttrs(from)["about"]
obj
})
setMethod("toNeXML",
signature("Annotated", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addChildren(parent, kids = object@meta)
if(length(object@about) > 0)
addAttributes(parent, "about" = object@about)
parent
})
######################################################
setClass("Labelled",
slots = c(label = "character"),
contains = "Annotated")
setMethod("fromNeXML",
signature("Labelled", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
if(!is.na(xmlAttrs(from)["label"]))
obj@label <- xmlAttrs(from)["label"]
obj
}
)
setMethod("toNeXML",
signature("Labelled", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
if(length(object@label) > 0)
addAttributes(parent, "label" = object@label)
parent
})
##############################
setClass("IDTagged",
slots = c(id = "character"),
contains = "Labelled")
setMethod("fromNeXML",
signature("IDTagged", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
if(!is.na(xmlAttrs(from)["id"]))
obj@id <- as.character(xmlAttrs(from)["id"])
obj
}
)
setMethod("toNeXML",
signature("IDTagged", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
if(length(object@id) > 0)
addAttributes(parent, "id" = object@id)
parent
})
##############################
setClass("OptionalTaxonLinked",
slots = c(otu = "character"),
contains = "IDTagged")
setMethod("fromNeXML",
signature("OptionalTaxonLinked", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
if(!is.na(xmlAttrs(from)["otu"]))
obj@otu <- as.character(xmlAttrs(from)["otu"])
obj
}
)
setMethod("toNeXML",
signature("OptionalTaxonLinked", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
if(length(object@otu) > 0)
addAttributes(parent, "otu" = object@otu)
parent
})
##############################
setClass("TaxaLinked",
slots = c(otus = "character"),
contains = "IDTagged")
setMethod("fromNeXML",
signature("TaxaLinked", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
if(!is.na(xmlAttrs(from)["otus"]))
obj@otus <- as.character(xmlAttrs(from)["otus"])
obj
}
)
setMethod("toNeXML",
signature("TaxaLinked", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
if(length(object@otus) > 0)
addAttributes(parent, "otus" = object@otus)
parent
})
############################## Really AbstractNode
setClass("node",
slots = c(root = "logical"),
contains = "OptionalTaxonLinked")
setMethod("fromNeXML", signature("node", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
if(!is.na(xmlAttrs(from)["root"]))
obj@root <- as.logical(xmlAttrs(from)["root"])
obj
}
)
setMethod("toNeXML",
signature("node", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
if(length(object@root) > 0)
addAttributes(parent, "root" = tolower(object@root))
parent
})
setAs("node", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("node")))
setAs("node", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("node")))
setAs("XMLInternalElementNode", "node",
function(from) fromNeXML(new("node"), from))
################################ Really AbstractEdge
setClass("edge",
slots = c(source = "character",
target = "character",
length = "numeric"),
contains="IDTagged")
setMethod("fromNeXML",
signature("edge", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
attrs <- xmlAttrs(from)
obj@source <- attrs["source"]
obj@target <- attrs["target"]
if(!is.na(attrs["length"]))
obj@length <- as.numeric(attrs["length"])
obj
}
)
setMethod("toNeXML",
signature("edge", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addAttributes(parent, "source" = object@source)
addAttributes(parent, "target" = object@target)
if(length(object@length) > 0)
addAttributes(parent, "length" = object@length)
parent
})
setAs("edge", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("edge")))
setAs("edge", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("edge")))
setAs("XMLInternalElementNode", "edge",
function(from) fromNeXML(new("edge"), from))
##################################################
setClass("rootEdge",
slots = c(source = "character",
target = "character",
length = "numeric"),
contains="IDTagged")
setMethod("fromNeXML",
signature("rootEdge", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
attrs <- xmlAttrs(from)
obj@target <- attrs["target"]
if(!is.na(attrs["length"]))
obj@length <- as.numeric(attrs["length"])
obj
}
)
setMethod("toNeXML",
signature("rootEdge", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addAttributes(parent, "target" = object@target)
if(length(object@length) > 0)
addAttributes(parent, "length" = object@length)
parent
})
setAs("rootEdge", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("rootedge")))
setAs("rootEdge", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("rootedge")))
setAs("XMLInternalElementNode", "rootEdge",
function(from) fromNeXML(new("rootEdge"), from))
################################ alternatively called "Taxon" by the schema
setClass("otu", contains = "IDTagged")
setMethod("fromNeXML",
signature("otu", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
obj
})
setMethod("toNeXML",
signature("otu", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
parent
})
setAs("otu", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("otu")))
setAs("otu", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("otu")))
setAs("XMLInternalElementNode", "otu",
function(from) fromNeXML(new("otu"), from))
################################ alternatively called Taxa by the schema
setClass("ListOfotu", slots = c(names="character"),
contains = "list",
validity = function(object)
if(!all(sapply(object, is, "otu")))
"not all elements are otu objects"
else
TRUE)
###############################
setClass("otus",
slots = c(otu = "ListOfotu", names="character"),
contains = "IDTagged")
setMethod("fromNeXML",
signature("otus", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
kids <- xmlChildren(from)
if(length(kids) > 0)
obj@otu <- new("ListOfotu",
lapply(kids[names(kids) == "otu"],
as, "otu"))
obj
})
setMethod("toNeXML",
signature("otus", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addChildren(parent, kids = object@otu)
parent
})
setAs("otus", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("otus")))
setAs("otus", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("otus")))
setAs("XMLInternalElementNode", "otus",
function(from) fromNeXML(new("otus"), from))
################################
setClass("ListOfedge", slots = c(names="character"),
contains = "list",
validity = function(object)
if(!all(sapply(object, is, "edge")))
"not all elements are meta objects"
else
TRUE)
setClass("ListOfnode", slots = c(names="character"),
contains = "list",
validity = function(object)
if(!all(sapply(object, is, "node")))
"not all elements are meta objects"
else
TRUE)
################################## actually AbstractTree
setClass("tree",
slots = c(node = "ListOfnode",
edge = "ListOfedge",
rootedge = "rootEdge"), # Actually AbstractRootEdge
contains = "IDTagged")
setMethod("fromNeXML",
signature("tree", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
kids <- xmlChildren(from)
obj@node <- new("ListOfnode",
lapply(kids[names(kids) == "node"],
as, "node"))
obj@edge <- new("ListOfedge",
lapply(kids[names(kids) == "edge"],
as, "edge"))
obj
})
setMethod("toNeXML",
signature("tree", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addChildren(parent, kids = object@node)
addChildren(parent, kids = object@edge)
parent
})
setAs("tree", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("tree")))
setAs("tree", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("tree")))
setAs("XMLInternalElementNode", "tree",
function(from) fromNeXML(new("tree"), from))
################################################
setClass("ListOftree", slots = c(names="character"), contains = "list") # validity can contain tree or network nodes?
setClass("trees",
slots = c(tree = "ListOftree"), # Can contain networks...
contains = "TaxaLinked")
setMethod("fromNeXML",
signature("trees", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
kids <- xmlChildren(from)
obj@tree <- new("ListOftree",
lapply(kids[names(kids) == "tree"],
as, "tree"))
obj
})
setMethod("toNeXML",
signature("trees", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addChildren(parent, kids = object@tree)
# addChildren(parent, kids = object@network)
parent
})
setAs("trees", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("trees")))
setAs("trees", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("trees")))
setAs("XMLInternalElementNode", "trees",
function(from) fromNeXML(new("trees"), from))
####################################################
setClass("ListOfotus", slots = c(names="character"), contains = "list")
setClass("ListOftrees", slots = c(names="character"), contains = "list")
setClass("ListOfcharacters", slots = c(names="character"), contains = "list")
####################################################
nexml_namespaces <-
c("nex" = "http://www.nexml.org/2009",
"xsi" = "http://www.w3.org/2001/XMLSchema-instance",
"xml" = "http://www.w3.org/XML/1998/namespace",
"cdao" = "http://purl.obolibrary.org/obo/cdao.owl",
"xsd" = "http://www.w3.org/2001/XMLSchema#",
"dc" = "http://purl.org/dc/elements/1.1/",
"dcterms" = "http://purl.org/dc/terms/",
"ter" = "http://purl.org/dc/terms/",
"prism" = "http://prismstandard.org/namespaces/1.2/basic/",
"cc" = "http://creativecommons.org/ns#",
"ncbi" = "http://www.ncbi.nlm.nih.gov/taxonomy#",
"tc" = "http://rs.tdwg.org/ontology/voc/TaxonConcept#")
setClass("nexml",
slots = c(version = "character",
generator = "character",
"xsi:schemaLocation" = "character", # part of base?
namespaces = "character", # part of base?
otus = "ListOfotus",
trees = "ListOftrees",
characters="ListOfcharacters"),
prototype = prototype(version = "0.9",
generator = "RNeXML",
"xsi:schemaLocation" = "http://www.nexml.org/2009/nexml.xsd",
namespaces = c(nexml_namespaces,
"http://www.nexml.org/2009")),
contains = "Annotated")
setMethod("fromNeXML",
signature("nexml", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
# handle attributes
attrs <- xmlAttrs(from)
obj@version <- attrs["version"] # required attribute
if(!is.na(attrs["generator"])) # optional attribute
obj@generator <- attrs["generator"]
if(!is.na(attrs["xsi:schemaLocation"]))
slot(obj, "xsi:schemaLocation") <- attrs["xsi:schemaLocation"]
if(!is.na(attrs["schemaLocation"]))
slot(obj, "xsi:schemaLocation") <- attrs["schemaLocation"]
if(!is.na(attrs["xsi:type"]))
slot(obj, "xsi:type") <- attrs["xsi:type"]
if(!is.na(attrs["type"]))
slot(obj, "xsi:type") <- attrs["type"]
if(!is.na(attrs["about"]))
obj@about <- attrs["about"]
ns_defs <- xmlNamespaceDefinitions(from)
ns <- sapply(ns_defs, `[[`, "uri")
obj <- add_namespaces(ns, obj)
# Handle children
kids <- xmlChildren(from)
# at least 1 OTU block is required
obj@otus <- new("ListOfotus",
lapply(kids[names(kids) == "otus"],
as, "otus"))
if("characters" %in% names(kids))
obj@characters <- new("ListOfcharacters",
lapply(kids[names(kids) == "characters"],
as, "characters"))
if("trees" %in% names(kids))
obj@trees <- new("ListOftrees",
lapply(kids[names(kids) == "trees"],
as, "trees"))
obj
})
setMethod("toNeXML",
signature("nexml", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addAttributes(parent, "version" = object@version)
if(length(object@generator)>0)
addAttributes(parent, "generator" = object@generator)
# Coercion of object to XML happens automatically
addChildren(parent, kids = object@otus) # a list of "otus" objects
addChildren(parent, kids = object@trees) # a list of "trees" objects
addChildren(parent, kids = object@characters) # a list of "characters" objects
parent
})
## NOTE: The root nexml element must have it's namespace
setAs("nexml", "XMLInternalNode",
function(from) suppressWarnings(toNeXML(from, newXMLNode("nex:nexml", namespaceDefinitions = from@namespaces))))
setAs("nexml", "XMLInternalElementNode",
function(from) suppressWarnings(toNeXML(from, newXMLNode("nex:nexml", namespaceDefinitions = from@namespaces))))
setAs("XMLInternalElementNode", "nexml",
function(from) fromNeXML(new("nexml"), from))
#######################################################
RNeXML/R/add_characters.R 0000644 0001762 0000144 00000021703 12641021656 014600 0 ustar ligges users #################### Write character matices into S4 #####################
#' Add character data to a nexml object
#'
#' @param x character data, in which character traits labels are column names
#' and taxon labels are row names. x can be in matrix or data.frame
#' format.
#' @param nexml a nexml object, if appending character table to an existing
#' nexml object. If ommitted will initiate a new nexml object.
#' @param append_to_existing_otus logical. If TRUE, will add any new taxa
#' (taxa not matching any existing otus block) to the existing (first)
#' otus block. Otherwise (default), a new otus block is created, even
#' though it may contain duplicate taxa to those already present. While
#' FALSE is the safe option, TRUE may be appropriate when building nexml
#' files from scratch with both characters and trees.
#' @include classes.R
#' @examples
#' library("geiger")
#' data(geospiza)
#' geiger_nex <- add_characters(geospiza$dat)
#' @export
add_characters <- function(x,
nexml = new("nexml"),
append_to_existing_otus=FALSE){
# FIXME does it make sense to take a phylo object here as an option?
# If so, perhaps don't call the argument 'nexml'.
# If not, then we don't really need this conversion. (maybe a type-check instead).
nexml <- as(nexml, "nexml")
## Check types & row names ##
x <- format_characters(x)
j <- length(nexml@characters) ## add after any existing character matrices
nexml <- add_character_nodes(nexml, x)
for(i in 1:length(x)){
new_taxa <- rownames(x[[i]])
nexml <- add_otu(nexml, new_taxa, append=append_to_existing_otus)
## Add the otus id to the characters node
otus_id <- nexml@otus[[length(nexml@otus)]]@id
nexml@characters[[i+j]]@otus <- get_by_id(nexml@otus, otus_id)@id
nexml <- add_char(nexml, x, i, j)
nexml <- add_states(nexml, x, i, j)
}
for(i in 1:length(x)){
nexml <- add_rows(nexml, x, i, j)
}
nexml
}
add_character_nodes <- function(nexml, x){
n <- length(x)
cs_list <- lapply(1:n, function(i){
uid <- nexml_id("cs")
characters <- new("characters",
id = uid,
about = paste0("#", uid))
if(class(x[[i]][[1]]) == "numeric") ## Should be numeric but not integer!
type <- "ContinuousCells"
else ## Should be integer!
type <- "StandardCells"
slot(characters, "xsi:type") <- type
characters
})
cs_list <- c(nexml@characters, cs_list)
nexml@characters <- new("ListOfcharacters", cs_list)
nexml
}
otu_list <- function(to_add, prefix="ou"){
lapply(to_add,
function(label){
uid <- nexml_id(prefix)
new("otu", label=label, id =uid, about = paste0("#", uid))})
}
add_otu <- function(nexml, new_taxa, append=FALSE){
current_taxa <- get_taxa_list(nexml)
if(length(current_taxa) == 0) { # No otus exist, create a new node
otus <- new_otus_block(nexml, new_taxa)
nexml@otus <- new("ListOfotus", c(nexml@otus, otus))
} else {
otu_pos <- lapply(current_taxa,
function(current)
match(new_taxa, current))
if(any(is.na(unlist(otu_pos)))){ # We have missing taxa
if(append){
## append to otus block `otus_id` ##
otus_id <- 1 # position that matches the id string
to_add <- new_taxa[sapply(otu_pos, is.na)]
nexml@otus[[otus_id]]@otu <- new("ListOfotu",
c(nexml@otus[[otus_id]]@otu,
otu_list(to_add, "ou_char"))) ## FIXME hack to make sure new ids are 'unique',
} else {
## Alternatively, do not append ##
otus <- new_otus_block(nexml, new_taxa)
nexml@otus <- new("ListOfotus", c(nexml@otus, otus))
}
} # else # all taxa matched, so we're all set
}
nexml
}
new_otus_block <- function(nexml, to_add){
id <- nexml_id("os")
new("ListOfotus",
list(new("otus",
id = id,
about = paste0("#", id),
otu = new("ListOfotu",
otu_list(to_add))
)))
}
# Turns char names into char nodes
add_char <- function(nexml, x, i = 1, j = 0){
char_labels <- colnames(x[[i]])
char_list <-
lapply(char_labels, function(lab){
id <- nexml_id("cr")
char <- new("char",
id = id,
about = paste0("#", id),
label = lab)
})
nexml@characters[[i+j]]@format@char <- new("ListOfchar", char_list)
nexml
}
add_states <- function(nexml, x, i = 1, J = 0){
# don't ctreate a states node if data is numeric
if(all(sapply(x[[i]], is.numeric)))
nexml
else {
nchars <- length(x[[i]])
char <- nexml@characters[[i+J]]@format@char
states_list <- lapply(1:nchars, function(j){
lab <- char[[j]]@label
lvls <- levels(x[[i]][[lab]])
id <- nexml_id("ss")
states <-
new("states",
id = id,
about = paste0("#", id),
state = new("ListOfstate",
lapply(lvls, function(lvl){
new("state",
id=nexml_id("s"),
symbol = as.integer(as.factor(lvl)))
}))
)
})
nexml@characters[[i+J]]@format@states <- new("ListOfstates", states_list)
# Add the states's id to char
for(j in 1:nchars)
nexml@characters[[i+J]]@format@char[[j]]@states <- states_list[[j]]@id
nexml
}
nexml
}
## Assumes that otu ids have already been added to the nexml
add_rows <- function(nexml, x, i = 1, j = 0){
X <- x[[i]]
taxa <- rownames(X)
char_labels <- colnames(X)
## get the relevant characters block and otus block
cs <- nexml@characters[[i+j]]@id
os <- nexml@characters[[i+j]]@otus
otu_map <- get_otu_maps(nexml)[[os]]
char_map <- get_char_maps(nexml)[[cs]]
state_map <- get_state_maps(nexml)[[cs]]
reverse_otu_map <- reverse_map(otu_map)
reverse_char_map <- reverse_map(char_map)
reverse_state_map <- reverse_map(state_map)
mat <-
new("obsmatrix",
row = new("ListOfrow",
lapply(taxa,
function(taxon){
id = nexml_id("rw")
new("row",
id = id,
about = paste0("#", id),
label = taxon,
otu = reverse_otu_map[taxon],
cell = new("ListOfcell",
lapply(char_labels, function(char){
state <- X[taxon,char] # unmapped
char_id <- reverse_char_map[[char]]
if(!is.null(state_map))
state <- reverse_state_map[[char_id]][state]
new("cell",
char = char_id,
state = as.character(state))
}))
)
}))
)
nexml@characters[[i+j]]@matrix <- mat
nexml
}
## divide matrix into discrete and continuous trait matrices, if necessary
## then write each as separate nodes:
## x should now be a list of data.frames of common type
format_characters <- function(x){
if(is(x, "numeric"))
x <- as.data.frame(x)
## Actually useful conversions ##
## Matrices are either all-numeric or all-character class, so no risk of mixed discrete and continous states.
if(is(x, "matrix")){
x <- list(as.data.frame(x))
## Data.frames can mix discrete and continous states, so we need to seperate them
} else if(is(x, "data.frame") && dim(x)[2] > 1) {
x <- split_by_class(x)
} else if(is(x, "data.frame") && dim(x)[2] == 1) {
x <- list(x)
#### Ugh, this next bit isn't pretty. Maybe we should just hope lists are formatted correctly, e.g. come from get_character_list.
## If we're getting a list with matrices, coerce them into data.frames and hope for the best.
## If the list has data.frames, check that each one has consistent class type.
## Otherwise, panic.
} else if(is(x, "list")) {
for(i in 1:length(x)){
if(is(x[[i]], "matrix"))
x[[i]] <- as.data.frame(x[[i]]) ## A list of matrices we can make into a list of data.frames...
}
## Someone didn't even try to read the documentation...
} else {
stop("x must be a named numeric, matrix, data.frame, or list thereof")
}
## Let's just hope folks read the documentation and have
## row names as taxa and column names as be character traits.
## Kinda hard to check that for sure?
## return the updated object: a list of data.frames
x
}
## Helper function for the above, contains the primary functionality
# divide a data.frame into a list of data.frames, in which each has only a unique column class
split_by_class <- function(x){
col.classes <- sapply(x, class)
if(all(sapply(col.classes, identical, col.classes[1])))
x <- list(x)
else {
## split into numerics and non-numerics
cts <- unname(which(col.classes=="numeric"))
discrete <- unname(which(col.classes!="numeric"))
x <- list(x[cts], x[discrete])
}
x
}
RNeXML/R/simmap.R 0000644 0001762 0000144 00000015607 12641021656 013145 0 ustar ligges users # simmap.R
# if(!is.null(phy$maps))
## FIXME write the characters/states block (but not matrix block) as well.
## FIXME support writing multiphylos, list of multiphylos to nexml
#' simmap_to_nexml
#'
#' simmap_to_nexml
#' @param phy a phy object containing simmap phy$maps element,
#' from the phytools pacakge
#' @param state_ids a named character vector giving the state
#' names corresponding to the ids used to refer to each state
#' in nexml. If null ids will be generated and states taken from
#' the phy$states names.
#' @return a nexml representation of the simmap
#' @export
#' @import XML
#' @examples
#' data(simmap_ex)
#' phy <- nexml_to_simmap(simmap_ex)
#' nex <- simmap_to_nexml(phy)
simmap_to_nexml <- function(phy, state_ids = NULL){
## Hack to deal with S3 class issues when coercing to S4
if(class(phy) == c("simmap", "phylo"))
class(phy) <- "phylo"
## Create the NeXML object
nexml <- as(phy, "nexml")
if(!is.null(phy$states)){
nexml <- add_characters(data.frame(states = as.integer(as.factor(phy$states))), nexml)
## FIXME doesn't have states
chars_ids <- get_state_maps(nexml)[[1]]
char_id <- names(chars_ids)
state_ids <- reverse_map(chars_ids[[1]])
# can assume no other states added yet since works on a phy, not nexml
}
if(!is.null(phy$maps))
nexml <- simmap_edge_annotations(maps = phy$maps,
nexml = nexml,
state_ids = state_ids,
char_id = char_id)
nexml
}
simmap_edge_annotations <- function(maps, nexml, state_ids = NULL, char_id = "simmapped_trait"){
## if state ids are not given
if(is.null(state_ids)){
state_ids <- levels(as.factor(names(unlist(maps))))
names(state_ids) <- state_ids
}
# Loop over all edges, adding the simmap annotation to each:
for(i in 1:length(nexml@trees[[1]]@tree[[1]]@edge)){
## FIXME check to assure this is always the correct order??
## Read the mapping of the current edge
edge_map <- maps[[i]]
## Generate the list of XML "stateChange" nodes
mapping <- lapply(1:length(edge_map), function(j){
## A node has an id, a length and a state
meta(property = "simmap:stateChange",
children = list(meta(property = "simmap:order",
content = j),
meta(property = "simmap:length",
content = edge_map[[j]]),
meta(property = "simmap:state",
content = state_ids[[names(edge_map[j])]] )
)
)
})
reconstruction <-meta(property = "simmap:reconstruction",
children =c(list(meta(property="simmap:char",
content = char_id)),
mapping))
## Insert the reconstructions into a element in each nexml edge
nexml@trees[[1]]@tree[[1]]@edge[[i]]@meta <-
c(meta(type = "LiteralMeta",
property = "simmap:reconstructions",
children = list(reconstruction)))
}
## Return the entire nexml object
nexml <- add_namespaces(c(simmap = "https://github.com/ropensci/RNeXML/tree/master/inst/simmap.md"),
nexml)
nexml
}
## Returns list of multiPhylo ...
#' nexml_to_simmap
#'
#' nexml_to_simmap
#' @param nexml a nexml object
#' @return a simmap object (phylo object with a $maps element
#' for use in phytools functions).
#' @export
#' @examples
#' data(simmap_ex)
#' phy <- nexml_to_simmap(simmap_ex)
#' nex <- simmap_to_nexml(phy)
nexml_to_simmap <- function(nexml){
## Get the statemap, if available
characters <- get_characters(nexml)
## loop over trees blocks
out <- lapply(nexml@trees, function(trees){
phys <- lapply(trees@tree,
tree_to_simmap,
get_otu_maps(nexml)[[trees@otus]],
get_state_maps(nexml)[[1]][[1]]
)
phys <- lapply(phys, characters_to_simmap, characters)
names(phys) <- NULL
class(phys) <- "multiPhylo"
phys
})
if(length(out) == 1){
if(length(out[[1]]) > 1){
flatten_multiphylo(out)
} else {
out[[1]][[1]]
}
}
}
characters_to_simmap <- function(phy, characters){
out <- as.character(characters[[1]]) # coerce factor to string
names(out) <- rownames(characters)
phy$states <- out
phy
}
# given the nexml tree:
tree_to_simmap <- function(tree, otus, state_maps = NULL){
maps <- lapply(tree@edge, function(edge){
reconstructions <- sapply(edge@meta, function(x) x@property == "simmap:reconstructions")
if(any(reconstructions))
reconstruction <- edge@meta[[which(reconstructions)]]@children
else { # handle exceptions
warning("no simmap data found")
return(toPhylo(tree, otus)) ## no simmap found
}
# lapply(reconstruction, function(reconstruction){ # for each reconstruction
stateChange <- sapply(reconstruction[[1]]@children, function(x) x@property == "simmap:stateChange")
values <- sapply(reconstruction[[1]]@children[which(stateChange)], function(stateChange){
# phytools only supports one reconstruction of one character per phy object
property <- sapply(stateChange@children, function(x) x@property)
names(stateChange@children) <- property # clean labels
sapply(stateChange@children, function(x) x@content)
})
out <- as.numeric(values["simmap:length", ])
ordering <- as.numeric(values["simmap:order",])
if(!is.null(state_maps))
states <- state_maps[values["simmap:state", ]]
else
states <- values["simmap:state", ]
names(out) <- states
out <- out[ordering] # sort according to explicit order
out
# })
})
names(maps) <- NULL
phy <- toPhylo(tree, otus)
phy$maps <- maps
## create the rest of the maps elements
## Return phylo object
phy
}
#' @name simmap_ex
#' @title A nexml class R object that includes simmap annotations
#' @description A nexml object with simmap stochastic character mapping
#' annotations added to the edges, for use with the RNeXML package
#' parsing and serializing NeXML into formats that work with the ape and
#' phytools packages.
#' @docType data
#' @usage simmap_ex
#' @format a \code{nexml} instance
#' @source Simulated tree and stochastic character mapping based on
#' Revell 2011 (doi:10.1111/j.2041-210X.2011.00169.x)
#' @author Carl Boettiger
NULL
## Extend directly with XML representation instead of S4
#setClass("simmap:reconstructions",
# slots = c(reconstruction = "ListOfreconstruction"))
#setClass("ListOfreconstruction", contains = "list")
#setClass("simmap:stateChange", contains = "IDTagged")
#
RNeXML/R/get_characters.R 0000644 0001762 0000144 00000011670 12734324011 014623 0 ustar ligges users #' Get character data.frame from nexml
#'
#' @param nex a nexml object
#' @param rownames_as_col option to return character matrix rownames (with taxon ids) as it's own column in the
#' data.frame. Default is FALSE for compatibility with geiger and similar packages.
#' @param otu_id logical, default FALSE. return a column with the
#' otu id (for joining with otu metadata, etc)
#' @param otus_id logical, default FALSE. return a column with the
#' otus block id (for joining with otu metadata, etc)
#' @return the character matrix as a data.frame
#' @details RNeXML will attempt to return the matrix using the NeXML taxon (otu) labels to name the rows
#' and the NeXML char labels to name the traits (columns). If these are unavailable or not unique, the NeXML
#' id values for the otus or traits will be used instead.
#' @importFrom tidyr spread
#' @importFrom dplyr left_join select_ matches
#' @importFrom stringr str_replace
#' @importFrom stats setNames
#' @export
#' @examples
#' \dontrun{
#' # A simple example with a discrete and a continous trait
#' f <- system.file("examples", "comp_analysis.xml", package="RNeXML")
#' nex <- read.nexml(f)
#' get_characters(nex)
#'
#' # A more complex example -- currently ignores sequence-type characters
#' f <- system.file("examples", "characters.xml", package="RNeXML")
#' nex <- read.nexml(f)
#' get_characters(nex)
#' }
get_characters <- function(nex, rownames_as_col=FALSE, otu_id = FALSE, otus_id = FALSE){
drop = lazyeval::interp(~-dplyr::matches(x), x = "about|xsi.type|format")
otus <- get_level(nex, "otus/otu") %>%
dplyr::select_(drop) %>%
optional_labels(id_col = "otu")
char <- get_level(nex, "characters/format/char") %>%
dplyr::select_(drop) %>%
optional_labels(id_col = "char")
## Rows have otu information
rows <- get_level(nex, "characters/matrix/row") %>%
dplyr::select_(.dots = c("otu", "row"))
cells <- get_level(nex, "characters/matrix/row/cell") %>%
dplyr::select_(.dots = c("char", "state", "row")) %>%
dplyr::left_join(rows, by = "row")
characters <- get_level(nex, "characters")
## States, including polymorphic states (or uncertain states)
states <- get_level(nex, "characters/format/states/state")
## Include polymorphic and uncertain states
polymorph <- get_level(nex, "characters/format/states/polymorphic_state_set")
uncertain <- get_level(nex, "characters/format/states/uncertain_state_set")
if(dim(polymorph)[1] > 0)
states <- dplyr::bind_rows(states, polymorph)
if(dim(uncertain)[1] > 0)
states <- dplyr::bind_rows(states, uncertain)
states <- dplyr::select_(states, drop)
if(dim(states)[1] > 0)
cells <- cells %>%
dplyr::left_join(states, by = c("state")) %>%
dplyr::select_(.dots = c("char", "symbol", "otu", "state"))
## Join the matrices. Note that we select unique column names after each join to avoid collisions
cells %>%
dplyr::left_join(char, by = c("char")) %>%
dplyr::rename_(.dots = c("trait" = "label")) %>%
dplyr::left_join(otus, by = c("otu")) %>%
dplyr::rename_(.dots = c("taxa" = "label")) %>%
na_symbol_to_state() %>%
dplyr::select_(.dots = c("taxa", "symbol", "trait", "otu", "otus")) %>%
tidyr::spread("trait", "symbol") ->
out
## Identify the class of each column and reset it appropriately
cellclass <- function(x){
x %>%
stringr::str_replace(".*ContinuousCells", "numeric") %>%
stringr::str_replace(".*StandardCells", "integer")
}
type <-
get_level(nex, "characters/matrix/row/cell") %>%
dplyr::select_(drop) %>%
dplyr::left_join(characters, by = "characters") %>%
dplyr::select_(.dots = c( "xsi.type", "char", "characters")) %>%
dplyr::left_join(char, by = c("char")) %>%
dplyr::select_(.dots = c("label", "xsi.type")) %>%
dplyr::distinct() %>%
dplyr::mutate_(.dots = setNames(list(~cellclass(xsi.type)), "class"))
for(i in dim(type)[1])
class(out[[type$label[i]]]) <- type$class[i]
## drop unwanted columns if requested (default)
if(!otu_id){
out <- dplyr::select_(out, quote(-otu))
}
if(!otus_id){
out <- dplyr::select_(out, quote(-otus))
}
if(!rownames_as_col){
taxa <- out$taxa
out <- dplyr::select_(out, quote(-taxa))
out <- as.data.frame(out)
rownames(out) <- taxa
out
}
out
}
## If 'label' column is missing, create it from 'id' column
## if label exists but has missing or non-unique values, also use ids instead
optional_labels <- function(df, id_col = "id"){
who <- names(df)
if(! "label" %in% who)
df$label <- df[[id_col]]
if(length(unique(df$label)) < length(df$label))
df$label <- df[[id_col]]
df
}
## Continuous traits have the values in "state" column, whereas
## for discrete states we return the value of the "symbol" column
na_symbol_to_state <- function(df){
if(is.null(df$symbol))
df$symbol <- NA
df$symbol[is.na(df$symbol)] <- suppressWarnings(as.numeric(df$state[is.na(df$symbol)]))
df
}
RNeXML/R/nexml_methods.R 0000644 0001762 0000144 00000004024 12641021656 014514 0 ustar ligges users
#setMethod("head", signature("nexml"), function(x, n=6L, ...){
# write.nexml(x, "tmp123.xml")
# txt <- readLines("tmp123.xml", n=n)
# unlink("tmp123.xml")
# cat(txt, "\n")
#})
#setMethod("tail", signature("nexml"), function(x, n=6L, ...){
# write.nexml(x, "tmp123.xml")
# txt <- readLines("tmp123.xml", n=-n)
# unlink("tmp123.xml")
# cat(txt, "\n")
#})
setMethod("show", signature("nexml"), function(object){
summary(object)
})
# FIXME: consider showing author/title/citation information if available?
setMethod("summary", signature("nexml"), function(object){
doc <- xmlParse(write.nexml(object))
nmeta <- length(getNodeSet(doc, "//x:meta", namespaces="x"))
ntree_blocks <- length(object@trees)
n_per_block <- sapply(unname(object@trees), function(x) length(x@tree))
ntrees <- length(getNodeSet(doc, "//x:tree", namespaces="x"))
ncharacters <- length(getNodeSet(doc, "//x:characters", namespaces="x"))
notu <- length(getNodeSet(doc, "//x:otu", namespaces="x"))
block_counts <-
paste(sapply(1:length(n_per_block),
function(i)
paste("\t block", i, "contains",
n_per_block[i], "phylogenetic trees")),
sep= "", collapse = "\n")
cat(paste("A nexml object representing:\n",
"\t", ntree_blocks, "phylogenetic tree blocks, where:", "\n",
block_counts, "\n",
"\t", nmeta, "meta elements", "\n",
"\t", ncharacters, "character matrices", "\n",
"\t", notu, "taxonomic units", "\n",
"Taxa: \t", paste(head(get_taxa(object)$label), collapse = ", "), "...", "\n\n",
"NeXML generated by", object@generator, "using",
"schema version:", object@version, "\n",
"size:", capture.output(print(object.size(object), units="auto")), "\n"))
})
RNeXML/R/nexml_publish.R 0000644 0001762 0000144 00000010405 12641021656 014517 0 ustar ligges users
#' publish nexml files to the web and receive a DOI
#'
#' publish nexml files to the web and receive a DOI
#' @param nexml a nexml object (or file path)
#' @param ... additional arguments, depending on repository. See examples.
#' @param repository desitination respository
#' @return a digital object identifier to the published data
#' @export
#' @examples \dontrun{
#' data(bird.orders)
#' birds <- add_trees(bird.orders)
#' doi <- nexml_publish(birds, visibility = "public", repository="figshare")
#' }
nexml_publish <- function(nexml, ..., repository="figshare"){
repository = match.arg(repository)
switch(repository,
figshare = nexml_figshare(nexml, ...))
}
#' publish nexml to figshare
#'
#' publish nexml to figshare
#' @param nexml a nexml object (or file path to a nexml file)
#' @param file The filename desired for the object, if nexml is not already a file.
#' if the first argument is already a path, this value is ignored.
#' @param categories The figshare categories, must match available set. see \code{fs_add_categories}
#' @param tags Any keyword tags you want to add to the data.
#' @param visibility whether the results should be published (public), or kept private,
#' or kept as a draft for further editing before publication. (New versions can be updated,
#' but any former versions that was once made public will always be archived and cannot be removed).
#' @param id an existing figshare id (e.g. from fs_create), to which this file can be appended.
#' @param ... additional arguments
#' @return the figshare id of the object
#' @export
#' @examples \dontrun{
#' data(bird.orders)
#' birds <- add_trees(bird.orders)
#' doi <- nexml_figshare(birds, visibility = "public", repository="figshare")
#' }
nexml_figshare <- function(nexml,
file = "nexml.xml",
categories = "Evolutionary Biology",
tags = list("phylogeny", "NeXML"),
visibility = c("public", "private", "draft"),
id = NULL,
...){
visibility = match.arg(visibility)
# success <- require(rfigshare)
# if(!success){
# message("rfigshare package not found. Attempting to install")
# install.packages("rfigshare")
# success <- require(rfigshare)
# if(!success)
# stop("The rfigshare package must be installed to publish data to figshare")
# }
# handle nexml as a file path or as an object
if(!is(nexml, "nexml")){
if(file.exists(nexml)){
file <- nexml
nexml <- nexml_read(nexml)
} # else warning?
}
m <- get_metadata(nexml)
if(is.null(id)){
id <- rfigshare::fs_create(title = m[["dc:title"]],
description = m[["dc:description"]],
type = "dataset")
}
doi <- paste("http://doi.org/10.6084/m9.figshare", id, sep=".")
rfigshare::fs_add_authors(id, authors = m[["dc:creator"]])
rfigshare::fs_add_categories(id, categories)
rfigshare::fs_add_tags(id, tags)
# Use object DOI instead of figshare id when available?
# Construct DOI from figshare id?
nexml <- add_meta(meta("dc:identifier", doi), nexml)
nexml_write(nexml, file)
rfigshare::fs_upload(id, file)
if (visibility == "private"){
rfigshare::fs_make_private(id)
message(paste("Your data has been uploaded to figshare privately.
You may make further edits and publish the data from
the online control panel at figshare.com or by using
the rfigshare package and the article_id:", id, ". Your
doi has been reserved but will not resolve until the article
is made public."))
} else if (visibility == "public"){
rfigshare::fs_make_public(id)
message(paste("Your data is published and now accessible at", doi))
} else {
message(paste("Your data has been uploaded to figshare as a draft.
You may make further edits and publish the data from
the online control panel at figshare.com or by using
the rfigshare package and the article_id:", id, " Your
doi has been reserved but will not resolve until the article
is made public."))
}
# FIXME consider not returning the DOI as a link.
# Consider returning just the Figshare id
#
id
}
RNeXML/R/get_trees.R 0000644 0001762 0000144 00000016777 12641021656 013651 0 ustar ligges users #' extract all phylogenetic trees in ape format
#'
#' extract all phylogenetic trees in ape format
#' @param nexml a representation of the nexml object from which the data is to be retrieved
#' @return returns a list of lists of multiphylo trees, even if all trees are in the same `trees` node (and hence the outer list will be of length 1) or if there is only a single tree (and hence the inner list will also be of length 1. This guarentees a consistent return type regardless of the number of trees present in the nexml file, and also preserves any heirarchy/grouping of trees.
#' @export
#' @import plyr
#' @examples
#' comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
#' nex <- nexml_read(comp_analysis)
#' get_trees_list(nex)
#' @seealso \code{\link{get_trees}} \code{\link{get_flat_trees}} \code{\link{get_item}}
get_trees_list <- function(nexml) as(nexml, "multiPhyloList")
#' extract a phylogenetic tree from the nexml
#'
#' extract a phylogenetic tree from the nexml
#' @param nexml a representation of the nexml object from which the data is to be retrieved
#' @return an ape::phylo tree, if only one tree is represented. Otherwise returns a list of lists of multiphylo trees. To consistently recieve the list of lists format (preserving the heriarchical nature of the nexml), use \code{\link{get_trees_list}} instead.
#' @export
#' @seealso \code{\link{get_trees}} \code{\link{get_flat_trees}} \code{\link{get_item}}
#' @examples
#' comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
#' nex <- nexml_read(comp_analysis)
#' get_trees(nex)
get_trees <- function(nexml) as(nexml, "phylo")
#' get_flat_trees
#'
#' extract a single multiPhylo object containing all trees in the nexml
#' @details Note that this method collapses any heirachical structure that may have been present as multiple `trees` nodes in the original nexml (though such a feature is rarely used). To preserve that structure, use \code{\link{get_trees}} instead.
#' @return a multiPhylo object (list of ape::phylo objects). See details.
#' @param nexml a representation of the nexml object from which the data is to be retrieved
#' @export
#' @seealso \code{\link{get_trees}} \code{\link{get_trees}} \code{\link{get_item}}
#' @examples
#' comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
#' nex <- nexml_read(comp_analysis)
#' get_flat_trees(nex)
get_flat_trees <- function(nexml) flatten_multiphylo(get_trees_list(nexml))
####### Coercion methods #########
setAs("nexml", "multiPhyloList", function(from){
map <- get_otu_maps(from)
unname(lapply(from@trees,
function(X){
out <- unname(lapply(X@tree, toPhylo, map[[X@otus]]))
class(out) <- "multiPhylo"
out
}))
})
# Always collapses all trees nodes into a multiphylo
setAs("nexml", "multiPhylo", function(from){
map <- get_otu_maps(from)
out <- unname(lapply(from@trees,
function(X){
out <- unname(lapply(X@tree, toPhylo, map[[X@otus]]))
class(out) <- "multiPhylo"
out
}))
flatten_multiphylo(out)
})
#' Flatten a multiphylo object
#'
#' @details NeXML has the concept of multiple nodes, each with multiple child nodes.
#' This maps naturally to a list of multiphylo objects. Sometimes
#' this heirarchy conveys important structural information, so it is not discarded by default.
#' Occassionally it is useful to flatten the structure though, hence this function. Note that this
#' discards the original structure, and the nexml file must be parsed again to recover it.
#' @param object a list of multiphylo objects
#' @export
flatten_multiphylo <- function(object){
out <- unlist(object, FALSE, FALSE)
class(out) <- "multiPhylo"
out
}
setAs("nexml", "phylo", function(from){
if(length(from@trees[[1]]@tree) == 1){
maps <- get_otu_maps(from)
otus_id <- from@trees[[1]]@otus
out <- toPhylo(from@trees[[1]]@tree[[1]], maps[[otus_id]])
} else {
warning("Multiple trees found, Returning multiPhylo object")
out <- as(from, "multiPhylo")
}
if(length(out) == 1)
out <- flatten_multiphylo(out)
out
})
########### Main internal function for converting nexml to phylo ########
#' nexml to phylo
#'
#' nexml to phylo coercion
#' @param tree an nexml tree element
#' @param otus a character string of taxonomic labels, named by the otu ids.
#' e.g. (from get_otu_maps for the otus set matching the relevant trees node.
#' @return phylo object. If a "reconstructions" annotation is found on the
#' edges, return simmap maps slot as well.
toPhylo <- function(tree, otus){
otu <- NULL # Avoid CRAN NOTE as per http://stackoverflow.com/questions/8096313/no-visible-binding-for-global-variable-note-in-r-cmd-check
## Extract the nodes list
nodes <- sapply(unname(tree@node),
function(x)
c(node = unname(x@id),
otu = missing_as_na(x@otu)))
# If any edges have lengths, use this routine
if(any(sapply(tree@edge, function(x) length(x@length) > 0)))
edges <- sapply(unname(tree@edge),
function(x)
c(source = unname(x@source),
target = unname(x@target),
length = if(identical(x@length, numeric(0)))
NA
else
unname(x@length),
id = unname(x@id)))
else # no edge lengths, use this routine
edges <- sapply(unname(tree@edge),
function(x)
c(source = unname(x@source),
target = unname(x@target),
id = unname(x@id)))
nodes <- data.frame(t(nodes), stringsAsFactors=FALSE)
names(nodes) <- c("node", "otu")
## Identifies tip.label based on being named with OTUs while others are NULL
## FIXME Should instead decide that these are tips based on the edge labels?
nodes <- cbind(plyr::arrange(nodes, otu), id = 1:dim(nodes)[1]) # Also warns because arrange isn't quoting the column name.
## NB: these ids are the ape:id numbers by which nodes are identified in ape::phylo
## Arbitrary ids are not supported - ape expecs the numbers 1:n, starting with tips.
## nodes$node lists tip taxa first (see arrange fn above), since
## APE expects nodes numbered 1:n_tips to be to correspond to tips.
source_nodes <- match(edges["source",], nodes$node)
target_nodes <- match(edges["target",], nodes$node)
## Define elements of a phylo class object ##
#--------------------------------------------#
## define edge matrix
edge <- unname(cbind(source_nodes, target_nodes))
if("length" %in% rownames(edges))
edge.length <- as.numeric(edges["length",])
else
edge.length <- NULL
## define tip labels
tip_otus <- as.character(na.omit(nodes$otu))
tip.label <- otus[tip_otus]
# Count internal nodes (assumes bifurcating tree. Does ape always assume this?)
# FIXME use a method that does not assume bifurcating tree...
Nnode <- length(tip.label) - 1
# assemble the phylo object, assign class and return.
phy = list(edge=edge,
tip.label = unname(tip.label),
Nnode = Nnode)
if(!is.null(edge.length))
phy$edge.length = edge.length # optional fields
class(phy) = "phylo"
## Check for simmap
phy
}
## Helper function
missing_as_na <- function(x){
if(length(x) == 0)
NA
else
unname(x)
}
RNeXML/R/add_meta.R 0000644 0001762 0000144 00000005367 12641021656 013417 0 ustar ligges users #' Add metadata to a nexml file
#'
#' @param meta a meta S4 object, e.g. ouput of the function \code{\link{meta}}, or a list of these meta objects
#' @param nexml (S4) object
#' @param level the level at which the metadata annotation should be added.
#' @param namespaces named character string for any additional namespaces that should be defined.
#' @param i for otus, trees, characters: if there are multiple such blocks, which one should be annotated? Default is first/only block.
#' @param at_id the id of the element to be annotated. Optional, advanced use only.
#' @seealso \code{\link{meta}} \code{\link{add_trees}} \code{\link{add_characters}} \code{\link{add_basic_meta}}
#' @return the updated nexml object
#' @examples
#' ## Create a new nexml object with a single metadata element:
#' modified <- meta(property = "prism:modificationDate", content = "2013-10-04")
#' nex <- add_meta(modified) # Note: 'prism' is defined in nexml_namespaces by default.
#'
#' ## Write multiple metadata elements, including a new namespace:
#' website <- meta(href = "http://carlboettiger.info",
#' rel = "foaf:homepage") # meta can be link-style metadata
#' nex <- add_meta(list(modified, website),
#' namespaces = c(foaf = "http://xmlns.com/foaf/0.1/"))
#'
#' ## Append more metadata, and specify a level:
#' history <- meta(property = "skos:historyNote",
#' content = "Mapped from the bird.orders data in the ape package using RNeXML")
#' nex <- add_meta(history,
#' nexml = nex,
#' level = "trees",
#' namespaces = c(skos = "http://www.w3.org/2004/02/skos/core#"))
#'
#' @export add_meta
#' @include classes.R
#'
add_meta <- function(meta,
nexml=new("nexml"),
level=c("nexml", "otus", "trees", "characters"),
namespaces = NULL,
i = 1,
at_id = NULL){
level <- match.arg(level)
if(is(meta, "meta"))
meta <- list(meta)
if(!all(sapply(meta, is, "meta")))
stop("All elements in list must be of class 'meta'")
if(!is.null(at_id)){
stop("function does not yet handle at_id assignments")
# case not written yet
} else if(level =="nexml"){
nexml@meta <- new("ListOfmeta", c(unlist(nexml@meta), unlist(meta)))
} else if(level =="otus"){
nexml@otus[[i]]@meta <- new("ListOfmeta", c(nexml@otus[[i]]@meta, meta))
} else if(level =="nexml"){
nexml@trees[[i]]@meta <- new("ListOfmeta", c(nexml@trees[[i]]@meta, meta))
} else if(level =="nexml"){
nexml@characters[[i]]@meta <- new("ListOfmeta", c(nexml@characters[[i]]@meta, meta))
}
## append additional namespaces
nexml <- add_namespaces(namespaces, nexml)
nexml
}
RNeXML/R/get_rdf.R 0000644 0001762 0000144 00000002063 12641021656 013261 0 ustar ligges users #' Extract rdf-xml from a NeXML file
#'
#' Extract rdf-xml from a NeXML file
#' @param file the name of a nexml file, or otherwise a nexml object.
#' @return an RDF-XML object (XMLInternalDocument). This can be manipulated with
#' tools from the XML R package, or converted into a triplestore for use with
#' SPARQL queries from the rrdf R package.
#' @export
#' @import httr XML
# @import Sxslt # not yet
#' @examples \dontrun{
#' f <- system.file("examples", "meta_example.xml", package="RNeXML")
#' rdf <- get_rdf(f)
#'
#' ## Write to a file and read in with rrdf
#' tmp <- tempfile()
#' saveXML(rdf, tmp)
#' library(rrdf)
#' lib <- load.rdf(tmp)
#'
#' ## Perform a SPARQL query:
#' sparql.rdf(lib, "SELECT ?title WHERE { ?x ?title}")
#' }
get_rdf <- function(file){
if(is(file, "nexml")){
who <- tempfile()
nexml_write(x=file, file=who)
file <- who
}
to_rdf <- system.file("examples", "RDFa2RDFXML.xsl", package="RNeXML")
rdf <- Sxslt::xsltApplyStyleSheet(file, to_rdf)
rdf
}
RNeXML/R/add_basic_meta.R 0000644 0001762 0000144 00000010501 12731606043 014541 0 ustar ligges users #' Add basic metadata
#'
#' adds Dublin Core metadata elements to (top-level) nexml
#' @param title A title for the dataset
#' @param description a description of the dataset
#' @param creator name of the data creator. Can be a string or R person object
#' @param pubdate publication date. Default is current date.
#' @param rights the intellectual property rights associated with the data.
#' The default is Creative Commons Zero (CC0) public domain declaration,
#' compatiable with all other licenses and appropriate for deposition
#' into the Dryad or figshare repositories. CC0 is also recommended by the Panton Principles.
#' Alternatively, any other plain text string can be added and will be provided as the content
#' attribute to the dc:rights property.
#' @param publisher the publisher of the dataset. Usually where a user may go to find the canonical
#' copy of the dataset: could be a repository, journal, or academic institution.
#' @param citation a citation associated with the data. Usually an acompanying academic journal
#' article that indicates how the data should be cited in an academic context. Multiple citations
#' can be included here.
#' citation can be a plain text object, but is preferably an R `citation` or `bibentry` object (which
#' can include multiple citations. See examples
#' @param nexml a nexml object to which metadata should be added. A new
#' nexml object will be created if none exists.
#' @return an updated nexml object
#' @details \code{add_basic_meta()} is just a wrapper for \code{\link{add_meta}} to make it easy to
#' provide generic metadata without explicitly providing the namespace. For instance,
#' \code{add_basic_meta(title="My title", description="a description")} is identical to:
#' \code{add_meta(list(meta("dc:title", "My title"), meta("dc:description", "a description")))}
#' Most function arguments are mapped directly to the Dublin Core terms
#' of the same name, with the exception of `rights`, which by default maps
#' to the Creative Commons namespace when using CC0 license.
#'
#' @seealso \code{\link{add_trees}} \code{\link{add_characters}} \code{\link{add_meta}}
#' @export
#' @importFrom stats na.omit
#' @importFrom utils capture.output head object.size
#' @examples
#' nex <- add_basic_meta(title = "My test title",
#' description = "A description of my test",
#' creator = "Carl Boettiger ",
#' publisher = "unpublished data",
#' pubdate = "2012-04-01")
#'
#' ## Adding citation to an R package:
#' nexml <- add_basic_meta(citation=citation("ape"))
#' \dontrun{
#' ## Use knitcitations package to add a citation by DOI:
#' library(knitcitations)
#' nexml <- add_basic_meta(citation = bib_metadata("10.2307/2408428"))
#' }
#' @include classes.R
add_basic_meta <- function(title = NULL,
description = NULL,
creator = Sys.getenv("USER"),
pubdate = Sys.Date(),
rights = "CC0",
publisher = NULL,
citation = NULL,
nexml = new("nexml")
){
mymeta <- get_metadata(nexml)
m <- mymeta$content
names(m) <- mymeta$property
if(!is.null(title))
nexml <- add_meta(meta("dc:title", title), nexml)
if(!is.null(creator) || creator == "")
nexml <- add_meta(meta("dc:creator", format(creator)), nexml)
if(!is.null(pubdate))
if(!is.null(m))
if(is.null(m["dc:pubdate"]) | is.na(m["dc:pubdate"]))
nexml <- add_meta(meta("dc:pubdate", format(pubdate)), nexml)
if(!is.null(description))
nexml <- add_meta(meta("dc:description", description), nexml)
if(!is.null(rights)){
if(rights == "CC0")
if(is.null(get_license(nexml)))
nexml <- add_meta(meta(rel="cc:license",
href="http://creativecommons.org/publicdomain/zero/1.0/"), nexml)
else
nexml <- add_meta(meta("dc:rights", rights), nexml)
}
if(!is.null(citation))
if(is(citation, "BibEntry"))
class(citation) = "bibentry"
if(is(citation, "bibentry"))
nexml <- add_meta(nexml_citation(citation), nexml)
else
nexml <- add_meta(meta("dcterms:bibliographicCitation", citation), nexml)
nexml
}
RNeXML/R/meta.R 0000644 0001762 0000144 00000014571 12641021656 012604 0 ustar ligges users ## Utilities for adding additional metadata
#' Constructor function for metadata nodes
#'
#' @param property specify the ontological definition together with it's namespace, e.g. dc:title
#' @param content content of the metadata field
#' @param rel Ontological definition of the reference provided in href
#' @param href A link to some reference
#' @param datatype optional RDFa field
#' @param id optional id element (otherwise id will be automatically generated).
#' @param type optional xsi:type. If not given, will use either "LiteralMeta" or "ResourceMeta" as
#' determined by the presence of either a property or a href value.
#' @param children Optional element containing any valid XML block (XMLInternalElementNode class, see the XML package for details).
#' @details User must either provide property+content or rel+href. Mixing these will result in potential garbage.
#' The datatype attribute will be detected automatically from the class of the content argument. Maps from R class
#' to schema datatypes are as follows:
#' character - xs:string,
#' Date - xs:date,
#' integer - xs:integer,
#' numeric - xs:decimal,
#' logical - xs:boolean
#'
#' @examples
#' meta(content="example", property="dc:title")
#' @export
#' @seealso \code{\link{nexml_write}}
#' @include classes.R
meta <- function(property = character(0),
content = character(0),
rel = character(0),
href = character(0),
datatype = character(0),
id = character(0),
type = character(0),
children = list()){
if(is.logical(content))
datatype <- "xsd:boolean"
else if(is(content, "Date"))
datatype <- "xsd:date"
else if(is.numeric(content))
datatype <- "xsd:decimal"
else if(is.character(content))
datatype <- "xsd:string"
else if(is.integer(content))
datatype <- "xsd:integer"
else
datatype <- "xsd:string"
# Having assigned the datatype,
# the content text must be written as a string
content <- as.character(content)
if(length(id) == 0)
id <- nexml_id("m")
if(is(children, "XMLAbstractNode") || is(children, "XMLInternalNode"))
children <- list(children)
if(length(property) > 0){ ## avoid
if(is.null(content) && length(children) == 0) ## Avoid writing when content is missing, e.g. prism:endingpage is blank
NULL
else
new("meta", content = content, datatype = datatype,
property = property, id = id, 'xsi:type' = "LiteralMeta",
children = children)
} else if(length(rel) > 0){
if(is.null(href))
NULL
else
new("meta", rel = rel, href = href,
id = id, 'xsi:type' = "ResourceMeta",
children = children)
} else {
new("meta", content = content, datatype = datatype,
rel = rel, href = href, id = id, 'xsi:type' = type,
children = children)
}
}
## Common helper functions
nexml_citation <- function(obj){
if(is(obj, "BibEntry"))
class(obj) <- "bibentry"
if(is(obj, "bibentry")){
out <- lapply(obj, function(obj){
if(length(grep("--", obj$pages)) > 0){
pgs <- strsplit(obj$pages, "--")[[1]]
start_page <- pgs[[1]]
end_page <- if(length(pgs)>1) pgs[[2]] else " "
} else if(length(grep("-", obj$pages)) > 0){
pgs <- strsplit(obj$pages, "-")[[1]]
start_page <- pgs[[1]]
end_page <- if(length(pgs)>1) pgs[[2]] else " "
} else {
start_page <- NULL
end_page <- NULL
}
list_of_metadata_nodes <- plyr::compact(c(list(
meta(content=obj$volume,
property="prism:volume"),
meta(content=obj$journal,
property="dc:publisher"),
meta(content=obj$journal,
property="prism:publicationName"),
meta(content = end_page,
property="prism:endingPage"),
meta(content=start_page,
property="prism:startingPage"),
meta(content=obj$year,
property="prism:publicationDate"),
meta(content=obj$title,
property="dc:title")),
lapply(obj$author, function(x){
meta(content = format(x, c("given", "family")),
property="dc:contributor")
})))
citation_elements = new("ListOfmeta", list_of_metadata_nodes)
meta(content=format(obj, "text"),
property="dcterms:bibliographicCitation",
children = lapply(citation_elements, as, "XMLInternalElementNode"))
})
out
}
}
#' Concatenate meta elements into a ListOfmeta
#'
#' Concatenate meta elements into a ListOfmeta
#' @param x,... meta elements to be concatenated, e.g. see \code{\link{meta}}
#' @param recursive logical, if 'recursive=TRUE', the function
#' descends through lists and combines their elements into a vector.
#' @return a listOfmeta object containing multiple meta elements.
#' @examples
#' c(meta(content="example", property="dc:title"),
#' meta(content="Carl", property="dc:creator"))
#'
setMethod("c",
signature("meta"),
function(x, ..., recursive = FALSE){
elements <- list(x, ...)
# if(recursive)
elements <- meta_recursion(elements)
new("ListOfmeta", elements)
})
#' Concatenate ListOfmeta elements into a ListOfmeta
#'
#' Concatenate ListOfmeta elements into a ListOfmeta
#' @param x,... meta or ListOfmeta elements to be concatenated, e.g. see \code{\link{meta}}
#' @param recursive logical, if 'recursive=TRUE', the function
#' descends through lists and combines their elements into a vector.
#' @return a listOfmeta object containing multiple meta elements.
#' @include classes.R
#' @examples
#' metalist <- c(meta(content="example", property="dc:title"),
#' meta(content="Carl", property="dc:creator"))
#' out <- c(metalist, metalist)
#' out <- c(metalist, meta(content="a", property="b"))
setMethod("c",
signature("ListOfmeta"),
function(x, ..., recursive = FALSE){
elements <- list(x, unlist(...))
elements <- meta_recursion(elements)
new("ListOfmeta", elements)
})
meta_recursion <- function(elements){
i <- 1
out <- vector("list")
for(e in elements){
if(length(e) > 0){
if(is(e, "meta")){
out[[i]] <- e
i <- i + 1
} else if(is.list(e)){
out <- c(out, meta_recursion(e))
i <- length(out) + 1
}
}
}
out
}
RNeXML/R/get_metadata.R 0000644 0001762 0000144 00000002500 12641022470 014255 0 ustar ligges users
## FIXME might want to define this for sub-nodes. e.g. so we can get all metadata on "nodes" in tree2...
#' get_metadata
#'
#' get_metadata
#' @param nexml a nexml object
#' @param level the name of the level of element desired, see details
#' @return the requested metadata as a data.frame. Additional columns
#' indicate tha parent element of the return value.
#' @details 'level' should be either the name of a child element of a NeXML document
#' (e.g. "otu", "characters"), or a path to the desired element, e.g. 'trees/tree'
#' will return the metadata for all phylogenies in all trees blocks.
#' @import XML
#' @examples \dontrun{
#' comp_analysis <- system.file("examples", "primates.xml", package="RNeXML")
#' nex <- nexml_read(comp_analysis)
#' get_metadata(nex)
#' get_metadata(nex, "otus/otu")
#' }
#' @export
get_metadata <- function(nexml, level = "nexml"){
# level = c("nexml", "otus", "trees", "characters",
# "otus/otu", "trees/tree", "characters/format", "characters/matrix",
# "characters/format/states")
# level <- match.arg(level)
## Handle deprecated formats
if(level =="otu")
level <- "otus/otu"
if(level =="tree")
level <- "trees/tree"
if(level == "nexml")
level <- "meta"
else
level <- paste(level, "meta", sep="/")
get_level(nexml, level)
}
RNeXML/R/nexml_write.R 0000644 0001762 0000144 00000007063 12665743025 014220 0 ustar ligges users #' Write nexml files
#'
#' @param x a nexml object, or any phylogeny object (e.g. phylo, phylo4)
#' that can be coerced into one. Can also be omitted, in which case a new
#' nexml object will be constructed with the additional parameters specified.
#' @param file the name of the file to write out
#' @param trees phylogenetic trees to add to the nexml file (if not already given in x)
#' see \code{\link{add_trees}} for details.
#' @param characters additional characters
#' @param meta A meta element or list of meta elements, see \code{\link{add_meta}}
#' @param ... additional arguments to add__basic_meta, such as the title. See \code{\link{add_basic_meta}}.
#' @return Writes out a nexml file
#' @import ape
#' @import XML
#' @import methods
#' @aliases nexml_write write.nexml
#' @export nexml_write write.nexml
#' @seealso \code{\link{add_trees}} \code{\link{add_characters}} \code{\link{add_meta}} \code{\link{nexml_read}}
#' @examples
#' ## Write an ape tree to nexml, analgous to write.nexus:
#' library(ape); data(bird.orders)
#' write.nexml(bird.orders, file="example.xml")
#'
#' \dontrun{ # takes > 5s
#' ## Assemble a nexml section by section and then write to file:
#' library(geiger)
#' data(geospiza)
#' nexml <- add_trees(geospiza$phy) # creates new nexml
#' nexml <- add_characters(geospiza$dat, nexml = nexml) # pass the nexml obj to append character data
#' nexml <- add_basic_meta(title="my title", creator = "Carl Boettiger", nexml = nexml)
#' nexml <- add_meta(meta("prism:modificationDate", format(Sys.Date())), nexml = nexml)
#'
#' write.nexml(nexml, file="example.xml")
#'
#' ## As above, but in one call (except for add_meta() call).
#' write.nexml(trees = geospiza$phy,
#' characters = geospiza$dat,
#' title = "My title",
#' creator = "Carl Boettiger",
#' file = "example.xml")
#'
#' ## Mix and match: identical to the section by section:
#' nexml <- add_meta(meta("prism:modificationDate", format(Sys.Date())))
#' write.nexml(x = nexml,
#' trees = geospiza$phy,
#' characters = geospiza$dat,
#' title = "My title",
#' creator = "Carl Boettiger",
#' file = "example.xml")
#'
#' }
nexml_write <- function(x = new("nexml"),
file = NULL,
trees = NULL,
characters = NULL,
meta = NULL,
...){
nexml <- as(x, "nexml")
if(!is.null(trees))
nexml <- add_trees(trees, nexml = nexml)
if(!is.null(characters))
nexml <- add_characters(characters, nexml = nexml)
if(!is.null(meta))
nexml <- add_meta(meta, nexml = nexml)
nexml <- do.call(add_basic_meta, c(list(...), list(nexml=nexml)))
out <- as(nexml, "XMLInternalNode")
saveXML(out, file = file)
}
write.nexml <- nexml_write
############## Promotion methods ########
## FIXME -- Coercion is not the way to go about any of this
## want generator methods that can handle id creation better
# consider:
# setMethod("promote",
# signature("tree", "character"),
# function(object, target_type)
setAs("tree", "nexml", function(from){
trees = as(from, "trees")
otus = as(from, "otus")
otus@id = "tax1" #UUIDgenerate()
trees@id = "Trees" #UUIDgenerate()
trees@otus = otus@id
new("nexml",
trees = new("ListOftrees", list(trees)),
otus = otus)
})
setAs("ListOfnode", "otus", function(from)
new("otus", otu = from))
setAs("tree", "trees", function(from)
new("trees", tree = new("ListOftree", list(from))))
RNeXML/R/deprecated.R 0000644 0001762 0000144 00000011555 12641021656 013755 0 ustar ligges users ## Some of these methods are still in use by simmap and various add_ functions.
## Ideally all would be replaced by the equivalent get_level() version
## Conversions between matrix and characters node
#' Extract the character matrix
#'
#' @param nexml nexml object (e.g. from read.nexml)
#' @param rownames_as_col option to return character matrix rownames
#' (with taxon ids) as it's own column in the data.frame. Default is FALSE
#' for compatibility with geiger and similar packages.
#' @return the list of taxa
#' @examples
#' comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
#' nex <- nexml_read(comp_analysis)
#' get_characters_list(nex)
#' @export
get_characters_list <- function(nexml, rownames_as_col=FALSE){
# extract mapping between otus and taxon ids
maps <- get_otu_maps(nexml)
# loop over all character matrices
out <- lapply(nexml@characters, function(characters){
# Make numeric data class numeric, discrete data class discrete
type <- slot(characters, 'xsi:type') # check without namespace?
if (grepl("ContinuousCells", type)) {
dat <- extract_character_matrix(characters@matrix)
dat <- otu_to_label(dat, maps[[characters@otus]])
dat <- character_to_label(dat, characters@format)
for(i in length(dat)) ## FIXME something more elegant, no?
dat[[i]] <- as.numeric(dat[[i]])
} else if (grepl("StandardCells", type)) {
dat <- extract_character_matrix(characters@matrix)
dat <- state_to_symbol(dat, characters@format)
dat <- otu_to_label(dat, maps[[characters@otus]])
dat <- character_to_label(dat, characters@format)
for(i in length(dat))
dat[[i]] <- factor(dat[[i]])
} else {
dat <- NULL
}
if(rownames_as_col){
dat <- cbind(taxa = rownames(dat), dat)
rownames(dat) <- NULL
}
dat
})
# name the character matrices by their labels,
# if available, otherwise, by id.
names(out) <- name_by_id_or_label(nexml@characters)
out
}
# for lists only
# identical_rownames <- function(x) all(sapply(lapply(x, rownames), identical, rownames(x[[1]])))
#### Subroutines (not exported) ###########
### The subroutines of "get_characters_list# function
## Fixme these could be adapted to use the get_*_maps functions
otu_to_label <- function(dat, otu_map){
rownames(dat) <- otu_map[rownames(dat)]
dat
}
character_to_label <- function(dat, format){
## Compute the mapping
map <- map_chars_to_label(format)
## replace colnames with matching labels
colnames(dat) <- map[colnames(dat)]
dat
}
state_to_symbol <- function(dat, format){
if(!isEmpty(format@states)){
map_by_char <- map_state_to_symbol(format)
for(n in names(dat)){
symbol <- map_by_char[[n]]
dat[[n]] <- symbol[dat[[n]]]
}
dat
} else {
dat ## Nothing to do if we don't have a states list
}
}
### Subroutine for characters_to_label,
### Also subroutine for get_char_map .
map_chars_to_label <- function(format){
map <- sapply(format@char, function(char){
if(length(char@label) > 0)
label <- char@label
else
label <- char@id
c(char@id, label)
})
out <- map[2,]
names(out) <- map[1,]
out
}
# Subroutine of the get_state_maps and state_to_symbol functions
#
# For each character, find the matching `states` set.
# For that set, map each state id to the state symbol
map_state_to_symbol <- function(format){
# loop over characters
map <- lapply(format@char, function(char){
# name the list with elements as `states` sets by their ids
states <- format@states
ids <- sapply(states, function(states) states@id)
names(states) <- ids
# Get the relevant states set matching the current character
map_states_to_symbols( states[[char@states]] )
})
names(map) <- name_by_id(format@char)
map
}
## Subroutine of the map_state_to_symbol function above
map_states_to_symbols <- function(states){
map <- sapply(states@state,
function(state){
if(length(state@symbol) > 0)
symbol <- state@symbol
else
symbol <- state@id
c(state@id, symbol)
})
out <- map[2, ]
names(out) <- map[1, ]
out
}
#' @import reshape2
extract_character_matrix <- function(matrix){
otu <- sapply(matrix@row, function(row) row@otu)
# charnames <- unname(sapply(matrix@row[[1]]@cell, function(cell) cell@char))
names(matrix@row) <- otu
mat <- lapply(matrix@row, function(row){
names(row@cell) <- unname(sapply(row@cell, function(b) b@char))
# names(row@cell) <- charnames
lapply(row@cell, function(cell) cell@state)
})
mat <- melt(mat)
colnames(mat) <- c("state", "character", "otu")
mat <- dcast(mat, otu ~ character, value.var = "state")
# Move otus into rownames and drop the column
rownames(mat) <- mat[["otu"]]
# mat <- mat[-1]
mat
}
RNeXML/R/add_namespaces.R 0000644 0001762 0000144 00000003551 12641021656 014601 0 ustar ligges users
#' add namespaces
#'
#' add namespaces, avoiding duplication if prefix is already defined
#' @param namespaces a named character vector of namespaces
#' @param nexml a nexml object. will create a new one if none is given.
#' @return a nexml object with updated namespaces
#' @examples
#' ## Create a new nexml object with a single metadata element:
#' modified <- meta(property = "prism:modificationDate", content = "2013-10-04")
#' nex <- add_meta(modified) # Note: 'prism' is defined in nexml_namespaces by default.
#'
#' ## Write multiple metadata elements, including a new namespace:
#' website <- meta(href = "http://carlboettiger.info",
#' rel = "foaf:homepage") # meta can be link-style metadata
#' nex <- add_meta(list(modified, website),
#' namespaces = c(foaf = "http://xmlns.com/foaf/0.1/"))
#'
#' ## Append more metadata, and specify a level:
#' history <- meta(property = "skos:historyNote",
#' content = "Mapped from the bird.orders data in the ape package using RNeXML")
#' nex <- add_meta(history,
#' nexml = nex,
#' level = "trees",
#' namespaces = c(skos = "http://www.w3.org/2004/02/skos/core#"))
#'
#' @seealso \code{\link{meta}} \code{\link{add_meta}}
#' @export
add_namespaces <- function(namespaces, nexml = new("nexml")){
if(!is.null(namespaces)){
## check for duplicated abbreviation, not for duplicated URI. OKAY to have multiple abbrs for same URI...
## FIXME Make sure that cases where abbreviation match actually match the URI as well
notdups <- match(names(namespaces), names(nexml@namespaces))
notdups <- sapply(notdups, is.na)
if(all(notdups)) # all are unique
nexml@namespaces <- c(nexml@namespaces, namespaces)
else {
nexml@namespaces <- c(nexml@namespaces, namespaces[notdups])
}
}
nexml
}
RNeXML/R/internal_nexml_id.R 0000644 0001762 0000144 00000001550 12641021656 015342 0 ustar ligges users
nexml_env = new.env(hash=TRUE)
# If no prefix is given, will use a UUID
# Generates an id number by appending a counter to the prefix
# Will keep track of the counter for each prefix for that session.
#' @import uuid
nexml_id <- function(prefix = "",
use_uuid = getOption("uuid", FALSE)){
if(use_uuid){
uid <- paste0("uuid-", UUIDgenerate())
} else {
if((prefix %in% ls(envir=nexml_env)))
id_counter <- get(prefix, envir=nexml_env)
else {
assign(prefix, 1, envir=nexml_env)
id_counter <- 1
}
uid <- paste0(prefix, id_counter)
id_counter <- id_counter + 1
assign(prefix, id_counter, envir=nexml_env)
}
uid
}
#' reset id counter
#'
#' reset the id counter
#' @export
reset_id_counter <- function(){
rm(list=ls(envir=nexml_env), envir=nexml_env)
}
# use an environment to store counter
RNeXML/R/internal_get_node_maps.R 0000644 0001762 0000144 00000002704 12641021656 016351 0 ustar ligges users # get otus map
#
# @param nexml nexml object
# @return a list showing the mapping between (internal) otu identifiers and labels (taxonomic names). List is named by the id of the otus block.
# @details largely for internal use
get_otu_maps <- function(nexml){
otus <- as.list(nexml@otus)
names(otus) <- name_by_id(otus)
otu_maps <-
lapply(otus, function(otus){ # loop over all otus nodes
taxon <- sapply(otus@otu, function(otu){ # loop over each otu in the otus set
if(length(otu@label) > 0)
label <- otu@label
else
label <- otu@id
c(otu@id, label)
})
out <- taxon[2, ] #label
names(out) <- taxon[1, ] #id
out
})
otu_maps
}
get_char_maps <- function(nexml){
map <- lapply(nexml@characters, function(characters)
map_chars_to_label(characters@format))
names(map) <- name_by_id(nexml@characters)
map
}
get_state_maps <- function(nexml){
map <- lapply(nexml@characters, function(characters){
if(!isEmpty(characters@format@states))
map_state_to_symbol(characters@format)
else
NULL
})
names(map) <- name_by_id(nexml@characters)
map
}
reverse_map <- function(map){
out <- NULL
if(is.list(map)){
out <- lapply(map,
function(x){
out <- names(x)
names(out) <- x
out})
} else if(is.character(map)) {
out <- names(map)
names(out) <- map
out
}
out
}
RNeXML/R/nexmlTree.R 0000644 0001762 0000144 00000004427 12641021656 013620 0 ustar ligges users setClass("phyloS4",
slots = c(edge = "matrix",
Nnode = "integer",
tip.label = "character",
edge.length = "numeric"))
setOldClass("phylo", S4Class="phyloS4")
# FIXME repeat selectMethod for all ape, geiger, etc methods(??)
selectMethod("show", "phylo")
removeClass("phyloS4")
setClass("nexmlTree", slots = c(nexml = "nexml"), contains="phylo")
setMethod("show", "nexmlTree", function(object) print.phylo(object))
# callNextMethod(object) ## callNextMethod might have been an option, but it looks for 'show' method, not print method??
## constructor function
nexmlTree <- function(object){
if(is(object, "nexml")){
phylo <- as(object, "phylo")
}
new("nexmlTree", nexml = object, phylo)
}
## Coercions between classes
setAs("XMLInternalElementNode", "nexmlTree", function(from)
nexmlTree(as(from, "nexml")))
setAs("nexmlTree", "XMLInternalElementNode", function(from)
as(from@nexml, "XMLInternalElementNode"))
setAs("XMLInternalNode", "nexmlTree", function(from)
nexmlTree(as(from, "nexml")))
setAs("nexmlTree", "XMLInternalNode", function(from)
as(from@nexml, "XMLInternalNode"))
setAs("phylo", "nexmlTree", function(from)
nexmlTree(as(from, "nexml")))
setAs("nexmlTree", "phylo", function(from)
as(from@nexml, "phylo"))
setAs("nexml", "nexmlTree", function(from)
nexmlTree(from))
setAs("nexmlTree", "nexml", function(from)
from@nexml)
### Testing
# a <- new("phylo", bird.orders)
# expect_is(a, "phylo")
# a
# plot(a)
#
# b <- new("nexmlTree", bird.orders, nexml = as(bird.orders, "nexml"))
# expect_is(b, "phylo")
# b
# plot(b)
#
# Some ape functions don't check class properly. i.e. class(b) == "phylo" is FALSE, but is(b, "phylo") is TRUE.
# Don't really need these, but here they are mapping between S3 and S4
setAs("phyloS4", "phylo", function(from){
out <- list(edge = from@edge,
Nnode = from@Nnode,
tip.label = from@tip.label,
edge.length = from@edge.length)
class(out) <- "phylo"
out
})
setAs("phylo", "phyloS4", function(from)
new("phyloS4",
edge = from$edge,
Nnode = from$Nnode,
tip.label = from$tip.label,
edge.length = from$edge.length))
RNeXML/R/internal_name_by_id.R 0000644 0001762 0000144 00000000504 12641021656 015627 0 ustar ligges users
## Helper functions
name_by_id <- function(x)
unname(sapply(x, function(i) if(length(i@id)>0) i@id else NULL))
name_by_id_or_label <- function(x)
unname(sapply(x, function(i) if(length(i@label)>0) i@label else i@id))
get_by_id <- function(x, id){
ids <- sapply(x, function(i) i@id)
m <- match(id, ids)
x[[m]]
}
RNeXML/R/internal_isEmpty.R 0000644 0001762 0000144 00000001174 12641021656 015177 0 ustar ligges users
isEmpty <- function (obj)
{
if (!isS4(obj)) {
if (length(obj) > 0)
FALSE
else TRUE
}
else {
if (identical(obj, new(class(obj)[1])))
out <- TRUE
else {
empty <- sapply(slotNames(obj), function(s) {
if (isS4(slot(obj, s)))
isEmpty(slot(obj, s))
else {
if (length(slot(obj, s)) == 0)
TRUE
else if (length(slot(obj, s)) > 0)
FALSE
}
})
out <- !any(!empty)
}
out
}
}
RNeXML/R/nexml_get.R 0000644 0001762 0000144 00000006224 12641021656 013634 0 ustar ligges users #' Get the desired element from the nexml object
#'
#' Get the desired element from the nexml object
#' @aliases nexml_get get_item
#' @param nexml a nexml object (from read_nexml)
#' @param element the kind of object desired, see details.
#' @param ... additional arguments, if applicable to certain elements
#' @details
#'
#' \itemize{
#' \item{"tree"}{ an ape::phylo tree, if only one tree is represented. Otherwise returns a list of lists of multiphylo trees. To consistently recieve the list of lists format (preserving the heriarchical nature of the nexml), use \code{trees} instead.}
#' \item{"trees"}{ returns a list of lists of multiphylo trees, even if all trees are in the same `trees` node (and hence the outer list will be of length 1) or if there is only a single tree (and hence the inner list will also be of length 1. This guarentees a consistent return type regardless of the number of trees present in the nexml file, and also preserves any heirarchy/grouping of trees. }
#' \item{"flat_trees"}{ a multiPhylo object (list of ape::phylo objects) Note that this method collapses any heirachical structure that may have been present as multiple `trees` nodes in the original nexml (though such a feature is rarely used). To preserve that structure, use `trees` instead.}
#' \item{"metadata"}{Get metadata from the specified level (default is top/nexml level) }
#' \item{"otu"}{ returns a named character vector containing all available metadata. names indicate \code{property} (or \code{rel} in the case of links/resourceMeta), while values indicate the \code{content} (or \code{href} for links). }
#' \item{"taxa"}{ alias for otu }
#' }
#' For a slightly cleaner interface, each of these elements is also defined as an S4 method
#' for a nexml object. So in place of `get_item(nexml, "tree")`, one could use `get_tree(nexml)`,
#' and so forth for each element type.
#' @return return type depends on the element requested. See details.
#' @export
#' @seealso \code{\link{get_trees}}
#' @include classes.R
#' @examples
#' comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
#' nex <- nexml_read(comp_analysis)
#' nexml_get(nex, "trees")
#' nexml_get(nex, "characters_list")
nexml_get <- function(nexml,
element = c("trees",
"trees_list",
"flat_trees",
"metadata",
"otu",
"taxa",
"characters",
"characters_list",
"namespaces"),
...){
element <- match.arg(element)
switch(element,
trees = get_trees(nexml), # will warn if more than one tree is available
trees_list = get_trees_list(nexml),
flat_trees = get_flat_trees(nexml),
metadata = get_metadata(nexml, ...),
otu = get_taxa(nexml),
taxa = get_taxa(nexml),
characters = get_characters(nexml),
characters_list = get_characters_list(nexml),
namespaces = get_namespaces(nexml))
}
get_item <- nexml_get
RNeXML/R/get_namespaces.R 0000644 0001762 0000144 00000000737 12641021656 014633 0 ustar ligges users
#' get namespaces
#'
#' get namespaces
#' @param nexml a nexml object
#' @return a named character vector providing the URLs defining each
#' of the namespaces used in the nexml file. Names correspond to
#' the prefix abbreviations of the namespaces.
#' @examples
#' comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
#' nex <- nexml_read(comp_analysis)
#' get_namespaces(nex)
#' @export
get_namespaces <- function(nexml){
nexml@namespaces
}
RNeXML/R/get_taxa.R 0000644 0001762 0000144 00000002166 12641021656 013447 0 ustar ligges users
#' get_taxa
#'
#' Retrieve names of all species/otus otus (operational taxonomic units) included in the nexml
#' @aliases get_taxa get_otu
#' @param nexml a nexml object
#' @return the list of taxa
#' @export get_taxa get_otu
#' @examples
#' comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
#' nex <- nexml_read(comp_analysis)
#' get_taxa(nex)
#' @seealso \code{\link{get_item}}
get_taxa <- function(nexml){
get_level(nexml, "otus/otu")
}
get_otu <- get_taxa
#' get_taxa_list
#'
#' Retrieve names of all species/otus otus (operational taxonomic units) included in the nexml
#' @aliases get_taxa_list get_otus_list
#' @param nexml a nexml object
#' @return the list of taxa
#' @export get_taxa_list get_otus_list
#' @seealso \code{\link{get_item}}
get_taxa_list <-
function(nexml){
out <- lapply(nexml@otus, function(otus){
out <- sapply(otus@otu, function(otu) otu@label)
names(out) <- name_by_id(otus@otu)
out
})
names(out) <- name_by_id(nexml@otus)
out
}
get_otus_list <- get_taxa_list
RNeXML/R/add_trees.R 0000644 0001762 0000144 00000010031 12641021656 013573 0 ustar ligges users #' add_trees
#'
#' add_trees
#' @param phy a phylo object, multiPhylo object, or list of
#' mulitPhylo to be added to the nexml
#' @param nexml a nexml object to which we should append this phylo.
#' By default, a new nexml object will be created.
#' @param append_to_existing_otus logical, indicating if we should
#' make a new OTU block (default) or append to the existing one.
#' @return a nexml object containing the phy in nexml format.
#' @export
#' @examples
#' library("geiger")
#' data(geospiza)
#' geiger_nex <- add_trees(geospiza$phy)
add_trees <- function(phy,
nexml=new("nexml"),
append_to_existing_otus=FALSE){
nexml <- as(nexml, "nexml")
phy <- standardize_phylo_list(phy)
## handle multiPhlyo cases
new_taxa <- unlist(sapply(phy, function(y)
sapply(y, function(z)
z$tip.label)))
nexml <- add_otu(nexml, new_taxa, append=append_to_existing_otus)
otus_id <- nexml@otus[[length(nexml@otus)]]@id
nexml <- add_trees_block(nexml, phy, otus_id)
nexml
}
##################### phylo -> nexml ###############
setAs("phylo", "nexml", function(from){
add_trees(from)
})
setAs("multiPhylo", "nexml", function(from){
add_trees(from)
})
standardize_phylo_list <- function(phy){
if(is(phy, "list") &&
(is(phy[[1]], "list") || is(phy[[1]], "multiPhylo")) &&
is(phy[[1]][[1]], "phylo")){
phy
} else if(is(phy, "multiPhylo") || (is(phy, "list") && is(phy[[1]], "phylo"))) {
list(phy)
} else if(is(phy, "phylo")) {
phy <- list(phy)
class(phy) <- "multiPhylo"
list(phy)
} else {
# desperate
phy <- list(as(phy, "phylo"))
class(phy) <- "multiPhylo"
list(phy)
}
}
add_trees_block <- function(nexml, phy, otus_id){
phy <- standardize_phylo_list(phy)
## all trees will use the same
otu_map <- reverse_map(get_otu_maps(nexml))[[otus_id]]
trees <- lapply(phy, function(trs){
tree_id <- nexml_id("ts")
new("trees",
id = tree_id,
about = paste0("#", tree_id),
otus = otus_id,
tree = new("ListOftree",
lapply(trs, function(tr)
fromPhylo(tr, otu_map)))
)
})
## Append to any existing trees nodes
nexml@trees <- new("ListOftrees", c(nexml@trees, trees))
nexml
}
# Main routine to generate NeXML from ape:phylo
fromPhylo <- function(phy, otu_map){
node_ids <- sapply(unique(as.numeric(phy$edge)),
function(i) nexml_id("n"))
names(node_ids) <- as.character(unique(as.numeric(phy$edge)))
## Generate the "ListOfedge" made of "edge" objects
edges <-
lapply(1:dim(phy$edge)[1],
function(i){
edge_id <- nexml_id("e")
source <- node_ids[as.character(phy$edge[i,1])]
target <- node_ids[as.character(phy$edge[i,2])]
e <- new("edge",
source = source,
target = target,
id = edge_id,
about = paste0("#", edge_id))
if(!is.null(phy$edge.length))
e@length <- as.numeric(phy$edge.length[i])
e
}
)
edges <- new("ListOfedge", edges)
## Generate the ListOfnode made of "node" objects
## In doing so, generate otu_id numbers for tip nodes
nodes <- lapply(unique(as.numeric(phy$edge)), function(i){
node_id <- node_ids[as.character(i)]
if(is.na(phy$tip.label[i]))
new("node", id = node_id, about = paste0("#", node_id))
else if(is.character(phy$tip.label[i])){
otu_id <- otu_map[phy$tip.label[i]]
new("node",
id = node_id,
about = paste0("#", node_id),
otu = otu_id)
}
})
## FIXME how about naming non-tip labels?
nodes <- new("ListOfnode", nodes)
## Create the "tree" S4 object
tree_id <- nexml_id("tree")
tree <- new("tree",
node = nodes,
edge = edges,
'xsi:type' = 'FloatTree',
id = tree_id,
about = paste0("#", tree_id))
}
RNeXML/R/character_classes.R 0000644 0001762 0000144 00000034472 12641021656 015331 0 ustar ligges users #' @include classes.R
####################################################
setClass("char",
slots = c(states = "character"),
contains = "IDTagged")
setMethod("fromNeXML",
signature("char", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
if(!is.na(xmlAttrs(from)["states"]))
obj@states <- xmlAttrs(from)["states"]
obj
})
setMethod("toNeXML",
signature("char", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
if(length(object@states) > 0)
addAttributes(parent, "states" = object@states)
parent
})
setAs("char", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("char")))
setAs("char", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("char")))
setAs("XMLInternalElementNode", "char",
function(from) fromNeXML(new("char"), from))
###############################################
setClass("ListOfrow", slots = c(names="character"), contains="list")
setClass("obsmatrix",
slots = c(row="ListOfrow"),
contains = "Annotated")
setMethod("fromNeXML",
signature("obsmatrix", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
kids <- xmlChildren(from)
if(length(kids) > 0)
obj@row <- new("ListOfrow",
lapply(kids[names(kids) == "row"],
as, "row"))
obj
})
setMethod("toNeXML",
signature("obsmatrix", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addChildren(parent, kids = object@row)
parent
})
setAs("obsmatrix", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("matrix")))
setAs("obsmatrix", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("matrix")))
setAs("XMLInternalElementNode", "obsmatrix",
function(from) fromNeXML(new("obsmatrix"), from))
######################################################
setClass("ListOfcell", slots = c(names="character"), contains="list")
setClass("ListOfseq", slots = c(names="character"), contains="list")
setClass("row",
slots = c(cell = "ListOfcell",
seq = "ListOfseq"),
contains = "OptionalTaxonLinked")
setMethod("fromNeXML",
signature("row", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
kids <- xmlChildren(from)
if(length(kids) > 0){
if("cell" %in% names(kids))
obj@cell <- new("ListOfcell",
lapply(kids[names(kids) == "cell"], as, "cell"))
if("seq" %in% names(kids))
obj@seq <- new("ListOfseq",
lapply(kids[names(kids) == "seq"], as, "seq"))
}
obj
})
setMethod("toNeXML",
signature("row", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addChildren(parent, kids = object@cell)
addChildren(parent, kids = object@seq)
parent
})
setAs("row", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("row")))
setAs("row", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("row")))
setAs("XMLInternalElementNode", "row",
function(from) fromNeXML(new("row"), from))
#######################################################
setClass("ListOfstate", slots = c(names="character"), contains="list")
setClass("ListOfpolymorphic_state_set", slots = c(names="character"), contains="list")
setClass("ListOfuncertain_state_set", slots = c(names="character"), contains="list")
setClass("states",
slots = c(state="ListOfstate",
polymorphic_state_set="ListOfpolymorphic_state_set",
uncertain_state_set="ListOfuncertain_state_set"),
contains = "IDTagged")
setMethod("fromNeXML",
signature("states", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
kids <- xmlChildren(from)
if(length(kids) > 0){
obj@state <- new("ListOfstate",
lapply(kids[names(kids) == "state"],
as, "state"))
obj@polymorphic_state_set <- new("ListOfpolymorphic_state_set",
lapply(kids[names(kids) == "polymorphic_state_set"],
as, "polymorphic_state_set"))
obj@uncertain_state_set <- new("ListOfuncertain_state_set",
lapply(kids[names(kids) == "uncertain_state_set"],
as, "uncertain_state_set"))
}
obj
})
setMethod("toNeXML",
signature("states", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addChildren(parent, kids = object@state)
parent
})
setAs("states", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("states")))
setAs("states", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("states")))
setAs("XMLInternalElementNode", "states",
function(from) fromNeXML(new("states"), from))
#######################################################
## technically symbol is positive integer http://nexml.org/doc/schema-1/characters/standard/#StandardToken
setClass("state",
slots = c(symbol = "integer"),
contains = "IDTagged")
setMethod("fromNeXML",
signature("state", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
obj@symbol <- as.integer(xmlAttrs(from)["symbol"])
obj
})
setMethod("toNeXML",
signature("state", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addAttributes(parent, "symbol" = object@symbol)
parent
})
setAs("state", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("state")))
setAs("state", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("state")))
setAs("XMLInternalElementNode", "state",
function(from) suppressWarnings(fromNeXML(new("state"), from)))
################################################
setClass("ListOfmember", slots = c(names="character"), contains="list")
setClass("uncertain_state_set",
slots = c(member = "ListOfmember"),
contains="state")
setMethod("fromNeXML",
signature("uncertain_state_set", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
kids <- xmlChildren(from)
if(length(kids) > 0)
obj@member <- new("ListOfmember",
lapply(kids[names(kids) == "member"],
as, "member"))
obj
})
setMethod("toNeXML",
signature("uncertain_state_set", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addChildren(parent, kids = object@member)
parent
})
setAs("uncertain_state_set", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("uncertain_state_set")))
setAs("uncertain_state_set", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("uncertain_state_set")))
setAs("XMLInternalElementNode", "uncertain_state_set",
function(from) fromNeXML(new("uncertain_state_set"), from))
################################################
setClass("polymorphic_state_set", contains="uncertain_state_set")
setMethod("fromNeXML",
signature("polymorphic_state_set", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
kids <- xmlChildren(from)
if(length(kids) > 0)
obj@member <- new("ListOfmember",
lapply(kids[names(kids) == "member"],
as, "member"))
obj
})
setMethod("toNeXML",
signature("polymorphic_state_set", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addChildren(parent, kids = object@member)
parent
})
setAs("polymorphic_state_set", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("polymorphic_state_set")))
setAs("polymorphic_state_set", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("polymorphic_state_set")))
setAs("XMLInternalElementNode", "polymorphic_state_set",
function(from) fromNeXML(new("polymorphic_state_set"), from))
#####################
setClass("cell",
slots = c(char="character",
state= "character"),
contains="Base")
setMethod("fromNeXML",
signature("cell", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
obj@char <- xmlAttrs(from)["char"]
obj@state <- xmlAttrs(from)["state"]
obj
})
setMethod("toNeXML",
signature("cell", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addAttributes(parent, "char" = object@char)
addAttributes(parent, "state" = object@state)
parent
})
setAs("cell", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("cell")))
setAs("cell", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("cell")))
setAs("XMLInternalElementNode", "cell",
function(from) fromNeXML(new("cell"), from))
#########################
setClass("member",
slots = c(state="character"),
contains="Base")
setMethod("fromNeXML",
signature("member", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
obj@state <- xmlAttrs(from)["state"]
obj
})
setMethod("toNeXML",
signature("member", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addAttributes(parent, "state" = object@state)
parent
})
setAs("member", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("member")))
setAs("member", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("member")))
setAs("XMLInternalElementNode", "member",
function(from) fromNeXML(new("member"), from))
########################
setClass("seq",
slots = c(seq = "character"),
contains="Base")
setMethod("fromNeXML",
signature("seq", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
obj@seq <- xmlValue(from)
obj
}
)
setMethod("toNeXML",
signature("seq", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
addChildren(parent, object@seq)
parent
})
setAs("seq", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("seq")))
setAs("seq", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("seq")))
setAs("XMLInternalElementNode", "seq",
function(from) fromNeXML(new("seq"), from))
#########################################
setClass("ListOfchar", slots = c(names="character"), contains="list")
setClass("ListOfstates", slots = c(names="character"), contains="list")
setClass("format",
slots = c(states = "ListOfstates", ## FIXME Should be ListOfstates
char = "ListOfchar"),
contains = "Annotated")
setMethod("fromNeXML",
signature("format", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
kids <- xmlChildren(from)
if(length(kids) > 0){
if("char" %in% names(kids))
obj@char <- new("ListOfchar",
lapply(kids[names(kids) == "char"],
as, "char"))
if("states" %in% names(kids))
obj@states <- new("ListOfstates",
lapply(kids[names(kids) == "states"],
as, "states"))
}
obj
})
setMethod("toNeXML",
signature("format", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
if(!isEmpty(object@char))
addChildren(parent, kids = object@char)
if(length(object@states) > 0)
addChildren(parent, kids = object@states)
parent
})
setAs("format", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("format")))
setAs("format", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("format")))
setAs("XMLInternalElementNode", "format",
function(from) fromNeXML(new("format"), from))
####################################################
setClass("characters",
slots = c(format = "format",
matrix = "obsmatrix"),
contains = "TaxaLinked")
setMethod("fromNeXML",
signature("characters", "XMLInternalElementNode"),
function(obj, from){
obj <- callNextMethod()
obj@format <- as(from[["format"]], "format")
obj@matrix <- as(from[["matrix"]], "obsmatrix")
obj
})
setMethod("toNeXML",
signature("characters", "XMLInternalElementNode"),
function(object, parent){
parent <- callNextMethod()
parent <- addChildren(parent, format = object@format)
parent <- addChildren(parent, matrix = object@matrix)
parent
})
setAs("characters", "XMLInternalNode",
function(from) toNeXML(from, newXMLNode("characters")))
setAs("characters", "XMLInternalElementNode",
function(from) toNeXML(from, newXMLNode("characters")))
setAs("XMLInternalElementNode", "characters",
function(from) fromNeXML(new("characters"), from))
RNeXML/R/tbl_df.R 0000644 0001762 0000144 00000000054 12731606043 013076 0 ustar ligges users `$.tbl_df` <- function(x, i) .subset2(x, i)
RNeXML/R/nexml_read.R 0000644 0001762 0000144 00000003473 12731606043 013772 0 ustar ligges users #' Read NeXML files into various R formats
#'
#' @param x Path to the file to be read in. Or an \code{\link[XML]{XMLInternalDocument-class}}
#' or \code{\link[XML]{XMLInternalNode-class}}
#' @param ... Further arguments passed on to \code{\link[XML]{xmlParse}}
#' @import XML
#' @import httr
#' @aliases nexml_read read.nexml
#' @export nexml_read read.nexml
#' @examples
#' # file
#' f <- system.file("examples", "trees.xml", package="RNeXML")
#' nexml_read(f)
#' \dontrun{ # may take > 5 s
#' # url
#' url <- "https://raw.githubusercontent.com/ropensci/RNeXML/master/inst/examples/trees.xml"
#' nexml_read(url)
#' # character string of XML
#' str <- paste0(readLines(f), collapse = "")
#' nexml_read(str)
#' # XMLInternalDocument
#' library("httr")
#' library("XML")
#' x <- xmlParse(content(GET(url)))
#' nexml_read(x)
#' # XMLInternalNode
#' nexml_read(xmlRoot(x))
#' }
nexml_read <- function(x, ...) {
UseMethod("nexml_read")
}
#' @export
#' @rdname nexml_read
nexml_read.character <- function(x, ...) {
if (!any(grepl("^https?://", x),
XML::isXMLString(x),
file.exists(x))) {
stop("character input must be a URL, xml string or file path", call. = FALSE)
}
# handle remote paths using httr::GET
if (grepl("^https?://", x)) {
tmp <- GET(x)
stop_for_status(tmp)
x <- content(tmp, as = "text")
}
doc <- xmlParse(x, ...)
output <- as(xmlRoot(doc), "nexml")
free(doc) # explicitly free the pointers after conversion into S4
return(output)
}
#' @export
#' @rdname nexml_read
nexml_read.XMLInternalDocument <- function(x, ...) {
as(xmlRoot(x), "nexml")
}
#' @export
#' @rdname nexml_read
nexml_read.XMLInternalNode <- function(x, ...) {
as(x, "nexml")
}
setAs("XMLInternalNode", "phylo", function(from)
as(as(from, "nexml"), "phylo")
)
read.nexml <- nexml_read
RNeXML/R/concatenate_nexml.R 0000644 0001762 0000144 00000003524 12641021656 015341 0 ustar ligges users
#' Concatenate nexml files
#'
#' Concatenate nexml files
#' @param x,... nexml objects to be concatenated, e.g. from
#' \code{\link{write.nexml}} or \code{\link{read.nexml}}.
#' Must have unique ids on all elements
#' @param recursive logical. If 'recursive = TRUE', the function recursively
#' descends through lists (and pairlists) combining all their
#' elements into a vector. (Not implemented).
#' @return a concatenated nexml file
#' @examples
#' \dontrun{
#' f1 <- system.file("examples", "trees.xml", package="RNeXML")
#' f2 <- system.file("examples", "comp_analysis.xml", package="RNeXML")
#' nex1 <- read.nexml(f1)
#' nex2 <- read.nexml(f2)
#' nex <- c(nex1, nex2)
#' }
setMethod("c",
signature("nexml"),
function(x, ..., recursive = FALSE){
elements = list(x, ...)
nexml <- new("nexml")
## Check that ids are unique
if(!do.call(unique_ids,elements))
stop("ids are not unique across nexml files.
Consider regenerating ids")
else {
nexml@otus <- new("ListOfotus",
unlist(lapply(elements,
function(n) n@otus),
recursive=FALSE))
nexml@characters <- new("ListOfcharacters",
unlist(lapply(elements,
function(n) n@characters),
recursive=FALSE))
nexml@trees <- new("ListOftrees",
unlist(lapply(elements,
function(n) n@trees),
recursive=FALSE))
}
nexml
})
get_ids <- function(nexml){
doc <- xmlDoc(as(nexml, "XMLInternalNode"))
out <- unname(xpathSApply(doc, "//@id"))
free(doc)
out
}
unique_ids <- function(...){
set <- list(...)
counts <- table(unlist(lapply(set, get_ids)))
!any(counts > 1)
}
RNeXML/R/nexml_add.R 0000644 0001762 0000144 00000002270 12641021656 013602 0 ustar ligges users
#' add elements to a new or existing nexml object
#'
#' add elements to a new or existing nexml object
#' @param x the object to be added
#' @param nexml an existing nexml object onto which the object should be appended
#' @param type the type of object being provided.
#' @param ... additional optional arguments to the add functions
#'
#' @return a nexml object with the additional data
#' @seealso \code{\link{add_trees}} \code{\link{add_characters}} \code{\link{add_meta}} \code{\link{add_namespaces}}
#' @export
#' @examples
#' library("geiger")
#' data(geospiza)
#' geiger_nex <- nexml_add(geospiza$phy, type="trees")
#' geiger_nex <- nexml_add(geospiza$dat, nexml = geiger_nex, type="characters")
nexml_add <- function(x,
nexml = new("nexml"),
type = c("trees",
"characters",
"meta",
"namespaces"),
...){
switch(type,
"trees" = add_trees(x, nexml, ...),
"characters" = add_characters(x, nexml, ...),
"metadata" = add_meta(x, nexml, ...),
"namespaces" = add_namespaces(x, nexml, ...))
}
RNeXML/R/get_basic_metadata.R 0000644 0001762 0000144 00000002377 12641021656 015437 0 ustar ligges users
## Goodness, but XPATH is so much more expressive for this purpose...
## get all top-level metadata More extensible than hardwired functions
## The following methods are somewhat too rigid. Might make more sense to do get_metadata(nexml, "nexml")["dc:creator"], etc.
## Note that we define our namespace prefixes explicitly, so that should the NeXML use a different abberivation, this should still work.
#' get_citation
#'
#' get_citation
#' @param nexml a nexml object
#' @return the list of taxa
#' @export
get_citation <- function(nexml){
b <- setxpath(as(nexml, "XMLInternalElementNode"))
## FIXME should return a citation class nexml!
cat(unname(xpathSApply(b, "/nexml/meta[@property='dcterms:bibliographicCitation']/@content", namespaces = nexml_namespaces)))
}
#' get_license
#'
#' get_license
#' @param nexml a nexml object
#' @return the list of taxa
#' @export
get_license <-
function(nexml){
b <- setxpath(as(nexml, "XMLInternalElementNode"))
dc_rights <- unname(xpathSApply(b, "/nexml/meta[@property='dc:rights']/@content", namespaces = nexml_namespaces))
cc_license <- unname(xpathSApply(b, "/nexml/meta[@rel='cc:license']/@href", namespaces = nexml_namespaces))
if(length(dc_rights) > 0)
dc_rights
else
cc_license
}
RNeXML/R/taxize_nexml.R 0000644 0001762 0000144 00000002333 12641021656 014356 0 ustar ligges users
#' taxize nexml
#'
#' Check taxanomic names against the specified service and
#' add appropriate semantic metadata to the nexml OTU unit
#' containing the corresponding identifier.
#' @param nexml a nexml object
#' @param type the name of the identifier to use
#' @param ... additional arguments (not implemented yet)
#' @import taxize
#' @export
#' @examples \dontrun{
#' data(bird.orders)
#' birds <- add_trees(bird.orders)
#' birds <- taxize_nexml(birds, "NCBI")
#' }
taxize_nexml <- function(nexml, type = c("NCBI"), ...){
type <- match.arg(type)
if(type == "NCBI"){
for(j in 1:length(nexml@otus)){
for(i in 1:length(nexml@otus[[j]]@otu)){
id <- get_uid(nexml@otus[[j]]@otu[[i]]@label)
if(is.na(id))
warning(paste("ID for otu", nexml@otus[[j]]@otu[[i]]@label, "not found. Consider checking the spelling or alternate classification"))
else
nexml@otus[[j]]@otu[[i]]@meta <- new("ListOfmeta", list(
meta(href = paste0("http://ncbi.nlm.nih.gov/taxonomy/", id),
rel = "tc:toTaxon")))
}
}
}
nexml
}
RNeXML/R/get_taxa_meta.R 0000644 0001762 0000144 00000003634 12641021656 014456 0 ustar ligges users ### TODO: how to deal with missing meta slot elements???
### Right now the functions break when an otu doesn't have meta slot
#' get_taxa_meta
#'
#' Retrieve metadata of all species/otus otus (operational taxonomic units) included in the nexml
#' @param nexml a nexml object
#' @param what One of href, rel, id, or xsi:type
#' @return the list of metadata for each taxon
#' @seealso \code{\link{get_item}}
#' @keywords internal
#' @examples
#' \dontrun{
#' data(bird.orders)
#' birds <- add_trees(bird.orders)
#' birds <- taxize_nexml(birds, "NCBI")
#' RNeXML:::get_taxa_meta(birds)
#' RNeXML:::get_taxa_meta(birds, 'rel')
#' RNeXML:::get_taxa_meta(birds, 'id')
#' RNeXML:::get_taxa_meta(birds, 'xsi:type')
#' }
get_taxa_meta <-
function(nexml, what='href'){
out <- lapply(nexml@otus, function(otus)
# sapply(otus@otu, function(otu) slot(otu@meta, what)))
sapply(otus@otu, function(otu) slot(otu@meta[[1]], what)))
unname(unlist(out, recursive = FALSE))
}
get_otu_meta <- get_taxa_meta
#' get_taxa_meta_list
#'
#' Retrieve metadata of all species/otus otus (operational taxonomic units) included in the nexml
#' @param nexml a nexml object
#' @param what One of href, rel, id, or xsi:type
#' @return the list of metadata for each taxon
#' @seealso \code{\link{get_item}}
#' @keywords internal
#' @examples \dontrun{
#' data(bird.orders)
#' birds <- add_trees(bird.orders)
#' birds <- taxize_nexml(birds, "NCBI")
#' RNeXML:::get_taxa_meta_list(birds)
#' RNeXML:::get_taxa_meta_list(birds, 'rel')
#' RNeXML:::get_taxa_meta_list(birds, 'id')
#' RNeXML:::get_taxa_meta_list(birds, 'xsi:type')
#' }
get_taxa_meta_list <-
function(nexml, what='href'){
out <- lapply(nexml@otus, function(otus){
out <- sapply(otus@otu, function(otu) slot(otu@meta[[1]], what))
names(out) <- name_by_id(otus@otu)
out
})
names(out) <- name_by_id(nexml@otus)
out
}
get_otu_meta_list <- get_taxa_meta_list
RNeXML/R/nexml_validate.R 0000644 0001762 0000144 00000004302 12731606043 014640 0 ustar ligges users ONLINE_VALIDATOR <- "http://162.13.187.155/nexml/phylows/validator"
CANONICAL_SCHEMA <- "http://162.13.187.155/nexml/xsd/nexml.xsd"
#ONLINE_VALIDATOR <- "http://www.nexml.org/nexml/phylows/validator"
#CANONICAL_SCHEMA <- "http://www.nexml.org/2009/nexml.xsd"
#' validate nexml using the online validator tool
#' @param file path to the nexml file to validate
#' @param schema URL of schema (for fallback method only, set by default).
#' @details Requires an internet connection. see http://www.nexml.org/nexml/phylows/validator for more information in debugging invalid files
#' @return TRUE if the file is valid, FALSE or error message otherwise
#' @export
#' @import httr XML
#' @examples \dontrun{
#' data(bird.orders)
#' birds <- nexml_write(bird.orders, "birds_orders.xml")
#' nexml_validate("birds_orders.xml")
#' unlink("birds_orders.xml") # delete file to clean up
#' }
nexml_validate <- function(file, schema=CANONICAL_SCHEMA){
a = POST(ONLINE_VALIDATOR, body=list(file = upload_file(file)))
if(a$status_code %in% c(200,201)){
TRUE
} else if(a$status_code == 504){
warning("Online validator timed out, trying schema-only validation.")
nexml_schema_validate(file, schema=schema)
} else if(a$status_code == 400){
warning(paste("Validation failed, error messages:",
xpathSApply(htmlParse(content(a, "text")),
"//li[contains(@class, 'error') or contains(@class, 'fatal')]", xmlValue)
))
FALSE
} else {
warning(paste("Unable to reach validator. status code:", a$status_code, ". Message:\n\n", content(a, "text")))
NULL
}
}
nexml_schema_validate <- function(file, schema=CANONICAL_SCHEMA){
a = GET(schema)
if(a$status_code == 200){
if(is.null(xmlSchemaParse(schema))){
warning(paste("Schema not accessible at", schema))
NULL
} else {
result <- xmlSchemaValidate(schema, file)
if(length(result$errors) == 0){
TRUE
} else {
warning(paste(result$errors))
FALSE
}
}
} else {
warning("Unable to obtain schema, couldn't validate")
NULL
}
}
#xmlSchemaValidate(xmlSchemaParse(content(a, "text"), asText=TRUE), file) # fails to get other remote resources
RNeXML/vignettes/ 0000755 0001762 0000144 00000000000 12734542424 013336 5 ustar ligges users RNeXML/vignettes/metadata.Rmd 0000644 0001762 0000144 00000016750 12641021656 015567 0 ustar ligges users ---
title: "Handling Metadata in RNeXML"
author:
- Carl Boettiger
- Scott Chamberlain
- Rutger Vos
- Hilmar Lapp
output: html_vignette
---
```{r compile-settings, include=FALSE}
library("methods")
library("knitr")
opts_chunk$set(tidy = FALSE, warning = FALSE, message = FALSE,
cache = FALSE, comment = NA, verbose = TRUE)
basename <- gsub(".Rmd", "", knitr:::knit_concord$get('infile'))
```
## Writing NeXML metadata
The `add_basic_meta()` function takes as input an existing `nexml` object
(like the other `add_` functions, if none is provided it will create one), and at the time
of this writing any of the following
parameters: `title`, `description`, `creator`, `pubdate`, `rights`, `publisher`,
`citation`. Other metadata elements and corresponding parameters may
be added in the future.
Load the packages and data:
```{r}
library('RNeXML')
data(bird.orders)
```
Create an `nexml` object for the phylogeny `bird.orders` and add appropriate metadata:
```{r}
birds <- add_trees(bird.orders)
birds <- add_basic_meta(
title = "Phylogeny of the Orders of Birds From Sibley and Ahlquist",
description = "This data set describes the phylogenetic relationships of the
orders of birds as reported by Sibley and Ahlquist (1990). Sibley
and Ahlquist inferred this phylogeny from an extensive number of
DNA/DNA hybridization experiments. The ``tapestry'' reported by
these two authors (more than 1000 species out of the ca. 9000
extant bird species) generated a lot of debates.
The present tree is based on the relationships among orders. The
branch lengths were calculated from the values of Delta T50H as
found in Sibley and Ahlquist (1990, fig. 353).",
citation = "Sibley, C. G. and Ahlquist, J. E. (1990) Phylogeny and
classification of birds: a study in molecular evolution. New
Haven: Yale University Press.",
creator = "Sibley, C. G. and Ahlquist, J. E.",
nexml=birds)
```
Instead of a literal string, citations can also be provided in R's
`bibentry` type, which is the one in which R package citations are obtained:
```{r}
birds <- add_basic_meta(citation = citation("ape"), nexml = birds)
```
## Taxonomic identifiers
The `taxize_nexml()` function uses the R package `taxize`
[@Chamberlain_2013] to check each taxon label against the NCBI database.
If a unique match is found, a metadata annotation is added to the taxon
providing the NCBI identification number to the taxonomic unit.
```{r message=FALSE, results='hide'}
birds <- taxize_nexml(birds, "NCBI")
```
If no match is found, the user is warned to check for possible typographic
errors in the taxonomic labels provided. If multiple matches are found,
the user will be prompted to choose between them.
## Custom metadata extensions
We can get a list of namespaces along with their prefixes from the `nexml` object:
```{r}
prefixes <- get_namespaces(birds)
prefixes["dc"]
```
We create a `meta` element containing this annotation using the `meta` function:
```{r}
modified <- meta(property = "prism:modificationDate", content = "2013-10-04")
```
We can add this annotation to our existing `birds` NeXML file using the
`add_meta()` function. Because we do not specify a level, it is added to
the root node, referring to the NeXML file as a whole.
```{r}
birds <- add_meta(modified, birds)
```
The built-in vocabularies are just the tip of the iceberg of established
vocabularies. Here we add an annotation from the `skos` namespace which
describes the history of where the data comes from:
```{r}
history <- meta(property = "skos:historyNote",
content = "Mapped from the bird.orders data in the ape package using RNeXML")
```
Because `skos` is not in the current namespace list, we add it with a
url when adding this meta element. We also specify that this annotation
be placed at the level of the `trees` sub-node in the NeXML file.
```{r}
birds <- add_meta(history,
birds,
level = "trees",
namespaces = c(skos = "http://www.w3.org/2004/02/skos/core#"))
```
For finer control of the level at which a `meta` element is added,
we will manipulate the `nexml` R object directly using S4 sub-setting,
as shown in the supplement.
Much richer metadata annotation is possible. Later we illustrate how
metadata annotation can be used to extend the base NeXML format to
represent new forms of data while maintaining compatibility with any
NeXML parser. The `RNeXML` package can be easily extended to support
helper functions such as `taxize_nexml` to add additional metadata
without imposing a large burden on the user.
## Reading NeXML metadata
A call to the `nexml` object prints some metadata summarizing the data structure:
```{r }
birds
```
We can extract all metadata pertaining to the NeXML document as a whole
(annotations of the XML root node, ``) with the command
```{r}
meta <- get_metadata(birds)
```
This returns a data.frame of available metadata. We can see the kinds
of metadata recorded from the names:
```{r}
meta
```
We can also access a table of taxonomic metadata:
```{r get_taxa}
get_taxa(birds)
```
Which returns text from the otu element labels, typically used to define
taxonomic names, rather than text from explicit meta elements.
We can also access metadata at a specific level (or use `level=all`
to extract all meta elements in a list). Here we show only the first
few results:
```{r}
otu_meta <- get_metadata(birds, level="otus/otu")
otu_meta
```
## Merging metadata tables
We often want to combine metadata from multiple tables. For instance, in this exercise we want to include the taxonomic identifier and id value for each species returned in the character table. This helps us more precisely identify the species whose traits are described by the table.
```{r}
library("RNeXML")
library("dplyr")
library("geiger")
knitr::opts_chunk$set(message = FALSE, warning=FALSE, comment = NA)
```
To begin, let's generate a `NeXML` file using the tree and trait data from the `geiger` package's "primates" data:
```{r}
data("primates")
add_trees(primates$phy) %>%
add_characters(primates$dat, ., append=TRUE) %>%
taxize_nexml() -> nex
```
(Note that we've used `dplyr`'s cute pipe syntax, but unfortunately our `add_` methods take the `nexml` object as the _second_
argument instead of the first, so this isn't as elegant since we need the stupid `.` to show where the piped output should go...)
We now read in the three tables of interest. Note that we tell `get_characters` to give us species labels as there own column, rather than as rownames. The latter is the default only because this plays more nicely with the default format for character matrices that is expected by `geiger` and other phylogenetics packages, but is in general a silly choice for data manipulation.
```{r}
otu_meta <- get_metadata(nex, "otus/otu")
taxa <- get_taxa(nex)
char <- get_characters(nex, rownames_as_col = TRUE)
```
We can take a peek at what the tables look like, just to orient ourselves:
```{r}
otu_meta
taxa
head(char)
```
Now that we have nice `data.frame` objects for all our data, it's easy to join them into the desired table with a few obvious `dplyr` commands:
```{r}
taxa %>%
left_join(char, by = c("label" = "taxa")) %>%
left_join(otu_meta, by = "otu") %>%
select(otu, label, x, href)
```
Because these are all from the same otus block anyway, we haven't selected that column, but were it of interest it is also available in the taxa table.
RNeXML/vignettes/simmap.Rmd 0000644 0001762 0000144 00000015455 12641021656 015276 0 ustar ligges users ---
title: "Extending NeXML: an example based on simmap"
author:
- Carl Boettiger
- Scott Chamberlain
- Rutger Vos
- Hilmar Lapp
output: html_vignette
bibliography: references.bib
---
```{r compile-settings, include=FALSE}
library("methods")
library("knitr")
opts_chunk$set(tidy = FALSE, warning = FALSE, message = FALSE,
cache = FALSE, comment = NA, verbose = TRUE)
basename <- gsub(".Rmd", "", knitr:::knit_concord$get('infile'))
library("RNeXML")
```
## Extending the NeXML standard through metadata annotation.
Here we illustrate this process using the example of stochastic character
mapping [@Huelsenbeck_2003]. A stochastic character map is simply
an annotation of the branches on a phylogeny, assigning each section
of each branch to a particular "state" (typically of a morphological
characteristic).
@Bollback_2006 provides a widely used stand-alone software implementation
of this method in the software `simmap`, which modified the standard
Newick tree format to express this additional information. This can
break compatibility with other software, and creates a format that
cannot be interpreted without additional information describing this
convention. By contrast, the NeXML extension is not only backwards
compatible but contains a precise and machine-readable description of
what it is encoding.
In this example, we illustrate how the additional information required
to define a stochastic character mapping (a `simmap` mapping) in NeXML.
@Revell_2012 describes the `phytools` package for R, which includes
utilities for reading, manipulating, and writing `simmap` files in R.
In this example, we also show how to define `RNeXML` functions that
map the R representation used by Revell (an extension of the `ape` class)
into the NeXML extension we have defined by using `RNeXML` functions.
Since a stochastic character map simply assigns different states to
parts of a branch (or edge) on the phylogenetic tree, we can create
a NeXML representation by annotating the `edge` elements with appropriate
`meta` elements. These elements need to describe the character state
being assigned and the duration (in terms of branch-length) that the edge
spends in that state (Stochastic character maps are specific to time-calibrated
or ultrametric trees).
NeXML already defines the `characters` element to handle discrete character traits (`nex:char`)
and the states they can assume (`nex:state`). We will thus reuse the `characters` element for
this purpose, referring to both the character trait and the states by the ids assigned to them
in that element. (NeXML's convention of referring to everything by id permits a single canonical
definition of each term, making it clear where additional annotation belongs). For each edge, we
need to indicate:
- That our annotation contains a stochastic character mapping reconstruction
- Since many reconstructions are possible for a single edge, we give each reconstruction an id
- We indicate for which character trait we are defining the reconstruction
- We then indicate which states the character assumes on that edge.
For each state realized on the edge, that involves stating:
+ the state assignment
+ the duration (length of time) for which the edge spends in the given state
+ the order in which the state changes happen (Though we could just assume
state transitions are listed chronologically, NeXML suggests making all
data explicit, rather than relying on the structure of the data file to
convey information).
Thus the annotation for an edge that switches from state `s2` to state
`s1` of character `cr1` would be constructed like this:
```{r}
m <- meta("simmap:reconstructions", children = c(
meta("simmap:reconstruction", children = c(
meta("simmap:char", "cr1"),
meta("simmap:stateChange", children = c(
meta("simmap:order", 1),
meta("simmap:length", "0.2030"),
meta("simmap:state", "s2"))),
meta("simmap:char", "cr1"),
meta("simmap:stateChange", children = c(
meta("simmap:order", 2),
meta("simmap:length", "0.0022"),
meta("simmap:state", "s1")))
))))
```
Of course writing out such a definition manually becomes tedious quickly. Because
these are just R commands, we can easily define a function that can loop over an
assignment like this for each edge, extracting the appropriate order, length and
state from an existing R object such as that provided in the `phytools` package.
Likewise, it is straightforward to define a function that reads this data using
the `RNeXML` utilities and converts it back to the `phytools` package. The full
implementation of this mapping can be seen in the `simmap_to_nexml()` and the
`nexml_to_simmap()` functions provided in the `RNeXML` package.
As the code indicates, the key step is simply to define the data in meta elements. In
so doing, we have defined a custom namespace, `simmap`, to hold our variables. This
allows us to provide a URL with more detailed descriptions of what each of these
elements mean:
```{r}
nex <- add_namespaces(c(simmap = "https://github.com/ropensci/RNeXML/tree/master/inst/simmap.md"))
```
At that URL we have posted a simple description of each term.
Using this convention we can generate NeXML files containing `simmap`
data, read those files into R, and convert them back into the `phytools`
package format. These simple functions serve as further illustration of
how `RNeXML` can be used to extend the NeXML standard. We illustrate
their use briefly here, starting with loading a `nexml` object containing
a `simmap` reconstruction into R:
```{r}
data(simmap_ex)
```
The `get_trees()` function can be used to return an `ape::phylo` tree as
usual. `RNeXML` automatically detects the `simmap` reconstruction data
and returns includes this in a `maps` element of the `ape::phylo` object,
for use with other `phytools` functions.
```{r}
phy <- nexml_to_simmap(simmap_ex)
```
We can then use various functions from `phytools` designed for `simmap`
objects [@Revell_2012], such as the plotting function:
```{r Figure1, fig.cap="Stochastic character mapping on a phylogeny, as generated by the phytools package after parsing the simmap-extended NeXML."}
library("phytools")
plotSimmap(phy)
```
Likewise, we can convert the object back in the NeXML format and write
it out to file to be read by other users.
```{r}
nex <- simmap_to_nexml(phy)
nexml_write(nex, "simmap.xml")
```
Though other NeXML parsers (for instance, for Perl or Python) have
not been written explicitly to express `simmap` data, those parsers will
nonetheless be able to successfully parse this file and expose the `simmap`
data to the user.
```{r cleanup, include=FALSE}
unlink("simmap.xml")
```
RNeXML/vignettes/S4.Rmd 0000644 0001762 0000144 00000010062 12641021656 014263 0 ustar ligges users ---
title: "The nexml S4 Object"
author:
- Carl Boettiger
- Scott Chamberlain
- Rutger Vos
- Hilmar Lapp
output: html_vignette
---
```{r supplement-compile-settings, include=FALSE}
library("methods")
library("knitr")
opts_chunk$set(tidy = FALSE, warning = FALSE, message = FALSE,
cache = FALSE, comment = NA, verbose = TRUE)
basename <- 'S4'
```
```{r include=FALSE}
library("RNeXML")
```
## Understanding the `nexml` S4 object
The `RNeXML` package provides many convenient functions to add and extract
information from `nexml` objects in the R environment without requiring
the reader to understand the details of the NeXML data structure and
making it less likely that a user will generate invalid NeXML syntax
that could not be read by other parsers. The `nexml` object we have been using
in all of the examples is built on R's S4 mechanism. Advanced users may
sometimes prefer to interact with the data structure more directly using
R's S4 class mechanism and subsetting methods. Many R users are more familiar
with the S3 class mechanism (such as in the `ape` package phylo objects)
rather than the S4 class mechanism used in phylogenetics packages such as
`ouch` and `phylobase`. The `phylobase` vignette provides an excellent introduction
to these data structures. Users already familiar with subsetting lists and other
S3 objects in R are likely familar with the use of the `$` operator, such as
`phy$edge`. S4 objects simply use an `@` operator instead (but cannot be subset
using numeric arguments such as `phy[[1]]` or named arguments such as phy[["edge"]]).
The `nexml` object is an S4 object, as are all of its components (slots). Its
hierarchical structure corresponds exactly with the XML tree of a NeXML file, with
the single exception that both XML attributes and children are represented as slots.
S4 objects have constructor functions to initialize them. We create a new `nexml`
object with the command:
```{r}
nex <- new("nexml")
```
We can see a list of slots contained in this object with
```{r}
slotNames(nex)
```
Some of these slots have already been populated for us, for instance, the schema version and default namespaces:
```{r}
nex@version
nex@namespaces
```
Recognize that `nex@namespaces` serves the same role as `get_namespaces`
function, but provides direct access to the slot data. For instance,
with this syntax we could also overwrite the existing namespaces with
`nex@namespaces <- NULL`. Changing the namespace in this way is not
advised.
Some slots can contain multiple elements of the same type, such as
`trees`, `characters`, and `otus`. For instance, we see that
```{r}
class(nex@characters)
```
is an object of class `ListOfcharacters`, and is currently empty,
```{r}
length(nex@characters)
```
In order to assign an object to a slot, it must match the class definition
of the slot. We can create a new element of any given class with the
`new` function,
```{r}
nex@characters <- new("ListOfcharacters", list(new("characters")))
```
and now we have a length-1 list of character matrices,
```{r}
length(nex@characters)
```
and we access the first character matrix using the list notation,
`[[1]]`. Here we check the class is a `characters` object.
```{r}
class(nex@characters[[1]])
```
Direct subsetting has two primary use cases: (a) useful in looking up
(and possibly editing) a specific value of an element, or (b) when adding
metadata annotations to specific elements. Consider the example file
```{r}
f <- system.file("examples", "trees.xml", package="RNeXML")
nex <- nexml_read(f)
```
We can look up the species label of the first `otu` in the first `otus` block:
```{r}
nex@otus[[1]]@otu[[1]]@label
```
We can add metadata to this particular OTU using this subsetting format
```{r}
nex@otus[[1]]@otu[[1]]@meta <-
c(meta("skos:note",
"This species was incorrectly identified"),
nex@otus[[1]]@otu[[1]]@meta)
```
Here we use the `c` operator to append this element to any existing meta annotations to this otu.
RNeXML/vignettes/sparql.Rmd 0000644 0001762 0000144 00000013724 12641021656 015307 0 ustar ligges users ---
title: "SPARQL with RNeXML"
author:
- Carl Boettiger
- Scott Chamberlain
- Rutger Vos
- Hilmar Lapp
output: html_vignette
---
```{r supplement-compile-settings, include=FALSE}
library("methods")
library("knitr")
opts_chunk$set(tidy = FALSE, warning = FALSE, message = FALSE,
cache = FALSE, comment = NA, verbose = TRUE,
eval = all(c(require("Sxslt"), require("rrdf"))))
basename <- 'sparql'
```
```{r include=FALSE}
library("RNeXML")
```
## SPARQL Queries
Rich, semantically meaningful metadata lies at the heart of the NeXML
standard. R provides a rich environment to unlock this information.
While our previous examples have relied on the user knowing exactly
what metadata they intend to extract (title, publication date, citation
information, and so forth), _semantic_ metadata has meaning that a
computer can make use of, allowing us to make much more conceptually
rich queries than those simple examples. The SPARQL query language
is a powerful way to make use of such semantic information in making
complex queries.
While users should consult a formal introduction to SPARQL for further
background, here we illustrate how SPARQL can be used in combination
with R functions in ways that would be much more tedious to assemble
with only traditional/non-semantic queries. The SPARQL query language
is provided for the R environment through the `rrdf` package [@Willighagen_2014],
so we start by loading that package. We will also make use of functions
from `phytools` and `RNeXML`.
```{r}
library("rrdf")
library("XML")
library("phytools")
library("RNeXML")
```
We read in an example file that contains semantic metadata annotations
describing the taxonomic units (OTUs) used in the tree.
```{r}
nexml <- nexml_read(system.file("examples/primates.xml", package="RNeXML"))
```
In particular, this example declares the taxon rank, NCBI identifier and parent taxon
for each OTU, such as:
```xml
```
In this example, we will construct a cladogram by using this information
to identify the taxonomic rank of each OTU, and its shared parent
taxonomic rank. (If this example looks complex, try writing down the
steps to do this without the aid of the SPARQL queries). These examples
show the manipulation of semantic triples, Unique Resource Identifiers
(URIs) and use of the SPARQL "Join" operator.
Note that this example can be run using `demo("sparql", "RNeXML")` to see the
code displayed in the R terminal and to avoid character errors that
can occur in having to copy and paste from PDF files.
We begin by extracting the RDF graph from the NeXML,
```{r}
rdf <- get_rdf(system.file("examples/primates.xml", package="RNeXML"))
tmp <- tempfile() # so we must write the XML out first
saveXML(rdf, tmp)
graph <- load.rdf(tmp)
```
We then fetch the NCBI URI for the taxon that has rank 'Order', i.e. the
root of the primates phylogeny. The dot operator `.` between clauses
implies a join, in this case
```{r}
root <- sparql.rdf(graph,
"SELECT ?uri WHERE {
?id .
?id ?uri
}")
```
This makes use of the SPARQL query language provided by the `rrdf`
package. We will also define some helper functions that use SPARQL
queries. Here we define a function to get the name
```{r}
get_name <- function(id) {
max <- length(nexml@otus[[1]]@otu)
for(i in 1:max) {
if ( nexml@otus[[1]]@otu[[i]]@id == id ) {
label <- nexml@otus[[1]]@otu[[i]]@label
label <- gsub(" ","_",label)
return(label)
}
}
}
```
Next, we define a recursive function to build a newick tree from the taxonomic rank information.
```{r}
recurse <- function(node){
# fetch the taxonomic rank and id string
rank_query <- paste0(
"SELECT ?rank ?id WHERE {
?id <",node,"> .
?id ?rank
}")
result <- sparql.rdf(graph, rank_query)
# get the local ID, strip URI part
id <- result[2]
id <- gsub("^.+#", "", id, perl = TRUE)
# if rank is terminal, return the name
if (result[1] == "http://rs.tdwg.org/ontology/voc/TaxonRank#Species") {
return(get_name(id))
}
# recurse deeper
else {
child_query <- paste0(
"SELECT ?uri WHERE {
?id <",node,"> .
?id ?uri
}")
children <- sparql.rdf(graph, child_query)
return(paste("(",
paste(sapply(children, recurse),
sep = ",", collapse = "," ),
")",
get_name(id), # label interior nodes
sep = "", collapse = ""))
}
}
```
With these functions in place, it is straight forward to build the tree
from the semantic RDFa data and then visualize it
```{r}
newick <- paste(recurse(root), ";", sep = "", collapse = "")
tree <- read.newick(text = newick)
collapsed <- collapse.singles(tree)
plot(collapsed,
type='cladogram',
show.tip.label=FALSE,
show.node.label=TRUE,
cex=0.75,
edge.color='grey60',
label.offset=-9)
```
RNeXML/vignettes/references.bib 0000644 0001762 0000144 00000027553 12641021656 016145 0 ustar ligges users @Misc{W3C_2014,
url = {http://www.w3.org/TR/rdf-sparql-query/},
title = {SPARQL Query Language for RDF},
journal = {W3C},
howpublished = {\url{http://www.w3.org/TR/rdf-sparql-query/}},
author = {Eric Prud'hommeaux},
archived = {http://greycite.knowledgeblog.org/?uri=http%3A%2F%2Fwww.w3.org%2FTR%2Frdf-sparql-query%2F},
year = {2014},
}
@article{Parr2011,
abstract = {The accelerating growth of data and knowledge in evolutionary biology is indisputable. Despite this rapid progress, information remains scattered, poorly documented and in formats that impede discovery and integration. A grand challenge is the creation of a linked system of all evolutionary data, information and knowledge organized around Darwin's ever-growing Tree of Life. Such a system, accommodating topological disagreement where necessary, would consolidate taxon names, phenotypic and geographical distributional data across clades, and serve as an integrated community resource. The field of evolutionary informatics, reviewed here for the first time, has matured into a robust discipline that is developing the conceptual, infrastructure and community frameworks for meeting this grand challenge.},
author = {Parr, Cynthia S and Guralnick, Robert and Cellinese, Nico and Page, Roderic D M},
doi = {10.1016/j.tree.2011.11.001},
file = {:home/cboettig/Documents/Mendeley/Trends in ecology \& evolution/2011/Parr et al. - 2011 - Trends in ecology \& evolution.pdf:pdf},
issn = {0169-5347},
journal = {Trends in ecology \& evolution},
mendeley-groups = {Evolutionary Theory/Phylogenetic Methods},
month = dec,
number = {2},
pages = {94--103},
pmid = {22154516},
publisher = {Elsevier Ltd},
title = {{Evolutionary informatics: unifying knowledge about the diversity of life.}},
url = {http://www.ncbi.nlm.nih.gov/pubmed/22154516},
volume = {27},
year = {2011}
}
@Article{Revell_2012,
title = {phytools: An R package for phylogenetic comparative biology (and other things).},
author = {Liam J. Revell},
journal = {Methods in Ecology and Evolution},
year = {2012},
volume = {3},
pages = {217-223},
}
@Book{Xie_2013,
title = {Dynamic Documents with {R} and knitr},
author = {Yihui Xie},
publisher = {Chapman and Hall/CRC},
address = {Boca Raton, Florida},
year = {2013},
note = {ISBN 978-1482203530},
url = {http://yihui.name/knitr/},
}
@Article{Vos_2012,
doi = {10.1093/sysbio/sys025},
url = {http://dx.doi.org/10.1093/sysbio/sys025},
year = {2012},
month = {Feb},
publisher = {Oxford University Press (OUP)},
volume = {61},
number = {4},
pages = {675-689},
author = {R. A. Vos and J. P. Balhoff and J. A. Caravas and M. T. Holder and H. Lapp and W. P. Maddison and P. E. Midford and A. Priyam and J. Sukumaran and X. Xia and A. Stoltzfus},
title = {NeXML: Rich, Extensible, and Verifiable Representation of Comparative Data and Metadata},
journal = {Systematic Biology},
}
@Article{Harmon_2008,
title = {GEIGER: investigating evolutionary radiations},
author = {LJ Harmon and JT Weir and CD Brock and RE Glor and W Challenger},
journal = {Bioinformatics},
year = {2008},
volume = {24},
pages = {129-131},
}
@Article{Rausher_2010,
doi = {10.1111/j.1558-5646.2009.00940.x},
url = {http://dx.doi.org/10.1111/j.1558-5646.2009.00940.x},
year = {2010},
month = {Mar},
publisher = {Wiley-Blackwell},
volume = {64},
number = {3},
pages = {603-604},
author = {Mark D. Rausher and Mark A. McPeek and Allen J. Moore and Loren Rieseberg and Michael C. Whitlock},
title = {Data Archiving},
journal = {Evolution},
}
@Article{Boettiger_2012,
doi = {10.1111/j.2041-210x.2012.00247.x},
url = {http://dx.doi.org/10.1111/j.2041-210x.2012.00247.x},
year = {2012},
month = {Oct},
publisher = {Wiley-Blackwell},
volume = {3},
number = {6},
pages = {1060-1066},
author = {Carl Boettiger and Duncan {Temple Lang}},
editor = {Luke Harmon},
title = {Treebase: an R package for discovery, access and manipulation of online phylogenies},
journal = {Methods Ecol Evol},
}
@Manual{R,
title = {R: A Language and Environment for Statistical Computing},
author = {{R Core Team}},
organization = {R Foundation for Statistical Computing},
address = {Vienna, Austria},
year = {2014},
url = {http://www.R-project.org/},
}
@Manual{phylobase,
title = {phylobase: Base package for phylogenetic structures and comparative data},
author = {{NESCENT R Hackathon Team}},
year = {2014},
note = {R package version 0.6.8},
url = {http://CRAN.R-project.org/package=phylobase},
}
@Article{Tenopir_2011,
doi = {10.1371/journal.pone.0021101},
url = {http://dx.doi.org/10.1371/journal.pone.0021101},
year = {2011},
month = {Jun},
publisher = {Public Library of Science (PLoS)},
volume = {6},
number = {6},
pages = {e21101},
author = {Carol Tenopir and Suzie Allard and Kimberly Douglass and Arsev Umur Aydinoglu and Lei Wu and Eleanor Read and Maribeth Manoff and Mike Frame},
editor = {Cameron Neylon},
title = {Data Sharing by Scientists: Practices and Perceptions},
journal = {PLoS ONE},
}
@Manual{Boettiger_2014,
title = {knitcitations: Citations for knitr markdown files},
author = {Carl Boettiger},
note = {R package version 1.0-1},
url = {https://github.com/cboettig/knitcitations},
year = {2014},
}
@InCollection{Hartig_2012,
doi = {10.1007/978-3-642-31753-8_56},
url = {http://dx.doi.org/10.1007/978-3-642-31753-8_56},
year = {2012},
publisher = {Springer Science + Business Media},
pages = {506-507},
author = {Olaf Hartig},
title = {An Introduction to SPARQL and Queries over Linked Data},
booktitle = {Web Engineering},
}
@Article{Chamberlain_2013,
doi = {10.12688/f1000research.2-191.v2},
url = {http://dx.doi.org/10.12688/f1000research.2-191.v2},
year = {2013},
month = {Oct},
publisher = {F1000 Research, Ltd.},
author = {Scott A. Chamberlain and Eduard Sz{\"o}cs},
title = {taxize: taxonomic search and retrieval in R},
journal = {F1000Research},
}
@Article{Drew_2013,
doi = {10.1371/journal.pbio.1001636},
url = {http://dx.doi.org/10.1371/journal.pbio.1001636},
year = {2013},
month = {Sep},
publisher = {Public Library of Science (PLoS)},
volume = {11},
number = {9},
pages = {e1001636},
author = {Bryan T. Drew and Romina Gazis and Patricia Cabezas and Kristen S. Swithers and Jiabin Deng and Roseana Rodriguez and Laura A. Katz and Keith A. Crandall and David S. Hibbett and Douglas E. Soltis},
title = {Lost Branches on the Tree of Life},
journal = {PLoS Biol},
}
@Article{Bollback_2006,
doi = {10.1186/1471-2105-7-88},
url = {http://dx.doi.org/10.1186/1471-2105-7-88},
year = {2006},
publisher = {Springer Science + Business Media},
volume = {7},
number = {1},
pages = {88},
author = {JonathanP Bollback},
journal = {BMC Bioinformatics},
}
@Article{Cranston_2014,
doi = {10.1371/currents.tol.bf01eff4a6b60ca4825c69293dc59645},
url = {http://dx.doi.org/10.1371/currents.tol.bf01eff4a6b60ca4825c69293dc59645},
year = {2014},
publisher = {Public Library of Science (PLoS)},
author = {Karen Cranston and Luke J. Harmon and Maureen A. O'Leary and Curtis Lisle},
title = {Best Practices for Data Sharing in Phylogenetic Research},
journal = {PLoS Curr},
}
@Article{Huelsenbeck_2003,
doi = {10.1080/10635150390192780},
url = {http://dx.doi.org/10.1080/10635150390192780},
year = {2003},
month = {Apr},
publisher = {Oxford University Press (OUP)},
volume = {52},
number = {2},
pages = {131-158},
author = {John P. Huelsenbeck and Rasmus Nielsen and Jonathan P. Bollback},
title = {Stochastic Mapping of Morphological Characters},
journal = {Systematic Biology},
}
@Article{Stoltzfus_2012,
doi = {10.1186/1756-0500-5-574},
url = {http://dx.doi.org/10.1186/1756-0500-5-574},
year = {2012},
publisher = {Springer Science + Business Media},
volume = {5},
number = {1},
pages = {574},
author = {Arlin Stoltzfus and Brian O'Meara and Jamie Whitacre and Ross Mounce and Emily L Gillespie and Sudhir Kumar and Dan F Rosauer and Rutger A Vos},
title = {Sharing and re-use of phylogenetic trees (and associated data) to facilitate synthesis},
journal = {BMC Research Notes},
}
@Article{Stodden_2014,
doi = {10.2139/ssrn.1550193},
url = {http://dx.doi.org/10.2139/ssrn.1550193},
publisher = {Social Science Electronic Publishing},
author = {Victoria Stodden},
title = {The Scientific Method in Practice: Reproducibility in the Computational Sciences},
journal = {SSRN Journal},
year = {2014},
}
@Article{Paradis_2004,
title = {{APE}: analyses of phylogenetics and evolution in {R} language},
author = {E. Paradis and J. Claude and K. Strimmer},
journal = {Bioinformatics},
year = {2004},
volume = {20},
pages = {289-290},
}
@Misc{taskview,
url = {http://cran.r-project.org/web/views/Phylogenetics.html},
author = {Brian O'Meara},
title = {CRAN Task View: Phylogenetics, Especially Comparative Methods},
howpublished = {\url{http://cran.r-project.org/web/views/Phylogenetics.html}},
archived = {http://greycite.knowledgeblog.org/?uri=http%3A%2F%2Fcran.r-project.org%2Fweb%2Fviews%2FPhylogenetics.html},
year = {2014},
}
@ARTICLE{Maddison_1997,
title = "{NEXUS}: an extensible file format for systematic information",
author = "Maddison, D and Swofford, D and Maddison, W",
journal = "Syst. Biol.",
volume = 46,
number = 4,
pages = "590--621",
month = dec,
year = 1997,
url = "http://www.ncbi.nlm.nih.gov/pubmed/11975335",
keywords = "data standard",
issn = "1063-5157",
pmid = "11975335"
}
@INCOLLECTION{Piel_2002,
title = "{TreeBASE}: a database of phylogenetic information",
booktitle = "The Interoperable ``Catalog of Life''",
author = "Piel, W H and Donoghue, M J and Sanderson, Michael J",
editor = "Shimura, J and Wilson, K L and Gordon, D",
abstract = "Phylogenetic systematics brings added value to the species lists
and taxonomic inventories that form the groundwork of our
understanding of biodiversity. But this added value is lost
without a central database to store what we know about
historical patterns and evolutionary relationships. TreeBASE was
developed to harness this information and to provide a tool to
study the evolution of biodiversity. Access to phylogenetic
trees, and to the data underlying them, is needed for a wide
variety of purposes, including comparative studies of
morphological and molecular evolution, biogeography,
coevolution, and studies of congruence of results based on
different sources of evidence. Such data are also needed to
monitor progress in phylogenetic research, to test new methods
of analysis, and to address immediate practical problems in
conservation of biodiversity. TreeBASE stores published
phylogenetic trees, character and molecular data matrices,
bibliographic information, and some details on taxa, characters,
algorithms used, and analyses performed. The database is
designed to be explored interactively and to allow retrieval and
recombination of trees and data from different studies. TreeBASE
therefore provides a means of assessing and synthesizing
knowledge of phylogenetic information and biodiversity. The URL
is: http://phylogeny.harvard.edu/treebase.",
publisher = "National Institute for Environmental Studies",
number = 171,
pages = "41--47",
series = "Research Report",
year = 2002,
url = "http://donoghuelab.yale.edu/sites/default/files/124_piel_shimura02.pdf",
address = "Tsukuba, Japan"
}
@Manual{XML,
title = {XML: Tools for parsing and generating XML within R and S-Plus.},
author = {Duncan Temple Lang},
year = {2013},
note = {R package version 3.98-1.1},
url = {http://CRAN.R-project.org/package=XML},
}
RNeXML/README.md 0000644 0001762 0000144 00000027511 12734530403 012605 0 ustar ligges users
[](http://dx.doi.org/10.5281/zenodo.13131) [](https://travis-ci.org/ropensci/RNeXML)
RNeXML: The next-generation phylogenetics format comes to R
===========================================================
- Maintainer: Carl Boettiger
- Authors: Carl Boettiger, Scott Chamberlain, Hilmar Lapp, Kseniia Shumelchyk, Rutger Vos
- License: BSD-3
- [Issues](https://github.com/ropensci/RNeXML/issues): Bug reports, feature requests, and development discussion.
An extensive and rapidly growing collection of richly annotated phylogenetics data is now available in the NeXML format. NeXML relies on state-of-the-art data exchange technology to provide a format that can be both validated and extended, providing a data quality assurance and adaptability to the future that is lacking in other formats. See [Vos et al 2012](http://doi.org/10.1093/sysbio/sys025 "NeXML: Rich, Extensible, and Verifiable Representation of Comparative Data and Metadata.") for further details on the NeXML format.
How to cite
-----------
RNeXML has been published in the following article:
> Boettiger C, Chamberlain S, Vos R and Lapp H (2016). “RNeXML: A Package for Reading and Writing Richly Annotated Phylogenetic, Character, and Trait Data in R.” *Methods in Ecology and Evolution*, **7**, pp. 352-357. [doi:10.1111/2041-210X.12469](http://doi.org/10.1111/2041-210X.12469)
Although the published version of the article is paywalled, the source of the manuscript, and a much better rendered PDF, are included in this package (in the `manuscripts` folder). You can also find it [freely available on arXiv](http://arxiv.org/abs/1506.02722).
Getting Started
---------------
The latest stable release of RNeXML is on CRAN, and can be installed with the usual `install.packages("RNeXML")` command. Some of the more specialized functionality described in the Vignettes (such as RDF manipulation) requires additional packages which can be installed using:
``` r
install.packages("RNeXML", deps=TRUE, repos=c("https://cran.rstudio.com", "http://packages.ropensci.org"))
```
which will also install the development version of the RNeXML package. For most common tasks such as shown here, those additional packages are not required. The development version of RNeXML is also [available on Github](https://github.com/ropensci/RNeXML). With the `devtools` package installed on your system, RNeXML can be installed using:
``` r
library(devtools)
install_github("ropensci/RNeXML")
library(RNeXML)
```
Read in a `nexml` file into the `ape::phylo` format:
``` r
f <- system.file("examples", "comp_analysis.xml", package="RNeXML")
nexml <- nexml_read(f)
tr <- get_trees(nexml) # or: as(nexml, "phylo")
plot(tr)
```
Write an `ape::phylo` tree into the `nexml` format:
``` r
data(bird.orders)
nexml_write(bird.orders, "test.xml")
#> [1] "test.xml"
```
A key feature of NeXML is the ability to formally validate the construction of the data file against the standard (the lack of such a feature in nexus files had lead to inconsistencies across different software platforms, and some files that cannot be read at all). While it is difficult to make an invalid NeXML file from `RNeXML`, it never hurts to validate just to be sure:
``` r
nexml_validate("test.xml")
#> [1] TRUE
```
Extract metadata from the NeXML file:
``` r
birds <- nexml_read("test.xml")
get_taxa(birds)
#> otu label about xsi.type otus
#> 1 ou70 Struthioniformes #ou70 NA os4
#> 2 ou71 Tinamiformes #ou71 NA os4
#> 3 ou72 Craciformes #ou72 NA os4
#> 4 ou73 Galliformes #ou73 NA os4
#> 5 ou74 Anseriformes #ou74 NA os4
#> 6 ou75 Turniciformes #ou75 NA os4
#> 7 ou76 Piciformes #ou76 NA os4
#> 8 ou77 Galbuliformes #ou77 NA os4
#> 9 ou78 Bucerotiformes #ou78 NA os4
#> 10 ou79 Upupiformes #ou79 NA os4
#> 11 ou80 Trogoniformes #ou80 NA os4
#> 12 ou81 Coraciiformes #ou81 NA os4
#> 13 ou82 Coliiformes #ou82 NA os4
#> 14 ou83 Cuculiformes #ou83 NA os4
#> 15 ou84 Psittaciformes #ou84 NA os4
#> 16 ou85 Apodiformes #ou85 NA os4
#> 17 ou86 Trochiliformes #ou86 NA os4
#> 18 ou87 Musophagiformes #ou87 NA os4
#> 19 ou88 Strigiformes #ou88 NA os4
#> 20 ou89 Columbiformes #ou89 NA os4
#> 21 ou90 Gruiformes #ou90 NA os4
#> 22 ou91 Ciconiiformes #ou91 NA os4
#> 23 ou92 Passeriformes #ou92 NA os4
get_metadata(birds)
#> LiteralMeta property datatype content
#> 1 m15 dc:creator xsd:string
#> 2
#> 3 m17 dcterms:bibliographicCitation xsd:string
#> xsi.type ResourceMeta rel
#> 1 LiteralMeta
#> 2 ResourceMeta m16 cc:license
#> 3 LiteralMeta
#> href
#> 1
#> 2 http://creativecommons.org/publicdomain/zero/1.0/
#> 3
```
------------------------------------------------------------------------
Add basic additional metadata:
``` r
nexml_write(bird.orders, file="meta_example.xml",
title = "My test title",
description = "A description of my test",
creator = "Carl Boettiger ",
publisher = "unpublished data",
pubdate = "2012-04-01")
#> [1] "meta_example.xml"
```
By default, `RNeXML` adds certain metadata, including the NCBI taxon id numbers for all named taxa. This acts a check on the spelling and definitions of the taxa as well as providing a link to additional metadata about each taxonomic unit described in the dataset.
### Advanced annotation
We can also add arbitrary metadata to a NeXML tree by define `meta` objects:
``` r
modified <- meta(property = "prism:modificationDate",
content = "2013-10-04")
```
Advanced use requires specifying the namespace used. Metadata follows the RDFa conventions. Here we indicate the modification date using the prism vocabulary. This namespace is included by default, as it is used for some of the basic metadata shown in the previous example. We can see from this list:
``` r
RNeXML:::nexml_namespaces
#> nex
#> "http://www.nexml.org/2009"
#> xsi
#> "http://www.w3.org/2001/XMLSchema-instance"
#> xml
#> "http://www.w3.org/XML/1998/namespace"
#> cdao
#> "http://purl.obolibrary.org/obo/cdao.owl"
#> xsd
#> "http://www.w3.org/2001/XMLSchema#"
#> dc
#> "http://purl.org/dc/elements/1.1/"
#> dcterms
#> "http://purl.org/dc/terms/"
#> ter
#> "http://purl.org/dc/terms/"
#> prism
#> "http://prismstandard.org/namespaces/1.2/basic/"
#> cc
#> "http://creativecommons.org/ns#"
#> ncbi
#> "http://www.ncbi.nlm.nih.gov/taxonomy#"
#> tc
#> "http://rs.tdwg.org/ontology/voc/TaxonConcept#"
```
This next block defines a resource (link), described by the `rel` attribute as a homepage, a term in the `foaf` vocabulalry. Becuase `foaf` is not a default namespace, we will have to provide its URL in the full definition below.
``` r
website <- meta(href = "http://carlboettiger.info",
rel = "foaf:homepage")
```
Here we create a history node using the `skos` namespace. We can also add id values to any metadata element to make the element easier to reference externally:
``` r
history <- meta(property = "skos:historyNote",
content = "Mapped from the bird.orders data in the ape package using RNeXML",
id = "meta123")
```
For this kind of richer annotation, it is best to build up our NeXML object sequentially. Frist we will add `bird.orders` phylogeny to a new phylogenetic object, and then we will add the metadata elements created above to this object. Finally, we will write the object out as an XML file:
``` r
birds <- add_trees(bird.orders)
birds <- add_meta(meta = list(history, modified, website),
namespaces = c(skos = "http://www.w3.org/2004/02/skos/core#",
foaf = "http://xmlns.com/foaf/0.1/"),
nexml=birds)
nexml_write(birds,
file = "example.xml")
#> [1] "example.xml"
```
### Taxonomic identifiers
Add taxonomic identifier metadata to the OTU elements:
``` r
nex <- add_trees(bird.orders)
nex <- taxize_nexml(nex)
```
Working with character data
---------------------------
NeXML also provides a standard exchange format for handling character data. The R platform is particularly popular in the context of phylogenetic comparative methods, which consider both a given phylogeny and a set of traits. NeXML provides an ideal tool for handling this metadata.
### Extracting character data
We can load the library, parse the NeXML file and extract both the characters and the phylogeny.
``` r
library(RNeXML)
nexml <- read.nexml(system.file("examples", "comp_analysis.xml", package="RNeXML"))
traits <- get_characters(nexml)
tree <- get_trees(nexml)
```
(Note that `get_characters` would return both discrete and continuous characters together in the same data.frame, but we use `get_characters_list` to get separate data.frames for the continuous `characters` block and the discrete `characters` block).
We can then fire up `geiger` and fit, say, a Brownian motion model the continuous data and a Markov transition matrix to the discrete states:
``` r
library(geiger)
fitContinuous(tree, traits[1], ncores=1)
#> GEIGER-fitted comparative model of continuous data
#> fitted 'BM' model parameters:
#> sigsq = 1.166011
#> z0 = 0.255591
#>
#> model summary:
#> log-likelihood = -20.501183
#> AIC = 45.002367
#> AICc = 46.716652
#> free parameters = 2
#>
#> Convergence diagnostics:
#> optimization iterations = 100
#> failed iterations = 0
#> frequency of best fit = 1.00
#>
#> object summary:
#> 'lik' -- likelihood function
#> 'bnd' -- bounds for likelihood search
#> 'res' -- optimization iteration summary
#> 'opt' -- maximum likelihood parameter estimates
fitDiscrete(tree, traits[2], ncores=1)
#> GEIGER-fitted comparative model of discrete data
#> fitted Q matrix:
#> 0 1
#> 0 -0.07308302 0.07308302
#> 1 0.07308302 -0.07308302
#>
#> model summary:
#> log-likelihood = -4.574133
#> AIC = 11.148266
#> AICc = 11.648266
#> free parameters = 1
#>
#> Convergence diagnostics:
#> optimization iterations = 100
#> failed iterations = 0
#> frequency of best fit = 1.00
#>
#> object summary:
#> 'lik' -- likelihood function
#> 'bnd' -- bounds for likelihood search
#> 'res' -- optimization iteration summary
#> 'opt' -- maximum likelihood parameter estimates
```
------------------------------------------------------------------------
[](http://ropensci.org)
RNeXML/MD5 0000644 0001762 0000144 00000020525 12734566742 011653 0 ustar ligges users ebe99292b89cc34140a39ad712681bf7 *DESCRIPTION
15d87f8d4ecfd954c8dd3fc2b69a0cbb *LICENSE
1d93149a8c506b01083905ff4c1ee3ea *NAMESPACE
04866c936719c90d023ccaa71d9246fe *NEWS
3f9769a15da159d125da7a8c314401b3 *R/add_basic_meta.R
40bece1f389a5a124ef19d214762e316 *R/add_characters.R
8a3742fe5e603f306cef2a96ae1e9b8e *R/add_meta.R
5cd943276adbf9f17f5230085652e9e9 *R/add_namespaces.R
12af339498a96925e3dcd0e74e80a046 *R/add_trees.R
4b8556f774eb9ee1d38df6cd6c742532 *R/character_classes.R
4888005a99dbdfe559fe99568a938c1f *R/classes.R
eeb4a688d49a71b887d4720a1730174d *R/concatenate_nexml.R
7bd3c9c98ffe79c342f9c367137050f5 *R/deprecated.R
bc53e2e4026dbbdeba595dcba9feaefd *R/get_basic_metadata.R
28300d92ffe9dad2934a153dbb3fcbd7 *R/get_characters.R
e51cbb9c28bd6bf98ecb76dd8cf2a5b8 *R/get_level.R
ae3df68ccfb01f0ceaae7c92e76a8052 *R/get_metadata.R
fe892d1d2be5fff56f37b24e89515f87 *R/get_namespaces.R
f561b1ded0a06a5d225d77a0aa39241b *R/get_rdf.R
c4aa799bc0ba7b7a23bd7a0a32409209 *R/get_taxa.R
3a890d1b39f18a08b0f4c7d94fe0d57b *R/get_taxa_meta.R
323a810bfdadcb830fd013011d4c40d4 *R/get_trees.R
f8c0a9c2cec4bcbde80170ee767eba13 *R/internal_get_node_maps.R
2c2f1c91251d019f03d99e61c62c42cd *R/internal_isEmpty.R
3372a2273979f5336464963d70fb710c *R/internal_name_by_id.R
88264b69fef8bccbdcb1619f7d8c80cf *R/internal_nexml_id.R
71a4b1b132719c58e5c5d7b4d8bc919e *R/meta.R
a0eb07febda79bb9019c22cc1de272bf *R/nexmlTree.R
8e1b70f3620578164ee69c83abaae05d *R/nexml_add.R
eaf388a4f6baa30b25470711aae80073 *R/nexml_get.R
543c0593bb8c0bf854f7637b0a578111 *R/nexml_methods.R
a3ed5cf4bcd243452e87c95e78a84284 *R/nexml_publish.R
e55ca62202b4a3ea46b584fc3e8f2a6b *R/nexml_read.R
de91697697c1d05dcac0b3df54344ad8 *R/nexml_validate.R
f7f02df61a764d23efcabc61fbc2044c *R/nexml_write.R
f09917e2c28d50018d6e9b94c920fed7 *R/simmap.R
7b7d400236ab6cfa6fe179224f9fa20c *R/taxize_nexml.R
78ad6d9378c8d09f85d70b4f62b176b6 *R/tbl_df.R
10f560b71f8e0371f94c5fe01be697e4 *README.md
2b0b8bd66c24f83cfee581819fbc1c0f *build/vignette.rds
b6698b64d799f3e60f545c4998233741 *data/simmap_ex.rda
b2e0de0418b8c0fa9efed1fa5475a534 *demo/00Index
5bb8b588882878ecd86680b26e79a5e9 *demo/sparql.R
84b45265f4efcfb698335957ec44d7ba *inst/CITATION
a7ba86ba5a8e6ed654b2faf068d665dc *inst/doc/S4.R
cf3f47f24e945e8258e5df3d447f509c *inst/doc/S4.Rmd
65d1e01a870615fe2aaee99f462a9a65 *inst/doc/S4.html
12a0995b3f1129d5ba6685beed5d164c *inst/doc/metadata.R
93e452d7bc5e213191d7e22781edda33 *inst/doc/metadata.Rmd
9b47e98360d4b50a6a3ade83a4a3506a *inst/doc/metadata.html
90daf8f0bf53cfe7cbfd4f2351319e2c *inst/doc/simmap.R
87f05f59fb504698ea3fd69c09cd2b1d *inst/doc/simmap.Rmd
fda10aa33741510b2d70ed2004f4b57d *inst/doc/simmap.html
a08f6e54ee3f739aef13b300fc33bf37 *inst/doc/sparql.R
64bbe5a0174518618dc6dd1eef9f44f9 *inst/doc/sparql.Rmd
645b3f8577e78a2d5265d37d8d7bcd7a *inst/doc/sparql.html
2de44d2898c22479b8a449767f1ab627 *inst/examples/RDFa2RDFXML.xsl
64a60bc7b825e88ba931e1da5fd08e28 *inst/examples/biophylo.xml
41cf6116441773694f8f32b88900d346 *inst/examples/characters.xml
7cfba1e69724dd93fe4a07525e419ed4 *inst/examples/comp_analysis.xml
835c4ec3a29a2a08be861f44d445fab5 *inst/examples/gardiner_1984.xml
d3a3d2519dcc6fe7b5399061db69f1d9 *inst/examples/geospiza.xml
84cf7d2d949b6a36df18bec31d4c8917 *inst/examples/mbank_X962_11-22-2013_1534.nex
dcd3fe12a4ec3d330d89f34ed10dbaf5 *inst/examples/merge_data.Rmd
3b7704edc024518cb054fd73f1f2f9b6 *inst/examples/merge_data.md
727f60b2ff7bdae76ffc09452937107f *inst/examples/meta_example.xml
12d5ea02edb324a2efc824b4cdec8ed8 *inst/examples/meta_taxa.xml
34b804a9a1187689fe223be6498dcd26 *inst/examples/missing_some_branchlengths.xml
2fc3d9aca072a9964a95de8a8d7e6d53 *inst/examples/multitrees.xml
e34f32b1c48ae0acd8bfab2f09971945 *inst/examples/ncbii.xml
fb1edb923697675d5282d9d181fcfcd3 *inst/examples/ontotrace-result.xml
200927eaf3dc24fd97bd607277693992 *inst/examples/phenoscape.xml
cb142aadc75b48b696ccf6d42637ff72 *inst/examples/primates.xml
1f52dfb1306c9ed696d14f805e95a498 *inst/examples/primates_from_R.xml
065eae0c3189850bcff9d838b5041f90 *inst/examples/primates_meta.xml
a64c177eae6be033dd8712e6d693b2ea *inst/examples/primates_meta_xslt.xml
8a8e3e961583a94cec32852e9b4d36e8 *inst/examples/simmap.nex
327200ae849ba639f267e42d04932aa0 *inst/examples/simmap.xml
d1740a7345534477c40477f0fc776ad7 *inst/examples/some_missing_branchlengths.xml
e49283485e7dec7c98f77c54cf6406bd *inst/examples/sparql.newick
f4744af232f0e5087b78f0002cc38e1d *inst/examples/taxa.xml
9e0f346fbf1ef7dcd87a3406b98e7aeb *inst/examples/treebase-record.xml
74361320b5d4bc935ea9d09a35463708 *inst/examples/trees.xml
797825bdfed94f7c25aff9b96cbe7c09 *inst/simmap.md
6616a1400f25bd536f5958135f5331a7 *man/add_basic_meta.Rd
9213fa78891cc24777b0d6d49fed0f87 *man/add_characters.Rd
a9185633f5d18322b55326130885bb8f *man/add_meta.Rd
f371974ff7018c18e597538799f1944b *man/add_namespaces.Rd
0d2a95d73d96b36d6050ad4d14ab2239 *man/add_trees.Rd
61286f843046e80e9e70c24584bb4ca3 *man/c-ListOfmeta-method.Rd
b751f355bc634e3311dc4338a8580038 *man/c-meta-method.Rd
db4566c1aba031ac575679ceebf492c8 *man/c-nexml-method.Rd
e47a01a239ab2714836d887ee74bc72f *man/flatten_multiphylo.Rd
6fa1f00c6f4aabb836afd36b5d8a7c36 *man/get_characters.Rd
fbb70fa0eaf8597465c8dcfc4720d970 *man/get_characters_list.Rd
659b91259dd9a40316097e6817938495 *man/get_citation.Rd
69bb6034d4b6df8665ec3a30e78a9212 *man/get_flat_trees.Rd
bb807456a44e2513696ae558276ad447 *man/get_level.Rd
6c2eee2b7165012bc454c227c0fa4d79 *man/get_license.Rd
203abcfb15fe3a50e885c20dde4d4839 *man/get_metadata.Rd
c46a4a683d6456763b66f598483fe4f9 *man/get_namespaces.Rd
888b720a376d8574a609b976f05cb96f *man/get_rdf.Rd
c4551423633e161dd7eb52febba2e9bb *man/get_taxa.Rd
017da4e56e201af8cd0ed7f4bddad95b *man/get_taxa_list.Rd
85eb6f6931f265dbaa3d70acf30669b3 *man/get_taxa_meta.Rd
49d76200b87f52a8702f07d591b4fc46 *man/get_taxa_meta_list.Rd
63db8648ca7565cf3a95f4ca03bd6c69 *man/get_trees.Rd
f8631c38b0a17cefd68d6dc837333d5d *man/get_trees_list.Rd
14bade08261118997384f8b19ef9cfe1 *man/meta.Rd
16213b88dcaeaead93b4ca14e0f1155d *man/nexml_add.Rd
86e03649975e3e304a4549d1b52ab0da *man/nexml_figshare.Rd
effecba3da7f455df1e03e91650ab30c *man/nexml_get.Rd
959776702ff1e5b6e68332679e146f2e *man/nexml_publish.Rd
621317a0b5a9f361cd3456ae4531b1e8 *man/nexml_read.Rd
9dcccbaae20ba7d6bae820f92a55bdd6 *man/nexml_to_simmap.Rd
e3f70ff0fcf24c0fa9e039d013f14f3c *man/nexml_validate.Rd
b572d80b8214325580b882615f2c69f5 *man/nexml_write.Rd
9013924bda3ef2fa50a2ab2eaefcee5c *man/reset_id_counter.Rd
3e0069cf908c01f5bf54456727bc9872 *man/simmap_ex.Rd
f3d53e87bdf4d6492be6ce6a817acd34 *man/simmap_to_nexml.Rd
ec58c682829b41bd6f719806aaf5fe2b *man/taxize_nexml.Rd
5b8bcfa789a527efd486e95d195af6e4 *man/toPhylo.Rd
f9774e3679709c9036691527556fe97e *tests/test-all.R
c64d6a3a0af9b631471c129a0957e626 *tests/testthat/conversions.R
2a83a0474b87536e4e1f9f4441c8fa60 *tests/testthat/geiger_test.R
570b83e755bcffaa47c2b716b7356a12 *tests/testthat/helper-RNeXML.R
4a961531db2de3c792e8c0a2999e8d22 *tests/testthat/test_ape.R
2e4db69073aed7c11e38e62668adc1bc *tests/testthat/test_characters.R
187111ca4a1a30f4ce667b29af1f545c *tests/testthat/test_comp_analysis.R
18f77acc3657c0c15a30b56439b10506 *tests/testthat/test_concatenate.R
82c84691dccf5ec3ee12825e167ee53f *tests/testthat/test_get_characters.R
74cd1774ba8b63c324af7e1d2f1fb7cb *tests/testthat/test_get_level.R
84b7067fbe52a42ea40cfd500990d22e *tests/testthat/test_global_ids.R
15bdc14e960842894d04719caab12223 *tests/testthat/test_inheritance.R
b3bcc9642dd9449837ec050d64ecf2dc *tests/testthat/test_meta.R
7536014afe9c3d74b23b7e77c49ecc81 *tests/testthat/test_meta_extract.R
85ffdcb97727d6337b897b1f7459f9b2 *tests/testthat/test_nexml_read.R
7aec4558c1d4b92f86e8bfda16d23a2a *tests/testthat/test_parsing.R
16a017f64abb2539015e3dd6d37a57b6 *tests/testthat/test_publish.R
e8830f5726f1450ff8c43f435e57857e *tests/testthat/test_rdf.R
cebc49fccf74e658b171651b18f06f9a *tests/testthat/test_serializing.R
c9ed51458274d31a7e799c73e3eabde7 *tests/testthat/test_simmap.R
e8700d675fcb9599051369e1c74d824c *tests/testthat/test_taxonomy.R
f04b0dc0ea1ddf2637106f69183e3db9 *tests/testthat/test_toplevel_api.R
4c6ba000905bdd7fca8a212b67159817 *tests/testthat/test_validate.R
24a4d4a46c84bf205bdd7407791f15f9 *tests/testthat/treebase_test.R
cf3f47f24e945e8258e5df3d447f509c *vignettes/S4.Rmd
6e669e1070f9fed34aa9645a2768a2a4 *vignettes/metadata.Rmd
70e3f1824013e209654f96e819ceba0a *vignettes/references.bib
87f05f59fb504698ea3fd69c09cd2b1d *vignettes/simmap.Rmd
5f8e0dfbf93b58d0f35d1005abc4518c *vignettes/sparql.Rmd
RNeXML/build/ 0000755 0001762 0000144 00000000000 12734542424 012425 5 ustar ligges users RNeXML/build/vignette.rds 0000644 0001762 0000144 00000000467 12734542424 014773 0 ustar ligges users RN0t 4P /?T*$Z(I H7: cvm@q9&`p.>\i6
e EA)dxO[v}T
JWؖ
E]-1eI8U|/Si|k⦼:pL7ӒVB'M`ܯh"8}3\ȂZȃQfӶKq3w88D1K| b r|c<KCTY=hTd 7?'~3ڥ4 ½Ph RNeXML/DESCRIPTION 0000644 0001762 0000144 00000004373 12734566742 013054 0 ustar ligges users Package: RNeXML
Type: Package
Title: Semantically Rich I/O for the 'NeXML' Format
Version: 2.0.7
Authors@R: c(person("Carl", "Boettiger", role = c("cre", "aut"),
email="cboettig@gmail.com"), person("Scott", "Chamberlain", role =
"aut"), person("Hilmar", "Lapp", role = "aut"), person("Kseniia",
"Shumelchyk", role = "aut"), person("Rutger", "Vos", role = "aut"))
Description: Provides access to phyloinformatic data in 'NeXML' format. The
package should add new functionality to R such as the possibility to
manipulate 'NeXML' objects in more various and refined way and compatibility
with 'ape' objects.
URL: https://github.com/ropensci/RNeXML
BugReports: https://github.com/ropensci/RNeXML/issues
License: BSD_3_clause + file LICENSE
Additional_repositories: http://packages.ropensci.org
VignetteBuilder: knitr
Suggests: rrdf (>= 2.0.2), geiger (>= 2.0), phytools (>= 0.3.93), knitr
(>= 1.5), rfigshare (>= 0.3.0), knitcitations (>= 1.0.1),
testthat (>= 0.10.0), phylobase (>= 0.6.8), rmarkdown (>=
0.3.3), Sxslt (>= 0.91)
Depends: R (>= 3.0.0), ape (>= 3.1), methods (>= 3.0.0)
Imports: XML (>= 3.95), plyr (>= 1.8), taxize (>= 0.2.2), reshape2 (>=
1.2.2), httr (>= 0.3), uuid (>= 0.1-1), dplyr (>= 0.4.0),
lazyeval (>= 0.1.0), tidyr (>= 0.3.1), stringr (>= 1.0)
Collate: 'classes.R' 'add_basic_meta.R' 'add_characters.R' 'add_meta.R'
'add_namespaces.R' 'add_trees.R' 'character_classes.R'
'concatenate_nexml.R' 'deprecated.R' 'get_basic_metadata.R'
'get_characters.R' 'get_level.R' 'get_metadata.R'
'get_namespaces.R' 'get_rdf.R' 'get_taxa.R' 'get_taxa_meta.R'
'get_trees.R' 'internal_get_node_maps.R' 'internal_isEmpty.R'
'internal_name_by_id.R' 'internal_nexml_id.R' 'meta.R'
'nexmlTree.R' 'nexml_add.R' 'nexml_get.R' 'nexml_methods.R'
'nexml_publish.R' 'nexml_read.R' 'nexml_validate.R'
'nexml_write.R' 'simmap.R' 'taxize_nexml.R' 'tbl_df.R'
RoxygenNote: 5.0.1
NeedsCompilation: no
Packaged: 2016-06-28 18:42:28 UTC; root
Author: Carl Boettiger [cre, aut],
Scott Chamberlain [aut],
Hilmar Lapp [aut],
Kseniia Shumelchyk [aut],
Rutger Vos [aut]
Maintainer: Carl Boettiger
Repository: CRAN
Date/Publication: 2016-06-28 23:36:34
RNeXML/man/ 0000755 0001762 0000144 00000000000 12731606043 012074 5 ustar ligges users RNeXML/man/flatten_multiphylo.Rd 0000644 0001762 0000144 00000001372 12641021656 016312 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_trees.R
\name{flatten_multiphylo}
\alias{flatten_multiphylo}
\title{Flatten a multiphylo object}
\usage{
flatten_multiphylo(object)
}
\arguments{
\item{object}{a list of multiphylo objects}
}
\description{
Flatten a multiphylo object
}
\details{
NeXML has the concept of multiple nodes, each with multiple child nodes.
This maps naturally to a list of multiphylo objects. Sometimes
this heirarchy conveys important structural information, so it is not discarded by default.
Occassionally it is useful to flatten the structure though, hence this function. Note that this
discards the original structure, and the nexml file must be parsed again to recover it.
}
RNeXML/man/get_taxa_meta_list.Rd 0000644 0001762 0000144 00000001445 12641021656 016225 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_taxa_meta.R
\name{get_taxa_meta_list}
\alias{get_taxa_meta_list}
\title{get_taxa_meta_list}
\usage{
get_taxa_meta_list(nexml, what = "href")
}
\arguments{
\item{nexml}{a nexml object}
\item{what}{One of href, rel, id, or xsi:type}
}
\value{
the list of metadata for each taxon
}
\description{
Retrieve metadata of all species/otus otus (operational taxonomic units) included in the nexml
}
\examples{
\dontrun{
data(bird.orders)
birds <- add_trees(bird.orders)
birds <- taxize_nexml(birds, "NCBI")
RNeXML:::get_taxa_meta_list(birds)
RNeXML:::get_taxa_meta_list(birds, 'rel')
RNeXML:::get_taxa_meta_list(birds, 'id')
RNeXML:::get_taxa_meta_list(birds, 'xsi:type')
}
}
\seealso{
\code{\link{get_item}}
}
\keyword{internal}
RNeXML/man/meta.Rd 0000644 0001762 0000144 00000003023 12641021656 013310 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/meta.R
\name{meta}
\alias{meta}
\title{Constructor function for metadata nodes}
\usage{
meta(property = character(0), content = character(0), rel = character(0),
href = character(0), datatype = character(0), id = character(0),
type = character(0), children = list())
}
\arguments{
\item{property}{specify the ontological definition together with it's namespace, e.g. dc:title}
\item{content}{content of the metadata field}
\item{rel}{Ontological definition of the reference provided in href}
\item{href}{A link to some reference}
\item{datatype}{optional RDFa field}
\item{id}{optional id element (otherwise id will be automatically generated).}
\item{type}{optional xsi:type. If not given, will use either "LiteralMeta" or "ResourceMeta" as
determined by the presence of either a property or a href value.}
\item{children}{Optional element containing any valid XML block (XMLInternalElementNode class, see the XML package for details).}
}
\description{
Constructor function for metadata nodes
}
\details{
User must either provide property+content or rel+href. Mixing these will result in potential garbage.
The datatype attribute will be detected automatically from the class of the content argument. Maps from R class
to schema datatypes are as follows:
character - xs:string,
Date - xs:date,
integer - xs:integer,
numeric - xs:decimal,
logical - xs:boolean
}
\examples{
meta(content="example", property="dc:title")
}
\seealso{
\code{\link{nexml_write}}
}
RNeXML/man/get_taxa_meta.Rd 0000644 0001762 0000144 00000001376 12641021656 015175 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_taxa_meta.R
\name{get_taxa_meta}
\alias{get_taxa_meta}
\title{get_taxa_meta}
\usage{
get_taxa_meta(nexml, what = "href")
}
\arguments{
\item{nexml}{a nexml object}
\item{what}{One of href, rel, id, or xsi:type}
}
\value{
the list of metadata for each taxon
}
\description{
Retrieve metadata of all species/otus otus (operational taxonomic units) included in the nexml
}
\examples{
\dontrun{
data(bird.orders)
birds <- add_trees(bird.orders)
birds <- taxize_nexml(birds, "NCBI")
RNeXML:::get_taxa_meta(birds)
RNeXML:::get_taxa_meta(birds, 'rel')
RNeXML:::get_taxa_meta(birds, 'id')
RNeXML:::get_taxa_meta(birds, 'xsi:type')
}
}
\seealso{
\code{\link{get_item}}
}
\keyword{internal}
RNeXML/man/add_characters.Rd 0000644 0001762 0000144 00000002127 12641021656 015315 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/add_characters.R
\name{add_characters}
\alias{add_characters}
\title{Add character data to a nexml object}
\usage{
add_characters(x, nexml = new("nexml"), append_to_existing_otus = FALSE)
}
\arguments{
\item{x}{character data, in which character traits labels are column names
and taxon labels are row names. x can be in matrix or data.frame
format.}
\item{nexml}{a nexml object, if appending character table to an existing
nexml object. If ommitted will initiate a new nexml object.}
\item{append_to_existing_otus}{logical. If TRUE, will add any new taxa
(taxa not matching any existing otus block) to the existing (first)
otus block. Otherwise (default), a new otus block is created, even
though it may contain duplicate taxa to those already present. While
FALSE is the safe option, TRUE may be appropriate when building nexml
files from scratch with both characters and trees.}
}
\description{
Add character data to a nexml object
}
\examples{
library("geiger")
data(geospiza)
geiger_nex <- add_characters(geospiza$dat)
}
RNeXML/man/c-nexml-method.Rd 0000644 0001762 0000144 00000001577 12641021656 015217 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/concatenate_nexml.R
\docType{methods}
\name{c,nexml-method}
\alias{c,nexml-method}
\title{Concatenate nexml files}
\usage{
\S4method{c}{nexml}(x, ..., recursive = FALSE)
}
\arguments{
\item{x, ...}{nexml objects to be concatenated, e.g. from
\code{\link{write.nexml}} or \code{\link{read.nexml}}.
Must have unique ids on all elements}
\item{recursive}{logical. If 'recursive = TRUE', the function recursively
descends through lists (and pairlists) combining all their
elements into a vector. (Not implemented).}
}
\value{
a concatenated nexml file
}
\description{
Concatenate nexml files
}
\examples{
\dontrun{
f1 <- system.file("examples", "trees.xml", package="RNeXML")
f2 <- system.file("examples", "comp_analysis.xml", package="RNeXML")
nex1 <- read.nexml(f1)
nex2 <- read.nexml(f2)
nex <- c(nex1, nex2)
}
}
RNeXML/man/reset_id_counter.Rd 0000644 0001762 0000144 00000000357 12641021656 015726 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/internal_nexml_id.R
\name{reset_id_counter}
\alias{reset_id_counter}
\title{reset id counter}
\usage{
reset_id_counter()
}
\description{
reset the id counter
}
RNeXML/man/simmap_ex.Rd 0000644 0001762 0000144 00000001165 12641021656 014351 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/simmap.R
\docType{data}
\name{simmap_ex}
\alias{simmap_ex}
\title{A nexml class R object that includes simmap annotations}
\format{a \code{nexml} instance}
\source{
Simulated tree and stochastic character mapping based on
Revell 2011 (doi:10.1111/j.2041-210X.2011.00169.x)
}
\usage{
simmap_ex
}
\description{
A nexml object with simmap stochastic character mapping
annotations added to the edges, for use with the RNeXML package
parsing and serializing NeXML into formats that work with the ape and
phytools packages.
}
\author{
Carl Boettiger
}
RNeXML/man/nexml_read.Rd 0000644 0001762 0000144 00000002265 12665743025 014516 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/nexml_read.R
\name{nexml_read}
\alias{nexml_read}
\alias{nexml_read.XMLInternalDocument}
\alias{nexml_read.XMLInternalNode}
\alias{nexml_read.character}
\alias{read.nexml}
\title{Read NeXML files into various R formats}
\usage{
nexml_read(x, ...)
\method{nexml_read}{character}(x, ...)
\method{nexml_read}{XMLInternalDocument}(x, ...)
\method{nexml_read}{XMLInternalNode}(x, ...)
}
\arguments{
\item{x}{Path to the file to be read in. Or an \code{\link[XML]{XMLInternalDocument-class}}
or \code{\link[XML]{XMLInternalNode-class}}}
\item{...}{Further arguments passed on to \code{\link[XML]{xmlParse}}}
}
\description{
Read NeXML files into various R formats
}
\examples{
# file
f <- system.file("examples", "trees.xml", package="RNeXML")
nexml_read(f)
\dontrun{ # may take > 5 s
# url
url <- "https://raw.githubusercontent.com/ropensci/RNeXML/master/inst/examples/trees.xml"
nexml_read(url)
# character string of XML
str <- paste0(readLines(f), collapse = "")
nexml_read(str)
# XMLInternalDocument
library("httr")
library("XML")
x <- xmlParse(content(GET(url)))
nexml_read(x)
# XMLInternalNode
nexml_read(xmlRoot(x))
}
}
RNeXML/man/get_characters.Rd 0000644 0001762 0000144 00000002702 12641021656 015343 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_characters.R
\name{get_characters}
\alias{get_characters}
\title{Get character data.frame from nexml}
\usage{
get_characters(nex, rownames_as_col = FALSE, otu_id = FALSE,
otus_id = FALSE)
}
\arguments{
\item{nex}{a nexml object}
\item{rownames_as_col}{option to return character matrix rownames (with taxon ids) as it's own column in the
data.frame. Default is FALSE for compatibility with geiger and similar packages.}
\item{otu_id}{logical, default FALSE. return a column with the
otu id (for joining with otu metadata, etc)}
\item{otus_id}{logical, default FALSE. return a column with the
otus block id (for joining with otu metadata, etc)}
}
\value{
the character matrix as a data.frame
}
\description{
Get character data.frame from nexml
}
\details{
RNeXML will attempt to return the matrix using the NeXML taxon (otu) labels to name the rows
and the NeXML char labels to name the traits (columns). If these are unavailable or not unique, the NeXML
id values for the otus or traits will be used instead.
}
\examples{
\dontrun{
# A simple example with a discrete and a continous trait
f <- system.file("examples", "comp_analysis.xml", package="RNeXML")
nex <- read.nexml(f)
get_characters(nex)
# A more complex example -- currently ignores sequence-type characters
f <- system.file("examples", "characters.xml", package="RNeXML")
nex <- read.nexml(f)
get_characters(nex)
}
}
RNeXML/man/nexml_validate.Rd 0000644 0001762 0000144 00000001523 12731606043 015360 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/nexml_validate.R
\name{nexml_validate}
\alias{nexml_validate}
\title{validate nexml using the online validator tool}
\usage{
nexml_validate(file, schema = CANONICAL_SCHEMA)
}
\arguments{
\item{file}{path to the nexml file to validate}
\item{schema}{URL of schema (for fallback method only, set by default).}
}
\value{
TRUE if the file is valid, FALSE or error message otherwise
}
\description{
validate nexml using the online validator tool
}
\details{
Requires an internet connection. see http://www.nexml.org/nexml/phylows/validator for more information in debugging invalid files
}
\examples{
\dontrun{
data(bird.orders)
birds <- nexml_write(bird.orders, "birds_orders.xml")
nexml_validate("birds_orders.xml")
unlink("birds_orders.xml") # delete file to clean up
}
}
RNeXML/man/taxize_nexml.Rd 0000644 0001762 0000144 00000001177 12641021656 015101 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/taxize_nexml.R
\name{taxize_nexml}
\alias{taxize_nexml}
\title{taxize nexml}
\usage{
taxize_nexml(nexml, type = c("NCBI"), ...)
}
\arguments{
\item{nexml}{a nexml object}
\item{type}{the name of the identifier to use}
\item{...}{additional arguments (not implemented yet)}
}
\description{
Check taxanomic names against the specified service and
add appropriate semantic metadata to the nexml OTU unit
containing the corresponding identifier.
}
\examples{
\dontrun{
data(bird.orders)
birds <- add_trees(bird.orders)
birds <- taxize_nexml(birds, "NCBI")
}
}
RNeXML/man/add_meta.Rd 0000644 0001762 0000144 00000003640 12641021656 014125 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/add_meta.R
\name{add_meta}
\alias{add_meta}
\title{Add metadata to a nexml file}
\usage{
add_meta(meta, nexml = new("nexml"), level = c("nexml", "otus", "trees",
"characters"), namespaces = NULL, i = 1, at_id = NULL)
}
\arguments{
\item{meta}{a meta S4 object, e.g. ouput of the function \code{\link{meta}}, or a list of these meta objects}
\item{nexml}{(S4) object}
\item{level}{the level at which the metadata annotation should be added.}
\item{namespaces}{named character string for any additional namespaces that should be defined.}
\item{i}{for otus, trees, characters: if there are multiple such blocks, which one should be annotated? Default is first/only block.}
\item{at_id}{the id of the element to be annotated. Optional, advanced use only.}
}
\value{
the updated nexml object
}
\description{
Add metadata to a nexml file
}
\examples{
## Create a new nexml object with a single metadata element:
modified <- meta(property = "prism:modificationDate", content = "2013-10-04")
nex <- add_meta(modified) # Note: 'prism' is defined in nexml_namespaces by default.
## Write multiple metadata elements, including a new namespace:
website <- meta(href = "http://carlboettiger.info",
rel = "foaf:homepage") # meta can be link-style metadata
nex <- add_meta(list(modified, website),
namespaces = c(foaf = "http://xmlns.com/foaf/0.1/"))
## Append more metadata, and specify a level:
history <- meta(property = "skos:historyNote",
content = "Mapped from the bird.orders data in the ape package using RNeXML")
nex <- add_meta(history,
nexml = nex,
level = "trees",
namespaces = c(skos = "http://www.w3.org/2004/02/skos/core#"))
}
\seealso{
\code{\link{meta}} \code{\link{add_trees}} \code{\link{add_characters}} \code{\link{add_basic_meta}}
}
RNeXML/man/get_taxa.Rd 0000644 0001762 0000144 00000001027 12641021656 014160 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_taxa.R
\name{get_taxa}
\alias{get_otu}
\alias{get_taxa}
\title{get_taxa}
\usage{
get_taxa(nexml)
}
\arguments{
\item{nexml}{a nexml object}
}
\value{
the list of taxa
}
\description{
Retrieve names of all species/otus otus (operational taxonomic units) included in the nexml
}
\examples{
comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
nex <- nexml_read(comp_analysis)
get_taxa(nex)
}
\seealso{
\code{\link{get_item}}
}
RNeXML/man/get_citation.Rd 0000644 0001762 0000144 00000000443 12641021656 015036 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_basic_metadata.R
\name{get_citation}
\alias{get_citation}
\title{get_citation}
\usage{
get_citation(nexml)
}
\arguments{
\item{nexml}{a nexml object}
}
\value{
the list of taxa
}
\description{
get_citation
}
RNeXML/man/get_trees_list.Rd 0000644 0001762 0000144 00000001763 12641021656 015407 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_trees.R
\name{get_trees_list}
\alias{get_trees_list}
\title{extract all phylogenetic trees in ape format}
\usage{
get_trees_list(nexml)
}
\arguments{
\item{nexml}{a representation of the nexml object from which the data is to be retrieved}
}
\value{
returns a list of lists of multiphylo trees, even if all trees are in the same `trees` node (and hence the outer list will be of length 1) or if there is only a single tree (and hence the inner list will also be of length 1. This guarentees a consistent return type regardless of the number of trees present in the nexml file, and also preserves any heirarchy/grouping of trees.
}
\description{
extract all phylogenetic trees in ape format
}
\examples{
comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
nex <- nexml_read(comp_analysis)
get_trees_list(nex)
}
\seealso{
\code{\link{get_trees}} \code{\link{get_flat_trees}} \code{\link{get_item}}
}
RNeXML/man/c-meta-method.Rd 0000644 0001762 0000144 00000001305 12641021656 015007 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/meta.R
\docType{methods}
\name{c,meta-method}
\alias{c,meta-method}
\title{Concatenate meta elements into a ListOfmeta}
\usage{
\S4method{c}{meta}(x, ..., recursive = FALSE)
}
\arguments{
\item{x, ...}{meta elements to be concatenated, e.g. see \code{\link{meta}}}
\item{recursive}{logical, if 'recursive=TRUE', the function
descends through lists and combines their elements into a vector.}
}
\value{
a listOfmeta object containing multiple meta elements.
}
\description{
Concatenate meta elements into a ListOfmeta
}
\examples{
c(meta(content="example", property="dc:title"),
meta(content="Carl", property="dc:creator"))
}
RNeXML/man/get_level.Rd 0000644 0001762 0000144 00000003573 12641021656 014342 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_level.R
\name{get_level}
\alias{get_level}
\title{get_level}
\usage{
get_level(nex, level)
}
\arguments{
\item{nex}{a nexml object}
\item{level}{a character vector indicating the class of node, see details}
}
\value{
Returns the attributes of specified class of nodes as a data.frame
}
\description{
get a data.frame of attribute values of a given node
}
\details{
level should be a character vector giving the path to the specified node
group. For instance, `otus`, `characters`, and `trees` are top-level blocks (e.g.
child nodes of the root nexml block), and can be specified directly. To get metadata
for all "char" elements from all characters blocks, you must specify that `char` nodes
are child nodes to `character` nodes: e.g. `get_level(nex, "characters/char")`,
or similarly for states: `get_level(nex, characters/states)`.
The return object is a data frame whose columns are the attribute names of the elements
specified. The column names match the attribute names except for "id" attribute, for which the column
is renamed using the node itself. (Thus would be rendered in a data.frame with column
called "otus" instead of "id"). Additional columns are
added for each parent element in the path; e.g. get_level(nex, "otus/otu") would include a column
named "otus" with the id of each otus block. Even though the method always returns the data frame
for all matching nodes in all blocks, these ids let you see which otu values came from which
otus block. This is identical to the function call `get_taxa()`.
Similarly, `get_level(nex, "otus/otu/meta")` would return additional columns 'otus' and
also a column, 'otu', with the otu parent ids of each metadata block. (This is identical to a
function call to `get_metadata`). This makes it easier to join data.frames as well, see examples
}
RNeXML/man/nexml_write.Rd 0000644 0001762 0000144 00000004441 12665743025 014733 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/nexml_write.R
\name{nexml_write}
\alias{nexml_write}
\alias{write.nexml}
\title{Write nexml files}
\usage{
nexml_write(x = new("nexml"), file = NULL, trees = NULL,
characters = NULL, meta = NULL, ...)
}
\arguments{
\item{x}{a nexml object, or any phylogeny object (e.g. phylo, phylo4)
that can be coerced into one. Can also be omitted, in which case a new
nexml object will be constructed with the additional parameters specified.}
\item{file}{the name of the file to write out}
\item{trees}{phylogenetic trees to add to the nexml file (if not already given in x)
see \code{\link{add_trees}} for details.}
\item{characters}{additional characters}
\item{meta}{A meta element or list of meta elements, see \code{\link{add_meta}}}
\item{...}{additional arguments to add__basic_meta, such as the title. See \code{\link{add_basic_meta}}.}
}
\value{
Writes out a nexml file
}
\description{
Write nexml files
}
\examples{
## Write an ape tree to nexml, analgous to write.nexus:
library(ape); data(bird.orders)
write.nexml(bird.orders, file="example.xml")
\dontrun{ # takes > 5s
## Assemble a nexml section by section and then write to file:
library(geiger)
data(geospiza)
nexml <- add_trees(geospiza$phy) # creates new nexml
nexml <- add_characters(geospiza$dat, nexml = nexml) # pass the nexml obj to append character data
nexml <- add_basic_meta(title="my title", creator = "Carl Boettiger", nexml = nexml)
nexml <- add_meta(meta("prism:modificationDate", format(Sys.Date())), nexml = nexml)
write.nexml(nexml, file="example.xml")
## As above, but in one call (except for add_meta() call).
write.nexml(trees = geospiza$phy,
characters = geospiza$dat,
title = "My title",
creator = "Carl Boettiger",
file = "example.xml")
## Mix and match: identical to the section by section:
nexml <- add_meta(meta("prism:modificationDate", format(Sys.Date())))
write.nexml(x = nexml,
trees = geospiza$phy,
characters = geospiza$dat,
title = "My title",
creator = "Carl Boettiger",
file = "example.xml")
}
}
\seealso{
\code{\link{add_trees}} \code{\link{add_characters}} \code{\link{add_meta}} \code{\link{nexml_read}}
}
RNeXML/man/nexml_figshare.Rd 0000644 0001762 0000144 00000002545 12641021656 015365 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/nexml_publish.R
\name{nexml_figshare}
\alias{nexml_figshare}
\title{publish nexml to figshare}
\usage{
nexml_figshare(nexml, file = "nexml.xml",
categories = "Evolutionary Biology", tags = list("phylogeny", "NeXML"),
visibility = c("public", "private", "draft"), id = NULL, ...)
}
\arguments{
\item{nexml}{a nexml object (or file path to a nexml file)}
\item{file}{The filename desired for the object, if nexml is not already a file.
if the first argument is already a path, this value is ignored.}
\item{categories}{The figshare categories, must match available set. see \code{fs_add_categories}}
\item{tags}{Any keyword tags you want to add to the data.}
\item{visibility}{whether the results should be published (public), or kept private,
or kept as a draft for further editing before publication. (New versions can be updated,
but any former versions that was once made public will always be archived and cannot be removed).}
\item{id}{an existing figshare id (e.g. from fs_create), to which this file can be appended.}
\item{...}{additional arguments}
}
\value{
the figshare id of the object
}
\description{
publish nexml to figshare
}
\examples{
\dontrun{
data(bird.orders)
birds <- add_trees(bird.orders)
doi <- nexml_figshare(birds, visibility = "public", repository="figshare")
}
}
RNeXML/man/add_trees.Rd 0000644 0001762 0000144 00000001355 12641021656 014322 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/add_trees.R
\name{add_trees}
\alias{add_trees}
\title{add_trees}
\usage{
add_trees(phy, nexml = new("nexml"), append_to_existing_otus = FALSE)
}
\arguments{
\item{phy}{a phylo object, multiPhylo object, or list of
mulitPhylo to be added to the nexml}
\item{nexml}{a nexml object to which we should append this phylo.
By default, a new nexml object will be created.}
\item{append_to_existing_otus}{logical, indicating if we should
make a new OTU block (default) or append to the existing one.}
}
\value{
a nexml object containing the phy in nexml format.
}
\description{
add_trees
}
\examples{
library("geiger")
data(geospiza)
geiger_nex <- add_trees(geospiza$phy)
}
RNeXML/man/c-ListOfmeta-method.Rd 0000644 0001762 0000144 00000001533 12641021656 016133 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/meta.R
\docType{methods}
\name{c,ListOfmeta-method}
\alias{c,ListOfmeta-method}
\title{Concatenate ListOfmeta elements into a ListOfmeta}
\usage{
\S4method{c}{ListOfmeta}(x, ..., recursive = FALSE)
}
\arguments{
\item{x, ...}{meta or ListOfmeta elements to be concatenated, e.g. see \code{\link{meta}}}
\item{recursive}{logical, if 'recursive=TRUE', the function
descends through lists and combines their elements into a vector.}
}
\value{
a listOfmeta object containing multiple meta elements.
}
\description{
Concatenate ListOfmeta elements into a ListOfmeta
}
\examples{
metalist <- c(meta(content="example", property="dc:title"),
meta(content="Carl", property="dc:creator"))
out <- c(metalist, metalist)
out <- c(metalist, meta(content="a", property="b"))
}
RNeXML/man/get_characters_list.Rd 0000644 0001762 0000144 00000001325 12641021656 016376 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprecated.R
\name{get_characters_list}
\alias{get_characters_list}
\title{Extract the character matrix}
\usage{
get_characters_list(nexml, rownames_as_col = FALSE)
}
\arguments{
\item{nexml}{nexml object (e.g. from read.nexml)}
\item{rownames_as_col}{option to return character matrix rownames
(with taxon ids) as it's own column in the data.frame. Default is FALSE
for compatibility with geiger and similar packages.}
}
\value{
the list of taxa
}
\description{
Extract the character matrix
}
\examples{
comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
nex <- nexml_read(comp_analysis)
get_characters_list(nex)
}
RNeXML/man/add_namespaces.Rd 0000644 0001762 0000144 00000002673 12641021656 015323 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/add_namespaces.R
\name{add_namespaces}
\alias{add_namespaces}
\title{add namespaces}
\usage{
add_namespaces(namespaces, nexml = new("nexml"))
}
\arguments{
\item{namespaces}{a named character vector of namespaces}
\item{nexml}{a nexml object. will create a new one if none is given.}
}
\value{
a nexml object with updated namespaces
}
\description{
add namespaces, avoiding duplication if prefix is already defined
}
\examples{
## Create a new nexml object with a single metadata element:
modified <- meta(property = "prism:modificationDate", content = "2013-10-04")
nex <- add_meta(modified) # Note: 'prism' is defined in nexml_namespaces by default.
## Write multiple metadata elements, including a new namespace:
website <- meta(href = "http://carlboettiger.info",
rel = "foaf:homepage") # meta can be link-style metadata
nex <- add_meta(list(modified, website),
namespaces = c(foaf = "http://xmlns.com/foaf/0.1/"))
## Append more metadata, and specify a level:
history <- meta(property = "skos:historyNote",
content = "Mapped from the bird.orders data in the ape package using RNeXML")
nex <- add_meta(history,
nexml = nex,
level = "trees",
namespaces = c(skos = "http://www.w3.org/2004/02/skos/core#"))
}
\seealso{
\code{\link{meta}} \code{\link{add_meta}}
}
RNeXML/man/get_trees.Rd 0000644 0001762 0000144 00000001533 12641021656 014347 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_trees.R
\name{get_trees}
\alias{get_trees}
\title{extract a phylogenetic tree from the nexml}
\usage{
get_trees(nexml)
}
\arguments{
\item{nexml}{a representation of the nexml object from which the data is to be retrieved}
}
\value{
an ape::phylo tree, if only one tree is represented. Otherwise returns a list of lists of multiphylo trees. To consistently recieve the list of lists format (preserving the heriarchical nature of the nexml), use \code{\link{get_trees_list}} instead.
}
\description{
extract a phylogenetic tree from the nexml
}
\examples{
comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
nex <- nexml_read(comp_analysis)
get_trees(nex)
}
\seealso{
\code{\link{get_trees}} \code{\link{get_flat_trees}} \code{\link{get_item}}
}
RNeXML/man/get_flat_trees.Rd 0000644 0001762 0000144 00000001647 12641021656 015363 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_trees.R
\name{get_flat_trees}
\alias{get_flat_trees}
\title{get_flat_trees}
\usage{
get_flat_trees(nexml)
}
\arguments{
\item{nexml}{a representation of the nexml object from which the data is to be retrieved}
}
\value{
a multiPhylo object (list of ape::phylo objects). See details.
}
\description{
extract a single multiPhylo object containing all trees in the nexml
}
\details{
Note that this method collapses any heirachical structure that may have been present as multiple `trees` nodes in the original nexml (though such a feature is rarely used). To preserve that structure, use \code{\link{get_trees}} instead.
}
\examples{
comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
nex <- nexml_read(comp_analysis)
get_flat_trees(nex)
}
\seealso{
\code{\link{get_trees}} \code{\link{get_trees}} \code{\link{get_item}}
}
RNeXML/man/nexml_publish.Rd 0000644 0001762 0000144 00000001303 12641021656 015232 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/nexml_publish.R
\name{nexml_publish}
\alias{nexml_publish}
\title{publish nexml files to the web and receive a DOI}
\usage{
nexml_publish(nexml, ..., repository = "figshare")
}
\arguments{
\item{nexml}{a nexml object (or file path)}
\item{...}{additional arguments, depending on repository. See examples.}
\item{repository}{desitination respository}
}
\value{
a digital object identifier to the published data
}
\description{
publish nexml files to the web and receive a DOI
}
\examples{
\dontrun{
data(bird.orders)
birds <- add_trees(bird.orders)
doi <- nexml_publish(birds, visibility = "public", repository="figshare")
}
}
RNeXML/man/get_metadata.Rd 0000644 0001762 0000144 00000001553 12641025014 014777 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_metadata.R
\name{get_metadata}
\alias{get_metadata}
\title{get_metadata}
\usage{
get_metadata(nexml, level = "nexml")
}
\arguments{
\item{nexml}{a nexml object}
\item{level}{the name of the level of element desired, see details}
}
\value{
the requested metadata as a data.frame. Additional columns
indicate tha parent element of the return value.
}
\description{
get_metadata
}
\details{
'level' should be either the name of a child element of a NeXML document
(e.g. "otu", "characters"), or a path to the desired element, e.g. 'trees/tree'
will return the metadata for all phylogenies in all trees blocks.
}
\examples{
\dontrun{
comp_analysis <- system.file("examples", "primates.xml", package="RNeXML")
nex <- nexml_read(comp_analysis)
get_metadata(nex)
get_metadata(nex, "otus/otu")
}
}
RNeXML/man/get_namespaces.Rd 0000644 0001762 0000144 00000001120 12641021656 015334 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_namespaces.R
\name{get_namespaces}
\alias{get_namespaces}
\title{get namespaces}
\usage{
get_namespaces(nexml)
}
\arguments{
\item{nexml}{a nexml object}
}
\value{
a named character vector providing the URLs defining each
of the namespaces used in the nexml file. Names correspond to
the prefix abbreviations of the namespaces.
}
\description{
get namespaces
}
\examples{
comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
nex <- nexml_read(comp_analysis)
get_namespaces(nex)
}
RNeXML/man/get_rdf.Rd 0000644 0001762 0000144 00000001536 12641021656 014003 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_rdf.R
\name{get_rdf}
\alias{get_rdf}
\title{Extract rdf-xml from a NeXML file}
\usage{
get_rdf(file)
}
\arguments{
\item{file}{the name of a nexml file, or otherwise a nexml object.}
}
\value{
an RDF-XML object (XMLInternalDocument). This can be manipulated with
tools from the XML R package, or converted into a triplestore for use with
SPARQL queries from the rrdf R package.
}
\description{
Extract rdf-xml from a NeXML file
}
\examples{
\dontrun{
f <- system.file("examples", "meta_example.xml", package="RNeXML")
rdf <- get_rdf(f)
## Write to a file and read in with rrdf
tmp <- tempfile()
saveXML(rdf, tmp)
library(rrdf)
lib <- load.rdf(tmp)
## Perform a SPARQL query:
sparql.rdf(lib, "SELECT ?title WHERE { ?x ?title}")
}
}
RNeXML/man/nexml_get.Rd 0000644 0001762 0000144 00000004615 12641021656 014354 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/nexml_get.R
\name{nexml_get}
\alias{get_item}
\alias{nexml_get}
\title{Get the desired element from the nexml object}
\usage{
nexml_get(nexml, element = c("trees", "trees_list", "flat_trees", "metadata",
"otu", "taxa", "characters", "characters_list", "namespaces"), ...)
}
\arguments{
\item{nexml}{a nexml object (from read_nexml)}
\item{element}{the kind of object desired, see details.}
\item{...}{additional arguments, if applicable to certain elements}
}
\value{
return type depends on the element requested. See details.
}
\description{
Get the desired element from the nexml object
}
\details{
\itemize{
\item{"tree"}{ an ape::phylo tree, if only one tree is represented. Otherwise returns a list of lists of multiphylo trees. To consistently recieve the list of lists format (preserving the heriarchical nature of the nexml), use \code{trees} instead.}
\item{"trees"}{ returns a list of lists of multiphylo trees, even if all trees are in the same `trees` node (and hence the outer list will be of length 1) or if there is only a single tree (and hence the inner list will also be of length 1. This guarentees a consistent return type regardless of the number of trees present in the nexml file, and also preserves any heirarchy/grouping of trees. }
\item{"flat_trees"}{ a multiPhylo object (list of ape::phylo objects) Note that this method collapses any heirachical structure that may have been present as multiple `trees` nodes in the original nexml (though such a feature is rarely used). To preserve that structure, use `trees` instead.}
\item{"metadata"}{Get metadata from the specified level (default is top/nexml level) }
\item{"otu"}{ returns a named character vector containing all available metadata. names indicate \code{property} (or \code{rel} in the case of links/resourceMeta), while values indicate the \code{content} (or \code{href} for links). }
\item{"taxa"}{ alias for otu }
}
For a slightly cleaner interface, each of these elements is also defined as an S4 method
for a nexml object. So in place of `get_item(nexml, "tree")`, one could use `get_tree(nexml)`,
and so forth for each element type.
}
\examples{
comp_analysis <- system.file("examples", "comp_analysis.xml", package="RNeXML")
nex <- nexml_read(comp_analysis)
nexml_get(nex, "trees")
nexml_get(nex, "characters_list")
}
\seealso{
\code{\link{get_trees}}
}
RNeXML/man/nexml_add.Rd 0000644 0001762 0000144 00000001646 12641021656 014326 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/nexml_add.R
\name{nexml_add}
\alias{nexml_add}
\title{add elements to a new or existing nexml object}
\usage{
nexml_add(x, nexml = new("nexml"), type = c("trees", "characters", "meta",
"namespaces"), ...)
}
\arguments{
\item{x}{the object to be added}
\item{nexml}{an existing nexml object onto which the object should be appended}
\item{type}{the type of object being provided.}
\item{...}{additional optional arguments to the add functions}
}
\value{
a nexml object with the additional data
}
\description{
add elements to a new or existing nexml object
}
\examples{
library("geiger")
data(geospiza)
geiger_nex <- nexml_add(geospiza$phy, type="trees")
geiger_nex <- nexml_add(geospiza$dat, nexml = geiger_nex, type="characters")
}
\seealso{
\code{\link{add_trees}} \code{\link{add_characters}} \code{\link{add_meta}} \code{\link{add_namespaces}}
}
RNeXML/man/simmap_to_nexml.Rd 0000644 0001762 0000144 00000001257 12641021656 015564 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/simmap.R
\name{simmap_to_nexml}
\alias{simmap_to_nexml}
\title{simmap_to_nexml}
\usage{
simmap_to_nexml(phy, state_ids = NULL)
}
\arguments{
\item{phy}{a phy object containing simmap phy$maps element,
from the phytools pacakge}
\item{state_ids}{a named character vector giving the state
names corresponding to the ids used to refer to each state
in nexml. If null ids will be generated and states taken from
the phy$states names.}
}
\value{
a nexml representation of the simmap
}
\description{
simmap_to_nexml
}
\examples{
data(simmap_ex)
phy <- nexml_to_simmap(simmap_ex)
nex <- simmap_to_nexml(phy)
}
RNeXML/man/get_taxa_list.Rd 0000644 0001762 0000144 00000000645 12641021656 015220 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_taxa.R
\name{get_taxa_list}
\alias{get_otus_list}
\alias{get_taxa_list}
\title{get_taxa_list}
\usage{
get_taxa_list(nexml)
}
\arguments{
\item{nexml}{a nexml object}
}
\value{
the list of taxa
}
\description{
Retrieve names of all species/otus otus (operational taxonomic units) included in the nexml
}
\seealso{
\code{\link{get_item}}
}
RNeXML/man/toPhylo.Rd 0000644 0001762 0000144 00000001023 12641021656 014016 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_trees.R
\name{toPhylo}
\alias{toPhylo}
\title{nexml to phylo}
\usage{
toPhylo(tree, otus)
}
\arguments{
\item{tree}{an nexml tree element}
\item{otus}{a character string of taxonomic labels, named by the otu ids.
e.g. (from get_otu_maps for the otus set matching the relevant trees node.}
}
\value{
phylo object. If a "reconstructions" annotation is found on the
edges, return simmap maps slot as well.
}
\description{
nexml to phylo coercion
}
RNeXML/man/get_license.Rd 0000644 0001762 0000144 00000000436 12641021656 014650 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_basic_metadata.R
\name{get_license}
\alias{get_license}
\title{get_license}
\usage{
get_license(nexml)
}
\arguments{
\item{nexml}{a nexml object}
}
\value{
the list of taxa
}
\description{
get_license
}
RNeXML/man/add_basic_meta.Rd 0000644 0001762 0000144 00000005640 12731606043 015267 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/add_basic_meta.R
\name{add_basic_meta}
\alias{add_basic_meta}
\title{Add basic metadata}
\usage{
add_basic_meta(title = NULL, description = NULL,
creator = Sys.getenv("USER"), pubdate = Sys.Date(), rights = "CC0",
publisher = NULL, citation = NULL, nexml = new("nexml"))
}
\arguments{
\item{title}{A title for the dataset}
\item{description}{a description of the dataset}
\item{creator}{name of the data creator. Can be a string or R person object}
\item{pubdate}{publication date. Default is current date.}
\item{rights}{the intellectual property rights associated with the data.
The default is Creative Commons Zero (CC0) public domain declaration,
compatiable with all other licenses and appropriate for deposition
into the Dryad or figshare repositories. CC0 is also recommended by the Panton Principles.
Alternatively, any other plain text string can be added and will be provided as the content
attribute to the dc:rights property.}
\item{publisher}{the publisher of the dataset. Usually where a user may go to find the canonical
copy of the dataset: could be a repository, journal, or academic institution.}
\item{citation}{a citation associated with the data. Usually an acompanying academic journal
article that indicates how the data should be cited in an academic context. Multiple citations
can be included here.
citation can be a plain text object, but is preferably an R `citation` or `bibentry` object (which
can include multiple citations. See examples}
\item{nexml}{a nexml object to which metadata should be added. A new
nexml object will be created if none exists.}
}
\value{
an updated nexml object
}
\description{
adds Dublin Core metadata elements to (top-level) nexml
}
\details{
\code{add_basic_meta()} is just a wrapper for \code{\link{add_meta}} to make it easy to
provide generic metadata without explicitly providing the namespace. For instance,
\code{add_basic_meta(title="My title", description="a description")} is identical to:
\code{add_meta(list(meta("dc:title", "My title"), meta("dc:description", "a description")))}
Most function arguments are mapped directly to the Dublin Core terms
of the same name, with the exception of `rights`, which by default maps
to the Creative Commons namespace when using CC0 license.
}
\examples{
nex <- add_basic_meta(title = "My test title",
description = "A description of my test",
creator = "Carl Boettiger ",
publisher = "unpublished data",
pubdate = "2012-04-01")
## Adding citation to an R package:
nexml <- add_basic_meta(citation=citation("ape"))
\dontrun{
## Use knitcitations package to add a citation by DOI:
library(knitcitations)
nexml <- add_basic_meta(citation = bib_metadata("10.2307/2408428"))
}
}
\seealso{
\code{\link{add_trees}} \code{\link{add_characters}} \code{\link{add_meta}}
}
RNeXML/man/nexml_to_simmap.Rd 0000644 0001762 0000144 00000000706 12641021656 015562 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/simmap.R
\name{nexml_to_simmap}
\alias{nexml_to_simmap}
\title{nexml_to_simmap}
\usage{
nexml_to_simmap(nexml)
}
\arguments{
\item{nexml}{a nexml object}
}
\value{
a simmap object (phylo object with a $maps element
for use in phytools functions).
}
\description{
nexml_to_simmap
}
\examples{
data(simmap_ex)
phy <- nexml_to_simmap(simmap_ex)
nex <- simmap_to_nexml(phy)
}
RNeXML/LICENSE 0000644 0001762 0000144 00000000120 12641021656 012320 0 ustar ligges users YEAR: 2013 - 2014
COPYRIGHT HOLDER: Carl Boettiger
ORGANIZATION: rOpenSci
