.Rhistory

suggestion.distance = 1
)
View(names.flora.2020)
phylomatic.names <-
tolower(paste(names.aggregated$name.family,
names.aggregated$name.genus,
paste(names.aggregated$name.genus,
names.aggregated$name.epithet,
sep = "_"),
sep = "/"))
phylomatic.names
get.tree.phylomatic <-
phylomatic(
phylomatic.names,
taxnames = FALSE,
informat = "newick",
method = "phylomatic",
storedtree = "R20120829",
outformat = "newick",
clean = FALSE, # influência no plot
db = "apg",
verbose = TRUE
)
# se o 'clean = TRUE', use a função plot direto.
# plot(get.tree.phylomatic)
plot(collapse.singles(get.tree.phylomatic), no.margin=TRUE)
###############################################################################
################### PHYLOCOM WORKFLOW #########################################
###############################################################################
# Uma pequena adaptação baseada em:
# https://greggilbertlab.sites.ucsc.edu/wp-content/uploads/sites/276/2015/10/R_Class10b_PicatePhylomatic.pdf
# temp <- tempfile()
# download.file("http://phylodiversity.net/phylocom/phylocom-4.2.zip", temp, mode = "wb")
# unzip(temp)
# setwd("phylocom-4.2/w32")
# getwd()
#
# write.tree(get.tree.phylomatic, "tree-phylomatic")
#
# file.rename(from = "../example_data/bladj_example/wikstrom.ages",
#            to = "ages")
#
# dated.tree <- system("phylocom bladj -f tree-phylomatic > dated-tree",
#                      intern = TRUE)
#
# write(dated.tree, "dated-tree")
#
# dated.clean <- scan("dated-tree", what = "character", nmax = -1, sep = "]")
#
# dated.clean <-
#   sub(pattern = ")euphyllophyte:1.000000",
#       replacement = "",
#       x = dated.clean)
#
# dated.clean <- sub(pattern = "\\(",
#                    replacement = "",
#                    x = dated.clean)
#
# dated.clean <- gsub(pattern = " ",
#                     replacement = "",
#                     x = dated.clean)
#
# dated.clean <- read.newick(text = dated.clean)
#
# setwd("../../")
# getwd()
#
# write.tree(dated.clean, "data/dated.clean.txt")
dated.clean <- read.newick(file = "data/dated.clean.txt")
# dated.clean$edge
# dated.clean$tip.label
# dated.clean$Nnode
# dated.clean$node.label
plot(collapse.singles(dated.clean), no.margin=TRUE)
add.scale.bar(length = 100)
# plot.phylo(collapse.singles(dated.clean), type = "phylogram", use.edge.length = TRUE, show.tip.label = TRUE, show.node.label = TRUE, edge.color = "grey10")
# nodelabels()
# tiplabels()
#
# cophenetic.phylo(collapse.singles(dated.clean))
temp <- tempfile()
download.file("http://phylodiversity.net/phylocom/phylocom-4.2.zip", temp, mode = "wb")
temp <- tempfile()
download.file("https://github.com/phylocom/phylocom/releases/download/4.2/phylocom-4.2.zip", temp, mode = "wb")
temp <- tempfile()
download.file("https://github.com/phylocom/phylocom/releases/download/4.2/phylocom-4.2.zip", temp, mode = "wb")
temp <- tempfile()
download.file("https://github.com/phylocom/phylocom/releases/download/4.2/phylocom-4.2.zip", temp, mode = "wb")
library(packrat)
packrat::init()
knitr::opts_chunk$set(echo = TRUE)
source("functions/ipak.R")
ipak(packages <- c("readxl", "reshape2", "magrittr", "flora",
"data.table", "ape", "phytools", "brranching",
"picante"))
sessionInfo()
knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(echo = TRUE)
local({
## Helper function to get the path to the library directory for a
## given packrat project.
getPackratLibDir <- function(projDir = NULL) {
path <- file.path("packrat", "lib", R.version$platform, getRversion())
if (!is.null(projDir)) {
## Strip trailing slashes if necessary
projDir <- sub("/+$", "", projDir)
## Only prepend path if different from current working dir
if (!identical(normalizePath(projDir), normalizePath(getwd())))
path <- file.path(projDir, path)
}
path
}
## Ensure that we set the packrat library directory relative to the
## project directory. Normally, this should be the working directory,
## but we also use '.rs.getProjectDirectory()' if necessary (e.g. we're
## rebuilding a project while within a separate directory)
libDir <- if (exists(".rs.getProjectDirectory"))
getPackratLibDir(.rs.getProjectDirectory())
else
getPackratLibDir()
## Unload packrat in case it's loaded -- this ensures packrat _must_ be
## loaded from the private library. Note that `requireNamespace` will
## succeed if the package is already loaded, regardless of lib.loc!
if ("packrat" %in% loadedNamespaces())
try(unloadNamespace("packrat"), silent = TRUE)
if (suppressWarnings(requireNamespace("packrat", quietly = TRUE, lib.loc = libDir))) {
# Check 'print.banner.on.startup' -- when NA and RStudio, don't print
print.banner <- packrat::get_opts("print.banner.on.startup")
if (print.banner == "auto" && is.na(Sys.getenv("RSTUDIO", unset = NA))) {
print.banner <- TRUE
} else {
print.banner <- FALSE
}
return(packrat::on(print.banner = print.banner))
}
## Escape hatch to allow RStudio to handle bootstrapping. This
## enables RStudio to provide print output when automagically
## restoring a project from a bundle on load.
if (!is.na(Sys.getenv("RSTUDIO", unset = NA)) &&
is.na(Sys.getenv("RSTUDIO_PACKRAT_BOOTSTRAP", unset = NA))) {
Sys.setenv("RSTUDIO_PACKRAT_BOOTSTRAP" = "1")
setHook("rstudio.sessionInit", function(...) {
# Ensure that, on sourcing 'packrat/init.R', we are
# within the project root directory
if (exists(".rs.getProjectDirectory")) {
owd <- getwd()
setwd(.rs.getProjectDirectory())
on.exit(setwd(owd), add = TRUE)
}
source("packrat/init.R")
})
return(invisible(NULL))
}
## Bootstrapping -- only performed in interactive contexts,
## or when explicitly asked for on the command line
if (interactive() || "--bootstrap-packrat" %in% commandArgs(TRUE)) {
message("Packrat is not installed in the local library -- ",
"attempting to bootstrap an installation...")
## We need utils for the following to succeed -- there are calls to functions
## in 'restore' that are contained within utils. utils gets loaded at the
## end of start-up anyhow, so this should be fine
library("utils", character.only = TRUE)
## Install packrat into local project library
packratSrcPath <- list.files(full.names = TRUE,
file.path("packrat", "src", "packrat")
)
## No packrat tarballs available locally -- try some other means of installation
if (!length(packratSrcPath)) {
message("> No source tarball of packrat available locally")
## There are no packrat sources available -- try using a version of
## packrat installed in the user library to bootstrap
if (requireNamespace("packrat", quietly = TRUE) && packageVersion("packrat") >= "0.2.0.99") {
message("> Using user-library packrat (",
packageVersion("packrat"),
") to bootstrap this project")
}
## Couldn't find a user-local packrat -- try finding and using devtools
## to install
else if (requireNamespace("devtools", quietly = TRUE)) {
message("> Attempting to use devtools::install_github to install ",
"a temporary version of packrat")
library(stats) ## for setNames
devtools::install_github("rstudio/packrat")
}
## Try downloading packrat from CRAN if available
else if ("packrat" %in% rownames(available.packages())) {
message("> Installing packrat from CRAN")
install.packages("packrat")
}
## Fail -- couldn't find an appropriate means of installing packrat
else {
stop("Could not automatically bootstrap packrat -- try running ",
"\"'install.packages('devtools'); devtools::install_github('rstudio/packrat')\"",
"and restarting R to bootstrap packrat.")
}
# Restore the project, unload the temporary packrat, and load the private packrat
packrat::restore(prompt = FALSE, restart = TRUE)
## This code path only reached if we didn't restart earlier
unloadNamespace("packrat")
requireNamespace("packrat", lib.loc = libDir, quietly = TRUE)
return(packrat::on())
}
## Multiple packrat tarballs available locally -- try to choose one
## TODO: read lock file and infer most appropriate from there; low priority because
## after bootstrapping packrat a restore should do the right thing
if (length(packratSrcPath) > 1) {
warning("Multiple versions of packrat available in the source directory;",
"using packrat source:\n- ", shQuote(packratSrcPath))
packratSrcPath <- packratSrcPath[[1]]
}
lib <- file.path("packrat", "lib", R.version$platform, getRversion())
if (!file.exists(lib)) {
dir.create(lib, recursive = TRUE)
}
lib <- normalizePath(lib, winslash = "/")
message("> Installing packrat into project private library:")
message("- ", shQuote(lib))
surround <- function(x, with) {
if (!length(x)) return(character())
paste0(with, x, with)
}
## The following is performed because a regular install.packages call can fail
peq <- function(x, y) paste(x, y, sep = " = ")
installArgs <- c(
peq("pkgs", surround(packratSrcPath, with = "'")),
peq("lib", surround(lib, with = "'")),
peq("repos", "NULL"),
peq("type", surround("source", with = "'"))
)
installCmd <- paste(sep = "",
"utils::install.packages(",
paste(installArgs, collapse = ", "),
")")
fullCmd <- paste(
surround(file.path(R.home("bin"), "R"), with = "\""),
"--vanilla",
"--slave",
"-e",
surround(installCmd, with = "\"")
)
system(fullCmd)
## Tag the installed packrat so we know it's managed by packrat
## TODO: should this be taking information from the lockfile? this is a bit awkward
## because we're taking an un-annotated packrat source tarball and simply assuming it's now
## an 'installed from source' version
## -- InstallAgent -- ##
installAgent <- 'InstallAgent: packrat 0.4.8-1'
## -- InstallSource -- ##
installSource <- 'InstallSource: source'
packratDescPath <- file.path(lib, "packrat", "DESCRIPTION")
DESCRIPTION <- readLines(packratDescPath)
DESCRIPTION <- c(DESCRIPTION, installAgent, installSource)
cat(DESCRIPTION, file = packratDescPath, sep = "\n")
# Otherwise, continue on as normal
message("> Attaching packrat")
library("packrat", character.only = TRUE, lib.loc = lib)
message("> Restoring library")
restore(restart = FALSE)
# If the environment allows us to restart, do so with a call to restore
restart <- getOption("restart")
if (!is.null(restart)) {
message("> Packrat bootstrap successfully completed. ",
"Restarting R and entering packrat mode...")
return(restart())
}
# Callers (source-erers) can define this hidden variable to make sure we don't enter packrat mode
# Primarily useful for testing
if (!exists(".__DONT_ENTER_PACKRAT_MODE__.") && interactive()) {
message("> Packrat bootstrap successfully completed. Entering packrat mode...")
packrat::on()
}
Sys.unsetenv("RSTUDIO_PACKRAT_BOOTSTRAP")
}
})
source("functions/ipak.R")
ipak(packages <- c("readxl", "reshape2", "magrittr", "flora",
"data.table", "ape", "phytools", "brranching",
"picante"))
knitr::opts_chunk$set(echo = TRUE)
library(packrat)
packrat::restore()
?decostand
source("functions/ipak.R")
ipak(c("readxl",
"reshape2",
"magrittr",
"flora",
"data.table",
"ape",
"phytools",
"brranching",
"picante"))
source("functions/ipak.R")
ipak(c("readxl",
"reshape2",
"magrittr",
"flora",
"data.table",
"ape",
"phytools",
"brranching",
"picante"))
raw.df <- read_excel("data/raw-data.xlsx", sheet = 1, col_names = TRUE)
str(raw.df) # estrutura da matriz e os tipos de variáveis contidas
new.df <-
subset(
raw.df,
select = c(
"sites",
"morphospecies",
"name.genus",
"name.epithet"
)
)
# new.df$name.merged <-  # 'name.merged' será uma nova coluna
#   with(new.df,         # em 'new.df', contendo a
#        paste0(         # concatenação das strings em
#          name.genus,   # 'name.genus'
#          ".",          # mais um ponto (".") e
#          name.epithet  # name.epithet
#          )
#        )
new.df$name.coded <-          # 'name.coded' será uma nova coluna
with(new.df,                # em 'new.df', contendo a
paste0(                # concatenação das strings
substr(              # que tiveram as letras extraídas
name.genus, 1, 3   # 'name.genus' (da primeira à terceira letra)
),                 # mais
".",                 # um ponto (".") e
substr(              #
name.epithet, 1, 3 # 'name.epithet' (da primeira à terceira letra)
)
)
)
str(new.df)
df1 <- ftable(morphospecies ~ sites, new.df) %>% # mantém df1 para a próxima função
as.matrix(.) %>% # o ponto se refere à df1
as.data.frame(.) # o ponto se refere à df1
df1
source("functions/ipak.R")
ipak(c("readxl",
"reshape2",
"magrittr",
"flora",
"data.table",
"ape",
"phytools",
"brranching",
"picante"))
new.df <-
subset(
raw.df,
select = c(
"sites",
"morphospecies",
"name.genus",
"name.epithet"
)
)
raw.df <- read_excel("data/raw-data.xlsx", sheet = 1, col_names = TRUE)
str(raw.df) # estrutura da matriz e os tipos de variáveis contidas
new.df <-
subset(
raw.df,
select = c(
"sites",
"morphospecies",
"name.genus",
"name.epithet"
)
)
# new.df$name.merged <-  # 'name.merged' será uma nova coluna
#   with(new.df,         # em 'new.df', contendo a
#        paste0(         # concatenação das strings em
#          name.genus,   # 'name.genus'
#          ".",          # mais um ponto (".") e
#          name.epithet  # name.epithet
#          )
#        )
new.df$name.coded <-          # 'name.coded' será uma nova coluna
with(new.df,                # em 'new.df', contendo a
paste0(                # concatenação das strings
substr(              # que tiveram as letras extraídas
name.genus, 1, 3   # 'name.genus' (da primeira à terceira letra)
),                 # mais
".",                 # um ponto (".") e
substr(              #
name.epithet, 1, 3 # 'name.epithet' (da primeira à terceira letra)
)
)
)
str(new.df)
df1 <- ftable(morphospecies ~ sites, new.df) %>% # mantém df1 para a próxima função
as.matrix(.) %>% # o ponto se refere à df1
as.data.frame(.) # o ponto se refere à df1
df1
df2 <- ftable(name.coded ~ sites, new.df) %>% # mantém df2 para a próxima função
as.matrix(.) %>% # o ponto se refere à df2
as.data.frame(.) # o ponto se refere à df2
df2      # chamando a matriz no console
df3 <- df2[order(colSums(df2), decreasing = TRUE)]
df3
df3 <- df2[order(colSums(df2), decreasing = TRUE)]
df3
xy <- read_excel("data/raw-data.xlsx", sheet = 2, col_names = TRUE) %>%
.[,-1]
for (i in colnames(df3)) {
plot(
xy,
cex = df3[, i],
pch = 22,
col = "white",
bg = "gray"
)
title(names(df3[i]))
}
raw.dt <- as.data.table(raw.df)
names.aggregated <-
raw.dt[, list(.N), by = c("name.family",
"name.genus",
"name.epithet")]
names.aggregated
query.flora <- paste0(names.aggregated$name.genus,
" ",
names.aggregated$name.epithet)
query.flora
names.flora.2020 <-
get.taxa(
query.flora,
replace.synonyms = TRUE,
suggest.names = TRUE,
life.form = TRUE,
habitat = TRUE,
vernacular = TRUE,
states = TRUE,
establishment = TRUE,
suggestion.distance = 1
)
phylomatic.names <-
tolower(paste(names.aggregated$name.family,
names.aggregated$name.genus,
paste(names.aggregated$name.genus,
names.aggregated$name.epithet,
sep = "_"),
sep = "/"))
phylomatic.names
get.tree.phylomatic <-
phylomatic(
phylomatic.names,
taxnames = FALSE,
informat = "newick",
method = "phylomatic",
storedtree = "R20120829",
outformat = "newick",
clean = FALSE, # influência no plot
db = "apg",
verbose = TRUE
)
# se o 'clean = TRUE', use a função plot direto.
# plot(get.tree.phylomatic)
plot(collapse.singles(get.tree.phylomatic), no.margin=TRUE)
temp <- tempfile()
download.file("https://github.com/phylocom/phylocom/releases/download/4.2/phylocom-4.2.zip", temp, method = "wget")
unzip(temp)
temp <- tempfile()
download.file("https://github.com/phylocom/phylocom/releases/download/4.2/phylocom-4.2.zip", temp, method = "wget")
unzip(temp)
setwd("phylocom-4.2/src")
system("make", invisible = FALSE)
system("./phylocom", invisible = FALSE)
bladj
bladj
ls
ls()
write.tree(get.tree.phylomatic, "tree-phylomatic")
file.copy(from = "../example_data/bladj_example/wikstrom.ages", to = ".")
file.rename(from = "wikstrom.ages", to = "ages")
dated.tree <- system("./phylocom bladj -f tree-phylomatic > dated-tree", invisible = FALSE)
dated.tree <- system("./phylocom bladj -f tree-phylomatic > dated-tree")
write(dated.tree, "dated-tree")
dated.clean <- scan("dated-tree", what = "character", nmax = -1, sep = "]")
dated.clean <-
sub(pattern = ")euphyllophyte:1.000000",
replacement = "",
x = dated.clean)
dated.clean <- sub(pattern = "\\(",
replacement = "",
x = dated.clean)
dated.clean <- gsub(pattern = " ",
replacement = "",
x = dated.clean)
dated.clean <- read.newick(text = dated.clean)
dated.tree <- system("./phylocom bladj -f tree-phylomatic > dated-tree")
write(dated.tree, "dated-tree")
dated.tree <- system("./phylocom bladj -f tree-phylomatic > dated-tree")
dated.clean <- scan("dated-tree", what = "character", nmax = -1, sep = "]")
dated.clean <-
sub(pattern = ")euphyllophyte:1.000000",
replacement = "",
x = dated.clean)
dated.clean <- sub(pattern = "\\(",
replacement = "",
x = dated.clean)
dated.clean <- gsub(pattern = " ",
replacement = "",
x = dated.clean)
dated.clean <- read.newick(text = dated.clean)
setwd("../../")
write.tree(dated.clean, "data/dated.clean.txt")
dated.clean <- read.newick(file = "data/dated.clean.txt")
plot(collapse.singles(dated.clean), no.margin=TRUE)
add.scale.bar(length = 100)