Browse code

biocheck

Simone authored on 17/05/2021 09:41:45
Showing34 changed files

... ...
@@ -2,8 +2,15 @@ Package: RGMQL
2 2
 Type: Package
3 3
 Title: GenoMetric Query Language for R/Bioconductor
4 4
 Version: 1.11.0
5
-Author: Simone Pallotta, Marco Masseroli
6
-Maintainer: Simone Pallotta <simonepallotta@hotmail.com>
5
+Authors@R: c(person(given = "Simone",
6
+           family = "Pallotta",
7
+           role = c("aut", "cre"),
8
+           email = "simonepallotta@hotmail.com"),
9
+           person(given = "Marco",
10
+           family = "Masseroli",
11
+           role = "aut",
12
+           email = "marco.masseroli@polimi.it")
13
+           )
7 14
 Description: This package brings the GenoMetric Query Language (GMQL)
8 15
     functionalities into the R environment. GMQL is a high-level, declarative
9 16
     language to manage heterogeneous genomic datasets for biomedical purposes, 
10 17
deleted file mode 100644
... ...
@@ -1,24 +0,0 @@
1
-CHANGES IN VERSION 1.11.1
2
-
3
-NEW FEATURES
4
-
5
-    o None
6
-
7
-SIGNIFICANT USER-VISIBLE CHANGES
8
-
9
-    o removed is_GMQL from read_gmql function
10
-      The entire dataset must have the right folder structure in order to
11
-      works correctly <dataset_name> ---> <files>
12
-
13
-    o Swap order of arguments 'dir_out' and 'name' of the collect()
14
-      function so now the latter comes before the former.
15
-
16
-DEPRECATED AND DEFUNCT
17
-
18
-    o None
19
-    
20
-BUG FIXES
21
-
22
-    o fixed the remote processing
23
-    
... ...
@@ -21,13 +21,13 @@ setClass("GMQLDataset", representation(value = "character"))
21 21
 #' @rdname GMQLDataset-class
22 22
 #' @noRd
23 23
 GMQLDataset <- function(value) {
24
-  dataset <- new("GMQLDataset",value = value)
25
-  return(dataset)
24
+    dataset <- new("GMQLDataset",value = value)
25
+    return(dataset)
26 26
 }
27 27
 
28 28
 setMethod("show", "GMQLDataset", function(object) {
29
-  cat("GMQL Dataset \n")
30
-  cat(" value :",paste(object@value))
29
+    cat("GMQL Dataset \n")
30
+    cat(" value :",paste(object@value))
31 31
 })
32 32
 
33 33
 setGeneric("value", function(.dataset) standardGeneric("value"))
... ...
@@ -29,100 +29,99 @@
29 29
 #' @export
30 30
 #'
31 31
 import_gmql <- function(dataset_path, is_gtf) {
32
-  if(is_gtf)
33
-    .importGMQL.gtf(dataset_path)
34
-  else
35
-    .importGMQL.gdm(dataset_path)
32
+    if(is_gtf)
33
+        .importGMQL.gtf(dataset_path)
34
+    else
35
+        .importGMQL.gdm(dataset_path)
36 36
 }
37 37
 
38 38
 .importGMQL.gtf <- function(datasetName) {
39
-  datasetName <- sub("/*[/]$","",datasetName)
40
-  if(basename(datasetName) !="files")
41
-    datasetName <- file.path(datasetName,"files")
42
-  
43
-  if(!dir.exists(datasetName))
44
-    stop("Directory does not exists")
45
-  
46
-  if(!length(list.files(datasetName)))
47
-    stop("no samples present in this dataset")
48
-  
49
-  regions <- list.files(datasetName, pattern = "*.gtf$",full.names = TRUE)
50
-  if(length(regions)) {
51
-    name_samples <- lapply(regions, function(x){
52
-      gsub("*.gtf", "", basename(x))})
53
-    sampleList <- lapply(regions, function(x){
54
-      rtracklayer::import(con = x, format = "gtf")} )
55
-    names(sampleList) <- name_samples
56
-    gRange_list <- GenomicRanges::GRangesList(sampleList)
39
+    datasetName <- sub("/*[/]$","",datasetName)
40
+    if(basename(datasetName) !="files")
41
+        datasetName <- file.path(datasetName,"files")
57 42
     
58
-  } else
59
-    stop("No GTF files present")
60
-  
61
-  meta <- list.files(datasetName, pattern = "*.gtf.meta$",full.names = TRUE)
62
-  if(length(meta)) {
63
-    meta_list <- lapply(meta, .add_metadata)
64
-    names(meta_list) <- name_samples
43
+    if(!dir.exists(datasetName))
44
+        stop("Directory does not exists")
65 45
     
66
-  } else
67
-    stop("No meta GTF files present")
68
-  
69
-  S4Vectors::metadata(gRange_list) <- meta_list
70
-  return(gRange_list)
46
+    if(!length(list.files(datasetName)))
47
+        stop("no samples present in this dataset")
48
+    
49
+    regions <- list.files(datasetName, pattern = "*.gtf$",full.names = TRUE)
50
+    if(length(regions)) {
51
+        name_samples <- lapply(regions, function(x) {
52
+            gsub("*.gtf", "", basename(x))})
53
+        sampleList <- lapply(regions, function(x) {
54
+            rtracklayer::import(con = x, format = "gtf")} )
55
+        names(sampleList) <- name_samples
56
+        gRange_list <- GenomicRanges::GRangesList(sampleList)
57
+        
58
+    } else
59
+        stop("No GTF files present")
60
+    
61
+    meta <- list.files(datasetName, pattern = "*.gtf.meta$",full.names = TRUE)
62
+    if(length(meta)) {
63
+        meta_list <- lapply(meta, .add_metadata)
64
+        names(meta_list) <- name_samples
65
+        
66
+    } else
67
+        stop("No meta GTF files present")
68
+    
69
+    S4Vectors::metadata(gRange_list) <- meta_list
70
+    return(gRange_list)
71 71
 }
72 72
 
73 73
 .importGMQL.gdm <- function(datasetName) {
74
-  datasetName <- sub("/*[/]$","",datasetName)
75
-  if(basename(datasetName) !="files")
76
-    datasetName <- file.path(datasetName,"files")
77
-  
78
-  if(!dir.exists(datasetName))
79
-    stop("Directory does not exists")
80
-  
81
-  if(!length(list.files(datasetName)))
82
-    stop("no samples present in this dataset")
83
-  
84
-  regions <- list.files(datasetName, pattern = "*.gdm$",full.names = TRUE)
85
-  if(length(regions)) {
86
-    name_samples <- lapply(regions, function(x){
87
-      gsub("*.gdm", "",basename(x))})
88
-    vector_field <- .schema_header(datasetName)
89
-    type_and_coord <- .schema_type_coordinate(datasetName)
90
-    names(vector_field) <- NULL
91
-    if(type_and_coord$coordinate_system %in% c("1-based")) {
92
-      sampleList <- lapply(regions,function(x){
93
-        df <- read.delim(x,col.names = vector_field,header = FALSE)
94
-        g <- GenomicRanges::makeGRangesFromDataFrame(
95
-          df,
96
-          keep.extra.columns = TRUE,
97
-          start.field = "left",
98
-          end.field = "right")
99
-      })
100
-    } else {
101
-      sampleList <- lapply(regions,function(x){
102
-        df <- read.delim(x,col.names = vector_field,header = FALSE)
103
-        df$left = df$left +1
104
-        g <- GenomicRanges::makeGRangesFromDataFrame(
105
-          df,
106
-          keep.extra.columns = TRUE,
107
-          start.field = "left",
108
-          end.field = "right")
109
-      })
110
-    }
74
+    datasetName <- sub("/*[/]$","",datasetName)
75
+    if(basename(datasetName) !="files")
76
+        datasetName <- file.path(datasetName,"files")
77
+    
78
+    if(!dir.exists(datasetName))
79
+        stop("Directory does not exists")
80
+    
81
+    if(!length(list.files(datasetName)))
82
+        stop("no samples present in this dataset")
111 83
     
112
-    names(sampleList) <- name_samples
113
-    gRange_list <- GenomicRanges::GRangesList(sampleList)
84
+    regions <- list.files(datasetName, pattern = "*.gdm$",full.names = TRUE)
85
+    if(length(regions)) {
86
+        name_samples <- lapply(regions, function(x){
87
+            gsub("*.gdm", "",basename(x))})
88
+        vector_field <- .schema_header(datasetName)
89
+        type_and_coord <- .schema_type_coordinate(datasetName)
90
+        names(vector_field) <- NULL
91
+        if(type_and_coord$coordinate_system %in% c("1-based")) {
92
+            sampleList <- lapply(regions,function(x){
93
+                df <- read.delim(x,col.names = vector_field,header = FALSE)
94
+                g <- GenomicRanges::makeGRangesFromDataFrame(
95
+                    df,
96
+                    keep.extra.columns = TRUE,
97
+                    start.field = "left",
98
+                    end.field = "right")
99
+            })
100
+        } else {
101
+            sampleList <- lapply(regions,function(x) {
102
+                df <- read.delim(x,col.names = vector_field,header = FALSE)
103
+                df$left = df$left +1
104
+                g <- GenomicRanges::makeGRangesFromDataFrame(
105
+                    df,
106
+                    keep.extra.columns = TRUE,
107
+                    start.field = "left",
108
+                    end.field = "right")
109
+                })
110
+        }
111
+        
112
+        names(sampleList) <- name_samples
113
+        gRange_list <- GenomicRanges::GRangesList(sampleList)
114
+        
115
+    } else
116
+        stop("No GDM files present")
114 117
     
115
-  } else
116
-    stop("No GDM files present")
117
-  
118
-  meta <- list.files(datasetName, pattern = "*.gdm.meta$",full.names = TRUE)
119
-  if(length(meta)) {
120
-    meta_list <- lapply(meta, .add_metadata)
121
-    names(meta_list) <- name_samples
118
+    meta <- list.files(datasetName, pattern = "*.gdm.meta$",full.names = TRUE)
119
+    if(length(meta)) {
120
+        meta_list <- lapply(meta, .add_metadata)
121
+        names(meta_list) <- name_samples
122
+    } else
123
+        stop("No meta GDM files present")
122 124
     
123
-  } else
124
-    stop("No meta GDM files present")
125
-  
126
-  S4Vectors::metadata(gRange_list) <- meta_list
127
-  return(gRange_list)
125
+    S4Vectors::metadata(gRange_list) <- meta_list
126
+    return(gRange_list)
128 127
 }
