... | ... |
@@ -25,22 +25,16 @@ Imports: |
25 | 25 |
graph, |
26 | 26 |
graphics, |
27 | 27 |
utils, |
28 |
- base64enc, |
|
29 |
- plyr, |
|
28 |
+ jsonlite, |
|
30 | 29 |
dplyr, |
31 | 30 |
grDevices, |
32 | 31 |
methods, |
33 | 32 |
ggcyto (>= 1.11.4), |
34 | 33 |
yaml, |
35 |
- lattice, |
|
36 | 34 |
stats, |
37 |
- corpcor, |
|
38 |
- RUnit, |
|
39 |
- tibble, |
|
40 |
- RcppParallel, |
|
41 |
- xml2 |
|
35 |
+ tibble |
|
42 | 36 |
biocViews: ImmunoOncology, FlowCytometry, DataImport, DataRepresentation |
43 |
-LinkingTo: Rcpp, BH(>= 1.62.0-1), RProtoBufLib, cytolib, Rhdf5lib, RcppArmadillo, RcppParallel(>= 4.4.2-1), flowWorkspace |
|
37 |
+LinkingTo: cpp11, BH(>= 1.62.0-1), RProtoBufLib, cytolib, Rhdf5lib, flowWorkspace |
|
44 | 38 |
Suggests: |
45 | 39 |
testthat, |
46 | 40 |
flowWorkspaceData , |
... | ... |
@@ -55,9 +49,9 @@ Collate: |
55 | 49 |
'AllClasses.R' |
56 | 50 |
'GatingSet2cytobank.R' |
57 | 51 |
'GatingSet2flowJo.R' |
58 |
- 'RcppExports.R' |
|
59 | 52 |
'gate-methods.R' |
60 | 53 |
'compensation.R' |
54 |
+ 'cpp11.R' |
|
61 | 55 |
'cytobank2GatingSet.R' |
62 | 56 |
'cytobankExperiment.R' |
63 | 57 |
'cytolibml_bin_path.R' |
... | ... |
@@ -72,6 +66,5 @@ Collate: |
72 | 66 |
'transforms.R' |
73 | 67 |
'utils.R' |
74 | 68 |
'writeGatingML.R' |
75 |
- 'zzz.R' |
|
76 | 69 |
SystemRequirements: xml2, GNU make, C++11 |
77 | 70 |
Encoding: UTF-8 |
... | ... |
@@ -6,8 +6,6 @@ S3method(extend,ellipsoidGate) |
6 | 6 |
S3method(extend,polygonGate) |
7 | 7 |
S3method(extend,rectangleGate) |
8 | 8 |
S3method(print,cytobank_experiment) |
9 |
-export(CytoML.par.get) |
|
10 |
-export(CytoML.par.set) |
|
11 | 9 |
export(GatingSet2cytobank) |
12 | 10 |
export(GatingSet2flowJo) |
13 | 11 |
export(ce_get_channels) |
... | ... |
@@ -62,7 +60,6 @@ importClassesFrom(methods,missing) |
62 | 60 |
importClassesFrom(methods,numeric) |
63 | 61 |
importClassesFrom(methods,oldClass) |
64 | 62 |
importFrom(RBGL,tsort) |
65 |
-importFrom(RcppParallel,RcppParallelLibs) |
|
66 | 63 |
importFrom(Rgraphviz,layoutGraph) |
67 | 64 |
importFrom(Rgraphviz,renderGraph) |
68 | 65 |
importFrom(XML,"xmlAttrs<-") |
... | ... |
@@ -85,11 +82,10 @@ importFrom(XML,xmlTreeParse) |
85 | 82 |
importFrom(XML,xmlValue) |
86 | 83 |
importFrom(XML,xpathApply) |
87 | 84 |
importFrom(XML,xpathSApply) |
88 |
-importFrom(base64enc,base64decode) |
|
89 |
-importFrom(base64enc,base64encode) |
|
90 | 85 |
importFrom(cytolib,cytolib_LdFlags) |
91 | 86 |
importFrom(dplyr,"%>%") |
92 | 87 |
importFrom(dplyr,arrange) |
88 |
+importFrom(dplyr,bind_rows) |
|
93 | 89 |
importFrom(dplyr,count) |
94 | 90 |
importFrom(dplyr,enquo) |
95 | 91 |
importFrom(dplyr,filter) |
... | ... |
@@ -190,6 +186,8 @@ importFrom(graph,removeNode) |
190 | 186 |
importFrom(graphics,abline) |
191 | 187 |
importFrom(graphics,polygon) |
192 | 188 |
importFrom(graphics,text) |
189 |
+importFrom(jsonlite,base64_dec) |
|
190 |
+importFrom(jsonlite,base64_enc) |
|
193 | 191 |
importFrom(jsonlite,fromJSON) |
194 | 192 |
importFrom(jsonlite,toJSON) |
195 | 193 |
importFrom(methods,as) |
... | ... |
@@ -199,15 +197,9 @@ importFrom(methods,new) |
199 | 197 |
importFrom(methods,selectMethod) |
200 | 198 |
importFrom(methods,show) |
201 | 199 |
importFrom(methods,slot) |
202 |
-importFrom(plyr,ldply) |
|
203 |
-importFrom(plyr,name_rows) |
|
204 | 200 |
importFrom(tibble,tibble) |
205 | 201 |
importFrom(utils,localeToCharset) |
206 | 202 |
importFrom(utils,menu) |
207 | 203 |
importFrom(utils,packageVersion) |
208 |
-importFrom(xml2,read_xml) |
|
209 |
-importFrom(xml2,write_xml) |
|
210 |
-importFrom(xml2,xml_add_sibling) |
|
211 |
-importFrom(xml2,xml_comment) |
|
212 | 204 |
importFrom(yaml,read_yaml) |
213 | 205 |
useDynLib(CytoML,.registration = TRUE) |
... | ... |
@@ -174,9 +174,9 @@ export_gates_cytobank <- function(gs, flowEnv, trans.Gm2objs, trans, compId, sho |
174 | 174 |
} |
175 | 175 |
|
176 | 176 |
|
177 |
-#' @importFrom base64enc base64encode base64decode |
|
177 |
+#' @importFrom jsonlite base64_enc base64_dec |
|
178 | 178 |
base64encode_cytobank <- function(x){ |
179 |
- x <- base64encode(charToRaw(x)) |
|
179 |
+ x <- base64_enc(charToRaw(x)) |
|
180 | 180 |
x <- gsub("=", ".", x) |
181 | 181 |
x <- gsub("\\+", "_", x) |
182 | 182 |
x <- gsub("/", "-", x) |
... | ... |
@@ -186,7 +186,7 @@ base64decode_cytobank <- function(x){ |
186 | 186 |
x <- gsub("\\.", "=", x) |
187 | 187 |
x <- gsub("_", "\\+", x) |
188 | 188 |
x <- gsub("-", "/", x) |
189 |
- base64decode(x) |
|
189 |
+ base64_dec(x) |
|
190 | 190 |
} |
191 | 191 |
|
192 | 192 |
|
... | ... |
@@ -47,7 +47,6 @@ GatingSet2flowJo <- function(...){ |
47 | 47 |
#' @importFrom flowWorkspace gs_clone gs_update_channels pData<- cs_unlock cs_lock gs_copy_tree_only cs_load_meta |
48 | 48 |
#' @export |
49 | 49 |
#' @rdname gatingset_to_flowjo |
50 |
-#' @importFrom xml2 read_xml write_xml |
|
51 | 50 |
gatingset_to_flowjo <- function(gs, outFile, showHidden = FALSE, docker_img = NULL, ...){ |
52 | 51 |
res <- check_binary_status() |
53 | 52 |
if(res!="binary_ok"){ |
... | ... |
@@ -93,24 +92,13 @@ gatingset_to_flowjo <- function(gs, outFile, showHidden = FALSE, docker_img = NU |
93 | 92 |
|
94 | 93 |
if(length(res) > 0) |
95 | 94 |
stop(res) |
96 |
- else |
|
97 |
- { |
|
98 |
- tree <- read_xml(tmpfile) |
|
99 |
- add_version_info(tree) |
|
100 |
- invisible(write_xml(tree, file = outFile)) |
|
101 |
- |
|
95 |
+ else { |
|
96 |
+ file.rename(tmpfile, outFile) |
|
102 | 97 |
} |
103 | 98 |
|
104 | 99 |
} |
105 | 100 |
|
106 |
-#' @importFrom xml2 xml_comment xml_add_sibling |
|
107 |
-add_version_info <- function(tree) |
|
108 |
-{ |
|
109 |
- info <- Sys.info() |
|
110 |
- xml_add_sibling(tree, xml_comment(paste0("CytoML-version: ", packageVersion("CytoML"))), .where = "before") |
|
111 |
- xml_add_sibling(tree, xml_comment(paste0("hostname: ", info[["nodename"]])), .where = "before") |
|
112 |
- xml_add_sibling(tree, xml_comment(paste0("user: ", info[["user"]])), .where = "before") |
|
113 |
-} |
|
101 |
+ |
|
114 | 102 |
check_docker_status <- function(docker_img = NULL){ |
115 | 103 |
if(Sys.info()["sysname"] == "Windows") |
116 | 104 |
errcode <- system2("WHERE", "docker", stdout = FALSE) |
117 | 105 |
deleted file mode 100644 |
... | ... |
@@ -1,35 +0,0 @@ |
1 |
-# Generated by using Rcpp::compileAttributes() -> do not edit by hand |
|
2 |
-# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 |
|
3 |
- |
|
4 |
-setLogLevel <- function(loglevel) { |
|
5 |
- invisible(.Call(`_CytoML_setLogLevel`, loglevel)) |
|
6 |
-} |
|
7 |
- |
|
8 |
-open_workspace <- function(filename, sample_name_location, xmlParserOption) { |
|
9 |
- .Call(`_CytoML_open_workspace`, filename, sample_name_location, xmlParserOption) |
|
10 |
-} |
|
11 |
- |
|
12 |
-parse_workspace <- function(ws, group_id, subset, execute, path, cytoset, backend_dir, backend, includeGates, additional_keys, additional_sampleID, keywords, is_pheno_data_from_FCS, keyword_ignore_case, extend_val, extend_to, channel_ignore_case, leaf_bool, include_empty_tree, skip_faulty_gate, comps, transform, fcs_file_extension, greedy_match, fcs_parse_arg, num_threads = 1L) { |
|
13 |
- .Call(`_CytoML_parse_workspace`, ws, group_id, subset, execute, path, cytoset, backend_dir, backend, includeGates, additional_keys, additional_sampleID, keywords, is_pheno_data_from_FCS, keyword_ignore_case, extend_val, extend_to, channel_ignore_case, leaf_bool, include_empty_tree, skip_faulty_gate, comps, transform, fcs_file_extension, greedy_match, fcs_parse_arg, num_threads) |
|
14 |
-} |
|
15 |
- |
|
16 |
-get_keywords_by_id <- function(ws, sample_id) { |
|
17 |
- .Call(`_CytoML_get_keywords_by_id`, ws, sample_id) |
|
18 |
-} |
|
19 |
- |
|
20 |
-get_keywords_by_name <- function(ws, sample_name) { |
|
21 |
- .Call(`_CytoML_get_keywords_by_name`, ws, sample_name) |
|
22 |
-} |
|
23 |
- |
|
24 |
-get_sample_groups <- function(ws) { |
|
25 |
- .Call(`_CytoML_get_sample_groups`, ws) |
|
26 |
-} |
|
27 |
- |
|
28 |
-get_samples <- function(ws) { |
|
29 |
- .Call(`_CytoML_get_samples`, ws) |
|
30 |
-} |
|
31 |
- |
|
32 |
-get_xml_file_path <- function(ws) { |
|
33 |
- .Call(`_CytoML_get_xml_file_path`, ws) |
|
34 |
-} |
|
35 |
- |
36 | 0 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,33 @@ |
1 |
+# Generated by cpp11: do not edit by hand |
|
2 |
+ |
|
3 |
+setLogLevel <- function(loglevel) { |
|
4 |
+ invisible(.Call(`_CytoML_setLogLevel`, loglevel)) |
|
5 |
+} |
|
6 |
+ |
|
7 |
+open_workspace <- function(filename, sample_name_location, xmlParserOption) { |
|
8 |
+ .Call(`_CytoML_open_workspace`, filename, sample_name_location, xmlParserOption) |
|
9 |
+} |
|
10 |
+ |
|
11 |
+parse_workspace <- function(ws, group_id, subset, execute, path, cytoset, backend_dir, backend, includeGates, additional_keys, additional_sampleID, keywords, is_pheno_data_from_FCS, keyword_ignore_case, extend_val, extend_to, channel_ignore_case, leaf_bool, include_empty_tree, skip_faulty_gate, comps, transform, fcs_file_extension, greedy_match, fcs_parse_arg, num_threads) { |
|
12 |
+ .Call(`_CytoML_parse_workspace`, ws, group_id, subset, execute, path, cytoset, backend_dir, backend, includeGates, additional_keys, additional_sampleID, keywords, is_pheno_data_from_FCS, keyword_ignore_case, extend_val, extend_to, channel_ignore_case, leaf_bool, include_empty_tree, skip_faulty_gate, comps, transform, fcs_file_extension, greedy_match, fcs_parse_arg, num_threads) |
|
13 |
+} |
|
14 |
+ |
|
15 |
+get_keywords_by_id <- function(ws, sample_id) { |
|
16 |
+ .Call(`_CytoML_get_keywords_by_id`, ws, sample_id) |
|
17 |
+} |
|
18 |
+ |
|
19 |
+get_keywords_by_name <- function(ws, sample_name) { |
|
20 |
+ .Call(`_CytoML_get_keywords_by_name`, ws, sample_name) |
|
21 |
+} |
|
22 |
+ |
|
23 |
+get_sample_groups <- function(ws) { |
|
24 |
+ .Call(`_CytoML_get_sample_groups`, ws) |
|
25 |
+} |
|
26 |
+ |
|
27 |
+get_samples <- function(ws) { |
|
28 |
+ .Call(`_CytoML_get_samples`, ws) |
|
29 |
+} |
|
30 |
+ |
|
31 |
+get_xml_file_path <- function(ws) { |
|
32 |
+ .Call(`_CytoML_get_xml_file_path`, ws) |
|
33 |
+} |
... | ... |
@@ -293,17 +293,18 @@ setMethod("pData","cytobank_experiment",function(object){ |
293 | 293 |
get_pd(object) |
294 | 294 |
}) |
295 | 295 |
|
296 |
-#' @importFrom plyr name_rows |
|
296 |
+#' @importFrom dplyr bind_rows |
|
297 | 297 |
get_pd <- function(ce){ |
298 |
- res <- ldply(ce$experiment$fcsFiles, function(sample){ |
|
298 |
+ res <- bind_rows(lapply(ce$experiment$fcsFiles, function(sample){ |
|
299 | 299 |
data.frame(as.list( |
300 | 300 |
c(name = sample[["filename"]] |
301 | 301 |
, unlist(sample[["tags"]]) |
302 |
- , .rownames = sample[["filename"]]#sample[["sampleName"]] |
|
302 |
+ # , .rownames = sample[["filename"]]#sample[["sampleName"]] |
|
303 | 303 |
) |
304 | 304 |
) |
305 | 305 |
, check.names = FALSE) |
306 | 306 |
}) |
307 |
- res <- name_rows(res) |
|
307 |
+ ) |
|
308 |
+ rownames(res) <- res[["name"]] |
|
308 | 309 |
res |
309 | 310 |
} |
... | ... |
@@ -94,7 +94,7 @@ open_diva_xml <- function(file,options = 0,...){ |
94 | 94 |
|
95 | 95 |
#' @export |
96 | 96 |
diva_get_sample_groups <- function(x){ |
97 |
- ldply( |
|
97 |
+ do.call(rbind, |
|
98 | 98 |
xpathApply(x@doc, "/bdfacs/experiment/specimen",function(specimen){ |
99 | 99 |
samples <- xpathApply(specimen, "tube",function(tube){ |
100 | 100 |
c(tube = xmlGetAttr(tube,"name") |
... | ... |
@@ -102,7 +102,7 @@ diva_get_sample_groups <- function(x){ |
102 | 102 |
) |
103 | 103 |
}) |
104 | 104 |
|
105 |
- samples <- ldply(samples) |
|
105 |
+ samples <- do.call(rbind, lapply(samples, function(i)data.frame(t(i)))) |
|
106 | 106 |
samples[["specimen"]] <- xmlGetAttr(specimen, "name") |
107 | 107 |
samples |
108 | 108 |
}) |
... | ... |
@@ -122,7 +122,6 @@ diva_get_sample_groups <- function(x){ |
122 | 122 |
#' @return |
123 | 123 |
#' A \code{data.frame} with columns \code{tub}, \code{name}, and \code{specimen} |
124 | 124 |
#' @importFrom methods selectMethod |
125 |
-#' @importFrom plyr ldply |
|
126 | 125 |
#' @export |
127 | 126 |
diva_get_samples <- diva_get_sample_groups |
128 | 127 |
|
... | ... |
@@ -66,8 +66,8 @@ open_flowjo_xml <- function(file,options = 0, sample_names_from = "keyword", ... |
66 | 66 |
} |
67 | 67 |
|
68 | 68 |
set_log_level <- function(level = "none"){ |
69 |
- if(.Platform$OS.type != "windows") |
|
70 |
- stop("Please call 'flowWorkspace::set_log_level' for non-windows platforms!") |
|
69 |
+ # if(.Platform$OS.type != "windows") |
|
70 |
+ # stop("Please call 'flowWorkspace::set_log_level' for non-windows platforms!") |
|
71 | 71 |
valid_levels <- c("none", "GatingSet", "GatingHierarchy", "Population", "Gate") |
72 | 72 |
level <- match.arg(level, valid_levels) |
73 | 73 |
setLogLevel( as.integer(match(level, valid_levels) - 1)) |
... | ... |
@@ -188,7 +188,6 @@ setMethod("parseWorkspace",signature("flowjo_workspace"),function(obj, ...){ |
188 | 188 |
#' @rdname flowjo_to_gatingset |
189 | 189 |
#' @export |
190 | 190 |
#' @importFrom utils menu |
191 |
-#' @importFrom RcppParallel RcppParallelLibs |
|
192 | 191 |
#' @importFrom dplyr enquo |
193 | 192 |
#' @importFrom flowWorkspace cytoset get_default_backend |
194 | 193 |
flowjo_to_gatingset <- function(ws, name = NULL |
... | ... |
@@ -292,8 +291,10 @@ backend <- match.arg(backend, c("h5", "tile")) |
292 | 291 |
{ |
293 | 292 |
compensation <- sapply(compensation, check_comp, simplify = FALSE) |
294 | 293 |
}else |
294 |
+ { |
|
295 | 295 |
compensation <- check_comp(compensation) |
296 |
- |
|
296 |
+ compensation <- list(compensation) |
|
297 |
+ } |
|
297 | 298 |
} |
298 | 299 |
args <- list(ws = ws@doc |
299 | 300 |
, group_id = groupInd - 1 |
300 | 301 |
deleted file mode 100644 |
... | ... |
@@ -1,106 +0,0 @@ |
1 |
-## Store state info in this internal global environment |
|
2 |
-CytoML.state <- new.env(hash = FALSE) |
|
3 |
-CytoML.state[["par"]] <- list() |
|
4 |
- |
|
5 |
-#' workspace version is parsed from xml node '/Workspace/version' in flowJo workspace |
|
6 |
-#' and matched with this list to dispatch to the one of the three workspace parsers |
|
7 |
-CytoML.par.init <- function(){ |
|
8 |
- |
|
9 |
- fj_ver <- list(win = c("1.61", "1.6") |
|
10 |
- , macII = c("2.0") |
|
11 |
- , macIII = c("3.0") |
|
12 |
- , vX = c("1.8", "20.0") |
|
13 |
- ) |
|
14 |
- |
|
15 |
- mac_II_path <- list(group = "/Workspace/Groups/GroupNode"# abs path |
|
16 |
- , sampleRef = ".//SampleRefs/SampleRef"#relative GroupNode |
|
17 |
- , sample = "/Workspace/SampleList/Sample"#abs path |
|
18 |
- , sampleNode = "./SampleNode"#relative to sample |
|
19 |
- , popNode = "./Population"#relative to sampleNode |
|
20 |
- , attrName = "name" |
|
21 |
- , compMatName = "name" |
|
22 |
- , compMatChName = "name" |
|
23 |
- , compMatVal = "value" |
|
24 |
- ) |
|
25 |
- mac_II_path[["sampleID"]] <- mac_II_path[["sample"]] |
|
26 |
- |
|
27 |
- #mac version 3.0 (flowJo version 9.7.2-9.7.4) |
|
28 |
- mac_III_path <- mac_II_path |
|
29 |
- mac_III_path[["sample"]] <- sub("SampleList", "Samples", mac_III_path[["sample"]]) |
|
30 |
- mac_III_path[["attrName"]] <- "nodeName" |
|
31 |
- mac_III_path[["compMatName"]] <- "matrixName" |
|
32 |
- mac_III_path[["compMatChName"]] <- "fluorName" |
|
33 |
- mac_III_path[["compMatVal"]] <- "spillValue" |
|
34 |
- mac_III_path[["sampleID"]] <- mac_III_path[["sample"]] |
|
35 |
- ####windows version |
|
36 |
- #inherit most paths from mac |
|
37 |
- win_path <- mac_II_path |
|
38 |
- win_path[["popNode"]] <- "./*/Population" |
|
39 |
- win_path[["gateDim"]] <- "*[local-name()='dimension']"#relative to gateNode |
|
40 |
- win_path[["gateParam"]] <- "*[local-name()='parameter']"#relative to dimNode |
|
41 |
- win_path[["sampleID"]] <- file.path(win_path[["sample"]],"DataSet") |
|
42 |
- |
|
43 |
- ####version X |
|
44 |
- #inherit most paths from win |
|
45 |
- vX_path <- win_path |
|
46 |
- vX_path[["gateParam"]] <- "*[local-name()='fcs-dimension']"; |
|
47 |
- |
|
48 |
- CytoML.state[["par"]] <- list(flowJo_versions = fj_ver |
|
49 |
- , nodePath = list(win = win_path |
|
50 |
- , macII = mac_II_path |
|
51 |
- , macIII = mac_III_path |
|
52 |
- , vX = vX_path |
|
53 |
- ) |
|
54 |
- ) |
|
55 |
- |
|
56 |
-} |
|
57 |
- |
|
58 |
-## call the init function |
|
59 |
-CytoML.par.init() |
|
60 |
- |
|
61 |
-#' CytoML.par.set sets a set of parameters in the CytoML package namespace. |
|
62 |
-#' |
|
63 |
-#' @param value A named list of values to set for category name or a list of such lists if name is missing. |
|
64 |
-#' @rdname CytoML.par.get |
|
65 |
-#' @export |
|
66 |
-CytoML.par.set <- function (name, value) |
|
67 |
-{ |
|
68 |
- old <- CytoML.state[["par"]] |
|
69 |
- if(name%in%names(old)){ |
|
70 |
- CytoML.state[["par"]][[name]] <- lattice:::updateList(old[[name]], value) |
|
71 |
- }else |
|
72 |
- stop(name, " is not a valid CytoML parameters!") |
|
73 |
- |
|
74 |
- invisible() |
|
75 |
-} |
|
76 |
- |
|
77 |
-#' Query and set session-wide parameter defaults. |
|
78 |
-#' |
|
79 |
-#' CytoML.par.get gets a set of parameters in the CytoML package namespace. |
|
80 |
-#' |
|
81 |
-#' It is currently used to add/remove the support for a specific flowJo versions (parsed from xml node '/Workspace/version' in flowJo workspace) |
|
82 |
-#' |
|
83 |
-#' @param name The name of a parameter category to get or set. |
|
84 |
-#' |
|
85 |
-#' |
|
86 |
-#' @examples |
|
87 |
-#' #get the flowJo versions currently supported |
|
88 |
-#' old <- CytoML.par.get("flowJo_versions") |
|
89 |
-#' |
|
90 |
-#' #add the new version |
|
91 |
-#' old[["win"]] <- c(old[["win"]], "1.7") |
|
92 |
-#' CytoML.par.set("flowJo_versions", old) |
|
93 |
-#' |
|
94 |
-#' CytoML.par.get("flowJo_versions") |
|
95 |
-#' |
|
96 |
-#' @export |
|
97 |
-#' @rdname CytoML.par.get |
|
98 |
-CytoML.par.get <- function (name = NULL) |
|
99 |
-{ |
|
100 |
- lPars <- CytoML.state[["par"]] |
|
101 |
- if (is.null(name)) |
|
102 |
- lPars |
|
103 |
- else if (name %in% names(lPars)) |
|
104 |
- lPars[[name]] |
|
105 |
- else NULL |
|
106 |
-} |
... | ... |
@@ -15,7 +15,6 @@ |
15 | 15 |
#include <boost/lexical_cast.hpp> |
16 | 16 |
#include <boost/tokenizer.hpp> |
17 | 17 |
#include "search_sample.hpp" |
18 |
-#define TBB_PREVIEW_SERIAL_SUBSET 1 |
|
19 | 18 |
|
20 | 19 |
//solve windows build issues |
21 | 20 |
#ifdef Free |
... | ... |
@@ -26,19 +25,13 @@ |
26 | 25 |
#endif |
27 | 26 |
|
28 | 27 |
|
29 |
-#include <tbb/tbb.h> |
|
30 |
-#include "tbb/task_scheduler_init.h" |
|
31 |
-#include <tbb/spin_mutex.h> |
|
32 |
-using namespace tbb; |
|
33 | 28 |
namespace CytoML |
34 | 29 |
{ |
35 | 30 |
|
36 |
-typedef tbb::spin_mutex GsMutexType; |
|
37 | 31 |
|
38 | 32 |
class flowJoWorkspace:public workspace{ |
39 | 33 |
private: |
40 | 34 |
string versionList;//used for legacy mac ws |
41 |
- GsMutexType GsMutex, TransMutex, h5Mutex; |
|
42 | 35 |
|
43 | 36 |
public: |
44 | 37 |
|
... | ... |
@@ -92,7 +85,6 @@ public: |
92 | 85 |
|
93 | 86 |
trans_local trans, trans_raw; |
94 | 87 |
{ |
95 |
- GsMutexType::scoped_lock lock1(TransMutex);//biexp interpolation could be performed on the shared global trans object |
|
96 | 88 |
|
97 | 89 |
//prefixed version |
98 | 90 |
trans = getTransformation(root,comp,transFlag,_gTrans, true); |
... | ... |
@@ -205,17 +197,10 @@ public: |
205 | 197 |
* try to parse each sample |
206 | 198 |
*/ |
207 | 199 |
GatingSet & gs = *gsPtr; |
208 |
- tbb::task_scheduler_init init(config.num_threads); |
|
209 | 200 |
|
201 |
+ for (int i = 0; i < sample_infos.size(); i++) |
|
202 |
+ this->parse_sample(sample_infos[i], config, data_dir, cf_dir, gTrans, gs, cytoset); |
|
210 | 203 |
|
211 |
- if(config.num_threads <=1) |
|
212 |
- tbb::serial::parallel_for<int>(0, sample_infos.size(), 1, [&, this](int i){ |
|
213 |
- this->parse_sample(sample_infos[i], config, data_dir, cf_dir, gTrans, gs, cytoset); |
|
214 |
- }); |
|
215 |
- else |
|
216 |
- tbb::parallel_for<int>(0, sample_infos.size(), 1, [&, this](int i){ |
|
217 |
- this->parse_sample(sample_infos[i], config, data_dir, cf_dir, gTrans, gs, cytoset); |
|
218 |
- }); |
|
219 | 204 |
if(gsPtr->size() == 0) |
220 | 205 |
throw(domain_error("No samples in this workspace to parse!")); |
221 | 206 |
//keep the cs in sync with backend file |
... | ... |
@@ -499,11 +484,7 @@ public: |
499 | 484 |
|
500 | 485 |
CytoFramePtr ptr; |
501 | 486 |
{ |
502 |
- if(config_const.fmt == FileFormat::H5) |
|
503 |
- { |
|
504 |
- |
|
505 |
- GsMutexType::scoped_lock lock(h5Mutex); |
|
506 |
- } |
|
487 |
+ |
|
507 | 488 |
frptr->write_to_disk(cf_filename, config_const.fmt); |
508 | 489 |
ptr = load_cytoframe(cf_filename, false); |
509 | 490 |
} |
... | ... |
@@ -514,7 +495,6 @@ public: |
514 | 495 |
gh->set_cytoframe_view(CytoFrameView(frptr)); |
515 | 496 |
|
516 | 497 |
{ |
517 |
- GsMutexType::scoped_lock lock(GsMutex); |
|
518 | 498 |
if(gs.find(uid) != gs.end()){ |
519 | 499 |
throw(domain_error("Duplicated GUIDs detected within group: " + uid |
520 | 500 |
+ "\n Consider adding additional keywords to the GUID with argument \"additional.keys\"" |
... | ... |
@@ -13,9 +13,48 @@ |
13 | 13 |
#include "cytolib/nodeProperties.hpp" |
14 | 14 |
using namespace std; |
15 | 15 |
|
16 |
+#include <cstdio> |
|
17 |
+#include <streambuf> |
|
18 |
+ |
|
19 |
+namespace CytoML { |
|
20 |
+ |
|
21 |
+ class Cytostreambuf : public std::streambuf { |
|
22 |
+ public: |
|
23 |
+ Cytostreambuf(){} |
|
24 |
+ |
|
25 |
+ protected: |
|
26 |
+ std::streamsize xsputn(const char *s, std::streamsize n) { |
|
27 |
+ Rprintf("%.*s", n, s); |
|
28 |
+ return n; |
|
29 |
+ } |
|
30 |
+ |
|
31 |
+ int overflow(int c = traits_type::eof()) { |
|
32 |
+ if (c != traits_type::eof()) { |
|
33 |
+ char_type ch = traits_type::to_char_type(c); |
|
34 |
+ return xsputn(&ch, 1) == 1 ? c : traits_type::eof(); |
|
35 |
+ } |
|
36 |
+ return c; |
|
37 |
+ } |
|
38 |
+ |
|
39 |
+ |
|
40 |
+ |
|
41 |
+ }; |
|
42 |
+ |
|
43 |
+ class CytoStream : public std::ostream { |
|
44 |
+ Cytostreambuf cytobuf; |
|
45 |
+ public: |
|
46 |
+ CytoStream() : std::ostream(&cytobuf){} |
|
47 |
+ }; |
|
48 |
+ |
|
49 |
+ |
|
50 |
+} |
|
51 |
+ |
|
52 |
+ |
|
53 |
+ |
|
54 |
+extern CytoML::CytoStream cytocout; |
|
55 |
+ |
|
16 | 56 |
#ifdef ROUT |
17 |
-#include <RcppArmadillo.h> |
|
18 |
-#define COUT Rcpp::Rcout //flowWorkspace is still using Rcpp, so we don't bother replace COUT with PRINT yet |
|
57 |
+#define COUT cytocout |
|
19 | 58 |
#endif |
20 | 59 |
|
21 | 60 |
|
22 | 61 |
deleted file mode 100644 |
... | ... |
@@ -1,33 +0,0 @@ |
1 |
-% Generated by roxygen2: do not edit by hand |
|
2 |
-% Please edit documentation in R/zzz.R |
|
3 |
-\name{CytoML.par.set} |
|
4 |
-\alias{CytoML.par.set} |
|
5 |
-\alias{CytoML.par.get} |
|
6 |
-\title{CytoML.par.set sets a set of parameters in the CytoML package namespace.} |
|
7 |
-\usage{ |
|
8 |
-CytoML.par.set(name, value) |
|
9 |
- |
|
10 |
-CytoML.par.get(name = NULL) |
|
11 |
-} |
|
12 |
-\arguments{ |
|
13 |
-\item{name}{The name of a parameter category to get or set.} |
|
14 |
- |
|
15 |
-\item{value}{A named list of values to set for category name or a list of such lists if name is missing.} |
|
16 |
-} |
|
17 |
-\description{ |
|
18 |
-CytoML.par.get gets a set of parameters in the CytoML package namespace. |
|
19 |
-} |
|
20 |
-\details{ |
|
21 |
-It is currently used to add/remove the support for a specific flowJo versions (parsed from xml node '/Workspace/version' in flowJo workspace) |
|
22 |
-} |
|
23 |
-\examples{ |
|
24 |
- #get the flowJo versions currently supported |
|
25 |
- old <- CytoML.par.get("flowJo_versions") |
|
26 |
- |
|
27 |
- #add the new version |
|
28 |
- old[["win"]] <- c(old[["win"]], "1.7") |
|
29 |
- CytoML.par.set("flowJo_versions", old) |
|
30 |
- |
|
31 |
- CytoML.par.get("flowJo_versions") |
|
32 |
- |
|
33 |
-} |
34 | 0 |
deleted file mode 100644 |
... | ... |
@@ -1,13 +0,0 @@ |
1 |
-% Generated by roxygen2: do not edit by hand |
|
2 |
-% Please edit documentation in R/zzz.R |
|
3 |
-\name{CytoML.par.init} |
|
4 |
-\alias{CytoML.par.init} |
|
5 |
-\title{workspace version is parsed from xml node '/Workspace/version' in flowJo workspace |
|
6 |
-and matched with this list to dispatch to the one of the three workspace parsers} |
|
7 |
-\usage{ |
|
8 |
-CytoML.par.init() |
|
9 |
-} |
|
10 |
-\description{ |
|
11 |
-workspace version is parsed from xml node '/Workspace/version' in flowJo workspace |
|
12 |
-and matched with this list to dispatch to the one of the three workspace parsers |
|
13 |
-} |
... | ... |
@@ -4,13 +4,13 @@ CXX_STD = CXX11 |
4 | 4 |
#so can't use the default libs shipped with Rtools4 |
5 | 5 |
VERSION=2.9.8 |
6 | 6 |
RWINLIB=../windows/libxml2-$(VERSION) |
7 |
-PKG_CPPFLAGS =-DROUT -I../inst/include/ -I$(RWINLIB)/include/libxml2 -DLIBXML_STATIC -fpermissive -DRCPP_PARALLEL_USE_TBB=1 |
|
7 |
+PKG_CPPFLAGS =-DROUT -I../inst/include/ -I$(RWINLIB)/include/libxml2 -DLIBXML_STATIC -fpermissive |
|
8 | 8 |
|
9 | 9 |
#needs to wrap in $(shell) to strip the quotes returned by rhdf5lib::pkgconfig |
10 | 10 |
RHDF5_LIBS= $(shell "${R_HOME}/bin/Rscript" -e "Rhdf5lib::pkgconfig('PKG_CXX_LIBS')") |
11 | 11 |
libxmllibs=-L$(RWINLIB)/lib${R_ARCH} -lxml2 -llzma -liconv -lz |
12 | 12 |
|
13 |
-PKG_LIBS += $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(libxmllibs) `${R_HOME}/bin/Rscript -e "cytolib:::cytolib_LdFlags();cat(' ');RProtoBufLib:::LdFlags();cat(' ');RcppParallel::RcppParallelLibs()"` ${RHDF5_LIBS} -lws2_32 |
|
13 |
+PKG_LIBS += $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(libxmllibs) `${R_HOME}/bin/Rscript -e "cytolib:::cytolib_LdFlags();cat(' ');RProtoBufLib:::LdFlags()"` ${RHDF5_LIBS} -lws2_32 |
|
14 | 14 |
|
15 | 15 |
all: clean winlibs |
16 | 16 |
|
17 | 17 |
deleted file mode 100644 |
... | ... |
@@ -1,147 +0,0 @@ |
1 |
-// Generated by using Rcpp::compileAttributes() -> do not edit by hand |
|
2 |
-// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 |
|
3 |
- |
|
4 |
-#include "../inst/include/CytoML.h" |
|
5 |
-#include <RcppArmadillo.h> |
|
6 |
-#include <Rcpp.h> |
|
7 |
- |
|
8 |
-using namespace Rcpp; |
|
9 |
- |
|
10 |
-#ifdef RCPP_USE_GLOBAL_ROSTREAM |
|
11 |
-Rcpp::Rostream<true>& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); |
|
12 |
-Rcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); |
|
13 |
-#endif |
|
14 |
- |
|
15 |
-// setLogLevel |
|
16 |
-void setLogLevel(unsigned short loglevel); |
|
17 |
-RcppExport SEXP _CytoML_setLogLevel(SEXP loglevelSEXP) { |
|
18 |
-BEGIN_RCPP |
|
19 |
- Rcpp::RNGScope rcpp_rngScope_gen; |
|
20 |
- Rcpp::traits::input_parameter< unsigned short >::type loglevel(loglevelSEXP); |
|
21 |
- setLogLevel(loglevel); |
|
22 |
- return R_NilValue; |
|
23 |
-END_RCPP |
|
24 |
-} |
|
25 |
-// open_workspace |
|
26 |
-XPtr<flowJoWorkspace> open_workspace(string filename, int sample_name_location, int xmlParserOption); |
|
27 |
-RcppExport SEXP _CytoML_open_workspace(SEXP filenameSEXP, SEXP sample_name_locationSEXP, SEXP xmlParserOptionSEXP) { |
|
28 |
-BEGIN_RCPP |
|
29 |
- Rcpp::RObject rcpp_result_gen; |
|
30 |
- Rcpp::RNGScope rcpp_rngScope_gen; |
|
31 |
- Rcpp::traits::input_parameter< string >::type filename(filenameSEXP); |
|
32 |
- Rcpp::traits::input_parameter< int >::type sample_name_location(sample_name_locationSEXP); |
|
33 |
- Rcpp::traits::input_parameter< int >::type xmlParserOption(xmlParserOptionSEXP); |
|
34 |
- rcpp_result_gen = Rcpp::wrap(open_workspace(filename, sample_name_location, xmlParserOption)); |
|
35 |
- return rcpp_result_gen; |
|
36 |
-END_RCPP |
|
37 |
-} |
|
38 |
-// parse_workspace |
|
39 |
-XPtr<GatingSet> parse_workspace(XPtr<flowJoWorkspace> ws, int group_id, List subset, bool execute, string path, XPtr<GatingSet> cytoset, string backend_dir, string backend, bool includeGates, vector<string> additional_keys, bool additional_sampleID, vector<string> keywords, bool is_pheno_data_from_FCS, bool keyword_ignore_case, float extend_val, float extend_to, bool channel_ignore_case, bool leaf_bool, bool include_empty_tree, bool skip_faulty_gate, List comps, bool transform, string fcs_file_extension, bool greedy_match, FCS_READ_PARAM fcs_parse_arg, int num_threads); |
|
40 |
-RcppExport SEXP _CytoML_parse_workspace(SEXP wsSEXP, SEXP group_idSEXP, SEXP subsetSEXP, SEXP executeSEXP, SEXP pathSEXP, SEXP cytosetSEXP, SEXP backend_dirSEXP, SEXP backendSEXP, SEXP includeGatesSEXP, SEXP additional_keysSEXP, SEXP additional_sampleIDSEXP, SEXP keywordsSEXP, SEXP is_pheno_data_from_FCSSEXP, SEXP keyword_ignore_caseSEXP, SEXP extend_valSEXP, SEXP extend_toSEXP, SEXP channel_ignore_caseSEXP, SEXP leaf_boolSEXP, SEXP include_empty_treeSEXP, SEXP skip_faulty_gateSEXP, SEXP compsSEXP, SEXP transformSEXP, SEXP fcs_file_extensionSEXP, SEXP greedy_matchSEXP, SEXP fcs_parse_argSEXP, SEXP num_threadsSEXP) { |
|
41 |
-BEGIN_RCPP |
|
42 |
- Rcpp::RObject rcpp_result_gen; |
|
43 |
- Rcpp::RNGScope rcpp_rngScope_gen; |
|
44 |
- Rcpp::traits::input_parameter< XPtr<flowJoWorkspace> >::type ws(wsSEXP); |
|
45 |
- Rcpp::traits::input_parameter< int >::type group_id(group_idSEXP); |
|
46 |
- Rcpp::traits::input_parameter< List >::type subset(subsetSEXP); |
|
47 |
- Rcpp::traits::input_parameter< bool >::type execute(executeSEXP); |
|
48 |
- Rcpp::traits::input_parameter< string >::type path(pathSEXP); |
|
49 |
- Rcpp::traits::input_parameter< XPtr<GatingSet> >::type cytoset(cytosetSEXP); |
|
50 |
- Rcpp::traits::input_parameter< string >::type backend_dir(backend_dirSEXP); |
|
51 |
- Rcpp::traits::input_parameter< string >::type backend(backendSEXP); |
|
52 |
- Rcpp::traits::input_parameter< bool >::type includeGates(includeGatesSEXP); |
|
53 |
- Rcpp::traits::input_parameter< vector<string> >::type additional_keys(additional_keysSEXP); |
|
54 |
- Rcpp::traits::input_parameter< bool >::type additional_sampleID(additional_sampleIDSEXP); |
|
55 |
- Rcpp::traits::input_parameter< vector<string> >::type keywords(keywordsSEXP); |
|
56 |
- Rcpp::traits::input_parameter< bool >::type is_pheno_data_from_FCS(is_pheno_data_from_FCSSEXP); |
|
57 |
- Rcpp::traits::input_parameter< bool >::type keyword_ignore_case(keyword_ignore_caseSEXP); |
|
58 |
- Rcpp::traits::input_parameter< float >::type extend_val(extend_valSEXP); |
|
59 |
- Rcpp::traits::input_parameter< float >::type extend_to(extend_toSEXP); |
|
60 |
- Rcpp::traits::input_parameter< bool >::type channel_ignore_case(channel_ignore_caseSEXP); |
|
61 |
- Rcpp::traits::input_parameter< bool >::type leaf_bool(leaf_boolSEXP); |
|
62 |
- Rcpp::traits::input_parameter< bool >::type include_empty_tree(include_empty_treeSEXP); |
|
63 |
- Rcpp::traits::input_parameter< bool >::type skip_faulty_gate(skip_faulty_gateSEXP); |
|
64 |
- Rcpp::traits::input_parameter< List >::type comps(compsSEXP); |
|
65 |
- Rcpp::traits::input_parameter< bool >::type transform(transformSEXP); |
|
66 |
- Rcpp::traits::input_parameter< string >::type fcs_file_extension(fcs_file_extensionSEXP); |
|
67 |
- Rcpp::traits::input_parameter< bool >::type greedy_match(greedy_matchSEXP); |
|
68 |
- Rcpp::traits::input_parameter< FCS_READ_PARAM >::type fcs_parse_arg(fcs_parse_argSEXP); |
|
69 |
- Rcpp::traits::input_parameter< int >::type num_threads(num_threadsSEXP); |
|
70 |
- rcpp_result_gen = Rcpp::wrap(parse_workspace(ws, group_id, subset, execute, path, cytoset, backend_dir, backend, includeGates, additional_keys, additional_sampleID, keywords, is_pheno_data_from_FCS, keyword_ignore_case, extend_val, extend_to, channel_ignore_case, leaf_bool, include_empty_tree, skip_faulty_gate, comps, transform, fcs_file_extension, greedy_match, fcs_parse_arg, num_threads)); |
|
71 |
- return rcpp_result_gen; |
|
72 |
-END_RCPP |
|
73 |
-} |
|
74 |
-// get_keywords_by_id |
|
75 |
-KW_PAIR get_keywords_by_id(XPtr<flowJoWorkspace> ws, int sample_id); |
|
76 |
-RcppExport SEXP _CytoML_get_keywords_by_id(SEXP wsSEXP, SEXP sample_idSEXP) { |
|
77 |
-BEGIN_RCPP |
|
78 |
- Rcpp::RObject rcpp_result_gen; |
|
79 |
- Rcpp::RNGScope rcpp_rngScope_gen; |
|
80 |
- Rcpp::traits::input_parameter< XPtr<flowJoWorkspace> >::type ws(wsSEXP); |
|
81 |
- Rcpp::traits::input_parameter< int >::type sample_id(sample_idSEXP); |
|
82 |
- rcpp_result_gen = Rcpp::wrap(get_keywords_by_id(ws, sample_id)); |
|
83 |
- return rcpp_result_gen; |
|
84 |
-END_RCPP |
|
85 |
-} |
|
86 |
-// get_keywords_by_name |
|
87 |
-KW_PAIR get_keywords_by_name(XPtr<flowJoWorkspace> ws, string sample_name); |
|
88 |
-RcppExport SEXP _CytoML_get_keywords_by_name(SEXP wsSEXP, SEXP sample_nameSEXP) { |
|
89 |
-BEGIN_RCPP |
|
90 |
- Rcpp::RObject rcpp_result_gen; |
|
91 |
- Rcpp::RNGScope rcpp_rngScope_gen; |
|
92 |
- Rcpp::traits::input_parameter< XPtr<flowJoWorkspace> >::type ws(wsSEXP); |
|
93 |
- Rcpp::traits::input_parameter< string >::type sample_name(sample_nameSEXP); |
|
94 |
- rcpp_result_gen = Rcpp::wrap(get_keywords_by_name(ws, sample_name)); |
|
95 |
- return rcpp_result_gen; |
|
96 |
-END_RCPP |
|
97 |
-} |
|
98 |
-// get_sample_groups |
|
99 |
-List get_sample_groups(XPtr<flowJoWorkspace> ws); |
|
100 |
-RcppExport SEXP _CytoML_get_sample_groups(SEXP wsSEXP) { |
|
101 |
-BEGIN_RCPP |
|
102 |
- Rcpp::RObject rcpp_result_gen; |
|
103 |
- Rcpp::RNGScope rcpp_rngScope_gen; |
|
104 |
- Rcpp::traits::input_parameter< XPtr<flowJoWorkspace> >::type ws(wsSEXP); |
|
105 |
- rcpp_result_gen = Rcpp::wrap(get_sample_groups(ws)); |
|
106 |
- return rcpp_result_gen; |
|
107 |
-END_RCPP |
|
108 |
-} |
|
109 |
-// get_samples |
|
110 |
-List get_samples(XPtr<flowJoWorkspace> ws); |
|
111 |
-RcppExport SEXP _CytoML_get_samples(SEXP wsSEXP) { |
|
112 |
-BEGIN_RCPP |
|
113 |
- Rcpp::RObject rcpp_result_gen; |
|
114 |
- Rcpp::RNGScope rcpp_rngScope_gen; |
|
115 |
- Rcpp::traits::input_parameter< XPtr<flowJoWorkspace> >::type ws(wsSEXP); |
|
116 |
- rcpp_result_gen = Rcpp::wrap(get_samples(ws)); |
|
117 |
- return rcpp_result_gen; |
|
118 |
-END_RCPP |
|
119 |
-} |
|
120 |
-// get_xml_file_path |
|
121 |
-string get_xml_file_path(XPtr<flowJoWorkspace> ws); |
|
122 |
-RcppExport SEXP _CytoML_get_xml_file_path(SEXP wsSEXP) { |
|
123 |
-BEGIN_RCPP |
|
124 |
- Rcpp::RObject rcpp_result_gen; |
|
125 |
- Rcpp::RNGScope rcpp_rngScope_gen; |
|
126 |
- Rcpp::traits::input_parameter< XPtr<flowJoWorkspace> >::type ws(wsSEXP); |
|
127 |
- rcpp_result_gen = Rcpp::wrap(get_xml_file_path(ws)); |
|
128 |
- return rcpp_result_gen; |
|
129 |
-END_RCPP |
|
130 |
-} |
|
131 |
- |
|
132 |
-static const R_CallMethodDef CallEntries[] = { |
|
133 |
- {"_CytoML_setLogLevel", (DL_FUNC) &_CytoML_setLogLevel, 1}, |
|
134 |
- {"_CytoML_open_workspace", (DL_FUNC) &_CytoML_open_workspace, 3}, |
|
135 |
- {"_CytoML_parse_workspace", (DL_FUNC) &_CytoML_parse_workspace, 26}, |
|
136 |
- {"_CytoML_get_keywords_by_id", (DL_FUNC) &_CytoML_get_keywords_by_id, 2}, |
|
137 |
- {"_CytoML_get_keywords_by_name", (DL_FUNC) &_CytoML_get_keywords_by_name, 2}, |
|
138 |
- {"_CytoML_get_sample_groups", (DL_FUNC) &_CytoML_get_sample_groups, 1}, |
|
139 |
- {"_CytoML_get_samples", (DL_FUNC) &_CytoML_get_samples, 1}, |
|
140 |
- {"_CytoML_get_xml_file_path", (DL_FUNC) &_CytoML_get_xml_file_path, 1}, |
|
141 |
- {NULL, NULL, 0} |
|
142 |
-}; |
|
143 |
- |
|
144 |
-RcppExport void R_init_CytoML(DllInfo *dll) { |
|
145 |
- R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); |
|
146 |
- R_useDynamicSymbols(dll, FALSE); |
|
147 |
-} |
148 | 0 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,93 @@ |
1 |
+// Generated by cpp11: do not edit by hand |
|
2 |
+// clang-format off |
|
3 |
+ |
|
4 |
+#include "CytoML_types.h" |
|
5 |
+#include "cpp11/declarations.hpp" |
|
6 |
+ |
|
7 |
+// parseFlowJoWorkspace.cpp |
|
8 |
+void setLogLevel(int short loglevel); |
|
9 |
+extern "C" SEXP _CytoML_setLogLevel(SEXP loglevel) { |
|
10 |
+ BEGIN_CPP11 |
|
11 |
+ setLogLevel(cpp11::as_cpp<cpp11::decay_t<int short>>(loglevel)); |
|
12 |
+ return R_NilValue; |
|
13 |
+ END_CPP11 |
|
14 |
+} |
|
15 |
+// parseFlowJoWorkspace.cpp |
|
16 |
+cpp11::external_pointer<flowJoWorkspace> open_workspace(std::string filename, int sample_name_location, int xmlParserOption); |
|
17 |
+extern "C" SEXP _CytoML_open_workspace(SEXP filename, SEXP sample_name_location, SEXP xmlParserOption) { |
|
18 |
+ BEGIN_CPP11 |
|
19 |
+ return cpp11::as_sexp(open_workspace(cpp11::as_cpp<cpp11::decay_t<std::string>>(filename), cpp11::as_cpp<cpp11::decay_t<int>>(sample_name_location), cpp11::as_cpp<cpp11::decay_t<int>>(xmlParserOption))); |
|
20 |
+ END_CPP11 |
|
21 |
+} |
|
22 |
+// parseFlowJoWorkspace.cpp |
|
23 |
+cpp11::external_pointer<GatingSet> parse_workspace(cpp11::external_pointer<flowJoWorkspace> ws, int group_id, cpp11::list subset, bool execute, std::string path, cpp11::external_pointer<GatingSet> cytoset, std::string backend_dir, std::string backend, bool includeGates, vector<std::string> additional_keys, bool additional_sampleID, vector<std::string> keywords, bool is_pheno_data_from_FCS, bool keyword_ignore_case, float extend_val, float extend_to, bool channel_ignore_case, bool leaf_bool, bool include_empty_tree, bool skip_faulty_gate, cpp11::list comps, bool transform, std::string fcs_file_extension, bool greedy_match, SEXP fcs_parse_arg, int num_threads); |
|
24 |
+extern "C" SEXP _CytoML_parse_workspace(SEXP ws, SEXP group_id, SEXP subset, SEXP execute, SEXP path, SEXP cytoset, SEXP backend_dir, SEXP backend, SEXP includeGates, SEXP additional_keys, SEXP additional_sampleID, SEXP keywords, SEXP is_pheno_data_from_FCS, SEXP keyword_ignore_case, SEXP extend_val, SEXP extend_to, SEXP channel_ignore_case, SEXP leaf_bool, SEXP include_empty_tree, SEXP skip_faulty_gate, SEXP comps, SEXP transform, SEXP fcs_file_extension, SEXP greedy_match, SEXP fcs_parse_arg, SEXP num_threads) { |
|
25 |
+ BEGIN_CPP11 |
|
26 |
+ return cpp11::as_sexp(parse_workspace(cpp11::as_cpp<cpp11::decay_t<cpp11::external_pointer<flowJoWorkspace>>>(ws), cpp11::as_cpp<cpp11::decay_t<int>>(group_id), cpp11::as_cpp<cpp11::decay_t<cpp11::list>>(subset), cpp11::as_cpp<cpp11::decay_t<bool>>(execute), cpp11::as_cpp<cpp11::decay_t<std::string>>(path), cpp11::as_cpp<cpp11::decay_t<cpp11::external_pointer<GatingSet>>>(cytoset), cpp11::as_cpp<cpp11::decay_t<std::string>>(backend_dir), cpp11::as_cpp<cpp11::decay_t<std::string>>(backend), cpp11::as_cpp<cpp11::decay_t<bool>>(includeGates), cpp11::as_cpp<cpp11::decay_t<vector<std::string>>>(additional_keys), cpp11::as_cpp<cpp11::decay_t<bool>>(additional_sampleID), cpp11::as_cpp<cpp11::decay_t<vector<std::string>>>(keywords), cpp11::as_cpp<cpp11::decay_t<bool>>(is_pheno_data_from_FCS), cpp11::as_cpp<cpp11::decay_t<bool>>(keyword_ignore_case), cpp11::as_cpp<cpp11::decay_t<float>>(extend_val), cpp11::as_cpp<cpp11::decay_t<float>>(extend_to), cpp11::as_cpp<cpp11::decay_t<bool>>(channel_ignore_case), cpp11::as_cpp<cpp11::decay_t<bool>>(leaf_bool), cpp11::as_cpp<cpp11::decay_t<bool>>(include_empty_tree), cpp11::as_cpp<cpp11::decay_t<bool>>(skip_faulty_gate), cpp11::as_cpp<cpp11::decay_t<cpp11::list>>(comps), cpp11::as_cpp<cpp11::decay_t<bool>>(transform), cpp11::as_cpp<cpp11::decay_t<std::string>>(fcs_file_extension), cpp11::as_cpp<cpp11::decay_t<bool>>(greedy_match), cpp11::as_cpp<cpp11::decay_t<SEXP>>(fcs_parse_arg), cpp11::as_cpp<cpp11::decay_t<int>>(num_threads))); |
|
27 |
+ END_CPP11 |
|
28 |
+} |
|
29 |
+// parseFlowJoWorkspace.cpp |
|
30 |
+SEXP get_keywords_by_id(cpp11::external_pointer<flowJoWorkspace> ws, int sample_id); |
|
31 |
+extern "C" SEXP _CytoML_get_keywords_by_id(SEXP ws, SEXP sample_id) { |
|
32 |
+ BEGIN_CPP11 |
|
33 |
+ return cpp11::as_sexp(get_keywords_by_id(cpp11::as_cpp<cpp11::decay_t<cpp11::external_pointer<flowJoWorkspace>>>(ws), cpp11::as_cpp<cpp11::decay_t<int>>(sample_id))); |
|
34 |
+ END_CPP11 |
|
35 |
+} |
|
36 |
+// parseFlowJoWorkspace.cpp |
|
37 |
+SEXP get_keywords_by_name(cpp11::external_pointer<flowJoWorkspace> ws, std::string sample_name); |
|
38 |
+extern "C" SEXP _CytoML_get_keywords_by_name(SEXP ws, SEXP sample_name) { |
|
39 |
+ BEGIN_CPP11 |
|
40 |
+ return cpp11::as_sexp(get_keywords_by_name(cpp11::as_cpp<cpp11::decay_t<cpp11::external_pointer<flowJoWorkspace>>>(ws), cpp11::as_cpp<cpp11::decay_t<std::string>>(sample_name))); |
|
41 |
+ END_CPP11 |
|
42 |
+} |
|
43 |
+// parseFlowJoWorkspace.cpp |
|
44 |
+cpp11::list get_sample_groups(cpp11::external_pointer<flowJoWorkspace> ws); |
|
45 |
+extern "C" SEXP _CytoML_get_sample_groups(SEXP ws) { |
|
46 |
+ BEGIN_CPP11 |
|
47 |
+ return cpp11::as_sexp(get_sample_groups(cpp11::as_cpp<cpp11::decay_t<cpp11::external_pointer<flowJoWorkspace>>>(ws))); |
|
48 |
+ END_CPP11 |
|
49 |
+} |
|
50 |
+// parseFlowJoWorkspace.cpp |
|
51 |
+cpp11::list get_samples(cpp11::external_pointer<flowJoWorkspace> ws); |
|
52 |
+extern "C" SEXP _CytoML_get_samples(SEXP ws) { |
|
53 |
+ BEGIN_CPP11 |
|
54 |
+ return cpp11::as_sexp(get_samples(cpp11::as_cpp<cpp11::decay_t<cpp11::external_pointer<flowJoWorkspace>>>(ws))); |
|
55 |
+ END_CPP11 |
|
56 |
+} |
|
57 |
+// parseFlowJoWorkspace.cpp |
|
58 |
+std::string get_xml_file_path(cpp11::external_pointer<flowJoWorkspace> ws); |
|
59 |
+extern "C" SEXP _CytoML_get_xml_file_path(SEXP ws) { |
|
60 |
+ BEGIN_CPP11 |
|
61 |
+ return cpp11::as_sexp(get_xml_file_path(cpp11::as_cpp<cpp11::decay_t<cpp11::external_pointer<flowJoWorkspace>>>(ws))); |
|
62 |
+ END_CPP11 |
|
63 |
+} |
|
64 |
+ |
|
65 |
+extern "C" { |
|
66 |
+/* .Call calls */ |
|
67 |
+extern SEXP _CytoML_get_keywords_by_id(SEXP, SEXP); |
|
68 |
+extern SEXP _CytoML_get_keywords_by_name(SEXP, SEXP); |
|
69 |
+extern SEXP _CytoML_get_sample_groups(SEXP); |
|
70 |
+extern SEXP _CytoML_get_samples(SEXP); |
|
71 |
+extern SEXP _CytoML_get_xml_file_path(SEXP); |
|
72 |
+extern SEXP _CytoML_open_workspace(SEXP, SEXP, SEXP); |
|
73 |
+extern SEXP _CytoML_parse_workspace(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); |
|
74 |
+extern SEXP _CytoML_setLogLevel(SEXP); |
|
75 |
+ |
|
76 |
+static const R_CallMethodDef CallEntries[] = { |
|
77 |
+ {"_CytoML_get_keywords_by_id", (DL_FUNC) &_CytoML_get_keywords_by_id, 2}, |
|
78 |
+ {"_CytoML_get_keywords_by_name", (DL_FUNC) &_CytoML_get_keywords_by_name, 2}, |
|
79 |
+ {"_CytoML_get_sample_groups", (DL_FUNC) &_CytoML_get_sample_groups, 1}, |
|
80 |
+ {"_CytoML_get_samples", (DL_FUNC) &_CytoML_get_samples, 1}, |
|
81 |
+ {"_CytoML_get_xml_file_path", (DL_FUNC) &_CytoML_get_xml_file_path, 1}, |
|
82 |
+ {"_CytoML_open_workspace", (DL_FUNC) &_CytoML_open_workspace, 3}, |
|
83 |
+ {"_CytoML_parse_workspace", (DL_FUNC) &_CytoML_parse_workspace, 26}, |
|
84 |
+ {"_CytoML_setLogLevel", (DL_FUNC) &_CytoML_setLogLevel, 1}, |
|
85 |
+ {NULL, NULL, 0} |
|
86 |
+}; |
|
87 |
+} |
|
88 |
+ |
|
89 |
+extern "C" void R_init_CytoML(DllInfo* dll){ |
|
90 |
+ R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); |
|
91 |
+ R_useDynamicSymbols(dll, FALSE); |
|
92 |
+ R_forceSymbols(dll, TRUE); |
|
93 |
+} |
... | ... |
@@ -6,16 +6,16 @@ |
6 | 6 |
* Created on: Mar 30, 2012 |
7 | 7 |
* Author: wjiang2 |
8 | 8 |
*/ |
9 |
+#include <cpp11.hpp> |
|
9 | 10 |
#include "CytoML/openWorkspace.hpp" |
10 | 11 |
#include "flowWorkspace.h" |
11 |
-using namespace Rcpp; |
|
12 | 12 |
using namespace cytolib; |
13 | 13 |
using namespace CytoML; |
14 | 14 |
WS_INIT() |
15 | 15 |
|
16 | 16 |
//only needed for win |
17 |
-//[[Rcpp::export]] |
|
18 |
-void setLogLevel(unsigned short loglevel) { |
|
17 |
+[[cpp11::register]] |
|
18 |
+void setLogLevel(int short loglevel) { |
|
19 | 19 |
|
20 | 20 |
g_loglevel = loglevel; |
21 | 21 |
|
... | ... |
@@ -24,38 +24,39 @@ GatingSet * getGsPtr(SEXP _gsPtr){ |
24 | 24 |
|
25 | 25 |
if(R_ExternalPtrAddr(_gsPtr)==0) |
26 | 26 |
throw(domain_error("Null GatingSet pointer!")); |
27 |
- XPtr<GatingSet>gs(_gsPtr); |
|
27 |
+ cpp11::external_pointer<GatingSet>gs(_gsPtr); |
|
28 |
+ |
|
29 |
+ return gs.get(); |
|
28 | 30 |
|
29 |
- return gs; |
|
30 | 31 |
} |
31 | 32 |
/* |
32 | 33 |
* can't use module for exposing overloaded methods |
33 | 34 |
*/ |
34 | 35 |
|
35 | 36 |
|
36 |
-//[[Rcpp::export]] |
|
37 |
-XPtr<flowJoWorkspace> open_workspace(string filename, int sample_name_location, int xmlParserOption) |
|
37 |
+[[cpp11::register]] |
|
38 |
+cpp11::external_pointer<flowJoWorkspace> open_workspace(std::string filename, int sample_name_location, int xmlParserOption) |
|
38 | 39 |
{ |
39 | 40 |
|
40 | 41 |
unique_ptr<flowJoWorkspace> ws = openWorkspace(filename, static_cast<SAMPLE_NAME_LOCATION>(sample_name_location),xmlParserOption); |
41 | 42 |
|
42 |
- return XPtr<flowJoWorkspace>(ws.release()); |
|
43 |
+ return cpp11::external_pointer<flowJoWorkspace>(ws.release()); |
|
43 | 44 |
} |
44 | 45 |
|
45 | 46 |
|
46 |
-//[[Rcpp::export]] |
|
47 |
-XPtr<GatingSet> parse_workspace(XPtr<flowJoWorkspace> ws |
|
47 |
+[[cpp11::register]] |
|
48 |
+cpp11::external_pointer<GatingSet> parse_workspace(cpp11::external_pointer<flowJoWorkspace> ws |
|
48 | 49 |
, int group_id |
49 |
- , List subset |
|
50 |
+ , cpp11::list subset |
|
50 | 51 |
, bool execute |
51 |
- , string path |
|
52 |
- , XPtr<GatingSet> cytoset |
|
53 |
- , string backend_dir |
|
54 |
- , string backend |
|
52 |
+ , std::string path |
|
53 |
+ , cpp11::external_pointer<GatingSet> cytoset |
|
54 |
+ , std::string backend_dir |
|
55 |
+ , std::string backend |
|
55 | 56 |
, bool includeGates |
56 |
- , vector<string> additional_keys |
|
57 |
+ , vector<std::string> additional_keys |
|
57 | 58 |
, bool additional_sampleID |
58 |
- , vector<string> keywords |
|
59 |
+ , vector<std::string> keywords |
|
59 | 60 |
, bool is_pheno_data_from_FCS |
60 | 61 |
, bool keyword_ignore_case |
61 | 62 |
, float extend_val |
... | ... |
@@ -64,11 +65,11 @@ XPtr<GatingSet> parse_workspace(XPtr<flowJoWorkspace> ws |
64 | 65 |
, bool leaf_bool |
65 | 66 |
, bool include_empty_tree |
66 | 67 |
, bool skip_faulty_gate |
67 |
- , List comps |
|
68 |
+ , cpp11::list comps |
|
68 | 69 |
, bool transform |
69 |
- , string fcs_file_extension |
|
70 |
+ , std::string fcs_file_extension |
|
70 | 71 |
, bool greedy_match |
71 |
- , FCS_READ_PARAM fcs_parse_arg |
|
72 |
+ , SEXP fcs_parse_arg |
|
72 | 73 |
, int num_threads = 1 |
73 | 74 |
) |
74 | 75 |
{ |
... | ... |
@@ -97,94 +98,94 @@ XPtr<GatingSet> parse_workspace(XPtr<flowJoWorkspace> ws |
97 | 98 |
SEXP nm = subset.names(); |
98 | 99 |
if(!Rf_isNull(nm))//without NULL checking, the following line will fail |
99 | 100 |
{ |
100 |
- vector<string> filter_names = as<vector<string> >(nm); |
|
101 |
+ vector<std::string> filter_names = cpp11::as_cpp<vector<std::string> >(nm); |
|
101 | 102 |
|
102 |
- for(unsigned i = 0; i < filter_names.size(); i++) |
|
103 |
+ for(int i = 0; i < filter_names.size(); i++) |
|
103 | 104 |
{ |
104 |
- string filter_name = filter_names[i]; |
|
105 |
- config.sample_filters[filter_name] = as<vector<string>>(subset[filter_name]); |
|
105 |
+ std::string filter_name = filter_names[i]; |
|
106 |
+ config.sample_filters[filter_name] = cpp11::as_cpp<vector<std::string>>(subset[filter_name]); |
|
106 | 107 |
} |
107 | 108 |
} |
108 | 109 |
//fcs parser config |
109 |
- config.fcs_read_param = fcs_parse_arg; |
|
110 |
+ config.fcs_read_param = sexp_to_fcs_read_param(fcs_parse_arg); |
|
110 | 111 |
// config.fcs_read_param.data.num_threads = num_threads; |
111 | 112 |
config.num_threads = num_threads; |
112 | 113 |
if(comps.size()==1&&Rf_isNull(comps.names())) |
113 | 114 |
{ |
114 | 115 |
if(!Rf_isMatrix(comps[0])) |
115 |
- stop("compensation must be of the type of NumericMatrix, "); |
|
116 |
+ cpp11::stop("compensation must be of the type of cpp11::doubles_matrix, "); |
|
116 | 117 |
|
117 |
- config.global_comp = mat_to_comp(as<NumericMatrix>(comps[0])); |
|
118 |
+ config.global_comp = mat_to_comp(cpp11::as_cpp<cpp11::doubles_matrix>(comps[0])); |
|
118 | 119 |
} |
119 | 120 |
else |
120 | 121 |
config.compensation_map = list_to_comps(comps); |
121 | 122 |
|
122 | 123 |
unique_ptr<GatingSet> gs = ws->to_GatingSet(group_id, config, *cytoset); |
123 |
- return XPtr<GatingSet>(gs.release()); |
|
124 |
+ return cpp11::external_pointer<GatingSet>(gs.release()); |
|
124 | 125 |
} |
125 | 126 |
|
126 |
-//[[Rcpp::export]] |
|
127 |
-KW_PAIR get_keywords_by_id(XPtr<flowJoWorkspace> ws, int sample_id) |
|
127 |
+[[cpp11::register]] |
|
128 |
+SEXP get_keywords_by_id(cpp11::external_pointer<flowJoWorkspace> ws, int sample_id) |
|
128 | 129 |
{ |
129 |
- return ws->get_keywords(sample_id).getPairs(); |
|
130 |
+ return kw_to_sexp(ws->get_keywords(sample_id).getPairs()); |
|
130 | 131 |
} |
131 | 132 |
|
132 |
-//[[Rcpp::export]] |
|
133 |
-KW_PAIR get_keywords_by_name(XPtr<flowJoWorkspace> ws, string sample_name) |
|
133 |
+[[cpp11::register]] |
|
134 |
+SEXP get_keywords_by_name(cpp11::external_pointer<flowJoWorkspace> ws, std::string sample_name) |
|
134 | 135 |
{ |
135 | 136 |
wsSampleNode node = ws->get_sample_node(sample_name); |
136 |
- return ws->get_keywords(node).getPairs(); |
|
137 |
+ return kw_to_sexp(ws->get_keywords(node).getPairs()); |
|
137 | 138 |
} |
138 | 139 |
|
139 |
-//[[Rcpp::export]] |
|
140 |
-List get_sample_groups(XPtr<flowJoWorkspace> ws) |
|
140 |
+[[cpp11::register]] |
|
141 |
+cpp11::list get_sample_groups(cpp11::external_pointer<flowJoWorkspace> ws) |
|
141 | 142 |
{ |
142 | 143 |
|
143 | 144 |
vector<SampleGroup> groups = ws->get_sample_groups(); |
144 |
- unsigned nGroup = groups.size(); |
|
145 |
- IntegerVector group_ids(nGroup); |
|
146 |
- StringVector group_names(nGroup); |
|
147 |
- List sample_ids(nGroup); |
|
148 |
- for(unsigned i = 0; i < nGroup; i++) |
|
145 |
+ int nGroup = groups.size(); |
|
146 |
+ cpp11::writable::integers group_ids(nGroup); |
|
147 |
+ cpp11::writable::strings group_names(nGroup); |
|
148 |
+ cpp11::writable::list sample_ids(nGroup); |
|
149 |
+ for(int i = 0; i < nGroup; i++) |
|
149 | 150 |
{ |
150 | 151 |
group_ids[i] = i; |
151 | 152 |
group_names[i] = groups[i].group_name; |
152 |
- unsigned nSample = groups[i].sample_ids.size(); |
|
153 |
- IntegerVector sample_id_vec(nSample); |
|
154 |
- for(unsigned j = 0; j < nSample; j++) |
|
153 |
+ int nSample = groups[i].sample_ids.size(); |
|
154 |
+ cpp11::writable::integers sample_id_vec(nSample); |
|
155 |
+ for(int j = 0; j < nSample; j++) |
|
155 | 156 |
sample_id_vec[j] = groups[i].sample_ids[j]; |
156 | 157 |
sample_ids[i] = sample_id_vec; |
157 | 158 |
} |
158 | 159 |
|
159 |
- return List::create(Named("groupID") = group_ids |
|
160 |
- , Named("groupName") = group_names |
|
161 |
- , Named("sampleID") = sample_ids |
|
162 |
- ); |
|
160 |
+ return cpp11::list({cpp11::named_arg("groupID") = group_ids |
|
161 |
+ , cpp11::named_arg("groupName") = group_names |
|
162 |
+ , cpp11::named_arg("sampleID") = sample_ids |
|
163 |
+ }); |
|
163 | 164 |
} |
164 | 165 |
|
165 |
-//[[Rcpp::export]] |
|
166 |
-List get_samples(XPtr<flowJoWorkspace> ws) |
|
166 |
+[[cpp11::register]] |
|
167 |
+cpp11::list get_samples(cpp11::external_pointer<flowJoWorkspace> ws) |
|
167 | 168 |
{ |
168 | 169 |
|
169 | 170 |
vector<SampleGroup> groups = ws->get_sample_groups(); |
170 |
- unsigned nGroup = groups.size(); |
|
171 |
- List grouplist(nGroup); |
|
171 |
+ int nGroup = groups.size(); |
|
172 |
+ cpp11::writable::list grouplist(nGroup); |
|
172 | 173 |
ParseWorkspaceParameters config; |
173 | 174 |
config.include_empty_tree = true; |
174 |
- for(unsigned i = 0; i < nGroup; i++) |
|
175 |
+ for(int i = 0; i < nGroup; i++) |
|
175 | 176 |
{ |
176 | 177 |
const vector<SampleInfo> & sample_info_vec = ws->get_sample_info(groups[i].sample_ids, config); |
177 |
- unsigned nSample = sample_info_vec.size(); |
|
178 |
- List samples(nSample); |
|
178 |
+ int nSample = sample_info_vec.size(); |
|
179 |
+ cpp11::writable::list samples(nSample); |
|
179 | 180 |
|
180 |
- for(unsigned j = 0; j < nSample; j++) |
|
181 |
+ for(int j = 0; j < nSample; j++) |
|
181 | 182 |
{ |
182 | 183 |
const SampleInfo & sample_info = sample_info_vec[j]; |
183 |
- samples[j] = List::create(Named("sampleID") = sample_info.sample_id |
|
184 |
- , Named("name") = sample_info.sample_name |
|
185 |
- , Named("count") = sample_info.total_event_count |
|
186 |
- , Named("pop.counts") = sample_info.population_count |
|
187 |
- ); |
|
184 |
+ samples[j] = cpp11::list({cpp11::named_arg("sampleID") = sample_info.sample_id |
|
185 |
+ , cpp11::named_arg("name") = sample_info.sample_name |
|
186 |
+ , cpp11::named_arg("count") = sample_info.total_event_count |
|
187 |
+ , cpp11::named_arg("pop.counts") = sample_info.population_count |
|
188 |
+ }); |
|
188 | 189 |
|
189 | 190 |
} |
190 | 191 |
|
... | ... |
@@ -195,14 +196,9 @@ List get_samples(XPtr<flowJoWorkspace> ws) |
195 | 196 |
} |
196 | 197 |
|
197 | 198 |
|
198 |
-// //[[Rcpp::export]] |
|
199 |
-// string get_version(XPtr<flowJoWorkspace> ws) |
|
200 |
-// { |
|
201 |
-// return ws->parseVersionList(); |
|
202 |
-// } |
|
203 | 199 |
|
204 |
-//[[Rcpp::export]] |
|
205 |
-string get_xml_file_path(XPtr<flowJoWorkspace> ws) |
|
200 |
+[[cpp11::register]] |
|
201 |
+std::string get_xml_file_path(cpp11::external_pointer<flowJoWorkspace> ws) |
|
206 | 202 |
{ |
207 | 203 |
return ws->get_xml_file_path(); |
208 | 204 |
} |
... | ... |
@@ -1,5 +1,6 @@ |
1 | 1 |
context("gatingset_to_flowjo ..") |
2 | 2 |
skip_if_not((check_docker_status()[1]=="docker_ok" || check_binary_status()=="binary_ok")) |
3 |
+register_plugins(flowStats:::.tailgate, "tailgate") |
|
3 | 4 |
test_that("autogating--tcell", { |
4 | 5 |
|
5 | 6 |
dataDir <- system.file("extdata",package="flowWorkspaceData") |
... | ... |
@@ -8,6 +8,7 @@ test_that("PE_2", { |
8 | 8 |
expect_equal(stats[, xml.count], stats[, openCyto.count], tolerance = 0.0018) |
9 | 9 |
|
10 | 10 |
sg <- diva_get_sample_groups(ws) |
11 |
+ |
|
11 | 12 |
expect_is(sg, "data.frame") |
12 | 13 |
expect_equal(sg[["tube"]], c('Unstained Control','FITC Stained Control','PE Stained Control','PerCP-Cy5-5 Stained Control','PE-Cy7 Stained Control','APC Stained Control','APC-Cy7 Stained Control','Bd Horizon V450 Stained Control','Pacific Orange Stained Control','_001','_002','_003','_004')) |
13 | 14 |
expect_equal(sg[["name"]], c('124480.fcs','124483.fcs','124485.fcs','124487.fcs','124489.fcs','124491.fcs','124493.fcs','124495.fcs','124497.fcs','124500.fcs','124502.fcs','124504.fcs','124506.fcs')) |
... | ... |
@@ -168,7 +168,9 @@ test_that("parse pData from keyword", { |
168 | 168 |
#parse pData from xml |
169 | 169 |
expect_error(gs1 <- flowjo_to_gatingset(ws, path = dataDir, name = 4, keywords = keys, execute = F, keywords.source="FCS") |
170 | 170 |
, "Can't parse phenodata", class = "error") |
171 |
- dd <- capture.output(suppressMessages(gs1 <- flowjo_to_gatingset(ws, path = dataDir, name = 4, keywords = keys, execute = F))) |
|
171 |
+ dd <- capture.output(suppressMessages(gs1 <- flowjo_to_gatingset(ws, path = dataDir, name = 4 |
|
172 |
+ , keywords = keys |
|
173 |
+ , execute = F))) |
|
172 | 174 |
pd1 <- pData(gs1) |
173 | 175 |
expect_equal(nrow(pd1), 4) |
174 | 176 |
|