R/io.r

In gitter: Quantification of Pinned Microbial Cultures

.getFlags <- function(dat){
  size_median = median(dat$size)
  if(size_median == 0){
    s = dat$size
  }else{
    s = dat$size / size_median
  }
  
  c = dat$circularity
  n = nrow(dat)
  
  fl = c()
  # If 10% of colonies have colonies smaller than 0.1
  if( (sum(s < 0.1) / n) > 0.1){
    fl = append(fl, "1")
  }
  # If empty 
  if( (sum(is.na(c) | c < 0.6) / n) > 0.1 ){
    fl = append(fl, "2")
  }
  return(fl)
}

.flagMap = c("1"="high count of small colony sizes",
             "2"="high count of low colony circularity")
.warningPat = "# Warning possible misgridding: "


.gitter.write <- function(dat, path){
  hd = c(sprintf('# gitter v%s data file generated on %s', .GITTER_VERSION, format(Sys.time(), "%a %b %d %X %Y")))
  id = .getFlags(dat)
  id = id[id %in% names(.flagMap)]
  fl = unname(.flagMap[id])
  if(length(fl) > 0){
    attr(dat, 'warnings') = fl
    fl = sprintf(paste0(.warningPat, "%s"), paste0(fl, collapse=', '))
    hd = append(hd, fl)
  }
  hd = append(hd, '# Flags: S - Colony spill or edge interference, C - Low colony circularity')
  writeLines(hd, path)
  cat('# ', file=path, append=T)
  
  suppressWarnings( write.table(dat, file=path, quote=F, sep='\t', row.names=F, col.names=T, append=T) )
  loginfo('Saved dat file to: %s', path)
  return(dat)
}

#' Read in a data file as a \code{\link{gitter}} data object.
#' 
#' This function will take a path to a data file generated by \code{\link{gitter}} and read it into a \code{\link{gitter}} object for use with plot, summary and warning functions.
#' 
#' @keywords gitter read dat file
#' 
#' @param path Path to the data file generated by \code{\link{gitter}}.
#' 
#' @return \code{\link{gitter}} \code{\link{data.frame}} object for use with plot, summary and warning functions.
#' @examples
#' # Get dat file path
#' f = system.file("extdata", "sample.jpg.dat", package="gitter")
#' # Read in path as a gitter data object
#' g = gitter.read(f)
#' @export
gitter.read <- function(path){
  if(is.character(path)){
    dat = read.table(path, stringsAsFactors=F, header=F, sep='\t')
    names(dat) = c('row', 'col', 'size', 'circularity', 'flags')
    
    #Read first 5 lines
    con  <- file(path, open = "r")
    i = 1
    while (length(line <- readLines(con, n = 1, warn = FALSE)) > 0) {
      if(i > 5) break;
      if(grepl(pattern=.warningPat, line)){
        line = gsub(.warningPat, replacement="", line)
        x = strsplit(line, ", ")[[1]]
        x = x[x %in% .flagMap]
        attr(dat, "warnings") = x
      }
    } 
    close(con)
  }else if(!is.data.frame(path)){
    stop('Please enter the filepath to a gitter data file')
  }
  class(dat) = c('gitter', 'data.frame')
  return(dat)
}

#' Show any plate-level warnings associated with a \code{\link{gitter}} data object
#' 
#' This function will show warnings associated with a \code{\link{gitter}} data object.
#' 
#' @keywords warning plate error
#' 
#' @param dat The data.frame produced by \code{\link{gitter}}.
#' 
#' @return 
#' Warnings associated with the gitter data object or NULL if no warnings.
#' 
#' @examples
#' # dat = gitter("/path/to/image")
#' # plate.warnings(dat)
#' 
#' @export
plate.warnings <- function(dat){
  if(!is.data.frame(dat) & ! 'gitter' %in% class(dat)) stop('Argument must be a gitter data object')
  return( attr(dat, 'warnings') )
}

#' View the summary of a gitter data file
#' 
#' This function will show a brief summary of a data frame produced by \code{\link{gitter}}. 
#' 
#' 
#' @keywords warning plate error
#' 
#' @param object The \code{\link{data.frame}} produced by \code{\link{gitter}}.
#' @param ... Additional arguments. Not used.
#' 
#' @return 
#' Summary including the call made to \code{\link{gitter}}, colony size quantiles and more.
#' 
#' @examples
#' # dat = gitter("/path/to/image")
#' # summary(dat)
#' 
#' @export
summary.gitter <- function(object, ...){
  d = object
  pf = attr(d, 'format')
  call = attr(d, 'call')
  if(is.null(call)){
    call = "not available"
  }else{
    call = deparse(call)
  }
  
  writeLines(sprintf('# gitter v%s data file #', .GITTER_VERSION))
  writeLines(sprintf('Function call: %s', call))
  writeLines(sprintf('Elapsed time: %s secs', attr(d, 'elapsed')))
  writeLines(sprintf('Plate format: %s x %s (%s)', pf[1], pf[2], prod(pf)))
  writeLines('Colony size statistics:')
  print(summary(d[[3]]))
  writeLines('Dat file (first 6 rows):')
  print(head(d))
  w = attr(object, 'warnings')
  if(! is.null(w)){
    writeLines('Plate warnings:')
    writeLines(paste0(w, collapse=', '))
  }
}