Browse code

update with some news

Simone authored on 21/03/2021 14:34:30
Showing87 changed files

1 1
old mode 100644
2 2
new mode 100755
3 3
old mode 100644
4 4
new mode 100755
5 5
old mode 100644
6 6
new mode 100755
7 7
old mode 100644
8 8
new mode 100755
9 9
old mode 100644
10 10
new mode 100755
... ...
@@ -14,6 +14,7 @@ export(DGE)
14 14
 export(DL)
15 15
 export(DLE)
16 16
 export(DOWN)
17
+export(FULL)
17 18
 export(MAX)
18 19
 export(MD)
19 20
 export(MEDIAN)
20 21
new file mode 100644
... ...
@@ -0,0 +1,24 @@
1
+CHANGES IN VERSION 1.11.1
2
+-------------------------
3
+
4
+NEW FEATURES
5
+
6
+    o None
7
+
8
+SIGNIFICANT USER-VISIBLE CHANGES
9
+
10
+    o removed is_GMQL from read_gmql function
11
+      The entire dataset must have the right folder structure in order to
12
+      works correctly <dataset_name> ---> <files>
13
+
14
+    o Swap order of arguments 'dir_out' and 'name' of the collect()
15
+      function so now the latter comes before the former.
16
+
17
+DEPRECATED AND DEFUNCT
18
+
19
+    o None
20
+    
21
+BUG FIXES
22
+
23
+    o fixed the remote processing
24
+    
... ...
@@ -37,4 +37,3 @@ setGeneric("take", function(.data, ...) standardGeneric("take"))
37 37
 #' @aliases extend,GMQLDataset-method
38 38
 #' 
39 39
 setGeneric("extend", function(.data, ...) standardGeneric("extend"))
40
-
41 40
old mode 100644
42 41
new mode 100755
... ...
@@ -28,112 +28,101 @@
28 28
 #'
29 29
 #' @export
30 30
 #'
31
-import_gmql <- function(dataset_path, is_gtf)
32
-{
33
-    if(is_gtf)
34
-        .importGMQL.gtf(dataset_path)
35
-    else
36
-        .importGMQL.gdm(dataset_path)
31
+import_gmql <- function(dataset_path, is_gtf) {
32
+  if(is_gtf)
33
+    .importGMQL.gtf(dataset_path)
34
+  else
35
+    .importGMQL.gdm(dataset_path)
37 36
 }
38 37
 
39
-.importGMQL.gtf <- function(datasetName)
40
-{
41
-    datasetName <- sub("/*[/]$","",datasetName)
42
-    if(basename(datasetName) !="files")
43
-        datasetName <- file.path(datasetName,"files")
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)
44 57
     
45
-    if(!dir.exists(datasetName))
46
-        stop("Directory does not exists")
47
-
48
-    if(!length(list.files(datasetName)))
49
-        stop("no samples present in this dataset")
50
-
51
-    regions <- list.files(datasetName, pattern = "*.gtf$",full.names = TRUE)
52
-    if(length(regions))
53
-    {
54
-        name_samples <- lapply(regions, function(x){
55
-            gsub("*.gtf", "", basename(x))})
56
-        sampleList <- lapply(regions, function(x){
57
-            rtracklayer::import(con = x, format = "gtf")} )
58
-        names(sampleList) <- name_samples
59
-        gRange_list <- GenomicRanges::GRangesList(sampleList)
60
-    }
61
-    else
62
-        stop("No GTF files present")
63
-
64
-    meta <- list.files(datasetName, pattern = "*.gtf.meta$",full.names = TRUE)
65
-    if(length(meta))
66
-    {
67
-        meta_list <- lapply(meta, .add_metadata)
68
-        names(meta_list) <- name_samples
69
-    }
70
-    else
71
-        stop("No meta GTF files present")
72
-
73
-    S4Vectors::metadata(gRange_list) <- meta_list
74
-    return(gRange_list)
75
-}
76
-
77
-.importGMQL.gdm <- function(datasetName)
78
-{
79
-    datasetName <- sub("/*[/]$","",datasetName)
80
-    if(basename(datasetName) !="files")
81
-        datasetName <- file.path(datasetName,"files")
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
82 65
     
83
-    if(!dir.exists(datasetName))
84
-        stop("Directory does not exists")
85
-
86
-    if(!length(list.files(datasetName)))
87
-        stop("no samples present in this dataset")
88
-
89
-    regions <- list.files(datasetName, pattern = "*.gdm$",full.names = TRUE)
90
-    if(length(regions))
91
-    {
92
-        name_samples <- lapply(regions, function(x){
93
-            gsub("*.gdm", "",basename(x))})
94
-        vector_field <- .schema_header(datasetName)
95
-        type_and_coord <- .schema_type_coordinate(datasetName)
96
-        names(vector_field) <- NULL
97
-        if(type_and_coord$coordinate_system %in% c("1-based"))
98
-        {
99
-            sampleList <- lapply(regions,function(x){
100
-                df <- read.delim(x,col.names = vector_field,header = FALSE)
101
-                g <- GenomicRanges::makeGRangesFromDataFrame(df,
102
-                        keep.extra.columns = TRUE,
103
-                        start.field = "left",
104
-                        end.field = "right")
105
-            })
106
-        }
107
-        else
108
-        {
109
-            sampleList <- lapply(regions,function(x){
110
-                df <- read.delim(x,col.names = vector_field,header = FALSE)
111
-                df$left = df$left +1
112
-                g <- GenomicRanges::makeGRangesFromDataFrame(df,
113
-                        keep.extra.columns = TRUE,
114
-                        start.field = "left",
115
-                        end.field = "right")
116
-            })
117
-        }
118
-       
119
-        names(sampleList) <- name_samples
120
-        gRange_list <- GenomicRanges::GRangesList(sampleList)
121
-    }
122
-    else
123
-        stop("No GDM files present")
66
+  } else
67
+    stop("No meta GTF files present")
68
+  
69
+  S4Vectors::metadata(gRange_list) <- meta_list
70
+  return(gRange_list)
71
+}
124 72
 
125
-    meta <- list.files(datasetName, pattern = "*.gdm.meta$",full.names = TRUE)
126
-    if(length(meta))
127
-    {
128
-        meta_list <- lapply(meta, .add_metadata)
129
-        names(meta_list) <- name_samples
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
+      })
130 110
     }
131
-    else
132
-        stop("No meta GDM files present")
133
-
134
-    S4Vectors::metadata(gRange_list) <- meta_list
135
-    return(gRange_list)
111
+    
112
+    names(sampleList) <- name_samples
113
+    gRange_list <- GenomicRanges::GRangesList(sampleList)
114
+    
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
122
+    
123
+  } else
124
+    stop("No meta GDM files present")
125
+  
126
+  S4Vectors::metadata(gRange_list) <- meta_list
127
+  return(gRange_list)
136 128
 }
