Merge pull request #40 from richfitz/cran-fix

.Rbuildignore

@@ -7,3 +7,4 @@ run_tests.R
 .travis.yml
 diversitree_.*\.tar.gz
 src/GNUmakefile
+^\.github$

.github/.gitignore

@@ -0,0 +1 @@
+*.html

.github/workflows/R-CMD-check.yaml

@@ -0,0 +1,60 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: R-CMD-check
+
+jobs:
+  R-CMD-check:
+    runs-on: ${{ matrix.config.os }}
+
+    name: ${{ matrix.config.os }} (${{ matrix.config.r }})
+
+    strategy:
+      fail-fast: false
+      matrix:
+        config:
+          - {os: macos-latest,   r: 'release'}
+          - {os: windows-latest, r: 'release'}
+          - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
+          - {os: ubuntu-latest,   r: 'release'}
+          - {os: ubuntu-latest,   r: 'oldrel-1'}
+
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      R_KEEP_PKG_SOURCE: yes
+
+    steps:
+      - uses: actions/checkout@v3
+
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          r-version: ${{ matrix.config.r }}
+          http-user-agent: ${{ matrix.config.http-user-agent }}
+          use-public-rspm: true
+
+      - name: Install lib-gsl
+        if: runner.os == 'macOS'
+        run: |
+          brew install gsl
+
+      - name: Install Windows system dependencies
+        if: runner.os == 'Windows'
+        run: |
+          pacman -Sy # Update repo index
+          pacman -S --noconfirm mingw-w64-x86_64-gsl mingw-w64-i686-gsl mingw-w64-ucrt-x86_64-gsl
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::rcmdcheck
+          needs: check
+
+      - uses: r-lib/actions/check-r-package@v2
+        with:
+          upload-snapshots: true

.github/workflows/pkgdown.yaml

