bug fix in chronopl()

git-svn-id: https://svn.mpl.ird.fr/ape/dev/ape@164 6e262413-ae40-0410-9e79-b911bd7a66b7

diff --git a/DESCRIPTION b/DESCRIPTION
index a45a55b216d6dfb3b5f25a59ff0e257619e210a7..4ea823664ab744ebfb3f630ec4acaa8f2f20915b 100644 (file)
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: ape
 Version: 2.7-3
-Date: 2011-06-22
+Date: 2011-07-04
 Title: Analyses of Phylogenetics and Evolution
 Author: Emmanuel Paradis, Ben Bolker, Julien Claude, Hoa Sien Cuong, Richard Desper, Benoit Durand, Julien Dutheil, Olivier Gascuel, Christoph Heibl, Daniel Lawson, Vincent Lefort, Pierre Legendre, Jim Lemon, Yvonnick Noel, Johan Nylander, Rainer Opgen-Rhein, Klaus Schliep, Korbinian Strimmer, Damien de Vienne
 Maintainer: Emmanuel Paradis <Emmanuel.Paradis@ird.fr>

diff --git a/NEWS b/NEWS
index a3aa8c97e7ab0d49d29f6711b1a41ed6b5b5a812..9e66a45982269e849ce15198fc94c2813a598e50 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -18,6 +18,9 @@ BUG FIXES
       process when alpha = 0 to avoid division by zero. The option
       'linear' has been removed.
 
+    o Cross-validation in chronopl() did not work when 'age.max' was
+      used.
+
 
 
                CHANGES IN APE VERSION 2.7-2

diff --git a/R/chronopl.R b/R/chronopl.R
index 570fa2602fbd9166199c5f68dc6e81fb6b73a4f6..0e72a3f65107c17b7de1d857bbcbe668fba5f93f 100644 (file)
--- a/R/chronopl.R
+++ b/R/chronopl.R
@@ -1,8 +1,8 @@
-## chronopl.R (2009-07-06)
+## chronopl.R (2011-07-04)
 
 ##   Molecular Dating With Penalized Likelihood
 
-## Copyright 2005-2009 Emmanuel Paradis
+## Copyright 2005-2011 Emmanuel Paradis
 
 ## This file is part of the R-package `ape'.
 ## See the file ../COPYING for licensing issues.
@@ -80,6 +80,9 @@ chronopl <-
     ratio <- age.min[1]/ini.time[node[1]]
     ini.time <- ini.time*ratio
 
+    ## because if (!is.null(age.max)), 'node' is modified, so we copy it in case CV = TRUE:
+    node.bak <- node
+
     if (length(node) > 1) {
         ini.time[node] <- age.min
         real.edge.length <- ini.time[e[, 1]] - ini.time[e[, 2]]
@@ -94,12 +97,12 @@ chronopl <-
                     ini.time[e[i, 1]] <- ini.time[e[1, 1]] + 2 * real.edge.length[i]
                     next
                 }
-                browser()
+                ##browser()
                 ini.time[e[i, 2]] <- ini.time[e[1, 2]] - real.edge.length[i]
                 ini.time[e[i, 1]] <- ini.time[e[1, 1]] + real.edge.length[i]
             }
             real.edge.length <- ini.time[e[, 1]] - ini.time[e[, 2]]
-            print(min(real.edge.length))
+            ##print(min(real.edge.length))
         }
     }
     ## `unknown.ages' will contain the index of the nodes of unknown age:
@@ -198,7 +201,7 @@ chronopl <-
     if (CV) ophy <- phy
     phy$edge.length <- age[e[, 1]] - age[e[, 2]]
     if (CV) attr(phy, "D2") <-
-        chronopl.cv(ophy, lambda, age.min, age.max, node,
+        chronopl.cv(ophy, lambda, age.min, age.max, node.bak,
                     n, S, tol, eval.max, iter.max, ...)
     phy
 }
@@ -214,9 +217,8 @@ chronopl.cv <- function(ophy, lambda, age.min, age.max, nodes,
     BT <- branching.times(ophy)
     D2 <- numeric(n)
 
-    cat("  dropping tip")
     for (i in 1:n) {
-        cat(" ", i, sep = "")
+        cat("\r  dropping tip ", i, " / ", n, sep = "")
         tr <- drop.tip(ophy, i)
         j <- which(ophy$edge[, 2] == i)
         if (ophy$edge[j, 1] %in% nodes) {