137
-
138
-
139
-
140 129
old mode 100644
141 130
new mode 100755
... ...
@@ -66,154 +66,145 @@
66 66
 #' 
67 67
 #' @export
68 68
 #'
69
-export_gmql <- function(samples, dir_out, is_gtf)
70
-{
71
-    if(is_gtf)
72
-        .exportGMQL.gtf(samples,dir_out,is_gtf)
73
-    else
74
-        .exportGMQL.gdm(samples,dir_out,is_gtf)
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)
75 74
 }
76 75
 
77
-.exportGMQL.gdm <- function(samples, dir_out, to_GTF)
78
-{
79
-    .exportGMQL(samples,dir_out,to_GTF)
80
-    print("Export to GDM complete")
76
+.exportGMQL.gdm <- function(samples, dir_out, to_GTF) {
77
+  .exportGMQL(samples,dir_out,to_GTF)
78
+  print("Export to GDM complete")
81 79
 }
82 80
 
83
-.exportGMQL.gtf <- function(samples, dir_out,to_GTF)
84
-{
85
-    .exportGMQL(samples, dir_out, to_GTF)
86
-    print("Export to GTF complete")
81
+.exportGMQL.gtf <- function(samples, dir_out,to_GTF) {
82
+  .exportGMQL(samples, dir_out, to_GTF)
83
+  print("Export to GTF complete")
87 84
 }
88 85
 
89
-
90
-.exportGMQL <- function(samples, dir_out, to_GTF)
91
-{
92
-    if(!is(samples,"GRangesList"))
93
-        stop("samples must be a GrangesList")
94
-
95
-    if(!dir.exists(dir_out))
96
-        dir.create(dir_out)
97
-    
98
-    files_sub_dir <- file.path(dir_out,"files")
99
-    dir.create(files_sub_dir)
100
-    cnt = .counter()
101
-    file_ext = ""
102
-    #col_names <- .get_schema_names(samples)
103
-    if(to_GTF)
104
-    {
105
-        #write region
106
-        lapply(samples,function(x,dir){
107
-            #anonymusFile <- file()
108
-            sample_name <- file.path(dir,paste0("S_",cnt(),".gtf"))
109
-            g <- rtracklayer::export(x,format = "gtf")
110
-            #lines <- readLines(sample_name)
111
-            lines <- g[-(1:3)] #delete first 3 lines
112
-            writeLines(lines,sample_name)
113
-            #close(anonymusFile)
114
-        },files_sub_dir)
115
-        file_ext = ".gtf"
116
-    }
117
-    else
118
-    {
119
-        #write region
120
-        lapply(samples,function(x,dir){
121
-            sample_name <- file.path(dir,paste0("S_",cnt(),".gdm"))
122
-            region_frame <- data.frame(x)
123
-            region_frame <- region_frame[-4] # delete width column
124
-            region_frame$start = region_frame$start - 1
125
-            write.table(region_frame,sample_name,col.names = FALSE,
126
-                            row.names = FALSE, sep = '\t',quote = FALSE)
127
-        },files_sub_dir)
128
-        file_ext = ".gdm"
129
-    }
130
-    
131
-    cnt = .counter(0)
132
-    meta <- metadata(samples)
133
-    
134
-    #write metadata
135
-    lapply(meta,function(x,dir){
136
-        sample_name <- file.path(dir,paste0("S_",cnt(),file_ext))
137
-        .write_metadata(x,sample_name)
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)
138 108
     },files_sub_dir)
109
+    file_ext = ".gtf"
139 110
     
140
-    # first regions to get column names
141
-    col_names <- vapply(elementMetadata(samples[[1]]),class,character(1)) 
142
-    # write schema XML
143
-    .write_schema(col_names,files_sub_dir,to_GTF)
144
-    c = .counter(0)
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)
120
+    },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)
145 138
 }
146 139
 
147
-
148
-.write_metadata <- function(meta_list,sample_name)
149
-{
150
-    #create my own list if metadata empty
151
-    if(!length(meta_list))
152
-        meta_list <- list(Provider = "Polimi", Application = "R-GMQL")
153
-    
154
-    names_list <- names(meta_list)
155
-    value_list <- unlist(meta_list)
156
-    file_meta_name = paste0(sample_name,".meta")
157
-    data <- data.frame(names_list,value_list)
158
-    names(data) <- NULL
159
-    write.table(data,file_meta_name,row.names = FALSE,
160
-                    col.names = FALSE, quote = FALSE,sep = '\t')
140
+.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')
161 152
 }
162 153
 
163
-.write_schema <- function(columns,directory,to_GTF)
164
-{
165
-    if(to_GTF)
166
-    {
167
-        names(columns) <- plyr::revalue(names(columns),c(type = "feature",
168
-                                            phase = "frame"))
169
-        fixed_element = c(seqname = "character", source = "character", 
170
-                        feature = "character",start = "long", end = "long", 
171
-                            score = "numeric", strand = "character",
172
-                            frame = "character")
173
-        node_list <- c(fixed_element, columns)
174
-        node_list <- node_list[!duplicated(names(node_list))]
175
-    }
176
-    else
177
-    {
178
-        fixed_element = c(chr = "factor", left = "long", right = "long", 
179
-                            strand = "character")
180
-        node_list <- c(fixed_element, columns)
181
-    }
182
-
183
-    schema <- file.path(directory,"granges.xml")
184
-    root <- xml2::xml_new_root("gmqlSchemaCollection")
185
-    xml2::xml_attr(root,"name") <- "DatasetName_SCHEMAS"
186
-    xml2::xml_attr(root,"xmlns") <- "http://genomic.elet.polimi.it/entities"
187
-    xml2::xml_add_child(root,"gmqlSchema")
188
-    gmqlSchema <- xml2::xml_child(root,1) #gmqlSchema
189
-    if(to_GTF)
190
-    {
191
-        xml2::xml_attr(gmqlSchema,"type") <- "gtf"
192
-        xml2::xml_attr(gmqlSchema,"coordinate_system") <- "1-based"
193
-    }
154
+.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))]
167
+    
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"
187
+    
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"
194 203
     else
195
-    {
196
-        xml2::xml_attr(gmqlSchema,"type") <- "tab"
197
-        xml2::xml_attr(gmqlSchema,"coordinate_system") <- "0-based"
198
-    }
204
+      xml2::xml_attr(field,"type") <- "NULL"
205
+    xml2::xml_text(field) <- text
199 206
     
200
-    names_node <- names(node_list)
201
-
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)
207
+  },node_list,names_node)
208
+  xml2::write_xml(root,schema)
216 209
 }
217 210
 
218
-
219
-
220 211
old mode 100644
221 212
new mode 100755
... ...
@@ -3,64 +3,61 @@
3 3
 ############################
4 4
 
