R/GatingSet2flowJo.R

In CytoML: A GatingML Interface for Cross Platform Cytometry Data Sharing

#' @templateVar old GatingSet2flowJo
#' @templateVar new gatingset_to_flowjo
#' @template template-depr_pkg
NULL

#' @export
GatingSet2flowJo <- function(...){
  .Deprecated("gatingset_to_flowjo")
  gatingset_to_flowjo(...)
}

#' Convert a GatingSet to flowJo workspace 
#' 
#' It is a R wrapper for the docker app
#' (https://hub.docker.com/r/rglab/gs-to-flowjo)
#'
#' @name gatingset_to_flowjo
#' @aliases GatingSet2flowJo
#' @param gs a GatingSet object or a folder contains the GatingSet archive (generated by previous \code{\link{save_gs}} call)
#' @param outFile the workspace file path to write
#' @param showHidden whether to export hidden gates. Default is FALSE
#' @param docker_img the docker image that does the actual work
#' @param ... other arguments passed to \code{\link{save_gs}}
#' @return nothing
#' 
#' @details 
#' Docker images for \code{gatingset_to_flowjo} will be maintained at https://gallery.ecr.aws/x4k5d9i7/cytoverse/gs-to-wsp
#' 
#' 
#' \code{docker pull public.ecr.aws/x4k5d9i7/cytoverse/gs-to-wsp:latest}
#' 
#' @examples
#' \dontrun{
#' library(flowWorkspace)
#'
#' path <- system.file("extdata",package="flowWorkspaceData")
#' gs_path <- list.files(path, pattern = "gs_manual",full = TRUE)
#' gs <- load_gs(gs_path)
#'
#' #output to flowJo
#' outFile <- tempfile(fileext = ".wsp")
#' gatingset_to_flowjo(gs, outFile)
#' 
#' #or directly use the archive as the input (to avoid the extra copying inside of the wrapper)
#' gatingset_to_flowjo(gs_path, outFile)
#' }
#' @importFrom flowWorkspace gs_clone gs_update_channels pData<- cs_unlock cs_lock gs_copy_tree_only cs_load_meta 
#' @export
#' @rdname gatingset_to_flowjo
#' @importFrom xml2 read_xml write_xml
gatingset_to_flowjo <- function(gs, outFile, showHidden = FALSE, docker_img = NULL, ...){
  res <- check_binary_status()
  if(res!="binary_ok"){
    res <- check_docker_status(docker_img)
  }
  
  if(!(res[1] %in% c("binary_ok", "docker_ok")))
    stop(res)
  
  if(is(gs, "GatingSet"))
  {
    tmp <- tempfile()
    suppressMessages(save_gs(gs, tmp, ...))#todo:fix link="cdf"
    
  }else
    tmp <- gs
  
  # Handle spaces in file path by expanding to absolute path and escaping spaces
  outFile <- gsub(" ", "\\\\ ", file.path(normalizePath(dirname(outFile)), basename(outFile)))
  tmpfile <- tempfile()
  if(res[1]=="binary_ok"){
    message("Using local gs-to-flowjo binary to write FlowJo workspace...")
    res <- suppressWarnings(system2("gs-to-flowjo", paste0(" --src=", tmp, " --dest=", tmpfile, " --showHidden=", showHidden), stderr = TRUE))
  }else{
    docker_img <- res[2] # The validated image name from check_docker_status()
    v1 <- packageVersion("cytolib")
    v2 <- system2("docker", paste0("run ", docker_img, " --cytolib-version"), stdout = TRUE)
    # if(v1!=v2)
    #   warning("docker image '", docker_img, "' is built with different cytolib version of from R package: ", v2, " vs ", v1)
    
    
    message(paste0("Using docker image ", docker_img, " to write FlowJo workspace..."))
    res <- suppressWarnings(system2("docker"
                                    , paste0("run"
                                             , " -v ", tmp, ":/gs"
                                             , " -v ", normalizePath(dirname(tmpfile)), ":/out "
                                             , docker_img
                                             , " --src=/gs --dest=/out/", basename(tmpfile)
                                             , " --showHidden=", showHidden)
                                    , stderr = TRUE)
    )
  }

  if(length(res) > 0)
    stop(res)
  else
  {
    tree <- read_xml(tmpfile)
    add_version_info(tree) 
    invisible(write_xml(tree, file = outFile))
    
  }
  
}

#' @importFrom xml2 xml_comment xml_add_sibling
add_version_info <- function(tree)
{
  info <- Sys.info()
  xml_add_sibling(tree, xml_comment(paste0("CytoML-version: ", packageVersion("CytoML"))), .where = "before")
  xml_add_sibling(tree, xml_comment(paste0("hostname: ", info[["nodename"]])), .where = "before")
  xml_add_sibling(tree,  xml_comment(paste0("user: ", info[["user"]])), .where = "before")
}
check_docker_status <- function(docker_img = NULL){
  if(Sys.info()["sysname"] == "Windows")
    errcode <- system2("WHERE", "docker", stdout = FALSE)
  else
    errcode <- system2("command", " -v docker", stdout = FALSE)
  
  if(errcode!=0)
    return("'docker' command is not found! ")
  
  errcode <- system2("docker", " info", stdout = FALSE, stderr = FALSE)
  if(errcode!=0)
    return("'docker' is not running properly! ")
  
  # Determine proper default image for this cytolib version
  if(is.null(docker_img)){
    docker_img <- "public.ecr.aws/x4k5d9i7/cytoverse/gs-to-wsp:latest"
    
    # # strip last patch numbers
    # cytolib_minor_version <- gsub("\\.[^.]*$", "", packageVersion("cytolib"))
    # 
    # # First try to match cytolib minor version directly to image name
    # docker_version_match <- system2("docker", paste0("  image inspect ", paste0(base_img, ":", cytolib_minor_version)), stdout = FALSE, stderr = FALSE)
    # if(docker_version_match==0){
    #   docker_img <- paste0(base_img, ":", cytolib_minor_version)
    # }else{
    # # Otherwise, check for devel tagged image and see if that minor version matches
    #   devel_img <- paste0(base_img, ":devel")
    #   if(system2("docker", paste0("  image inspect ", devel_img), stdout = FALSE, stderr = FALSE) == 0){
    #     devel_img_version <- system2("docker", paste0("run ", devel_img, " --cytolib-version"), stdout = TRUE)
    #     if(gsub("\\.[^.]*$", "", devel_img_version) == cytolib_minor_version)
    #       docker_img <- devel_img
    #   }
    # }
  }
  
  if(is.null(docker_img)){
    # Search for a valid default image failed
    return(paste0("No default docker image found\n",
                  "Please see help(gatingset_to_flowjo) about pulling the appropriate docker image."))
  }else{
    # Try candidate image
    errcode <- system2("docker", paste0("  image inspect ", docker_img), stdout = FALSE, stderr = FALSE)
    if(errcode!=0)
      return(paste0("docker image '", docker_img, "' is not present! "))
  }
  
  return(c("docker_ok", docker_img))
}

check_binary_status <- function(){
  if(Sys.info()["sysname"] == "Windows")
    errcode <- suppressWarnings(system2("WHERE", "gs-to-flowjo", stdout = FALSE))
  else
    errcode <- suppressWarnings(system2("command", " -v gs-to-flowjo", stdout = FALSE))
  if(errcode!=0)
    return(paste0("gs-to-flowjo binary is not present"))
  
  return("binary_ok")
}