makeVRangesFromDataFrame

##' Make a VRanges object from a GRanges object
##' 
##' makeVRangesFromDataFrame takes a \code{\linkS4class{GenomicRanges}} object as input and tries to find the specified columns required by the \code{\link{VRanges}} constructor.
##' @param gr \code{\linkS4class{GenomicRanges}} object
##' @param ... Additional arguments passed on to the \code{\link{VRanges}} constructor function.
##' @return \code{\linkS4class{VRanges}} object
##' @importFrom VariantAnnotation VRanges
##' @importFrom GenomicRanges makeGRangesFromDataFrame
##' @importMethodsFrom S4Vectors mcols
##' @importMethodsFrom GenomeInfoDb seqinfo
##' @examples 
##' df <- data.frame(
##'   chr=rep("chr1",3),
##'   start=11:13, 
##'   end=12:14,
##'   ref=c("C", "A", "T"),
##'   alt=c("G", NA, "C"), 
##'   refDepth=rep(10,3), 
##'   altDepth=c(5,NA,6), 
##'   totalDepth=c(15,20,30), 
##'   sampleNames=letters[1:3],
##'   score=1:3
##' )
##' gr <- GenomicRanges::makeGRangesFromDataFrame(
##'   df, 
##'   keep.extra.columns = TRUE
##' )
##' makeVRangesFromGRanges( gr )
makeVRangesFromGRanges <- function(
  gr, 
  ref.field = c("ref"),
  alt.field = c("alt"),
  totalDepth.field = c("totalDepth"), 
  altDepth.field = c("altDepth"), 
  refDepth.field = c("refDepth"), 
  sampleNames.field = c("sampleNames"), 
  ...
  
){
  ## check arguments
  if (!is(gr, "GenomicRanges")){
    stop("'df' must be a GenomicRanges object")
  }
  .isString <- function(x){
    if( !(is.character(x) && length(x) == 1)){
      stop(
        paste0(deparse(x), " is not a string (a length one character vector)."),
        call. = FALSE 
      )
    }
    return(TRUE)
  }
  vapply(
    c(
      ref.field,
      alt.field,
      totalDepth.field,
      altDepth.field,
      refDepth.field,
      sampleNames.field
    ),
    .isString,
    logical(1)
  )    
  
  ## match field names
  matched.fields <- base::match(
    base::tolower(
      c(
        ref.field,
        alt.field,
        totalDepth.field,
        altDepth.field,
        refDepth.field,
        sampleNames.field
      )
    ),
    base::tolower(
      colnames(
        mcols(gr)
      )
    ),
    nomatch = 0
  )
  names( matched.fields ) <- c(
    "ref.field",
    "alt.field",
    "totalDepth.field",
    "altDepth.field",
    "refDepth.field",
    "sampleNames.field"
  )
  
  ## lookup VRanges columns
  if( matched.fields["ref.field"] == 0){
    stop("No 'ref' column could be identified.")
  }
  ref.allele <- as.character(S4Vectors::mcols(gr)[,matched.fields["ref.field"]])
  total.depth <- alt.depth <- ref.depth <- NA_integer_
  sample.names <- alt.allele <- NA_character_
  
  if( matched.fields["alt.field"] != 0 ){
    alt.allele <- as.character(S4Vectors::mcols(gr)[,matched.fields["alt.field"]])
  }
  if( matched.fields["totalDepth.field"] != 0 ){
    total.depth <- as.character(S4Vectors::mcols(gr)[,matched.fields["totalDepth.field"]])
  } 
  if( matched.fields["altDepth.field"] != 0 ){
    alt.depth <- as.character(S4Vectors::mcols(gr)[,matched.fields["altDepth.field"]])
  } 
  if( matched.fields["refDepth.field"] != 0 ){
    ref.depth <- as.character(S4Vectors::mcols(gr)[,matched.fields["refDepth.field"]])
  }
  if( matched.fields["sampleNames.field"] != 0 ){
    sample.names <- as.character(S4Vectors::mcols(gr)[,matched.fields["sampleNames.field"]])
  }
  
    ## construct VRanges
    vr <- VariantAnnotation::VRanges( 
    seqnames = seqnames( gr ), 
    ranges=ranges(gr),
    ref = ref.allele, 
    alt = alt.allele, 
    totalDepth = total.depth, 
    altDepth = alt.depth, 
    refDepth = ref.depth, 
    sampleNames = sample.names, 
    seqinfo = GenomeInfoDb::seqinfo(gr),
    mcols(gr)[,-matched.fields,drop=FALSE],
    ...
  )
  row.names(vr) <- row.names(gr)
  return(vr)
}