... ...
@@ -67,144 +67,150 @@
67 67
 #' @export
68 68
 #'
69 69
 export_gmql <- function(samples, dir_out, is_gtf) {
70
-  if(is_gtf)
71
-    .exportGMQL.gtf(samples,dir_out,is_gtf)
72
-  else
73
-    .exportGMQL.gdm(samples,dir_out,is_gtf)
70
+    if(is_gtf)
71
+        .exportGMQL.gtf(samples,dir_out,is_gtf)
72
+    else
73
+        .exportGMQL.gdm(samples,dir_out,is_gtf)
74 74
 }
75 75
 
76 76
 .exportGMQL.gdm <- function(samples, dir_out, to_GTF) {
77
-  .exportGMQL(samples,dir_out,to_GTF)
78
-  print("Export to GDM complete")
77
+    .exportGMQL(samples,dir_out,to_GTF)
78
+    print("Export to GDM complete")
79 79
 }
80 80
 
81 81
 .exportGMQL.gtf <- function(samples, dir_out,to_GTF) {
82
-  .exportGMQL(samples, dir_out, to_GTF)
83
-  print("Export to GTF complete")
82
+    .exportGMQL(samples, dir_out, to_GTF)
83
+    print("Export to GTF complete")
84 84
 }
85 85
 
