[adegenet-commits] r407 - pkg/R

[noreply at r-forge.r-project.org]

Author: jombart
Date: 2009-06-18 19:16:44 +0200 (Thu, 18 Jun 2009)
New Revision: 407

Modified:
   pkg/R/seqTrack.R
Log:
get.likelihood done.


Modified: pkg/R/seqTrack.R
===================================================================
--- pkg/R/seqTrack.R	2009-06-17 18:16:51 UTC (rev 406)
+++ pkg/R/seqTrack.R	2009-06-18 17:16:44 UTC (rev 407)
@@ -11,7 +11,17 @@
 }
 
 
+get.likelyhood <- function(...){
+    UseMethod("get.likelyhood")
+}
 
+get.likelyhood.seqTrack.default <- function(...){
+    cat("Method not implemented.")
+    return()
+}
+
+
+
 #############
 ## seqTrack
 #############
@@ -114,6 +124,8 @@
     res <- cbind.data.frame(id,res, date=x.dates, ances.date)
     rownames(res) <- x.names
 
+    class(res) <- c("seqTrack","data.frame")
+
     return(res)
 } # end seqTrack
 
@@ -131,7 +143,7 @@
                          plot=TRUE,...){
 
     ## CHECKS ##
-    if(class(x) != "data.frame") stop("x is not a data.frame")
+    if(!inherits(x,"seqTrack")) stop("x is not a seqTrack object")
     ##if(ncol(x) != 5) stop("x does not have five columns")
     if(ncol(xy) != 2) stop("xy does not have two columns")
     if(nrow(xy) != nrow(x)) stop("x and xy have inconsistent dimensions")
@@ -411,8 +423,6 @@
 
 
 
-
-
 #####################
 ## optimize.seqTrack
 #####################
@@ -801,6 +811,39 @@
 
 
 
+###########################
+## get.likelyhood.seqTrack
+###########################
+get.likelyhood.seqTrack <-function(x, method=("genetic"), mu0=NULL, seq.length=NULL,...){
+    method <- match.arg(method)
+    if(method=="genetic"){ # p(nb mutations occur in the time interval)
+        if(any(na.omit(res$weight - round(res$weight) > 1e-10))){
+            warning("Non-integer weights: number of mutations expected in x$weight.")
+        }
+
+        if(is.null(mu0)) stop("mu0 is required.")
+        if(is.null(seq.length)) stop("seq.length is required.")
+
+        dates <- as.POSIXct(x$date)
+        anc.dates <- as.POSIXct(x$ances.date)
+        nb.days <- abs(as.integer(anc.dates-dates))
+        nb.mut <- x$weight
+        mu <- mu0/365
+        mu <- mu*nb.days
+
+        res <- dbinom(nb.mut, size=seq.length, prob=mu)
+    } else{
+        cat("Method not implemented.")
+    }
+
+    return(res)
+} # end get.likelyhood.seqTrack
+
+
+
+
+
+
 ###############
 ## seqTrack.ml
 ###############