5 5
 
6
-AGGREGATES <- function(value)
7
-{
8
-    op_list <- list(value = value)
9
-    ## Set the name for the class
10
-    class(op_list) <- "AGGREGATES"
11
-    return(op_list)
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)
12 11
 }
13 12
 
14
-check.META_AGGREGATES <- function(value)
15
-{
16
-    if(is.character(value) && length(value)>1)
17
-        stop("value: no multiple string")
18
-    
19
-    if(!is.character(value))
20
-        stop("value: is not a string")
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")
21 19
 }
22 20
 
23
-META_AGGREGATES <- function(value)
24
-{
25
-    op_list <- list(value = value)
26
-    ## Set the name for the class
27
-    class(op_list) <- "META_AGGREGATES"
28
-    return(op_list)
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)
29 26
 }
30 27
 
31 28
 print.META_AGGREGATES <- function(obj) {
32
-    res <- as.character(obj)
33
-    cat(res)
29
+  res <- as.character(obj)
30
+  cat(res)
34 31
 }
35 32
 
36 33
 as.character.META_AGGREGATES <- function(obj) {
37
-    class <- class(obj)[1]
38
-    val <- obj$value
39
-    c(class,val)
34
+  class <- class(obj)[1]
35
+  val <- obj$value
36
+  c(class,val)
40 37
 }
41 38
 
42 39
 take_value.META_AGGREGATES <- function(obj){
43
-    class <- class(obj)[1]
44
-    val <- obj$value
45
-    text <- switch(class,
46
-                "SUM" = paste0("sum_",val),
47
-                "MIN" = paste0("min_",val),
48
-                "MAX" = paste0("max_",val),
49
-                "COUNT" = paste0("count"),
50
-                "BAG" = paste0("bag_",val),
51
-                "BAGD" = paste0("bagd_",val),
52
-                "AVG" = paste0("avg_",val),
53
-                "STD" = paste0("std_"),
54
-                "MEDIAN" = paste0("median_",val),
55
-                "Q1" = paste0("q1_",val),
56
-                "Q2" = paste0("q2_"),
57
-                "Q3" = paste0("q3_",val)
58
-    )
59
-    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
60 58
 }
61 59
 
62 60
 
63
-
64 61
 #' AGGREGATES object class constructor
65 62
 #' 
66 63
 #' 
... ...
@@ -171,14 +168,13 @@ take_value.META_AGGREGATES <- function(obj){
171 168
 #' @rdname aggr-class
172 169
 #' @export
173 170
 #'
174
-SUM <- function(value)
175
-{
176
-    check.META_AGGREGATES(value)
177
-    
178
-    list <- list(value = value)
179
-    ## Set the name for the class
180
-    class(list) <- c("SUM","AGGREGATES","META_AGGREGATES")
181
-    return(list)
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)
182 178
 }
183 179
 
184 180
 #' @name AGGREGATES-Object
... ...
@@ -186,16 +182,15 @@ SUM <- function(value)
186 182
 #' @rdname aggr-class
187 183
 #' @export
188 184
 #'
189
-COUNT <- function()
190
-{
191
-    list <- list()
192
-    ## Set the name for the class
193
-    class(list) <- c("COUNT","AGGREGATES","META_AGGREGATES")
194
-    return(list)
185
+COUNT <- function() {
186
+  list <- list()
187
+  ## Set the name for the class
188
+  class(list) <- c("COUNT","AGGREGATES","META_AGGREGATES")
189
+  return(list)
195 190
 }
196 191
 as.character.COUNT <- function(obj) {
197
-    class <- class(obj)[1]
198
-    c(class,"")
192
+  class <- class(obj)[1]
193
+  c(class,"")
199 194
 }
200 195
 check.COUNT <- function(obj){}
201 196
 
... ...
@@ -205,16 +200,15 @@ check.COUNT <- function(obj){}
205 200
 #' @rdname aggr-class
206 201
 #' @export
207 202
 #'
208
-COUNTSAMP <- function()
209
-{
210
-    list <- list()
211
-    ## Set the name for the class
212
-    class(list) <- c("COUNTSAMP","AGGREGATES","META_AGGREGATES")
213
-    return(list)
203
+COUNTSAMP <- function() {
204
+  list <- list()
205
+  ## Set the name for the class
206
+  class(list) <- c("COUNTSAMP","AGGREGATES","META_AGGREGATES")
207
+  return(list)
214 208
 }
215 209
 as.character.COUNTSAMP <- function(obj) {
216
-    class <- class(obj)[1]
217
-    c(class,"")
210
+  class <- class(obj)[1]
211
+  c(class,"")
218 212
 }
219 213
 check.COUNTSAMP <- function(obj){}
220 214
 
... ...
@@ -224,30 +218,27 @@ check.COUNTSAMP <- function(obj){}
224 218
 #' @rdname aggr-class
225 219
 #' @export
226 220
 #'
227
-MIN <- function(value)
228
-{
229
-    check.META_AGGREGATES(value)
230
-    
231
-    list <- list(value = value)
232
-    ## Set the name for the class
233
-    class(list) <- c("MIN","AGGREGATES","META_AGGREGATES")
234
-    return(list)
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)
235 228
 }
236 229
 
237
-
238 230
 #' @name AGGREGATES-Object
239 231
 #' @aliases MAX
240 232
 #' @rdname aggr-class 
241 233
 #' @export
242 234
 #'
243
-MAX <- function(value)
244
-{
245
-    check.META_AGGREGATES(value)
246
-    
247
-    list <- list(value = value)
248
-    ## Set the name for the class
249
-    class(list) <- c("MAX","AGGREGATES","META_AGGREGATES")
250
-    return(list)
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)
251 242
 }
252 243
 
253 244
 #' @name AGGREGATES-Object
... ...
@@ -255,14 +246,13 @@ MAX <- function(value)
255 246
 #' @rdname aggr-class
256 247
 #' @export
257 248
 #'
258
-AVG <- function(value)
259
-{
260
-    check.META_AGGREGATES(value)
261
-    
262
-    list <- list(value = value)
263
-    ## Set the name for the class
264
-    class(list) <- c("AVG","AGGREGATES","META_AGGREGATES")
265
-    return(list)
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)
266 256
 }
267 257
 
268 258
 #' @name AGGREGATES-Object
... ...
@@ -270,14 +260,13 @@ AVG <- function(value)
270 260
 #' @rdname aggr-class
271 261
 #' @export
272 262
 #'
273
-MEDIAN <- function(value)
274
-{
275
-    check.META_AGGREGATES(value)
276
-    
277
-    list <- list(value = value)
278
-    ## Set the name for the class
279
-    class(list) <- c("MEDIAN","AGGREGATES","META_AGGREGATES")
280
-    return(list)
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)
281 270
 }
282 271
 
283 272
 
