inst/doc/vignette.R

In treebase: Discovery, Access and Manipulation of 'TreeBASE' Phylogenies

## ----include=FALSE-------------------------------------------------------
knitr::opts_chunk$set(eval = FALSE)

## ----install, eval=FALSE-------------------------------------------------
#  install.packages('treebase')

## ----loadpkg-------------------------------------------------------------
#  library(treebase)

## ----search1, eval=FALSE, message=FALSE, warning=FALSE-------------------
#  both <- search_treebase("Ronquist or Hulesenbeck", by=c("author", "author"))
#  dolphins <- search_treebase('"Delphinus"', by="taxon", max_trees=5)
#  studies <- search_treebase("2377", by="id.study")

## ----search2, message=FALSE, warning=FALSE-------------------------------
#  Near <- search_treebase("Near", "author", branch_lengths=TRUE, max_trees=3)
#  Near[1]

## ----metadata, eval=FALSE, message=FALSE, warning=FALSE------------------
#  all <- download_metadata("", by="all")
#  dates <- sapply(all, function(x) as.numeric(x$date))
#  library(ggplot2)
#  qplot(dates, main="Treebase growth", xlab="Year", binwidth=.5)

## ----eval=FALSE, message=FALSE, warning=FALSE----------------------------
#  nature <- sapply(all, function(x) length(grep("Nature", x$publisher))>0)
#  science <- sapply(all, function(x) length(grep("^Science$", x$publisher))>0)
#  sum(nature)
#  sum(science)

## ----message=FALSE, warning=FALSE----------------------------------------
#  search_treebase("Derryberry", "author")[[1]] -> tree
#  plot(tree)

## ----message=FALSE, warning=FALSE, eval = FALSE--------------------------
#  library(laser)
#  tt <- branching.times(tree)
#  models <-  list(pb = pureBirth(tt),
#                  bdfit = bd(tt),
#                  y2r = yule2rate(tt), # yule model with single shift pt
#                  ddl = DDL(tt), # linear, diversity-dependent
#                  ddx = DDX(tt), #exponential diversity-dendent
#                  sv = fitSPVAR(tt), # vary speciation in time
#                  ev = fitEXVAR(tt), # vary extinction in time
#                  bv = fitBOTHVAR(tt)# vary both
#                  )
#  names(models[[3]])[5] <- "aic"
#  aics <- sapply(models, "[[", "aic")
#  # show the winning model
#  models[which.min(aics)]
#  
#  

## ----eval=FALSE, message=FALSE, warning=FALSE----------------------------
#  timetree <- function(tree){
#      check.na <- try(sum(is.na(tree$edge.length))>0)
#      if(is(check.na, "try-error") | check.na)
#        NULL
#      else
#      try( chronoMPL(multi2di(tree)) )
#  }
#  drop_errors <- function(tr){
#    tt <- tr[!sapply(tr, is.null)]
#    tt <- tt[!sapply(tt, function(x) is(x, "try-error"))]
#    print(paste("dropped", length(tr)-length(tt), "trees"))
#    tt
#  }
#  require(laser)
#  pick_branching_model <- function(tree){
#    m1 <- try(pureBirth(branching.times(tree)))
#    m2 <- try(bd(branching.times(tree)))
#    as.logical(try(m2$aic < m1$aic))
#  }

## ----eval=FALSE, message=FALSE, warning=FALSE----------------------------
#  all <- search_treebase("Consensus", "type.tree", branch_lengths=TRUE)
#  tt <- drop_errors(sapply(all, timetree))
#  is_yule <- sapply(tt, pick_branching_model)
#  table(is_yule)