#' @import tibble
#' @import dplyr
NULL

#' Build error matrix.
#' 
#' Error matrix is a 4 x 4 numeric matrix providing sequencing
#' error probalibiltie for each nucleotides. Each row correspond
#' to one of the four nucleotides `A`,`C`,`G`,`T`. Each column indicates
#' the probability of reading a given nucleotide considering that the TRUE
#' one is indicated by the row.
#' `error.jc` build an error matrix following the Juke et Cantor model
#' where all errors are equiprobable.
#
#' @param rate is the global error probability per site expressed as a numeric
#'             value ranging between 0 and 1.
#'             
#' @return a 4 x 4 numeric matrix providing sequencing
#'         error probalibiltie for each nucleotides.
#'         
#' @examples 
#'   # Build an error matrix corresponding 
#'   # to 5% of sequencing error
#'   
#'   err = error_jc(0.05)
#'   err
#'   
#'   #          A          C          G          T
#'   # A 0.95000000 0.01666667 0.01666667 0.01666667
#'   # C 0.01666667 0.95000000 0.01666667 0.01666667
#'   # G 0.01666667 0.01666667 0.95000000 0.01666667
#'   # T 0.01666667 0.01666667 0.01666667 0.95000000
#'   
#' @author Eric Coissac
#' @export
error_jc = function(rate) {
  e = rate/3
  err = matrix(e,nrow = 4,ncol=4)
  diag(err)=1-rate
  rownames(err) <- c("A","C","G","T")
  colnames(err) <- rownames(err)
  
  return(err)
}

#' Generate substitution sequencing error.
#' 
#' Simulate substitution sequencing error on a set of nucleotides following
#' substitution rates stored in an error matrix.
#' 
#' @param nuc         character; a vector of nucleotide to be modified according
#'                    to a error matrix.
#' @param error       numeric 4 x 4 matrix; the error matrix as produced by the
#'                     \code{\link{error_jc}} function.
#'      
#' @examples 
#'    sequencing_error(c("A","A","C","T","T","G"),
#'                     error_jc(0.2))              
#' 
#' @seealso \code{\link{error_jc}}
#' @author Eric Coissac
#' @export
sequencing_error = function(nuc,error) {
  apply(error[nuc,,drop=FALSE],
        MARGIN = 1,
        function(p) sample(colnames(error),
                           size = 1,
                           prob = p))
}

#' Simulate the shotgun sequencing of a diploid loci.
#' 
#' Build a contengency table of observed nucleotide for a given site
#' after its sequencing. 
#' 
#' @param haplotype.1 character; the first haplotype  A, C, G or T of the locus.
#' @param haplotype.2 character; the second haplotype A, C, G or T of the locus.
#' @param coverage    numeric;   the average sequencing depth of the sequencing.
#' @param error       numeric 4 x 4 matrix; the error matrix as produced by the
#'                     \code{\link{error_jc}} function
#'                     
#' @return a tibble with seven columns. \code{haplotype.1} and \code{haplotype.2} are both
#'         the true happlotypes at the given locus. \code{haplotype.1} is by convention 
#'         always lexicographically smaller than \code{haplotype.2}. 
#'         \code{coverage} the actual sequencing
#'         depth at that locus. It a random number drawn from a Poisson distribution
#'         of mean \code{coverage}. \code{A}, \code{C}, \code{G}, \code{T} 
#'         the simulated observation of each nucleotide after the sequencing.  
#'                     
#' @examples 
#'     simulate_sites(c("A","C","T"),
#'                    c("A","G","G"),
#'                    coverage=10,
#'                    error = error_jc(0.1))
#'                     
#' @seealso \code{\link{error_jc}}
#' @author Eric Coissac
#' @export
simulate_sites = function(haplotype.1,haplotype.2,coverage,error) {
  n = length(haplotype.1)
  stopifnot(n==length(haplotype.2))
  
  genotypes = tibble(haplotype.1,haplotype.2)
  genotypes = as.tibble(t(apply(genotypes,
                                MARGIN = 1,
                                sort)))
  
  colnames(genotypes) = c("haplotype.1","haplotype.2")
  
  cov = rpois(n,lambda = coverage-1)+1
  obs1= vapply(cov,function(x) rbinom(1,x,0.5),0)
  obs2 = cov - obs1
  
  rep = matrix(0,nrow = n,ncol = 4)
  colnames(rep) = c("A","C","G","T")

  mapply(function(i,a1,a2,o1,o2) { rep[i,a1]<<-rep[i,a1] + o1;
                                   rep[i,a2]<<-rep[i,a2] + o2},
               1:n,
               genotypes$haplotype.1,
               genotypes$haplotype.2,
               obs1,
               obs2)
  
  
  rep = apply(rep,
              MARGIN = 1,
              function(ns) table(factor(sequencing_error(rep(c("A","C","G","T"),
                                                             ns),
                                                         error),
                                        levels=c("A","C","G","T"))))
 

  rep = as.tibble(t(rep))
  
  rep = bind_cols(haplotype.1=haplotype.1,
                  haplotype.2=haplotype.2,
                  coverage=cov,
                  rep)
  
  return(rep)
}