... ...
@@ -286,14 +275,13 @@ MEDIAN <- function(value)
286 275
 #' @rdname aggr-class
287 276
 #' @export
288 277
 #'
289
-STD <- function(value)
290
-{
291
-    check.META_AGGREGATES(value)
292
-    
293
-    list <- list(value = value)
294
-    ## Set the name for the class
295
-    class(list) <- c("STD","META_AGGREGATES")
296
-    return(list)
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)
297 285
 }
298 286
 
299 287
 #' @name AGGREGATES-Object
... ...
@@ -301,14 +289,13 @@ STD <- function(value)
301 289
 #' @rdname aggr-class
302 290
 #' @export
303 291
 #'
304
-BAG <- function(value)
305
-{
306
-    check.META_AGGREGATES(value)
307
-    
308
-    list <- list(value = value)
309
-    ## Set the name for the class
310
-    class(list) <- c("BAG","AGGREGATES","META_AGGREGATES")
311
-    return(list)
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)
312 299
 }
313 300
 
314 301
 #' @name AGGREGATES-Object
... ...
@@ -316,14 +303,13 @@ BAG <- function(value)
316 303
 #' @rdname aggr-class
317 304
 #' @export
318 305
 #'
319
-BAGD <- function(value)
320
-{
321
-    check.META_AGGREGATES(value)
322
-    
323
-    list <- list(value = value)
324
-    ## Set the name for the class
325
-    class(list) <- c("BAGD","AGGREGATES","META_AGGREGATES")
326
-    return(list)
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)
327 313
 }
328 314
 
329 315
 #' @name AGGREGATES-Object
... ...
@@ -331,14 +317,13 @@ BAGD <- function(value)
331 317
 #' @rdname aggr-class
332 318
 #' @export
333 319
 #'
334
-Q1 <- function(value)
335
-{
336
-    check.META_AGGREGATES(value)
337
-    
338
-    list <- list(value = value)
339
-    ## Set the name for the class
340
-    class(list) <- c("Q1","META_AGGREGATES")
341
-    return(list)
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)
342 327
 }
343 328
 
344 329
 #' @name AGGREGATES-Object
... ...
@@ -346,13 +331,12 @@ Q1 <- function(value)
346 331
 #' @rdname aggr-class
347 332
 #' @export
348 333
 #'
349
-Q2 <- function(value)
350
-{
351
-    check.META_AGGREGATES(value)
352
-    list <- list(value = value)
353
-    ## Set the name for the class
354
-    class(list) <- c("Q2","META_AGGREGATES")
355
-    return(list)
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)
356 340
 }
357 341
 
358 342
 #' @name AGGREGATES-Object
... ...
@@ -360,14 +344,11 @@ Q2 <- function(value)
360 344
 #' @rdname aggr-class
361 345
 #' @export
362 346
 #'
363
-Q3 <- function(value)
364
-{
365
-    check.META_AGGREGATES(value)
366
-    
367
-    list <- list(value = value)
368
-    ## Set the name for the class
369
-    class(list) <- c("Q3","META_AGGREGATES")
370
-    return(list)
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)
371 354
 }
372
-
373
-
374 355
old mode 100644
375 356
new mode 100755
... ...
@@ -2,20 +2,19 @@
2 2
 #       PARAMETER          #
3 3
 ############################
4 4
 
5
-PARAMETER <- function()
6
-{
7
-    op_list <- list()
8
-    ## Set the name for the class
9
-    class(op_list) <- "PARAMETER"
10
-    return(op_list)
5
+PARAMETER <- function() {
6
+  op_list <- list()
7
+  ## Set the name for the class
8
+  class(op_list) <- "PARAMETER"
9
+  return(op_list)
11 10
 }
12 11
 
13 12
 as.character.PARAMETER <- function(obj) {
14
-    class <- class(obj)[1]
13
+  class <- class(obj)[1]
15 14
 }
16 15
 
17 16
 print.PARAMETER <- function(obj){
18
-    print(as.character.PARAMETER(obj))
17
+  print(as.character.PARAMETER(obj))
19 18
 }
20 19
 
21 20
 
... ...
@@ -71,12 +70,11 @@ print.PARAMETER <- function(obj){
71 70
 #' @rdname cover-param-class
72 71
 #' @export
73 72
 #'
74
-ALL <- function()
75
-{
76
-    list <- list()
77
-    ## Set the name for the class
78
-    class(list) <- c("ALL","PARAMETER")
79
-    return(list)
73
+ALL <- function() {
74
+  list <- list()
75
+  ## Set the name for the class
76
+  class(list) <- c("ALL","PARAMETER")
77
+  return(list)
80 78
 }
81 79
 
82 80
 #' @name Cover-Param
... ...
@@ -84,10 +82,37 @@ ALL <- function()
84 82
 #' @rdname cover-param-class
85 83
 #' @export
86 84
 #'
87
-ANY <- function()
88
-{
89
-    list <- list()
90
-    ## Set the name for the class
91
-    class(list) <- c("ANY","PARAMETER")
92
-    return(list)
85
+ANY <- function() {
86
+  list <- list()
87
+  ## Set the name for the class
88
+  class(list) <- c("ANY","PARAMETER")
89
+  return(list)
90
+}
91
+
92
+
93
+#' PARAM object class constructor
94
+#'
95
+#' This class constructor is used to create instances of PARAM object
96
+#' to be used in filter and extract function.
97
+#' 
98
+#' It is used to encompasses all the region parameters already present 
99
+#' into the dataset or GrangesList
100
+#' 
101
+#' \itemize{
102
+#' \item{FULL: It consider all the region paramter}
103
+#' }
104
+#' @param except The list of attribute to not consider
105
+#' 
106
+#' @return Param object
107
+#'
108
+#' @name filter-extract
109
+#' @aliases FULL
110
+#' @rdname filter-extract-param-class
111
+#' @export
112
+#'
113
+FULL <- function(except = NULL) {
114
+  value <- list(values = c(except))
115
+  ## Set the name for the class
116
+  class(value) <- c("FULL", "PARAMETER")
117
+  return(value)
93 118
 }
94 119
old mode 100644
95 120
new mode 100755
... ...
@@ -2,31 +2,29 @@
2 2
 #       DISTAL          #
3 3
 #########################
4 4
 
5
-DISTAL <- function(value)
6
-{
7
-    op_list <- list(value = value)
8
-    ## Set the name for the class
9
-    class(op_list) <- "DISTAL"
10
-    return(op_list)
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)
11 10
 }
12 11
 
13 12
 print.DISTAL <- function(obj) {
14
-    print(as.character.DISTAL(obj))
13
+  print(as.character.DISTAL(obj))
15 14
 }
16 15
 
17 16
 as.character.DISTAL <- function(obj) {
18
-    class <- class(obj)[1]
19
-    val <- obj$value
20
-    c(class,val)
17
+  class <- class(obj)[1]
18
+  val <- obj$value
19
+  c(class,val)
21 20
 }
22 21
 
23
-check.DISTAL <- function(value)
24
-{
25
-    if(!is.numeric(value))
26
-        stop("value: is not a numeric")
27
-    
28
-    if(is.numeric(value) && length(value)>1)
29
-        stop("value: no multiple string")
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")
30 28
 }
31 29
 #' DISTAL object class constructor
32 30
 #'
... ...
@@ -115,13 +113,12 @@ check.DISTAL <- function(value)
115 113
 #' @rdname distal-class
116 114
 #' @export
117 115
 #' 
118
-DL <- function(value)
119
-{
120
-    check.DISTAL(value)
121
-    list <- list(value = as.integer(value))
122
-    ## Set the name for the class
123
-    class(list) <- c("DL","DISTAL")
124
-    return(list)
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)
125 122
 }
126 123
 
127 124
 #' @name DG
... ...
@@ -129,13 +126,12 @@ DL <- function(value)
129 126
 #' @rdname distal-class
130 127
 #' @export
131 128
 #' 
132
-DG <- function(value)
133
-{
134
-    check.DISTAL(value)
135
-    list <- list(value = as.integer(value))
136
-    ## Set the name for the class
137
-    class(list) <- c("DG","DISTAL")
138
-    return(list)
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)
139 135
 }
140 136
 
141 137
 #' @name DISTAL-Object
... ...
@@ -143,13 +139,12 @@ DG <- function(value)
143 139
 #' @rdname distal-class
144 140
 #' @export
145 141
 #' 
146
-DLE <- function(value)
147
-{
148
-    check.DISTAL(value)
149
-    list <- list(value = as.integer(value))
150
-    ## Set the name for the class
151
-    class(list) <- c("DLE","DISTAL")
152
-    return(list)
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)
153 148
 }