@@ -0,0 +1,46 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+  release:
+    types: [published]
+  workflow_dispatch:
+
+name: pkgdown
+
+jobs:
+  pkgdown:
+    runs-on: ubuntu-latest
+    # Only restrict concurrency for non-PR jobs
+    concurrency:
+      group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - uses: actions/checkout@v3
+
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::pkgdown, local::.
+          needs: website
+
+      - name: Build site
+        run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)
+        shell: Rscript {0}
+
+      - name: Deploy to GitHub pages 🚀
+        if: github.event_name != 'pull_request'
+        uses: JamesIves/github-pages-deploy-action@v4.4.1
+        with:
+          clean: false
+          branch: gh-pages
+          folder: docs

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: diversitree
-Version: 0.9-17
+Version: 0.9-18
 Title: Comparative 'Phylogenetic' Analyses of Diversification
 Authors@R: c(person("Richard G.", "FitzJohn", role = c("aut", "cre"),
     email = "rich.fitzjohn@gmail.com"),

NAMESPACE

@@ -98,6 +98,7 @@ export(mcmc)
 
 S3method(mcmc, default)
 S3method(mcmc, dtlik)
+S3method(mcmc, lowerzero)
 
 export(sampler.slice)
 export(sampler.norm)
@@ -187,6 +188,8 @@ S3method(make.asr.marginal, musse)
 S3method(make.asr.marginal, bisse.t)
 S3method(make.asr.marginal, musse.t)
 
+S3method(make.asr.marginal, geosse)
+
 S3method(residuals, pgls.dt)
 S3method(fitted,    pgls.dt)
 S3method(residuals, fit.mle.pgls)

R/asr-bisse.R

@@ -7,7 +7,7 @@
 make.asr.marginal.bisse <- function(lik, ...) {
   e <- environment(lik)
   unresolved <- e$unresolved
-  do.asr <- make.do.asr.marginal(e$all.branches, e$rootfunc)
+  do.asr <- make.do.asr.marginal(e$all_branches, e$rootfunc)
   asr <- function(pars, nodes=NULL, condition.surv=TRUE,
                   root=ROOT.FLAT, root.p=NULL, ...) {
     check.pars.bisse(pars)
@@ -22,7 +22,7 @@ make.asr.marginal.bisse.split <- function(lik, ...) {
   e <- environment(lik)
   unresolved <- e$unresolved
   cache <- get.cache(lik)
-  do.asr <- make.do.asr.marginal(e$all.branches, e$rootfunc)
+  do.asr <- make.do.asr.marginal(e$all_branches, e$rootfunc)
   asr <- function(pars, nodes=NULL, condition.surv=TRUE,
                   root=ROOT.FLAT, root.p=NULL, ...) {
     pars <- check.pars.bisse.split(pars, cache$n.part)

R/asr-geosse.R

@@ -1,6 +1,6 @@
 make.asr.marginal.geosse <- function(lik, ...) {
   e <- environment(lik)
-  do.asr <- make.do.asr.marginal(e$all.branches, e$rootfunc)
+  do.asr <- make.do.asr.marginal(e$all_branches, e$rootfunc)
   asr <- function(pars, nodes=NULL, condition.surv=TRUE,
                   root=ROOT.FLAT, root.p=NULL, ...) {
     check.pars.nonnegative(pars, 7)    

R/asr-mkn.R

@@ -3,7 +3,7 @@ make.asr.marginal.mkn <- function(lik, ...) {
     stop("ASR not yet possible with ode-based Mkn")
   e <- environment(lik)
   f.pars <- e$f.pars
-  all.branches <- e$all.branches
+  all_branches <- e$all_branches
   cache <- e$cache
 
   info <- get.info(lik)
@@ -23,7 +23,7 @@ make.asr.marginal.mkn <- function(lik, ...) {
     root.f <- function(pars, vals, lq)
       rootfunc.mkn(list(vals=vals, lq=lq), pars, root, root.p, FALSE)
 
-    res <- all.branches(pars2, TRUE, NULL)
+    res <- all_branches(pars2, TRUE, NULL)
     .Call(r_asr_marginal_mkn, k, pars2, nodes.C, cache.C, res,
           root.f, env)
   }

R/asr-musse.R

@@ -7,7 +7,7 @@
 make.asr.marginal.musse <- function(lik, ...) {
   e <- environment(lik)
   f.pars <- e$f.pars
-  do.asr <- make.do.asr.marginal(e$all.branches, e$rootfunc)
+  do.asr <- make.do.asr.marginal(e$all_branches, e$rootfunc)
   asr <- function(pars, nodes=NULL, condition.surv=TRUE,
                   root=ROOT.FLAT, root.p=NULL, ...) {
     pars2 <- f.pars(pars)

R/asr-t.R

@@ -1,7 +1,7 @@
-make.asr.marginal.dtlik.t <- function(lik, ...) {
+make_asr_marginal_dtlik_t <- function(lik, ...) {
   e <- environment(lik)
   cache <- get.cache(lik)
-  do.asr <- make.do.asr.marginal(e$all.branches, e$rootfunc)
+  do.asr <- make.do.asr.marginal(e$all_branches, e$rootfunc)
   preset <- NULL
 
   ## Slightly different prototypes will be needed for different
@@ -16,6 +16,6 @@ make.asr.marginal.dtlik.t <- function(lik, ...) {
   asr
 }
 
-make.asr.marginal.bisse.t <- make.asr.marginal.dtlik.t
-make.asr.marginal.musse.t <- make.asr.marginal.dtlik.t
+make.asr.marginal.bisse.t <- make_asr_marginal_dtlik_t
+make.asr.marginal.musse.t <- make_asr_marginal_dtlik_t
 

R/asr.R

@@ -51,8 +51,8 @@ make.asr.stoch.constrained <- function(lik, ...) {
 }
 
 ## Next, the utility functions for the different types of models This
-## is to asr.marginal what all.branches is for the core models.  Here,
-## the argument 'res' is the result of running all.branches
+## is to asr.marginal what all_branches is for the core models.  Here,
+## the argument 'res' is the result of running all_branches
 do.asr.marginal.R <- function(pars, cache, res, nodes, states.idx,
                               initial.conditions, branches, root,
                               ...) {
@@ -105,8 +105,8 @@ do.asr.marginal.R <- function(pars, cache, res, nodes, states.idx,
   matrix(unlist(lapply(nodes, f)), ncol=length(nodes))
 }
 
-make.do.asr.marginal <- function(all.branches, rootfunc) {
-  eb <- environment(all.branches)
+make.do.asr.marginal <- function(all_branches, rootfunc) {
+  eb <- environment(all_branches)
   cache <- eb$cache
   states.idx <- cache$info$idx.d
   if (isTRUE(cache$info$partitioned)) {
@@ -119,7 +119,7 @@ make.do.asr.marginal <- function(all.branches, rootfunc) {
   function(pars, nodes, preset, ...) {
     root.f <- function(res, pars)
       rootfunc(res, pars, ...)
-    res <- all.branches(pars, TRUE, preset)
+    res <- all_branches(pars, TRUE, preset)
     do.asr.marginal.R(pars, cache, res, nodes, states.idx,
                       initial.conditions, branches, root.f)
   }

R/clade-tree.R

@@ -62,7 +62,7 @@ clades.from.polytomies <- function(tree) {
 
   ## Drop all but the representative species from each clade.
   clades.drop <- sort(unlist(lapply(clades, "[", -1)))
-  tree2 <- drop.tip.fixed(tree, clades.drop)
+  tree2 <- drop_tip_fixed(tree, clades.drop)
 
   make.clade.tree(tree2, clades.spp)
 }
@@ -98,7 +98,7 @@ clades.from.sample <- function(phy, p) {
     }
   }
 
-  make.clade.tree(drop.tip.fixed(phy, drop), clades)
+  make.clade.tree(drop_tip_fixed(phy, drop), clades)
 }
 
 
@@ -131,7 +131,7 @@ ancestors2 <- function(x, tree, tips.only=FALSE) {
 clades.from.classification <- function(tree, class, check=TRUE) {
   n.tip <- length(tree$tip.label)
 
-  if ( class(class) != "character" )
+  if ( !is.character(class) )
     stop("'class' must be a character vector")
   if ( length(class) != n.tip )
     stop("'class' must be the same length as the tip.labels")
@@ -154,7 +154,7 @@ clades.from.classification <- function(tree, class, check=TRUE) {
            paste(names(desc)[!ok], collapse=", "))
       i <- which(!ok)[1]
       to.drop <- setdiff(tree$tip.label, chk[[i]])
-      tmp <- drop.tip.fixed(tree, setdiff(tree$tip.label, chk[[i]]))
+      tmp <- drop_tip_fixed(tree, setdiff(tree$tip.label, chk[[i]]))
       col <- (tmp$tip.label %in% tree$tip.label[class == names(chk)[i]])+1
       plot2.phylo(tmp, type="f", cex=.5, label.offset=1, font=1,
                   tip.color=col, no.margin=TRUE)
@@ -164,7 +164,7 @@ clades.from.classification <- function(tree, class, check=TRUE) {
 
   to.drop <- unlist(lapply(spp.cl, "[", -1))
   if ( length(to.drop) > 0 )
-    tree.cl <- drop.tip.fixed(tree, unlist(lapply(spp.cl, "[", -1)))
+    tree.cl <- drop_tip_fixed(tree, unlist(lapply(spp.cl, "[", -1)))
   else
     tree.cl <- tree
   tmp <- sapply(spp.cl, "[[", 1)

R/continuous.R

@@ -28,7 +28,7 @@ check.control.continuous <- function(control) {
   control
 }
 
-make.all.branches.continuous <- function(cache, control) {
+make.all_branches.continuous <- function(cache, control) {
   cache.C <- toC.cache.continuous(cache)
 
   br.name <- sprintf("branches_%s", cache$info$name)
@@ -75,7 +75,7 @@ toC.cache.continuous <- function(cache) {
   cache
 }
 
-make.all.branches.rescale.vcv <- function(cache, control) {
+make.all_branches.rescale.vcv <- function(cache, control) {
   n.tip <- cache$n.tip
   states <- cache$states
   states.sd <- cache$states.sd
@@ -95,7 +95,7 @@ make.all.branches.rescale.vcv <- function(cache, control) {
   }
 }
 
-make.all.branches.rescale.contrasts <- function(cache, control) {
+make.all_branches.rescale.contrasts <- function(cache, control) {
   if (any(cache$states.sd > 0))
     stop("Cannot (yet) do contrasts based bm models with state error")
 
@@ -131,7 +131,7 @@ make.all.branches.rescale.contrasts <- function(cache, control) {
     ## duplicated!
     root.x <- pgls.root.mean.bm(tree, cache$states)
 
-    ## This is the bit that is shared with all.branches.bm
+    ## This is the bit that is shared with all_branches.bm
     ll <- -(n * log(2 * pi * s2) +
             sum(log(V)) +
             log(V0) +