# samHeader.R - Construct and work with the header from a *.sam file
#' Return a SamHeader object
#'
#' S3 method that returns an S3 SamHeader objet.
#'
#' @section Internal implementation:
#' A \code{SamHeader} object is supposed to be
#' opaque to the user, with internals accesible via \code{SamSource(x)},
#' \code{as.data.frame(x)}, and \code{areHeaderTagsParsed(x)}.
#'
#' Currently this object is structured as a \code{list} with two elements:
#' \code{header} which is the header data frame and
#' \code{areHeaderTagsParsed}, which is \code{TRUE} when the record sub-tags
#' are parsed parsed and \code{FALSE} otherwise. Currently this is always
#' false. The object also has an attribute, \code{source}, which is the source
#' object. This structure may change on a patch release with no notice.
#'
#' @param x For \code{SamHeader(x)}, this is the object to extract or build a
#' sam header object from. It can be a character vector of unparsed header
#' lines or a \code{Sam} object. For \code{as.data.frame(x)}, it can only be a
#' \code{SamHeader} object.
#'
#' @param source The \code{SamSource} object to associate with a header. If
#' \code{x} is a \code{Sam} object, it will use that objects \code{SamSource},
#' otherwise it will use a default \code{SamSource()}
#'
#' @param ... Required for S3 object method implementation. Not currently used.
#'
#' @return For \code{SamHeader()}, a \code{SamHeader} object.
#'
#' For \code{as.data.frame(SamHeader)}, a data frame as generated by
#' \code{\link{parseSamHeaderLines}},
#'
#' @seealso Sam, SamSource, as.data.frame.SamSource
#'
#' @export
SamHeader <- function(x, ...) {
UseMethod("SamHeader")
}
#' Parse strings as sam file header lines
#'
#' @param x Vector of string, each a sam file header
#'
#' @return A SamHeader data frame. Currently this has only two columns, the
#' first giving the tag name, the second the original full line. Not the final
#' version of this.
#'
#' @export
parseSamHeaderLines <- function( x ) {
tag= substr(trimws(x), 2, 3)
if (any(substr( x, 1, 1 ) != "@")) {
stop( "Header lines must begin with \"@\"" )
}
if (any(substr( tag, 2, 2 ) == ":")) {
warning( "Possible use of one character tags in headers" )
}
data.frame(
tag=tag,
record = trimws(sub("^@..\\t", "", x)),
row.names= 1:length(x),
stringsAsFactors = FALSE
)
}
#' @rdname SamHeader
#' @export
SamHeader.character <- function( x, source= SamSource(NULL), ... ) {
return( structure(
class= "SamHeader", source= source,
list( header= parseSamHeaderLines(x), areHeaderTagsParsed= FALSE )
))
}
#' @rdname SamHeader
#' @export
SamHeader.Sam <- function( x, ... ) {
return( structure(
class= "SamHeader", source= attr(x, "source"),
list( header= x$header, areHeaderTagsParsed= x$areHeaderTagsParsed )
))
}
#' @rdname SamHeader
#' @export
as.data.frame.SamHeader <- function(x, ...) {
return(x$header)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.