154 149
 
155 150
 #' @name DISTAL-Object
... ...
@@ -157,13 +152,12 @@ DLE <- function(value)
157 152
 #' @rdname distal-class
158 153
 #' @export
159 154
 #' 
160
-DGE <- function(value)
161
-{
162
-    check.DISTAL(value)
163
-    list <- list(value = as.integer(value))
164
-    ## Set the name for the class
165
-    class(list) <- c("DGE","DISTAL")
166
-    return(list)
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)
167 161
 }
168 162
 
169 163
 #' @name DISTAL-Object
... ...
@@ -171,13 +165,12 @@ DGE <- function(value)
171 165
 #' @rdname distal-class
172 166
 #' @export
173 167
 #' 
174
-MD <- function(value)
175
-{
176
-    check.DISTAL(value)
177
-    list <- list(value = as.integer(value))
178
-    ## Set the name for the class
179
-    class(list) <- c("MD","DISTAL")
180
-    return(list)
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)
181 174
 }
182 175
 
183 176
 
... ...
@@ -186,16 +179,15 @@ MD <- function(value)
186 179
 #' @rdname distal-class
187 180
 #' @export
188 181
 #' 
189
-UP <- function()
190
-{
191
-    list <- list()
192
-    ## Set the name for the class
193
-    class(list) <- c("UP","DISTAL")
194
-    return(list)
182
+UP <- function() {
183
+  list <- list()
184
+  ## Set the name for the class
185
+  class(list) <- c("UP","DISTAL")
186
+  return(list)
195 187
 }
196 188
 as.character.UP <- function(obj) {
197
-    class <- class(obj)[1]
198
-    c(class,"")
189
+  class <- class(obj)[1]
190
+  c(class,"")
199 191
 }
200 192
 
201 193
 
... ...
@@ -204,17 +196,14 @@ as.character.UP <- function(obj) {
204 196
 #' @rdname distal-class
205 197
 #' @export
206 198
 #' 
207
-DOWN <- function()
208
-{
209
-    list <- list()
210
-    ## Set the name for the class
211
-    class(list) <- c("DOWN","DISTAL")
212
-    return(list)
199
+DOWN <- function() {
200
+  list <- list()
201
+  ## Set the name for the class
202
+  class(list) <- c("DOWN","DISTAL")
203
+  return(list)
213 204
 }
214
-
215
-
216 205
 as.character.DOWN <- function(obj) {
217
-    class <- class(obj)[1]
218
-    c(class,"")
206
+  class <- class(obj)[1]
207
+  c(class,"")
219 208
 }
220 209
 
221 210
old mode 100644
222 211
new mode 100755
... ...
@@ -3,34 +3,31 @@
3 3
 ############################
4 4
 
5 5
 
6
-OPERATOR <- function(value)
7
-{
8
-    op_list <- list(value = value)
9
-    ## Set the name for the class
10
-    class(op_list) <- "OPERATOR"
11
-    return(op_list)
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)
12 11
 }
13 12
 
14
-check.OPERATOR <- function(value)
15
-{
16
-    if(!is.null(value))
17
-    {
18
-        if(is.character(value) && length(value)>1)
19
-            stop("value: no multiple string")
20
-        
21
-        if(!is.character(value))
22
-            stop("value: is not a string")
23
-    }
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
+  }
24 21
 }
25 22
 
26 23
 print.OPERATOR <- function(obj) {
27
-    as.character(obj)
24
+  as.character(obj)
28 25
 }
29 26
 
30 27
 as.character.OPERATOR <- function(obj) {
31
-    class <- class(obj)[1]
32
-    val <- obj$value
33
-    c(class,val)
28
+  class <- class(obj)[1]
29
+  val <- obj$value
30
+  c(class,val)
34 31
 }
35 32
 
36 33
 #' OPERATOR object class constructor
... ...
@@ -94,58 +91,57 @@ as.character.OPERATOR <- function(obj) {
94 91
 #' @rdname operator-class
95 92
 #' @export
96 93
 #'
97
-META <- function(value, type = NULL)
98
-{
99
-    check.OPERATOR(value)
100
-    if(!is.null(type))
101
-        check.OPERATOR(type)
102
-    
103
-    list <- list(value = value,type = type)
104
-    ## Set the name for the class
105
-    class(list) <- c("META","OPERATOR")
106
-    return(list)
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)
107 104
 }
105
+
108 106
 print.META <- function(obj) {
109
-    as.character(obj)
107
+  as.character(obj)
110 108
 }
109
+
111 110
 as.character.META <- function(obj) {
112
-    class <- class(obj)[1]
113
-    val <- obj$value
114
-    type <- obj$type
115
-    c(class,val,type)
111
+  class <- class(obj)[1]
112
+  val <- obj$value
113
+  type <- obj$type
114
+  c(class,val,type)
116 115
 }
117 116
 
118
-check.META <- function(type)
119
-{
120
-    check.OPERATOR(value)
121
-    value <- toupper(value)
122
-    if(!value %in% c("DOUBLE","INTEGER","STRING"))
123
-        stop("only DOUBLE or INTEGER or STRING")
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")
124 123
 }
125 124
 
126
-
127 125
 #' @name OPERATOR-Object
128 126
 #' @aliases NIL
129 127
 #' @rdname operator-class
130 128
 #' @export
131 129
 #'
132
-NIL <- function(type)
133
-{
134
-    check.NIL(type)
135
-    
136
-    list <- list(value = type)
137
-    ## Set the name for the class
138
-    class(list) <- c("NIL","OPERATOR")
139
-    return(list)
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)
140 137
 }