86 86
 .exportGMQL <- function(samples, dir_out, to_GTF) {
87
-  if(!is(samples,"GRangesList"))
88
-    stop("samples must be a GrangesList")
89
-  
90
-  if(!dir.exists(dir_out))
91
-    dir.create(dir_out)
92
-  
93
-  files_sub_dir <- file.path(dir_out,"files")
94
-  dir.create(files_sub_dir)
95
-  cnt = .counter()
96
-  file_ext = ""
97
-  #col_names <- .get_schema_names(samples)
98
-  if(to_GTF) {
99
-    #write region
100
-    lapply(samples,function(x,dir){
101
-      #anonymusFile <- file()
102
-      sample_name <- file.path(dir,paste0("S_",cnt(),".gtf"))
103
-      g <- rtracklayer::export(x,format = "gtf")
104
-      #lines <- readLines(sample_name)
105
-      lines <- g[-(1:3)] #delete first 3 lines
106
-      writeLines(lines,sample_name)
107
-      #close(anonymusFile)
108
-    },files_sub_dir)
109
-    file_ext = ".gtf"
87
+    if(!is(samples,"GRangesList"))
88
+        stop("samples must be a GrangesList")
89
+    
90
+    if(!dir.exists(dir_out))
91
+        dir.create(dir_out)
92
+    
93
+    files_sub_dir <- file.path(dir_out,"files")
94
+    dir.create(files_sub_dir)
95
+    cnt = .counter()
96
+    file_ext = ""
97
+    #col_names <- .get_schema_names(samples)
98
+    if(to_GTF) {
99
+        #write region
100
+        lapply(samples,function(x,dir){
101
+            #anonymusFile <- file()
102
+            sample_name <- file.path(dir,paste0("S_",cnt(),".gtf"))
103
+            g <- rtracklayer::export(x,format = "gtf")
104
+            #lines <- readLines(sample_name)
105
+            lines <- g[-(1:3)] #delete first 3 lines
106
+            writeLines(lines,sample_name)
107
+            #close(anonymusFile)
108
+        },files_sub_dir)
109
+        file_ext = ".gtf"
110
+    } else {
111
+        #write region
112
+        lapply(samples,function(x,dir){
113
+            sample_name <- file.path(dir,paste0("S_",cnt(),".gdm"))
114
+            region_frame <- data.frame(x)
115
+            region_frame <- region_frame[-4] # delete width column
116
+            region_frame$start = region_frame$start - 1
117
+            write.table(
118
+                region_frame,
119
+                sample_name,
120
+                col.names = FALSE,
121
+                row.names = FALSE, 
122
+                sep = '\t',
123
+                quote = FALSE)
124
+        },files_sub_dir)
125
+        file_ext = ".gdm"
126
+    }
127
+    
128
+    cnt = .counter(0)
129
+    meta <- metadata(samples)
110 130
     
111
-  } else {
112
-    #write region
113
-    lapply(samples,function(x,dir){
114
-      sample_name <- file.path(dir,paste0("S_",cnt(),".gdm"))
115
-      region_frame <- data.frame(x)
116
-      region_frame <- region_frame[-4] # delete width column
117
-      region_frame$start = region_frame$start - 1
118
-      write.table(region_frame,sample_name,col.names = FALSE,
119
-                  row.names = FALSE, sep = '\t',quote = FALSE)
131
+    #write metadata
132
+    lapply(meta,function(x,dir){
133
+        sample_name <- file.path(dir,paste0("S_",cnt(),file_ext))
134
+        .write_metadata(x,sample_name)
120 135
     },files_sub_dir)
121
-    file_ext = ".gdm"
122
-  }
123
-  
124
-  cnt = .counter(0)
125
-  meta <- metadata(samples)
126
-  
127
-  #write metadata
128
-  lapply(meta,function(x,dir){
129
-    sample_name <- file.path(dir,paste0("S_",cnt(),file_ext))
130
-    .write_metadata(x,sample_name)
131
-  },files_sub_dir)
132
-  
133
-  # first regions to get column names
134
-  col_names <- vapply(elementMetadata(samples[[1]]),class,character(1)) 
135
-  # write schema XML
136
-  .write_schema(col_names,files_sub_dir,to_GTF)
137
-  c = .counter(0)
136
+    
137
+    # first regions to get column names
138
+    col_names <- vapply(elementMetadata(samples[[1]]),class,character(1)) 
139
+    # write schema XML
140
+    .write_schema(col_names,files_sub_dir,to_GTF)
141
+    c = .counter(0)
138 142
 }
139 143
 
140 144
 .write_metadata <- function(meta_list,sample_name) {
141
-  #create my own list if metadata empty
142
-  if(!length(meta_list))
143
-    meta_list <- list(Provider = "Polimi", Application = "R-GMQL")
144
-  
145
-  names_list <- names(meta_list)
146
-  value_list <- unlist(meta_list)
147
-  file_meta_name = paste0(sample_name,".meta")
148
-  data <- data.frame(names_list,value_list)
149
-  names(data) <- NULL
150
-  write.table(data,file_meta_name,row.names = FALSE,
151
-              col.names = FALSE, quote = FALSE,sep = '\t')
145
+    #create my own list if metadata empty
146
+    if(!length(meta_list))
147
+        meta_list <- list(Provider = "Polimi", Application = "R-GMQL")
148
+    
149
+    names_list <- names(meta_list)
150
+    value_list <- unlist(meta_list)
151
+    file_meta_name = paste0(sample_name,".meta")
152
+    data <- data.frame(names_list,value_list)
153
+    names(data) <- NULL
154
+    write.table(
155
+        data,
156
+        file_meta_name,
157
+        row.names = FALSE,
158
+        col.names = FALSE, 
159
+        quote = FALSE,
160
+        sep = '\t')
152 161
 }
153 162
 
154 163
 .write_schema <- function(columns,directory,to_GTF) {
155
-  if(to_GTF) {
156
-    names(columns) <- plyr::revalue(
157
-      names(columns),
158
-      c(type = "feature", phase = "frame")
159
-    )
160
-    fixed_element = c(
161
-      seqname = "character", source = "character", 
162
-      feature = "character",start = "long", end = "long", 
163
-      score = "numeric", strand = "character",
164
-      frame = "character")
165
-    node_list <- c(fixed_element, columns)
166
-    node_list <- node_list[!duplicated(names(node_list))]
164
+    if(to_GTF) {
165
+        names(columns) <- plyr::revalue(
166
+            names(columns),
167
+            c(type = "feature", phase = "frame")
168
+        )
169
+        fixed_element = c(
170
+            seqname = "character", source = "character", 
171
+            feature = "character",start = "long", end = "long", 
172
+            score = "numeric", strand = "character",
173
+            frame = "character")
174
+        node_list <- c(fixed_element, columns)
175
+        node_list <- node_list[!duplicated(names(node_list))]
176
+    } else {
177
+        fixed_element = c(
178
+            chr = "factor", 
179
+            left = "long", 
180
+            right = "long", 
181
+            strand = "character"
182
+        )
183
+        node_list <- c(fixed_element, columns)
184
+    }
167 185
     
168
-  } else {
169
-    fixed_element = c(
170
-      chr = "factor", 
171
-      left = "long", 
172
-      right = "long", 
173
-      strand = "character"
174
-    )
175
-    node_list <- c(fixed_element, columns)
176
-  }
177
-  
178
-  schema <- file.path(directory,"granges.xml")
179
-  root <- xml2::xml_new_root("gmqlSchemaCollection")
180
-  xml2::xml_attr(root,"name") <- "DatasetName_SCHEMAS"
181
-  xml2::xml_attr(root,"xmlns") <- "http://genomic.elet.polimi.it/entities"
182
-  xml2::xml_add_child(root,"gmqlSchema")
183
-  gmqlSchema <- xml2::xml_child(root,1) #gmqlSchema
184
-  if(to_GTF) {
185
-    xml2::xml_attr(gmqlSchema,"type") <- "gtf"
186
-    xml2::xml_attr(gmqlSchema,"coordinate_system") <- "1-based"
186
+    schema <- file.path(directory,"granges.xml")
187
+    root <- xml2::xml_new_root("gmqlSchemaCollection")
188
+    xml2::xml_attr(root,"name") <- "DatasetName_SCHEMAS"
189
+    xml2::xml_attr(root,"xmlns") <- "http://genomic.elet.polimi.it/entities"
190
+    xml2::xml_add_child(root,"gmqlSchema")
191
+    gmqlSchema <- xml2::xml_child(root,1) #gmqlSchema
192
+    if(to_GTF) {
193
+        xml2::xml_attr(gmqlSchema,"type") <- "gtf"
194
+        xml2::xml_attr(gmqlSchema,"coordinate_system") <- "1-based"
195
+    } else {
196
+        xml2::xml_attr(gmqlSchema,"type") <- "tab"
197
+        xml2::xml_attr(gmqlSchema,"coordinate_system") <- "0-based"
198
+    }
187 199
     
188
-  } else {
189
-    xml2::xml_attr(gmqlSchema,"type") <- "tab"
190
-    xml2::xml_attr(gmqlSchema,"coordinate_system") <- "0-based"
191
-  }
192
-  
193
-  names_node <- names(node_list)
194
-  
195
-  mapply(function(type,text){
196
-    field <- xml2::xml_add_child(gmqlSchema,"field")
197
-    if(identical(type,"factor") || identical(type,"character"))
198
-      xml2::xml_attr(field,"type") <- "STRING"
199
-    else if(identical(type,"numeric") || identical(type,"integer"))
200
-      xml2::xml_attr(field,"type") <- "DOUBLE"
201
-    else if(identical(type,"long"))
202
-      xml2::xml_attr(field,"type") <- "LONG"
203
-    else
204
-      xml2::xml_attr(field,"type") <- "NULL"
205
-    xml2::xml_text(field) <- text
200
+    names_node <- names(node_list)
206 201
     
207
-  },node_list,names_node)
208
-  xml2::write_xml(root,schema)
202
+    mapply(function(type,text){
203
+        field <- xml2::xml_add_child(gmqlSchema,"field")
204
+        if(identical(type,"factor") || identical(type,"character"))
205
+            xml2::xml_attr(field,"type") <- "STRING"
206
+        else if(identical(type,"numeric") || identical(type,"integer"))
207
+            xml2::xml_attr(field,"type") <- "DOUBLE"
208
+        else if(identical(type,"long"))
209
+            xml2::xml_attr(field,"type") <- "LONG"
210
+        else
211
+            xml2::xml_attr(field,"type") <- "NULL"
212
+        xml2::xml_text(field) <- text
213
+        
214
+    },node_list,names_node)
215
+    xml2::write_xml(root,schema)
209 216
 }
210
-
... ...
@@ -4,57 +4,57 @@
4 4
 
5 5
 
6 6
 AGGREGATES <- function(value) {
7
-  op_list <- list(value = value)
8
-  ## Set the name for the class
9
-  class(op_list) <- "AGGREGATES"
10
-  return(op_list)
7
+    op_list <- list(value = value)
8
+    ## Set the name for the class
9
+    class(op_list) <- "AGGREGATES"
10
+    return(op_list)
11 11
 }
12 12
 
13 13
 check.META_AGGREGATES <- function(value) {
14
-  if(is.character(value) && length(value)>1)
15
-    stop("value: no multiple string")
16
-  
17
-  if(!is.character(value))
18
-    stop("value: is not a string")
14
+    if(is.character(value) && length(value)>1)
15
+        stop("value: no multiple string")
16
+    
17
+    if(!is.character(value))
18
+        stop("value: is not a string")
19 19
 }
20 20
 
21 21
 META_AGGREGATES <- function(value) {
22
-  op_list <- list(value = value)
23
-  ## Set the name for the class
24
-  class(op_list) <- "META_AGGREGATES"
25
-  return(op_list)
22
+    op_list <- list(value = value)
23
+    ## Set the name for the class
24
+    class(op_list) <- "META_AGGREGATES"
25
+    return(op_list)
26 26
 }
27 27
 
28 28
 print.META_AGGREGATES <- function(obj) {
29
-  res <- as.character(obj)
30
-  cat(res)
29
+    res <- as.character(obj)
30
+    cat(res)
31 31
 }
32 32
 
33 33
 as.character.META_AGGREGATES <- function(obj) {
34
-  class <- class(obj)[1]
35
-  val <- obj$value
36
-  c(class,val)
34
+    class <- class(obj)[1]
35
+    val <- obj$value
36
+    c(class,val)
37 37
 }
38 38
 
39 39
 take_value.META_AGGREGATES <- function(obj){
40
-  class <- class(obj)[1]
41
-  val <- obj$value
42
-  text <- switch(
43
-    class,
44
-    "SUM" = paste0("sum_",val),
45
-    "MIN" = paste0("min_",val),
46
-    "MAX" = paste0("max_",val),
47
-    "COUNT" = paste0("count"),
48
-    "BAG" = paste0("bag_",val),
49
-    "BAGD" = paste0("bagd_",val),
50
-    "AVG" = paste0("avg_",val),
51
-    "STD" = paste0("std_"),
52
-    "MEDIAN" = paste0("median_",val),
53
-    "Q1" = paste0("q1_",val),
54
-    "Q2" = paste0("q2_"),
55
-    "Q3" = paste0("q3_",val)
56
-  )
57
-  text
40
+    class <- class(obj)[1]
41
+    val <- obj$value
42
+    text <- switch(
43
+        class,
44
+        "SUM" = paste0("sum_",val),
45
+        "MIN" = paste0("min_",val),
46
+        "MAX" = paste0("max_",val),
47
+        "COUNT" = paste0("count"),
48
+        "BAG" = paste0("bag_",val),
49
+        "BAGD" = paste0("bagd_",val),
50
+        "AVG" = paste0("avg_",val),
51
+        "STD" = paste0("std_"),
52
+        "MEDIAN" = paste0("median_",val),
53
+        "Q1" = paste0("q1_",val),
54
+        "Q2" = paste0("q2_"),
55
+        "Q3" = paste0("q3_",val)
56
+    )
57
+    text
58 58
 }
59 59
 
60 60
 
... ...
@@ -169,12 +169,12 @@ take_value.META_AGGREGATES <- function(obj){
169 169
 #' @export
170 170
 #'
171 171
 SUM <- function(value) {
172
-  check.META_AGGREGATES(value)
173
-  
174
-  list <- list(value = value)
175
-  ## Set the name for the class
176
-  class(list) <- c("SUM","AGGREGATES","META_AGGREGATES")
177
-  return(list)
172
+    check.META_AGGREGATES(value)
173
+    
174
+    list <- list(value = value)
175
+    ## Set the name for the class
176
+    class(list) <- c("SUM","AGGREGATES","META_AGGREGATES")
177
+    return(list)
178 178
 }
179 179
 
180 180
 #' @name AGGREGATES-Object
... ...
@@ -183,14 +183,14 @@ SUM <- function(value) {
183 183
 #' @export
184 184
 #'
185 185
 COUNT <- function() {
186
-  list <- list()
187
-  ## Set the name for the class
188
-  class(list) <- c("COUNT","AGGREGATES","META_AGGREGATES")
189
-  return(list)
186
+    list <- list()
187
+    ## Set the name for the class
188
+    class(list) <- c("COUNT","AGGREGATES","META_AGGREGATES")
189
+    return(list)
190 190
 }
191 191
 as.character.COUNT <- function(obj) {
192
-  class <- class(obj)[1]
193
-  c(class,"")
192
+    class <- class(obj)[1]
193
+    c(class,"")
194 194
 }
195 195
 check.COUNT <- function(obj){}
196 196
 
... ...
@@ -201,14 +201,14 @@ check.COUNT <- function(obj){}
201 201
 #' @export
202 202
 #'
203 203
 COUNTSAMP <- function() {
204
-  list <- list()
205
-  ## Set the name for the class
206
-  class(list) <- c("COUNTSAMP","AGGREGATES","META_AGGREGATES")
207
-  return(list)
204
+    list <- list()
205
+    ## Set the name for the class
206
+    class(list) <- c("COUNTSAMP","AGGREGATES","META_AGGREGATES")
207
+    return(list)
208 208
 }
209 209
 as.character.COUNTSAMP <- function(obj) {
210
-  class <- class(obj)[1]
211
-  c(class,"")
210
+    class <- class(obj)[1]
211
+    c(class,"")
212 212
 }
213 213
 check.COUNTSAMP <- function(obj){}
214 214
 
... ...
@@ -219,12 +219,12 @@ check.COUNTSAMP <- function(obj){}
219 219
 #' @export
220 220
 #'
221 221
 MIN <- function(value) {
222
-  check.META_AGGREGATES(value)
223
-  
224
-  list <- list(value = value)
225
-  ## Set the name for the class
226
-  class(list) <- c("MIN","AGGREGATES","META_AGGREGATES")
227
-  return(list)
222
+    check.META_AGGREGATES(value)
223
+    
224
+    list <- list(value = value)
225
+    ## Set the name for the class
226
+    class(list) <- c("MIN","AGGREGATES","META_AGGREGATES")
227
+    return(list)
228 228
 }
229 229
 
230 230
 #' @name AGGREGATES-Object
... ...
@@ -233,12 +233,12 @@ MIN <- function(value) {
233 233
 #' @export
234 234
 #'
235 235
 MAX <- function(value) {
236
-  check.META_AGGREGATES(value)
237
-  
238
-  list <- list(value = value)
239
-  ## Set the name for the class
240
-  class(list) <- c("MAX","AGGREGATES","META_AGGREGATES")
241
-  return(list)
236
+    check.META_AGGREGATES(value)
237
+    
238
+    list <- list(value = value)
239
+    ## Set the name for the class
240
+    class(list) <- c("MAX","AGGREGATES","META_AGGREGATES")
241
+    return(list)
242 242
 }
243 243
 
244 244
 #' @name AGGREGATES-Object
... ...
@@ -247,12 +247,12 @@ MAX <- function(value) {
247 247
 #' @export
248 248
 #'
249 249
 AVG <- function(value) {
250
-  check.META_AGGREGATES(value)
251
-  
252
-  list <- list(value = value)
253
-  ## Set the name for the class
254
-  class(list) <- c("AVG","AGGREGATES","META_AGGREGATES")
255
-  return(list)
250
+    check.META_AGGREGATES(value)
251
+    
252
+    list <- list(value = value)
253
+    ## Set the name for the class
254
+    class(list) <- c("AVG","AGGREGATES","META_AGGREGATES")
255
+    return(list)
256 256
 }
257 257
 
258 258
 #' @name AGGREGATES-Object
... ...
@@ -261,12 +261,12 @@ AVG <- function(value) {
261 261
 #' @export
262 262
 #'
263 263
 MEDIAN <- function(value) {
264
-  check.META_AGGREGATES(value)
265
-  
266
-  list <- list(value = value)
267
-  ## Set the name for the class
268
-  class(list) <- c("MEDIAN","AGGREGATES","META_AGGREGATES")
269
-  return(list)
264
+    check.META_AGGREGATES(value)
265
+    
266
+    list <- list(value = value)
267
+    ## Set the name for the class
268
+    class(list) <- c("MEDIAN","AGGREGATES","META_AGGREGATES")
269
+    return(list)
270 270
 }
271 271
 
272 272
 
... ...
@@ -276,12 +276,12 @@ MEDIAN <- function(value) {
276 276
 #' @export
277 277
 #'
278 278
 STD <- function(value) {
279
-  check.META_AGGREGATES(value)
280
-  
281
-  list <- list(value = value)
282
-  ## Set the name for the class
283
-  class(list) <- c("STD","META_AGGREGATES")
284
-  return(list)
279
+    check.META_AGGREGATES(value)
280
+    
281
+    list <- list(value = value)
282
+    ## Set the name for the class
283
+    class(list) <- c("STD","META_AGGREGATES")
284
+    return(list)
285 285
 }
286 286
 
287 287
 #' @name AGGREGATES-Object
... ...
@@ -290,12 +290,12 @@ STD <- function(value) {
290 290
 #' @export
291 291
 #'
292 292
 BAG <- function(value) {
293
-  check.META_AGGREGATES(value)
294
-  
295
-  list <- list(value = value)
296
-  ## Set the name for the class
297
-  class(list) <- c("BAG","AGGREGATES","META_AGGREGATES")
298
-  return(list)
293
+    check.META_AGGREGATES(value)
294
+    
295
+    list <- list(value = value)
296
+    ## Set the name for the class
297
+    class(list) <- c("BAG","AGGREGATES","META_AGGREGATES")
298
+    return(list)
299 299
 }
300 300
 
301 301
 #' @name AGGREGATES-Object
... ...
@@ -304,12 +304,12 @@ BAG <- function(value) {
304 304
 #' @export
305 305
 #'
306 306
 BAGD <- function(value) {
307
-  check.META_AGGREGATES(value)
308
-  
309
-  list <- list(value = value)
310
-  ## Set the name for the class
311
-  class(list) <- c("BAGD","AGGREGATES","META_AGGREGATES")
312
-  return(list)
307
+    check.META_AGGREGATES(value)
308
+    
309
+    list <- list(value = value)
310
+    ## Set the name for the class
311
+    class(list) <- c("BAGD","AGGREGATES","META_AGGREGATES")
312
+    return(list)
313 313
 }
314 314
 
315 315
 #' @name AGGREGATES-Object
... ...
@@ -318,12 +318,12 @@ BAGD <- function(value) {
318 318
 #' @export
319 319
 #'
320 320
 Q1 <- function(value) {
321
-  check.META_AGGREGATES(value)
322
-  
323
-  list <- list(value = value)
324
-  ## Set the name for the class
325
-  class(list) <- c("Q1","META_AGGREGATES")
326
-  return(list)
321
+    check.META_AGGREGATES(value)
322
+    
323
+    list <- list(value = value)
324
+    ## Set the name for the class
325
+    class(list) <- c("Q1","META_AGGREGATES")
326
+    return(list)
327 327
 }
328 328
 
329 329
 #' @name AGGREGATES-Object
... ...
@@ -332,11 +332,11 @@ Q1 <- function(value) {
332 332
 #' @export
333 333
 #'
334 334
 Q2 <- function(value) {
335
-  check.META_AGGREGATES(value)
336
-  list <- list(value = value)
337
-  ## Set the name for the class
338
-  class(list) <- c("Q2","META_AGGREGATES")
339
-  return(list)
335
+    check.META_AGGREGATES(value)
336
+    list <- list(value = value)
337
+    ## Set the name for the class
338
+    class(list) <- c("Q2","META_AGGREGATES")
339
+    return(list)
340 340
 }
341 341
 
342 342
 #' @name AGGREGATES-Object
... ...
@@ -345,10 +345,10 @@ Q2 <- function(value) {
345 345
 #' @export
346 346
 #'
347 347
 Q3 <- function(value) {
348
-  check.META_AGGREGATES(value)
349
-  
350
-  list <- list(value = value)
351
-  ## Set the name for the class
352
-  class(list) <- c("Q3","META_AGGREGATES")
353
-  return(list)
348
+    check.META_AGGREGATES(value)
349
+    
350
+    list <- list(value = value)
351
+    ## Set the name for the class
352
+    class(list) <- c("Q3","META_AGGREGATES")
353
+    return(list)
354 354
 }
... ...
@@ -3,18 +3,18 @@
3 3
 ############################
4 4
 
5 5
 PARAMETER <- function() {
6
-  op_list <- list()
7
-  ## Set the name for the class
8
-  class(op_list) <- "PARAMETER"
9
-  return(op_list)
6
+    op_list <- list()
7
+    ## Set the name for the class
8
+    class(op_list) <- "PARAMETER"
9
+    return(op_list)
10 10
 }
11 11
 
12 12
 as.character.PARAMETER <- function(obj) {
13
-  class <- class(obj)[1]
13
+    class <- class(obj)[1]
14 14
 }
15 15
 
16 16
 print.PARAMETER <- function(obj){
17
-  print(as.character.PARAMETER(obj))
17
+    print(as.character.PARAMETER(obj))
18 18
 }
19 19
 
20 20
 
... ...
@@ -71,10 +71,10 @@ print.PARAMETER <- function(obj){
71 71
 #' @export
72 72
 #'
73 73
 ALL <- function() {
74
-  list <- list()
75
-  ## Set the name for the class
76
-  class(list) <- c("ALL","PARAMETER")
77
-  return(list)
74
+    list <- list()
75
+    ## Set the name for the class
76
+    class(list) <- c("ALL","PARAMETER")
77
+    return(list)
78 78
 }
79 79
 
80 80
 #' @name Cover-Param
... ...
@@ -83,9 +83,9 @@ ALL <- function() {
83 83
 #' @export
84 84
 #'
85 85
 ANY <- function() {
86
-  list <- list()
87
-  ## Set the name for the class
88
-  class(list) <- c("ANY","PARAMETER")
89
-  return(list)
86
+    list <- list()
87
+    ## Set the name for the class
88
+    class(list) <- c("ANY","PARAMETER")
89
+    return(list)
90 90
 }
91 91
 
... ...
@@ -3,28 +3,28 @@
3 3
 #########################
4 4
 
5 5
 DISTAL <- function(value) {
6
-  op_list <- list(value = value)
7
-  ## Set the name for the class
8
-  class(op_list) <- "DISTAL"
9
-  return(op_list)
6
+    op_list <- list(value = value)
7
+    ## Set the name for the class
8
+    class(op_list) <- "DISTAL"
9
+    return(op_list)
10 10
 }
11 11
 
12 12
 print.DISTAL <- function(obj) {
13
-  print(as.character.DISTAL(obj))
13
+    print(as.character.DISTAL(obj))
14 14
 }
15 15
 
16 16
 as.character.DISTAL <- function(obj) {
17
-  class <- class(obj)[1]
18
-  val <- obj$value
19
-  c(class,val)
17
+    class <- class(obj)[1]
18
+    val <- obj$value
19
+    c(class,val)
20 20
 }
21 21
 
22 22
 check.DISTAL <- function(value) {
23
-  if(!is.numeric(value))
24
-    stop("value: is not a numeric")
25
-  
26
-  if(is.numeric(value) && length(value)>1)
27
-    stop("value: no multiple string")
23
+    if(!is.numeric(value))
24
+        stop("value: is not a numeric")
25
+    
26
+    if(is.numeric(value) && length(value)>1)
27
+        stop("value: no multiple string")
28 28
 }
29 29
 #' DISTAL object class constructor
30 30
 #'
... ...
@@ -114,11 +114,11 @@ check.DISTAL <- function(value) {
114 114
 #' @export
115 115
 #' 
116 116
 DL <- function(value) {
117
-  check.DISTAL(value)
118
-  list <- list(value = as.integer(value))
119
-  ## Set the name for the class
120
-  class(list) <- c("DL","DISTAL")
121
-  return(list)
117
+    check.DISTAL(value)
118
+    list <- list(value = as.integer(value))
119
+    ## Set the name for the class
120
+    class(list) <- c("DL","DISTAL")
121
+    return(list)
122 122
 }
123 123
 
124 124
 #' @name DG
... ...
@@ -127,11 +127,11 @@ DL <- function(value) {
127 127
 #' @export
128 128
 #' 
129 129
 DG <- function(value) {
130
-  check.DISTAL(value)
131
-  list <- list(value = as.integer(value))
132
-  ## Set the name for the class
133
-  class(list) <- c("DG","DISTAL")
134
-  return(list)
130
+    check.DISTAL(value)
131
+    list <- list(value = as.integer(value))
132
+    ## Set the name for the class
133
+    class(list) <- c("DG","DISTAL")
134
+    return(list)
135 135
 }
136 136
 
137 137
 #' @name DISTAL-Object
... ...
@@ -140,11 +140,11 @@ DG <- function(value) {
140 140
 #' @export
141 141
 #' 
142 142
 DLE <- function(value) {
143
-  check.DISTAL(value)
144
-  list <- list(value = as.integer(value))
145
-  ## Set the name for the class
146
-  class(list) <- c("DLE","DISTAL")
147
-  return(list)
143
+    check.DISTAL(value)
144
+    list <- list(value = as.integer(value))
145
+    ## Set the name for the class
146
+    class(list) <- c("DLE","DISTAL")
147
+    return(list)
148 148
 }
149 149
 
150 150
 #' @name DISTAL-Object
... ...
@@ -153,11 +153,11 @@ DLE <- function(value) {
153 153
 #' @export
154 154
 #' 
155 155
 DGE <- function(value) {
156
-  check.DISTAL(value)
157
-  list <- list(value = as.integer(value))
158
-  ## Set the name for the class
159
-  class(list) <- c("DGE","DISTAL")
160
-  return(list)
156
+    check.DISTAL(value)
157
+    list <- list(value = as.integer(value))
158
+    ## Set the name for the class
159
+    class(list) <- c("DGE","DISTAL")
160
+    return(list)
161 161
 }
162 162
 
163 163
 #' @name DISTAL-Object
... ...
@@ -166,11 +166,11 @@ DGE <- function(value) {
166 166
 #' @export
167 167
 #' 
168 168
 MD <- function(value) {
169
-  check.DISTAL(value)
170
-  list <- list(value = as.integer(value))
171
-  ## Set the name for the class
172
-  class(list) <- c("MD","DISTAL")
173
-  return(list)
169
+    check.DISTAL(value)
170
+    list <- list(value = as.integer(value))
171
+    ## Set the name for the class
172
+    class(list) <- c("MD","DISTAL")
173
+    return(list)
174 174
 }
175 175
 
176 176
 
... ...
@@ -180,14 +180,14 @@ MD <- function(value) {
180 180
 #' @export
181 181
 #' 
182 182
 UP <- function() {
183
-  list <- list()
184
-  ## Set the name for the class
185
-  class(list) <- c("UP","DISTAL")
186
-  return(list)
183
+    list <- list()
184
+    ## Set the name for the class
185
+    class(list) <- c("UP","DISTAL")
186
+    return(list)
187 187
 }
188 188
 as.character.UP <- function(obj) {
189
-  class <- class(obj)[1]
190
-  c(class,"")
189
+    class <- class(obj)[1]
190
+    c(class,"")
191 191
 }
192 192
 
193 193
 
... ...
@@ -197,13 +197,13 @@ as.character.UP <- function(obj) {
197 197
 #' @export
198 198
 #' 
199 199
 DOWN <- function() {
200
-  list <- list()
201
-  ## Set the name for the class
202
-  class(list) <- c("DOWN","DISTAL")
203
-  return(list)
200
+    list <- list()
201
+    ## Set the name for the class
202
+    class(list) <- c("DOWN","DISTAL")
203
+    return(list)
204 204
 }
205 205
 as.character.DOWN <- function(obj) {
206
-  class <- class(obj)[1]
207
-  c(class,"")
206
+    class <- class(obj)[1]
207
+    c(class,"")
208 208
 }
209 209
 
... ...
@@ -4,30 +4,30 @@
4 4
 
5 5
 
6 6
 OPERATOR <- function(value) {
7
-  op_list <- list(value = value)
8
-  ## Set the name for the class
9
-  class(op_list) <- "OPERATOR"
10
-  return(op_list)
7
+    op_list <- list(value = value)
8
+    ## Set the name for the class
9
+    class(op_list) <- "OPERATOR"
10
+    return(op_list)
11 11
 }
12 12
 
13 13
 check.OPERATOR <- function(value) {
14
-  if(!is.null(value)) {
15
-    if(is.character(value) && length(value)>1)
16
-      stop("value: no multiple string")
17
-    
18
-    if(!is.character(value))
19
-      stop("value: is not a string")
20
-  }
14
+    if(!is.null(value)) {
15
+        if(is.character(value) && length(value)>1)
16
+            stop("value: no multiple string")
17
+        
18
+        if(!is.character(value))
19
+            stop("value: is not a string")
20
+    }
21 21
 }
22 22
 
23 23
 print.OPERATOR <- function(obj) {
24
-  as.character(obj)
24
+    as.character(obj)
25 25
 }
26 26
 
27 27
 as.character.OPERATOR <- function(obj) {
28
-  class <- class(obj)[1]
29
-  val <- obj$value
30
-  c(class,val)
28
+    class <- class(obj)[1]
29
+    val <- obj$value
30
+    c(class,val)
31 31
 }
32 32
 
33 33
 #' OPERATOR object class constructor
... ...
@@ -92,34 +92,34 @@ as.character.OPERATOR <- function(obj) {
92 92
 #' @export
93 93
 #'
94 94
 META <- function(value, type = NULL) {
95
-  check.OPERATOR(value)
96
-  
97
-  if(!is.null(type))
98
-    check.OPERATOR(type)
99
-  
100
-  list <- list(value = value,type = type)
101
-  ## Set the name for the class
102
-  class(list) <- c("META","OPERATOR")
103
-  return(list)
95
+    check.OPERATOR(value)
96
+    
97
+    if(!is.null(type))
98
+        check.OPERATOR(type)
99
+    
100
+    list <- list(value = value,type = type)
101
+    ## Set the name for the class
102
+    class(list) <- c("META","OPERATOR")
103
+    return(list)
104 104
 }
105 105
 
106 106
 print.META <- function(obj) {
107
-  as.character(obj)
107
+    as.character(obj)
108 108
 }
109 109
 
110 110
 as.character.META <- function(obj) {
111
-  class <- class(obj)[1]
112
-  val <- obj$value
113
-  type <- obj$type
114
-  c(class,val,type)
111
+    class <- class(obj)[1]
112
+    val <- obj$value
113
+    type <- obj$type
114
+    c(class,val,type)
115 115
 }
116 116
 
117 117
 check.META <- function(type) {
118
-  check.OPERATOR(value)
119
-  
120
-  value <- toupper(value)
121
-  if(!value %in% c("DOUBLE","INTEGER","STRING"))
122
-    stop("only DOUBLE or INTEGER or STRING")
118
+    check.OPERATOR(value)
119
+    
120
+    value <- toupper(value)
121
+    if(!value %in% c("DOUBLE","INTEGER","STRING"))
122
+        stop("only DOUBLE or INTEGER or STRING")
123 123
 }
124 124
 
125 125
 #' @name OPERATOR-Object
... ...
@@ -128,20 +128,20 @@ check.META <- function(type) {
128 128
 #' @export
129 129
 #'
130 130
 NIL <- function(type) {
131
-  check.NIL(type)
132
-  
133
-  list <- list(value = type)
134
-  ## Set the name for the class
135
-  class(list) <- c("NIL","OPERATOR")
136
-  return(list)
131
+    check.NIL(type)
132
+    
133
+    list <- list(value = type)
134
+    ## Set the name for the class
135
+    class(list) <- c("NIL","OPERATOR")
136
+    return(list)
137 137
 }
138 138
 
139 139
 check.NIL <- function(value) {
140
-  check.OPERATOR(value)
141
-  
142
-  value <- toupper(value)
143
-  if(!value %in% c("DOUBLE","INTEGER"))
144
-    stop("only DOUBLE or INTEGER")
140
+    check.OPERATOR(value)
141
+    
142
+    value <- toupper(value)
143
+    if(!value %in% c("DOUBLE","INTEGER"))
144
+        stop("only DOUBLE or INTEGER")
145 145
 }
146 146
 
147 147
 #' @name OPERATOR-Object
... ...
@@ -150,10 +150,10 @@ check.NIL <- function(value) {
150 150
 #' @export
151 151
 #'
152 152
 SQRT <- function(value) {
153
-  check.OPERATOR(value)
154
-  
155
-  list <- list(value = value)
156
-  ## Set the name for the class
157
-  class(list) <- c("SQRT","OPERATOR")
158
-  return(list)
153
+    check.OPERATOR(value)
154
+    
155
+    list <- list(value = value)
156
+    ## Set the name for the class
157
+    class(list) <- c("SQRT","OPERATOR")
158
+    return(list)
159 159
 }
... ...
@@ -3,18 +3,18 @@
3 3
 #########################################
4 4
 
5 5
 PARAMETER_FILTER_EXTRACT <- function() {
6
-  op_list <- list()
7
-  ## Set the name for the class
8
-  class(op_list) <- "PARAMETER_FILTER_EXTRACT"
9
-  return(op_list)
6
+    op_list <- list()
7
+    ## Set the name for the class
8
+    class(op_list) <- "PARAMETER_FILTER_EXTRACT"
9
+    return(op_list)
10 10
 }
11 11
 
12 12
 as.character.PARAMETER_FILTER_EXTRACT <- function(obj) {
13
-  class <- class(obj)[1]
13
+    class <- class(obj)[1]
14 14
 }
15 15
 
16 16
 print.PARAMETER_FILTER_EXTRACT <- function(obj){
17
-  print(as.character.PARAMETER_FILTER_EXTRACT(obj))
17
+    print(as.character.PARAMETER_FILTER_EXTRACT(obj))
18 18
 }
19 19
 
20 20
 
... ...
@@ -39,8 +39,8 @@ print.PARAMETER_FILTER_EXTRACT <- function(obj){
39 39
 #' @export
40 40
 #'
41 41
 FULL <- function(except = NULL) {
42
-  value <- list(values = c(except))
43
-  ## Set the name for the class
44
-  class(value) <- c("FULL", "PARAMETER_FILTER_EXTRACT")
45
-  return(value)
42
+    value <- list(values = c(except))
43
+    ## Set the name for the class
44
+    class(value) <- c("FULL", "PARAMETER_FILTER_EXTRACT")
45
+    return(value)
46 46
 }
47 47
\ No newline at end of file
... ...
@@ -1,138 +1,138 @@
1 1
 
2 2
 .counter <- function(zero = 0) {
3
-  i <- zero
4
-  function() {
5
-    i <<- i + 1
6
-    toString <- as.character(i)
7
-  }
3
+    i <- zero
4
+    function() {
5
+        i <<- i + 1
6
+        toString <- as.character(i)
7
+    }
8 8
 }
9 9
 
10 10
 .add_metadata <- function(files) {
11
-  x <- scan(files, what="", sep="\n")
12
-  y <- strsplit(x, "\t")
13
-  names(y) <- vapply(y, `[[`,character(1), 1)
14
-  listMeta <- lapply(y, `[`, -1)
11
+    x <- scan(files, what="", sep="\n")
12
+    y <- strsplit(x, "\t")
13
+    names(y) <- vapply(y, `[[`,character(1), 1)
14
+    listMeta <- lapply(y, `[`, -1)
15 15
 }
16 16
 
17 17
 .schema_header <- function(datasetName) {
18
-  schema_name <- list.files(
19
-    datasetName, 
20
-    pattern = "*.schema$",
21
-    full.names = TRUE)
22
-  
23
-  schema_name_xml <- list.files(
24
-    datasetName, 
25
-    pattern = "*.xml$",
26
-    full.names = TRUE)
27
-  
28
-  if(!length(schema_name) && !length(schema_name_xml))
29
-    stop("schema not present")
30
-  
31
-  if(!length(schema_name))
32
-    xml_schema <- xml2::read_xml(schema_name_xml)
33
-  else
34
-    xml_schema <- xml2::read_xml(schema_name)
35
-  
36
-  list_field <- xml2::as_list(xml_schema)
37
-  vector_field <- unlist(list_field)
18
+    schema_name <- list.files(
19
+        datasetName, 
20
+        pattern = "*.schema$",
21
+        full.names = TRUE)
22
+    
23
+    schema_name_xml <- list.files(
24
+        datasetName, 
25
+        pattern = "*.xml$",
26
+        full.names = TRUE)
27
+    
28
+    if(!length(schema_name) && !length(schema_name_xml))
29
+        stop("schema not present")
30
+    
31
+    if(!length(schema_name))
32
+        xml_schema <- xml2::read_xml(schema_name_xml)
33
+    else
34
+        xml_schema <- xml2::read_xml(schema_name)
35
+    
36
+    list_field <- xml2::as_list(xml_schema)
37
+    vector_field <- unlist(list_field)
38 38
 }
39 39
 
40 40
 .schema_type_coordinate <- function(datasetName) {
41
-  schema_name <- list.files(
42
-    datasetName, 
43
-    pattern = "*.schema$",
44
-    full.names = TRUE)
45
-  
46
-  schema_name_xml <- list.files(
47
-    datasetName, 
48
-    pattern = "*.xml$",
49
-    full.names = TRUE)
50
-  
51
-  if(!length(schema_name) && !length(schema_name_xml))
52
-    stop("schema not present")
53
-  
54
-  if(!length(schema_name))
55
-    xml_schema <- xml2::read_xml(schema_name_xml)
56
-  else
57
-    xml_schema <- xml2::read_xml(schema_name)
58
-  
59
-  gmql_schema_tag <- xml2::xml_children(xml_schema)
60
-  all_attrs <- xml2::xml_attrs(gmql_schema_tag)
61
-  all_attrs_list <- as.list(all_attrs[[1]])
41
+    schema_name <- list.files(
42
+        datasetName, 
43
+        pattern = "*.schema$",
44
+        full.names = TRUE)
45
+    
46
+    schema_name_xml <- list.files(
47
+        datasetName, 
48
+        pattern = "*.xml$",
49
+        full.names = TRUE)
50
+    
51
+    if(!length(schema_name) && !length(schema_name_xml))
52
+        stop("schema not present")
53
+    
54
+    if(!length(schema_name))
55
+        xml_schema <- xml2::read_xml(schema_name_xml)
56
+    else
57
+        xml_schema <- xml2::read_xml(schema_name)
58
+    
59
+    gmql_schema_tag <- xml2::xml_children(xml_schema)
60
+    all_attrs <- xml2::xml_attrs(gmql_schema_tag)
61
+    all_attrs_list <- as.list(all_attrs[[1]])
62 62
 }
63 63
 
64 64
 # aggregates factory
65 65
 .aggregates <- function(meta_data,class) {
66
-  if(!is.list(meta_data))
67
-    stop("meta_data: invalid input")
68
-  
69
-  if(!all(vapply(meta_data, function(x) is(x,class), logical(1))))
70
-    stop("All elements must be META_AGGREGATES object")
71
-  
72
-  names <- names(meta_data)
73
-  if(is.null(names)) {
74
-    warning("You did not assign a names to a list.\nWe build it for you")
75
-    names <- vapply(meta_data, take_value.META_AGGREGATES,character(1))
76
-  } else {
77
-    if("" %in% names)
78
-      stop("No partial names assignment is allowed")
79
-  }
80
-  aggregate_matrix <- t(vapply(meta_data, function(x) {
81
-    new_value = as.character(x)
82
-    matrix <- matrix(new_value)
83
-  },character(2)))
84
-  
85
-  m_names <- matrix(names)
86
-  metadata_matrix <- cbind(m_names,aggregate_matrix)
66
+    if(!is.list(meta_data))
67
+        stop("meta_data: invalid input")
68
+    
69
+    if(!all(vapply(meta_data, function(x) is(x,class), logical(1))))
70
+        stop("All elements must be META_AGGREGATES object")
71
+    
72
+    names <- names(meta_data)
73
+    if(is.null(names)) {
74
+        warning("You did not assign a names to a list.\nWe build it for you")
75
+        names <- vapply(meta_data, take_value.META_AGGREGATES,character(1))
76
+    } else {
77
+        if("" %in% names)
78
+            stop("No partial names assignment is allowed")
79
+    }
80
+    aggregate_matrix <- t(vapply(meta_data, function(x) {
81
+        new_value = as.character(x)
82
+        matrix <- matrix(new_value)
83
+    },character(2)))
84
+    
85
+    m_names <- matrix(names)
86
+    metadata_matrix <- cbind(m_names,aggregate_matrix)
87 87
 }
88 88
 
89 89
 
90 90
 # meta join condition
91 91
 .join_condition <- function(cond) {
92
-  cond_matrix <- NULL
93
-  def <- cond$condition$def
94
-  if(!is.null(def))
95
-    cond_matrix <- rbind(cond_matrix, def)
96
-  
97
-  exact <- cond$condition$exact
98
-  if(!is.null(exact))
99
-    cond_matrix <- rbind(cond_matrix, exact)
100
-  
101
-  full <- cond$condition$full
102
-  if(!is.null(full))
103
-    cond_matrix <- rbind(cond_matrix, full)
104
-  cond_matrix
92
+    cond_matrix <- NULL
93
+    def <- cond$condition$def
94
+    if(!is.null(def))
95
+        cond_matrix <- rbind(cond_matrix, def)
96
+    
97
+    exact <- cond$condition$exact
98
+    if(!is.null(exact))
99
+        cond_matrix <- rbind(cond_matrix, exact)
100
+    
101
+    full <- cond$condition$full
102
+    if(!is.null(full))
103
+        cond_matrix <- rbind(cond_matrix, full)
104
+    cond_matrix
105 105
 }
106 106
 
107 107
 .check_input <- function(value) {
108
-  if(!is.character(value))
109
-    stop("no valid data")
110
-  
111
-  if(length(value)>1)
112
-    stop("no multiple string")
108
+    if(!is.character(value))
109
+        stop("no valid data")
110
+    
111
+    if(length(value)>1)
112
+        stop("no multiple string")
113 113
 }
114 114
 
115 115
 .check_logical <- function(value) {
116
-  if(!is.logical(value))
117
-    stop("no valid data")
118
-  
119
-  if(length(value)>1)
120
-    stop("no multiple string")
116
+    if(!is.logical(value))
117
+        stop("no valid data")
118
+    
119
+    if(length(value)>1)
120
+        stop("no multiple string")
121 121
 }
122 122
 
123 123
 .is_login_expired <- function(url) {
124
-  if(exists("GMQL_credentials", envir = .GlobalEnv)) {
125
-    if(exists("authToken", where = GMQL_credentials)) {
126
-      authToken <- GMQL_credentials$authToken
127
-      url <- sub("/*[/]$","",url)
128
-      h <- c('Accept' = 'Application/json', 'X-Auth-Token' = authToken)
129
-      URL <- paste0(url,"/user")
130
-      req <- httr::GET(URL,httr::add_headers(h))
131
-      if(req$status_code != 200)
132
-        return(TRUE)
133
-      else
134
-        return(FALSE)
124
+    if(exists("GMQL_credentials", envir = .GlobalEnv)) {
125
+        if(exists("authToken", where = GMQL_credentials)) {
126
+            authToken <- GMQL_credentials$authToken
127
+            url <- sub("/*[/]$","",url)
128
+            h <- c('Accept' = 'Application/json', 'X-Auth-Token' = authToken)
129
+            URL <- paste0(url,"/user")
130
+            req <- httr::GET(URL,httr::add_headers(h))
131
+            if(req$status_code != 200)
132
+                return(TRUE)
133
+            else
134
+                return(FALSE)
135
+        }
135 136
     }
136
-  }
137
-  return(TRUE)
137
+    return(TRUE)
138 138
 }
... ...
@@ -32,23 +32,23 @@
32 32
 #' @rdname condition_eval_func
33 33
 #' @export
34 34
 conds <- function(default = c(""), full = c(""), exact = c("")) {
35
-  df <- .condition("DEF",default)
36
-  fn <- .condition("FULL",full)
37
-  ex <- .condition("EXACT",exact)
38
-  list("condition" = list("def" = df, "full" = fn, "exact" = ex))
35
+    df <- .condition("DEF",default)
36
+    fn <- .condition("FULL",full)
37
+    ex <- .condition("EXACT",exact)
38
+    list("condition" = list("def" = df, "full" = fn, "exact" = ex))
39 39
 }
40 40
 
41 41
 .condition <- function(cond, array) {
42
-  array = array[!array %in% ""]
43
-  array = array[!duplicated(array)]
44
-  
45
-  if(!length(array)) {
46
-    join_condition_matrix <- NULL
47
-  } else {
48
-    join_condition_matrix <- t(vapply(array, function(x) {
49
-      new_value = c(cond, x)
50
-      matrix <- matrix(new_value)
51
-    },character(2)))
52
-  }
53
-  join_condition_matrix
42
+    array = array[!array %in% ""]
43
+    array = array[!duplicated(array)]
44
+    
45
+    if(!length(array)) {
46
+        join_condition_matrix <- NULL
47
+    } else {
48
+        join_condition_matrix <- t(vapply(array, function(x) {
49
+            new_value = c(cond, x)
50
+            matrix <- matrix(new_value)
51
+        },character(2)))
52
+    }
53
+    join_condition_matrix
54 54
 }
... ...
@@ -83,376 +83,365 @@
83 83
 #' @export
84 84
 #'
85 85
 filter_and_extract <- function(
86
-  data,
87
-  metadata = NULL,
88
-  metadata_prefix = NULL,
89
-  region_attributes = NULL,
90
-  suffix = "antibody_target"
86
+    data,
87
+    metadata = NULL,
88
+    metadata_prefix = NULL,
89
+    region_attributes = NULL,
90
+    suffix = "antibody_target"
91 91
 ) {
92
-  
93
-  if (is(data, "GRangesList")) {
94
-    .extract_from_GRangesList(
95
-      data,
96
-      metadata,
97
-      metadata_prefix,
98
-      region_attributes,
99
-      suffix
100
-    )
101
-  } else {
102
-    .extract_from_dataset(
103
-      data,
104
-      metadata,
105
-      metadata_prefix,
106
-      region_attributes, suffix
107
-    )
108
-  }
92
+    if (is(data, "GRangesList")) {
93
+        .extract_from_GRangesList(
94
+            data,
95
+            metadata,
96
+            metadata_prefix,
97
+            region_attributes,
98
+            suffix)
99
+    } else {
100
+        .extract_from_dataset(
101
+            data,
102
+            metadata,
103
+            metadata_prefix,
104
+            region_attributes, suffix)
105
+    }
109 106
 }
110 107
 
111 108
 .extract_from_dataset <- function(
112
-  datasetName,
113
-  metadata,
114
-  metadata_prefix,
115
-  regions,
116
-  suffix
117
-) {
118
-  datasetName <- sub("/*[/]$", "", datasetName)
119
-  if (basename(datasetName) != "files") {
120
-    datasetName <- file.path(datasetName, "files")
121
-  }
122
-  
123
-  if (!dir.exists(datasetName)) {
124
-    stop("Directory does not exists")
125
-  }
126
-  
127
-  gdm_meta_files <- list.files(
128
-    datasetName,
129
-    pattern = "*.gdm.meta$",
130
-    full.names = TRUE
131
-  )
132
-  
133
-  gtf_meta_files <- list.files(
134 109
     datasetName,
135
-    pattern = "*.gtf.meta$",
136
-    full.names = TRUE
137
-  )
138
-  
139
-  if (!length(gdm_meta_files) && !length(gtf_meta_files)) {
140
-    stop("no samples present or no files format supported")
141
-  }
142
-  
143
-  if (length(gdm_meta_files) && length(gtf_meta_files)) {
144
-    stop("GMQL dataset cannot be mixed dataset: no GTF and GDM together")
145
-  }
146
-  
147
-  vector_field <- .schema_header(datasetName)
148
-  
149
-  if (length(gdm_meta_files)) {
150
-    samples_file <- .check_metadata_files(
151
-      metadata, metadata_prefix,
152
-      gdm_meta_files
153
-    )
154
-    
155
-    samples_meta_to_read <- unlist(samples_file)
110
+    metadata,
111
+    metadata_prefix,
112
+    regions,
113
+    suffix
114
+) {
115
+    datasetName <- sub("/*[/]$", "", datasetName)
116
+    if (basename(datasetName) != "files") {
117
+        datasetName <- file.path(datasetName, "files")
118
+    }
156 119
     
157
-    if (length(samples_meta_to_read)) {
158
-      samples_to_read <- gsub(".meta$", "", samples_meta_to_read)
159
-    } else {
160
-      samples_to_read <- gsub(".meta$", "", gdm_meta_files)
161
-      samples_meta_to_read <- gtf_meta_files
120
+    if (!dir.exists(datasetName)) {
121
+        stop("Directory does not exists")
162 122
     }
163 123
     
164
-    suffix_vec <- .get_suffix(suffix, FALSE, samples_meta_to_read)
165
-    granges <- .parse_gdm_files(
166
-      vector_field, 
167
-      samples_to_read, 
168
-      regions,
169
-      suffix_vec
124
+    gdm_meta_files <- list.files(
125
+        datasetName,
126
+        pattern = "*.gdm.meta$",
127
+        full.names = TRUE
170 128
     )
171 129
     
172
-  } else {
173
-    samples_file <- .check_metadata_files(
174
-      metadata, 
175
-      metadata_prefix,
176
-      gtf_meta_files
130
+    gtf_meta_files <- list.files(
131
+        datasetName,
132
+        pattern = "*.gtf.meta$",
133
+        full.names = TRUE
177 134
     )
178
-    samples_meta_to_read <- unlist(samples_file)
179 135
     
180
-    if (length(samples_meta_to_read)) {
181
-      samples_to_read <- gsub(".meta$", "", samples_meta_to_read)
182
-    } else {
183
-      samples_to_read <- gsub(".meta$", "", gtf_meta_files)
184
-      samples_meta_to_read <- gtf_meta_files
136
+    if (!length(gdm_meta_files) && !length(gtf_meta_files)) {
137
+        stop("no samples present or no files format supported")
185 138
     }
186 139
     
187
-    suffix_vec <- .get_suffix(suffix, FALSE, samples_meta_to_read)
188
-    granges <- .parse_gtf_files(
189
-      samples_to_read, 
190
-      regions, 
191
-      suffix_vec, 
192
-      vector_field
193
-    )
194
-  }
140
+    if (length(gdm_meta_files) && length(gtf_meta_files)) {
141
+        stop("GMQL dataset cannot be mixed dataset: no GTF and GDM together")
142
+    }
143
+    
144
+    vector_field <- .schema_header(datasetName)
145
+    
146
+    if (length(gdm_meta_files)) {
147
+        samples_file <- .check_metadata_files(
148
+            metadata, metadata_prefix,
149
+            gdm_meta_files
150
+        )
151
+        
152
+        samples_meta_to_read <- unlist(samples_file)
153
+        
154
+        if (length(samples_meta_to_read)) {
155
+            samples_to_read <- gsub(".meta$", "", samples_meta_to_read)
156
+        } else {
157
+            samples_to_read <- gsub(".meta$", "", gdm_meta_files)
158
+            samples_meta_to_read <- gtf_meta_files
159
+        }
160
+        
161
+        suffix_vec <- .get_suffix(suffix, FALSE, samples_meta_to_read)
162
+        granges <- .parse_gdm_files(
163
+            vector_field, 
164
+            samples_to_read, 
165
+            regions,
166
+            suffix_vec)
167
+    } else {
168
+        samples_file <- .check_metadata_files(
169
+            metadata, 
170
+            metadata_prefix,
171
+            gtf_meta_files
172
+        )
173
+        samples_meta_to_read <- unlist(samples_file)
174
+        
175
+        if (length(samples_meta_to_read)) {
176
+            samples_to_read <- gsub(".meta$", "", samples_meta_to_read)
177
+        } else {
178
+            samples_to_read <- gsub(".meta$", "", gtf_meta_files)
179
+            samples_meta_to_read <- gtf_meta_files
180
+        }
181
+        
182
+        suffix_vec <- .get_suffix(suffix, FALSE, samples_meta_to_read)
183
+        granges <- .parse_gtf_files(
184
+            samples_to_read, 
185
+            regions, 
186
+            suffix_vec, 
187
+            vector_field
188
+        )
189
+    }
195 190
 }
196 191
 
197 192
 .extract_from_GRangesList <- function(
198
-  rangesList,
199
-  metadata,
200
-  metadata_prefix,
201
-  regions,
202
-  suffix
193
+    rangesList,
194
+    metadata,
195
+    metadata_prefix,
196
+    regions,
197
+    suffix
203 198
 ) {
204
-  if (!is(rangesList, "GRangesList")) {
205
-    stop("only GrangesList admitted")
206
-  }
207
-  
208
-  if (!length(rangesList)) {
209
-    stop("rangesList empty")
210
-  }
211
-  
212
-  meta_list <- metadata(rangesList)
213
-  samples <- .check_metadata_list(metadata, metadata_prefix, meta_list)
214
-  if (!length(unlist(samples))) {
215
-    samples <- rangesList
216
-  } else {
217
-    index <- unlist(samples)
218
-    samples <- rangesList[c(index)]
219
-  }
220
-  new_meta_list <- metadata(samples)
221
-  suffix_vec <- .get_suffix(suffix, TRUE, new_meta_list)
222
-  granges <- .parse_Granges(samples, regions, suffix_vec)
199
+    if (!is(rangesList, "GRangesList")) {
200
+        stop("only GrangesList admitted")
201
+    }
202
+    
203
+    if (!length(rangesList)) {
204
+        stop("rangesList empty")
205
+    }
206
+    
207
+    meta_list <- metadata(rangesList)
208
+    samples <- .check_metadata_list(metadata, metadata_prefix, meta_list)
209
+    if (!length(unlist(samples))) {
210
+        samples <- rangesList
211
+    } else {
212
+        index <- unlist(samples)
213
+        samples <- rangesList[c(index)]
214
+    }
215
+    new_meta_list <- metadata(samples)
216
+    suffix_vec <- .get_suffix(suffix, TRUE, new_meta_list)
217
+    granges <- .parse_Granges(samples, regions, suffix_vec)
223 218
 }
224 219
 
225 220
 .parse_Granges <- function(region_list, regions, suffixes) {
226
-  if (is.null(suffixes)) {
227
-    suffixes <- ""
228
-  }
229
-  
230
-  g1 <- region_list[[1]]
231
-
232
-  if(is.object(regions) && ("FULL" %in% class(regions))) {
233
-    all_values <- names(elementMetadata(g1))
234
-    except_values <- regions$values
235
-    regions <- if (is.null(except_values))
236
-      all_values
237
-    else
238
-      all_values[!all_values %in% except_values]
239
-    names(regions) <- NULL
240
-    # since import convert this value from GMQL schema to GTF format
241
-    # we need to convert it back
242
-    regions <- replace(regions, regions == "feature", "type")
243
-    regions <- replace(regions, regions == "frame", "phase")
244
-  }
245
-  
246
-  elementMetadata(g1) <- NULL
247
-  if (!is.null(regions)) {
248
-    DF_list <- mapply(function(g_x, h) {
249
-      meta <- elementMetadata(g_x)[regions]
250
-      if (h != "") {
251
-        names(meta) <- paste(regions, h, sep = ".")
252
-      }
253
-      data.frame(meta)
254
-    }, region_list, suffixes, SIMPLIFY = FALSE)
255
-    DF_only_regions <- dplyr::bind_cols(DF_list)
256
-    elementMetadata(g1) <- DF_only_regions
257
-  }
258
-  g1
221
+    if (is.null(suffixes)) {
222
+        suffixes <- ""
223
+    }
224
+    
225
+    g1 <- region_list[[1]]
226
+    
227
+    if(is.object(regions) && ("FULL" %in% class(regions))) {
228
+        all_values <- names(elementMetadata(g1))
229
+        except_values <- regions$values
230
+        regions <- if (is.null(except_values))
231
+            all_values
232
+        else
233
+            all_values[!all_values %in% except_values]
234
+        names(regions) <- NULL
235
+        # since import convert this value from GMQL schema to GTF format
236
+        # we need to convert it back
237
+        regions <- replace(regions, regions == "feature", "type")
238
+        regions <- replace(regions, regions == "frame", "phase")
239
+    }
240
+    
241
+    elementMetadata(g1) <- NULL
242
+    if (!is.null(regions)) {
243
+        DF_list <- mapply(function(g_x, h) {
244
+            meta <- elementMetadata(g_x)[regions]
245
+            if (h != "") {
246
+                names(meta) <- paste(regions, h, sep = ".")
247
+            }
248
+            data.frame(meta)
249
+        }, region_list, suffixes, SIMPLIFY = FALSE)
250
+        DF_only_regions <- dplyr::bind_cols(DF_list)
251
+        elementMetadata(g1) <- DF_only_regions
252
+    }
253
+    g1
259 254
 }
260 255
 
261 256
 .get_suffix <- function(col_name, from_list, meta_fl) {
262
-  suffix <- paste0(col_name, "$")
263
-  
264
-  if (from_list) {
265
-    meta_list <- mapply(function(x, index) {
266
-      vec_names <- names(x)
267
-      s_index <- grep(suffix, vec_names)
268
-      first_index <- s_index[1]
269
-      suffix <- unlist(x[first_index]) # ne prendo solo uno
270
-      names(suffix) <- NULL
271
-      
272
-      # if found retrieve samples that has at least one choosen metadata
273
-      if (first_index && !is.na(first_index)) {
274
-        suffix
275
-      } else {
276
-        ""
277
-      }
278
-    }, meta_fl, seq_along(meta_fl))
279
-  }
280
-  else {
281
-    meta_list <- vapply(meta_fl, function(x) {
282
-      list <- .add_metadata(x)
283
-      vec_names <- names(list)
284
-      index <- grep(suffix, vec_names)
285
-      first_index <- index[1]
286
-      suffix <- unlist(list[first_index]) # ne prendo solo uno
287
-      names(suffix) <- NULL
288
-      # if found retrieve samples that has at least one choosen metadata
289
-      if (first_index && !is.na(first_index)) {
290
-        suffix
291
-      } else {
292
-        ""
293
-      }
294
-    }, character(1))
295
-  }
296
-  names(meta_list) <- NULL
297
-  meta_list
257
+    suffix <- paste0(col_name, "$")
258
+    
259
+    if (from_list) {
260
+        meta_list <- mapply(function(x, index) {
261
+            vec_names <- names(x)
262
+            s_index <- grep(suffix, vec_names)
263
+            first_index <- s_index[1]
264
+            suffix <- unlist(x[first_index]) # ne prendo solo uno
265
+            names(suffix) <- NULL
266
+            
267
+            # if found retrieve samples that has at least one choosen metadata
268
+            if (first_index && !is.na(first_index)) {
269
+                suffix
270
+            } else {
271
+                ""
272
+            }
273
+        }, meta_fl, seq_along(meta_fl))
274
+    }
275
+    else {
276
+        meta_list <- vapply(meta_fl, function(x) {
277
+            list <- .add_metadata(x)
278
+            vec_names <- names(list)
279
+            index <- grep(suffix, vec_names)
280
+            first_index <- index[1]
281
+            suffix <- unlist(list[first_index]) # ne prendo solo uno
282
+            names(suffix) <- NULL
283
+            # if found retrieve samples that has at least one choosen metadata
284
+            if (first_index && !is.na(first_index)) {
285
+                suffix
286
+            } else {
287
+                ""
288
+            }
289
+        }, character(1))
290
+    }
291
+    names(meta_list) <- NULL
292
+    meta_list
298 293
 }
299 294
 
300 295
 .check_metadata_list <- function(metadata, metadata_prefix, meta_list) {
301
-  vec_meta <- paste0(metadata_prefix, metadata)
302
-  list <- mapply(function(x, index) {
303
-    vec_names <- names(x)
304
-    a <- lapply(vec_meta, function(y) {
305
-      which(y == vec_names)
306
-    })
307
-    ## we would like that manage more index from grep
308
-    found <- as.logical(length(unlist(a)))
309
-    # if found retrieve samples that has at least one choosen metadata
310
-    if (found) {
311
-      index
312
-    }
313
-  }, meta_list, seq_along(meta_list))
296
+    vec_meta <- paste0(metadata_prefix, metadata)
297
+    list <- mapply(function(x, index) {
298
+        vec_names <- names(x)
299
+        a <- lapply(vec_meta, function(y) {
300
+            which(y == vec_names)
301
+        })
302
+        ## we would like that manage more index from grep
303
+        found <- as.logical(length(unlist(a)))
304
+        # if found retrieve samples that has at least one choosen metadata
305
+        if (found) {
306
+            index
307
+        }
308
+    }, meta_list, seq_along(meta_list))
314 309
 }
315 310
 
316 311
 .check_metadata_files <- function(metadata, metadata_prefix, meta_files) {
317
-  vec_meta <- paste0(metadata_prefix, metadata)
318
-  meta_list <- lapply(meta_files, function(x) {
319
-    list <- .add_metadata(x)
320
-    vec_names <- names(list)
321
-    a <- lapply(vec_meta, function(y) {
322
-      grep(y, vec_names)
312
+    vec_meta <- paste0(metadata_prefix, metadata)
313
+    meta_list <- lapply(meta_files, function(x) {
314
+        list <- .add_metadata(x)
315
+        vec_names <- names(list)
316
+        a <- lapply(vec_meta, function(y)