# FlowCam.R
#' Reference class for FlowCam data
#'
#' @field path the path to the dataset
#' @field name the basename of path
#' @field filelist the listing of relative filepaths
#' @field ctx the context ConfiguratorRefClass
#' @field data a data.frame of .csv exported data
FlowCamRefClass <- setRefClass("FlowCamRefClass",
field = list(
path = "character",
name = "character",
filelist = 'ANY',
ctx = "ANY",
cla = 'ANY',
data = "ANY"),
methods = list(
initialize = function(flowcam_path){
if (missing(flowcam_path)) flowcam_path = .self$path
if (!file.exists(flowcam_path[1])) stop("path not found:", flowcam_path[1])
.self$path <- flowcam_path[1]
.self$name <- basename(.self$path)
.self$filelist <- list.files(.self$path, recursive = TRUE, include.dirs = FALSE)
if(!.self$readData()) cat("error reading data\n")
if(!.self$readContext()) cat("error reading context\n")
if(!.self$readClassification()) cat("error reading classification\n")
},
show = function(){
cat("Path:", .self$path, "\n")
if(inherits(.self$ctx, 'ConfiguratorRefClass')) show_context(.self$ctx)
if(inherits(.self$data, "data.frame")) .self$show_data()
},
show_data = function(){
if (!is.data.frame(.self$data)) return(invisible(NULL))
s <- .self$volume_summary()
cat("n_particles:", nrow(.self$data), "\n")
print(s)
invisible(NULL)
}
) # methods
) # setRefClass
#' Find the indices of particles labeled as identified
#'
#' @name FlowCamRefClass_which_labeled
#' @param label one or more labels to search for
#' @param column the value of the user label column
#' @return zero or more indices of labeled items
NULL
FlowCamRefClass$methods(
which_labeled = function(label = 'none', column = 'PP_UserLabel'){
index = integer()
if (column[1] %in% colnames(.self$data)){
index <- which(.self$data[,column[1]] %in% label)
}
return(index)
}
)
#'
#' Summarize by class and volume
#'
#' @name FlowCamRefClass_volume_summary
#' @param include_name logical if TRUE include a column for the data set name
#' @param save_file logical if TRUE saves as CSV
#' @param filename character if save_file is TRUE then save to this file
#' @return a data frame of 'UserLabel', 'Count' and 'Volume' or NULL
NULL
FlowCamRefClass$methods(
volume_summary = function(include_name = FALSE,
save_file = FALSE, filename = NULL){
if (!is.data.frame(.self$data)) return(NULL)
if (all(c('PP_UserLabel', "PP_Vol") %in% colnames(.self$data)) ){
tx <- table(.self$data[,'PP_UserLabel'])
x <- split(.self$data, .self$data[,'PP_UserLabel'])
sx <- sapply(x, function(x) sum(x[,'PP_Vol'], na.rm = TRUE) )
s <- data.frame(UserLabel = names(tx), Count = as.vector(tx), Volume = sx,
stringsAsFactors = FALSE)
} else {
s <- data.frame(UserLabel = 'none', Count = nrow(.self$data),
Volume = NA)
}
if (include_name){
s <- data.frame(name = rep(.self$name, nrow(s)),
s, stringsAsFactors = FALSE)
}
if (save_file) {
if (is.null(filename)) filename <- .self$get_filename("volume_summary", test = FALSE)
#cat("writing to", filename[1], "\n")
ok = write.csv(s, file=filename[1], row.names = FALSE)
}
s
})
#' Read the classification file
#'
#' @name FlowCamRefClass_read_classification
#' @return logical
NULL
FlowCamRefClass$methods(
readClassification = function(){
OK <- FALSE
ff <- .self$get_filename("classification")
if (length(ff)>0) {
tryCatch(
.self$cla <- read_classifications(ff),
finally = OK)
}
TRUE
})
#' Read the context file
#'
#' @name FlowCamRefClass_read_context
#' @return logical
NULL
FlowCamRefClass$methods(
readContext = function(){
OK <- FALSE
ff <- .self$get_filename("context")
tryCatch(
.self$ctx <- read_context(ff),
finally = OK)
TRUE
})
#' Read the data
#'
#' @name FlowCamRefClass_read_data
#' @return logical
NULL
FlowCamRefClass$methods(
readData = function(){
.self$data <- flowcam_read_data(.self)
!is.null(.self$data)
})
#' Retrieve a filename by keyword
#'
#' @name FlowCamRefClass_get_filename
#' @param what the keyword describing the file
#' @param test logical if TRUE test for existence
#' @return the fully qualified filename(s)
NULL
FlowCamRefClass$methods(
get_filename = function(what = c("data", "postdata", "context", "classification",
"collage", "mask", "raw", "background", "cal", "volume_summary")[1], test = TRUE){
select_files <- function(pattern, files = .self$filelist){
ix <- grepl(pattern, files)
files[ix]
}
ff <- switch(tolower(what),
"data" = paste0(.self$name, ".csv"),
"postdata" = file.path(paste0("_", .self$name), paste0(.self$name, ".csv")),
"context" = paste0(.self$name, ".ctx"),
"classification" = paste0(.self$name, ".cla"),
"collage" = select_files(paste0(name, "_[0-9]+\\.tif")),
"mask" = select_files(paste0(name, "_[0-9]+\\_bin.tif")),
"raw"= select_files("^raw.*\\.tif$"),
"background" = select_files("^cal.*\\.tif$"),
"cal" = select_files("^cal.*\\.tif$"),
"volume_summary" = file.path(paste0("_", .self$name), paste0(.self$name, "_volume_summary.csv")),
.self$filelist
)
ff <- file.path(.self$path, ff)
if(test && (length(ff) > 0)){
ok <- sapply(ff,file.exists)
ff <- ff[ok]
}
if (length(ff) == 0) ff <- ""
return(ff)
})
#' Create an instance of a FlowCamRefClass object
#'
#' @export
#' @param path character directory name (required, must exist)
#' @return a FlowCamRefClass object
FlowCam <- function(path){
if (missing(path)) stop("path is required")
if (!file.exists(path[1])) stop("path not found:", path[1])
FlowCamRefClass$new(path[1])
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.