141 138
 
142
-check.NIL <- function(value)
143
-{
144
-    check.OPERATOR(value)
145
-    value <- toupper(value)
146
-    if(!value %in% c("DOUBLE","INTEGER"))
147
-        stop("only DOUBLE or INTEGER")
148
-    
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")
149 145
 }
150 146
 
151 147
 #' @name OPERATOR-Object
... ...
@@ -153,13 +149,11 @@ check.NIL <- function(value)
153 149
 #' @rdname operator-class
154 150
 #' @export
155 151
 #'
156
-SQRT <- function(value)
157
-{
158
-    check.OPERATOR(value)
159
-    
160
-    list <- list(value = value)
161
-    ## Set the name for the class
162
-    class(list) <- c("SQRT","OPERATOR")
163
-    return(list)
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)
164 159
 }
165
-
166 160
old mode 100644
167 161
new mode 100755
... ...
@@ -1,133 +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(datasetName, pattern = "*.schema$",
19
-                                full.names = TRUE)
20
-    
21
-    schema_name_xml <- list.files(datasetName, pattern = "*.xml$",
22
-                                full.names = TRUE)
23
-    
24
-    if(!length(schema_name) && !length(schema_name_xml))
25
-        stop("schema not present")
26
-    
27
-    if(!length(schema_name))
28
-        xml_schema <- xml2::read_xml(schema_name_xml)
29
-    else
30
-        xml_schema <- xml2::read_xml(schema_name)
31
-    
32
-    list_field <- xml2::as_list(xml_schema)
33
-    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)
34 38
 }
35 39
 
36 40
 .schema_type_coordinate <- function(datasetName) {
37
-    schema_name <- list.files(datasetName, pattern = "*.schema$",
38
-                              full.names = TRUE)
39
-    
40
-    schema_name_xml <- list.files(datasetName, pattern = "*.xml$",
41
-                                  full.names = TRUE)
42
-    
43
-    if(!length(schema_name) && !length(schema_name_xml))
44
-        stop("schema not present")
45
-    
46
-    if(!length(schema_name))
47
-        xml_schema <- xml2::read_xml(schema_name_xml)
48
-    else
49
-        xml_schema <- xml2::read_xml(schema_name)
50
-    
51
-    gmql_schema_tag <- xml2::xml_children(xml_schema)
52
-    all_attrs <- xml2::xml_attrs(gmql_schema_tag)
53
-    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]])
54 62
 }
55 63
 
56 64
 # aggregates factory
57 65
 .aggregates <- function(meta_data,class) {
58
-    if(!is.list(meta_data))
59
-        stop("meta_data: invalid input")
60
-    
61
-    if(!all(vapply(meta_data, function(x) is(x,class), logical(1))))
62
-        stop("All elements must be META_AGGREGATES object")
63
-    
64
-    names <- names(meta_data)
65
-    if(is.null(names))
66
-    {
67
-        warning("You did not assign a names to a list.\nWe build it for you")
68
-        names <- vapply(meta_data, take_value.META_AGGREGATES,character(1))
69
-    }
70
-    else
71
-    {
72
-        if("" %in% names)
73
-            stop("No partial names assignment is allowed")
74
-    }
75
-    aggregate_matrix <- t(vapply(meta_data, function(x) {
76
-        new_value = as.character(x)
77
-        matrix <- matrix(new_value)
78
-    },character(2)))
79
-    
80
-    m_names <- matrix(names)
81
-    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)
82 87
 }
83 88
 
84 89
 
85 90
 # meta join condition
86 91
 .join_condition <- function(cond) {
87
-    cond_matrix <- NULL
88
-    def <- cond$condition$def
89
-    if(!is.null(def))
90
-        cond_matrix <- rbind(cond_matrix, def)
91
-    
92
-    exact <- cond$condition$exact
93
-    if(!is.null(exact))
94
-        cond_matrix <- rbind(cond_matrix, exact)
95
-    
96
-    full <- cond$condition$full
97
-    if(!is.null(full))
98
-        cond_matrix <- rbind(cond_matrix, full)
99
-    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
100 105
 }
101 106
 
102 107
 .check_input <- function(value) {
103
-    if(!is.character(value))
104
-        stop("no valid data")
105
-    
106
-    if(length(value)>1)
107
-        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")
108 113
 }
109 114
 
110 115
 .check_logical <- function(value) {
111
-    if(!is.logical(value))
112
-        stop("no valid data")
113
-    
114
-    if(length(value)>1)
115
-        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")
116 121
 }
117 122
 
118 123
 .is_login_expired <- function(url) {
119
-    if(exists("GMQL_credentials", envir = .GlobalEnv)) {
120
-        if(exists("authToken", where = GMQL_credentials)) {
121
-            authToken <- GMQL_credentials$authToken
122
-            url <- sub("/*[/]$","",url)
123
-            h <- c('Accept' = 'Application/json', 'X-Auth-Token' = authToken)
124
-            URL <- paste0(url,"/user")
125
-            req <- httr::GET(URL,httr::add_headers(h))
126
-            if(req$status_code != 200)
127
-                return(TRUE)
128
-            else
129
-                return(FALSE)
130
-        }
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)
131 135
     }
132
-    return(TRUE)
136
+  }
137
+  return(TRUE)
133 138
 }
