support cqc_insert in cqc_fix.cqc_solution

R/cqc_fix.R

@@ -3,20 +3,20 @@
 #' Peform the actual fixing action (i.e update or delete)
 #' @param x the \code{cqc_solution} returned by \code{\link{cqc_match}} calls
 #' @param ... addiitional arguments not for the user.
-#' @examples 
+#' @examples
 #' # Read in FCS files with inconsistencies
 #' fcs_files <- list.files(system.file("extdata", "GvHD_QC", package = "cytoqc"), full.names = TRUE)
 #' qc_cf_list <- cqc_load_fcs(fcs_files)
-#' 
+#'
 #' # Check for marker inconsitencies
 #' groups <- cqc_check(qc_cf_list, type = "marker")
-#' 
+#'
 #' # Attempt to fix them automatically
 #' match_result <- cqc_match(groups, ref = c("CD14 PerCP", "CD15 FITC", "CD33 APC", "CD45 PE", "FSC-Height", "SSC-Height", "Time"))
-#' 
+#'
 #' # Add a manual match that automatic matching could not find
 #' match_result <- cqc_update_match(match_result, map = c("PTPRC PE" = "CD45 PE"))
-#' 
+#'
 #' # Apply the fix to the original cytoframes
 #' cqc_fix(match_result)
 #' @export
@@ -40,15 +40,45 @@ cqc_fix.cqc_solution <- function(x, ...) {
   invisible(group %>% inner_join(x, "group_id") %>%
     select(object, from, to) %>% distinct() %>% rowwise() %>% do({
       obj <- cqc_data[[.[["object"]]]]
-      if (is.na(.[["to"]])) {
+      if (!is.na(.[["from"]])&&is.na(.[["to"]])) {#xxx -> NA
         cqc_delete(obj, .[["from"]], type)
-      } else {
+      } else if(!is.na(.[["from"]])&&!is.na(.[["to"]])){#xxx -> yyy
         cqc_update(obj, .[["from"]], .[["to"]], type)
-      }
+      } else if(is.na(.[["from"]])&&!is.na(.[["to"]]))#NA -> yyy
+      {
+        cqc_insert(obj, is.na(.[["to"]]))
+      }else#NA -> NA
+        stop("both 'from' and 'to' are NA!")
       tibble()
     }))
 }
 
+#' insertion methods for cyto data
+#'
+#' It is typically called automatically by cqc_fix call
+#'
+#' @param x cytoframe or GatingSet
+#' @param value the value to be deleted
+#' @param type one of qc task "channel", "marker", "keyword", "gate"
+#' @param ... unused
+cqc_insert <- function(x, value, type, ...) UseMethod("cqc_delete")
+
+cqc_insert.cytoframe <- function(x, value, type, ...) {
+  if  (type == "keyword") {
+    cf_keyword_insert(x, value, "")
+  } else {
+    stop("insert ", type, " not supported yet!")
+  }
+}
+
+cqc_insert.GatingSet <- function(x, value, type, ...) {
+  cs <- gs_cyto_data(x) # cs is a new view
+  lapply(cs, function(cf) {
+    cqc_insert(cf, value, type, ...)
+  })
+
+}
+
 
 #' Delete methods for cyto data
 #'

lyoplate/parsews.R

@@ -24,7 +24,7 @@ for(center in centers) {
     dir.create(this_out)
   this_ws_path <- file.path(ws_path, center, paste0("CA c3 v2 ", center, ".xml"))
   ws <- open_flowjo_xml(this_ws_path)
-  groupNames <- levels(fj_ws_get_sample_groups(ws)[,"groupName"])
+  groupNames <- unique(fj_ws_get_sample_groups(ws)[,"groupName"])
   #NOTE: here we use the fussy match due to the short name used in auto gating
   #ideally, we want to do the strict full string match avoid picking up the wrong panel
   #in case the panel name are similar. But in this particular panel set, it is safe to do so.

vignettes/keywords.Rmd

@@ -26,7 +26,8 @@ library(cytoqc)
 ```{r include=FALSE}
 # prepare the test data
 data("GvHD")
-fs <- GvHD
+set.seed(1)
+fs <- Subset(GvHD, sampleFilter(10))
 data_dir <- tempfile()
 dir.create(data_dir)
 write.flowSet(fs, data_dir)
@@ -131,5 +132,5 @@ grps <- split(groups)
 grps
 ```
 
-
+## or insert the missing keywords for selected groups