... ...
@@ -42,9 +42,9 @@ conds <- function(default = c(""), full = c(""), exact = c("")) {
42 42
   array = array[!array %in% ""]
43 43
   array = array[!duplicated(array)]
44 44
   
45
-  if(!length(array))
45
+  if(!length(array)) {
46 46
     join_condition_matrix <- NULL
47
-  else {
47
+  } else {
48 48
     join_condition_matrix <- t(vapply(array, function(x) {
49 49
       new_value = c(cond, x)
50 50
       matrix <- matrix(new_value)
51 51
old mode 100644
52 52
new mode 100755
... ...
@@ -2,9 +2,9 @@
2 2
 #'
3 3
 #' This function lets user to create a new GRangesList with fixed information:
4 4
 #' seqnames, ranges and strand, and a variable part made up by the regions
5
-#' defined as input. The metadata and metadata_prefix are used to filter 
6
-#' the data and choose only the samples that match at least one metdatata 
7
-#' with its prefix. The input regions are shown for each sample obtained 
5
+#' defined as input. The metadata and metadata_prefix are used to filter
6
+#' the data and choose only the samples that match at least one metdatata
7
+#' with its prefix. The input regions are shown for each sample obtained
8 8
 #' from filtering.
9 9
 #'
10 10
 #' @import xml2
... ...
@@ -21,300 +21,387 @@
21 21
 #' if NULL no filtering action occures
22 22
 #' (i.e every sample is taken for region filtering)
23 23
 #' @param metadata_prefix vector of strings that will support the metadata
24
-#' filtering. If defined, each 'metadata' is concatenated with the 
24
+#' filtering. If defined, each 'metadata' is concatenated with the
25 25
 #' corresponding prefix.
26
-#' @param region_attributes vector of strings that extracts only region 
27
-#' attributes  specified; if NULL no regions attribute is taken and the output 
28
-#' is only GRanges made up by the region coordinate attributes 
26
+#' @param region_attributes vector of strings that extracts only region
27
+#' attributes  specified; if NULL no regions attribute is taken and the output
28
+#' is only GRanges made up by the region coordinate attributes
29 29
 #' (seqnames, start, end, strand)
30
-#' @param suffix name for each metadata column of GRanges. By default it is the 
31
-#' value of the metadata attribute named "antibody_target". This string is 
32
-#' taken from sample metadata file or from metadata() associated. 
30
+#' @param suffix name for each metadata column of GRanges. By default it is the
31
+#' value of the metadata attribute named "antibody_target". This string is
32
+#' taken from sample metadata file or from metadata() associated.
33 33
 #' If not present, the column name is the name of selected regions specified
34 34
 #' by 'region_attributes' input parameter
35 35
 #'
36 36
 #' @details
37
-#' This function works only with datatset or GRangesList all whose samples or 
38
-#' Granges have the same region coordinates (chr, ranges, strand) ordered in 
39
-#' the same way for each sample 
40
-#' 
37
+#' This function works only with dataset or GRangesList all whose samples or
38
+#' Granges have the same region coordinates (chr, ranges, strand) ordered in
39
+#' the same way for each sample
40
+#'
41 41
 #' In case of GRangesList data input, the function searches for metadata
42 42
 #' into metadata() function associated to GRangesList.
43 43
 #'
44 44
 #' @return GRanges with selected regions
45 45
 #'
46 46
 #' @examples
47
-#' 
48
-#' ## This statement defines the path to the folder "DATASET" in the 
49
-#' ## subdirectory "example" of the package "RGMQL" and filters such folder 
47
+#'
48
+#' ## This statement defines the path to the folder "DATASET" in the
49
+#' ## subdirectory "example" of the package "RGMQL" and filters such folder
50 50
 #' ## dataset including at output only "pvalue" and "peak" region attributes
51
-#' 
51
+#'
52 52
 #' test_path <- system.file("example", "DATASET", package = "RGMQL")
53 53
 #' filter_and_extract(test_path, region_attributes = c("pvalue", "peak"))
54
-#' 
55
-#' ## This statement imports a GMQL dataset as GRangesList and filters it 
54
+#'
55
+#' ## This statement imports a GMQL dataset as GRangesList and filters it
56 56
 #' ## including at output only "pvalue" and "peak" region attributes, the sort
57
-#' ## function makes sure that the region coordinates (chr, ranges, strand) 
57
+#' ## function makes sure that the region coordinates (chr, ranges, strand)
58 58
 #' ## of all samples are ordered correctly
59
-#' 
60
-#' 
61
-#' grl = import_gmql(test_path, TRUE)
62
-#' sorted_grl = sort(grl)
63
-#' filter_and_extract(sorted_grl, region_attributes = c("pvalue", "peak"))
64 59
 #'
65 60
 #'
61
+#' grl <- import_gmql(test_path, TRUE)
62
+#' sorted_grl <- sort(grl)
63
+#' filter_and_extract(sorted_grl, region_attributes = c("pvalue", "peak"))
66 64
 #' @export
67 65
 #'
68
-filter_and_extract <- function(data, metadata = NULL,
69
-                    metadata_prefix = NULL, region_attributes = NULL, 
70
-                    suffix = "antibody_target")
71
-{
72
-    if(is(data,"GRangesList"))
73
-        .extract_from_GRangesList(data, metadata, metadata_prefix, 
74
-            region_attributes, suffix)
75
-    else
76
-        .extract_from_dataset(data, metadata, metadata_prefix, 
77
-            region_attributes, suffix)
66
+filter_and_extract <- function(
67
+  data,
68
+  metadata = NULL,
69
+  metadata_prefix = NULL,
70
+  region_attributes = NULL,
71
+  suffix = "antibody_target"
72
+) {
73
+  
74
+  if (is(data, "GRangesList")) {
75
+    .extract_from_GRangesList(
76
+      data,
77
+      metadata,
78
+      metadata_prefix,
79
+      region_attributes,
80
+      suffix
81
+    )
82
+  } else {
83
+    .extract_from_dataset(
84
+      data,
85
+      metadata,
86
+      metadata_prefix,
87
+      region_attributes, suffix
88
+    )
89
+  }
78 90
 }
79 91
 
80
-.extract_from_dataset <- function(datasetName, metadata, metadata_prefix, 
81
-                                        regions, suffix)
82
-{
83
-    datasetName <- sub("/*[/]$","",datasetName)
84
-    if(basename(datasetName) !="files")
85
-        datasetName <- file.path(datasetName,"files")
86
-
87
-    if(!dir.exists(datasetName))
88
-        stop("Directory does not exists")
92
+.extract_from_dataset <- function(
93
+  datasetName,
94
+  metadata,
95
+  metadata_prefix,
96
+  regions,
97
+  suffix
98
+) {
99
+  datasetName <- sub("/*[/]$", "", datasetName)
100
+  if (basename(datasetName) != "files") {
101
+    datasetName <- file.path(datasetName, "files")
102
+  }
103
+  
104
+  if (!dir.exists(datasetName)) {
105
+    stop("Directory does not exists")
106
+  }
107
+  
108
+  gdm_meta_files <- list.files(
109
+    datasetName,
110
+    pattern = "*.gdm.meta$",
111
+    full.names = TRUE
112
+  )
113
+  
114
+  gtf_meta_files <- list.files(
115
+    datasetName,
116
+    pattern = "*.gtf.meta$",
117
+    full.names = TRUE
118
+  )
119
+  
120
+  if (!length(gdm_meta_files) && !length(gtf_meta_files)) {
121
+    stop("no samples present or no files format supported")
122
+  }
123
+  
124
+  if (length(gdm_meta_files) && length(gtf_meta_files)) {
125
+    stop("GMQL dataset cannot be mixed dataset: no GTF and GDM together")
126
+  }
127
+  
128
+  vector_field <- .schema_header(datasetName)
129
+  
130
+  if (length(gdm_meta_files)) {
131
+    samples_file <- .check_metadata_files(
132
+      metadata, metadata_prefix,
133
+      gdm_meta_files
134
+    )
89 135
     
90
-    gdm_meta_files <- list.files(datasetName, pattern = "*.gdm.meta$",
91
-                                    full.names = TRUE)
92
-    gtf_meta_files <- list.files(datasetName, pattern = "*.gtf.meta$",
93
-                                    full.names = TRUE)
136
+    samples_meta_to_read <- unlist(samples_file)
94 137
     
95
-    if(!length(gdm_meta_files) && !length(gtf_meta_files))
96
-        stop("no samples present or no files format supported")
97
-    
98
-    if(length(gdm_meta_files) && length(gtf_meta_files))
99
-        stop("GMQL dataset cannot be mixed dataset: no GTF and GDM together")
138
+    if (length(samples_meta_to_read)) {
139
+      samples_to_read <- gsub(".meta$", "", samples_meta_to_read)
140
+    } else {
141
+      samples_to_read <- gsub(".meta$", "", gdm_meta_files)
142
+      samples_meta_to_read <- gtf_meta_files
143
+    }
100 144
     
101
-    vector_field <- .schema_header(datasetName)
145
+    suffix_vec <- .get_suffix(suffix, FALSE, samples_meta_to_read)
146
+    granges <- .parse_gdm_files(
147
+      vector_field, 
148
+      samples_to_read, 
149
+      regions,
150
+      suffix_vec,
151
+      vector_field
152
+    )
102 153
     
154
+  } else {
155
+    samples_file <- .check_metadata_files(
156
+      metadata, 
157
+      metadata_prefix,
158
+      gtf_meta_files
159
+    )
160
+    samples_meta_to_read <- unlist(samples_file)
103 161
     
104
-    if(length(gdm_meta_files))
105
-    {
106
-        samples_file <- .check_metadata_files(metadata,metadata_prefix,
107
-                                                gdm_meta_files)
108
-        
109
-        samples_meta_to_read <- unlist(samples_file)
110
-        
111
-        if(length(samples_meta_to_read))
112
-            samples_to_read <- gsub(".meta$", "", samples_meta_to_read)
113
-        else
114
-        {
115
-            samples_to_read <- gsub(".meta$", "", gdm_meta_files)
116
-            samples_meta_to_read <- gtf_meta_files
117
-            
118
-        }
119
-        
120
-        suffix_vec <- .get_suffix(suffix, FALSE, samples_meta_to_read)
121
-        granges <- .parse_gdm_files(vector_field,samples_to_read,regions,
122
-                                        suffix_vec)
123
-    }
124
-    else
125
-    {
126
-        samples_file <- .check_metadata_files(metadata,metadata_prefix,
127
-                                                    gtf_meta_files)
128
-        samples_meta_to_read <- unlist(samples_file)
129
-        
130
-        if(length(samples_meta_to_read))
131
-            samples_to_read <- gsub(".meta$", "", samples_meta_to_read)
132
-        else
133
-        {
134
-            samples_to_read <- gsub(".meta$", "", gtf_meta_files)
135
-            samples_meta_to_read <- gtf_meta_files
136
-        }
137
-        
138
-        suffix_vec <- .get_suffix(suffix, FALSE, samples_meta_to_read)
139
-        granges <- .parse_gtf_files(samples_to_read, regions,suffix_vec)
162
+    if (length(samples_meta_to_read)) {
163
+      samples_to_read <- gsub(".meta$", "", samples_meta_to_read)
164
+    } else {
165
+      samples_to_read <- gsub(".meta$", "", gtf_meta_files)
166
+      samples_meta_to_read <- gtf_meta_files
140 167
     }
141
-}
142
-
143
-.extract_from_GRangesList <- function(rangesList, metadata, metadata_prefix, 
144
-                                        regions, suffix)
145
-{
146
-    if(!is(rangesList,"GRangesList"))
147
-        stop("only GrangesList admitted")
148 168
     
149
-    if(!length(rangesList))
150
-        stop("rangesList empty")
151
-    
152
-    meta_list <- metadata(rangesList)
153
-    samples <- .check_metadata_list(metadata, metadata_prefix, meta_list)
154
-    if(!length(unlist(samples)))
155
-        samples <- rangesList
156
-    else
157
-    {
158
-        index <- unlist(samples)
159
-        samples <- rangesList[c(index)]
160
-    }
161
-    new_meta_list <- metadata(samples)
162
-    suffix_vec <- .get_suffix(suffix, TRUE, new_meta_list)
163
-    granges <- .parse_Granges(samples,regions,suffix_vec)
169
+    suffix_vec <- .get_suffix(suffix, FALSE, samples_meta_to_read)
170
+    granges <- .parse_gtf_files(
171
+      samples_to_read, 
172
+      regions, 
173
+      suffix_vec, 
174
+      vector_field
175
+    )
176
+  }
164 177
 }
165 178
 
166
-.parse_Granges <- function(region_list,regions,suffixes)
167
-{
168
-    if(is.null(suffixes))
169
-        suffixes = ""
170
-    
171
-    g1 <- region_list[[1]]
172
-    elementMetadata(g1) <- NULL
173
-    if(!is.null(regions))
174
-    {
175
-        DF_list <- mapply(function(g_x,h){
176
-            meta <- elementMetadata(g_x)[regions]
177
-            if(h!="")
178
-                names(meta) <- paste(regions,h,sep = ".")
179
-            data.frame(meta)
180
-        },region_list, suffixes, SIMPLIFY = FALSE)
181
-        DF_only_regions <- dplyr::bind_cols(DF_list)
182
-        elementMetadata(g1) <- DF_only_regions
183
-    }
184
-    g1
179
+.extract_from_GRangesList <- function(
180
+  rangesList,
181
+  metadata,
182
+  metadata_prefix,
183
+  regions,
184
+  suffix
185
+) {
186
+  if (!is(rangesList, "GRangesList")) {
187
+    stop("only GrangesList admitted")
188
+  }
189
+  
190
+  if (!length(rangesList)) {
191
+    stop("rangesList empty")
192
+  }
193
+  
194
+  meta_list <- metadata(rangesList)
195
+  samples <- .check_metadata_list(metadata, metadata_prefix, meta_list)
196
+  if (!length(unlist(samples))) {
197
+    samples <- rangesList
198
+  } else {
199
+    index <- unlist(samples)
200
+    samples <- rangesList[c(index)]
201
+  }
202
+  new_meta_list <- metadata(samples)
203
+  suffix_vec <- .get_suffix(suffix, TRUE, new_meta_list)
204
+  granges <- .parse_Granges(samples, regions, suffix_vec)
185 205