1. RGMQL
  2. Commit 73652f4dcd12969102b6b86948f627038f454a4a
Browse code

update with some news

Simone authored on 21/03/2021 14:34:30
Showing 87 changed files
.BBSoptions
History View file @ 73652f4
1 1 
old mode 100644
2 2 
new mode 100755
.Rbuildignore
History View file @ 73652f4
3 3 
old mode 100644
4 4 
new mode 100755
.gitignore
History View file @ 73652f4
5 5 
old mode 100644
6 6 
new mode 100755
DESCRIPTION
History View file @ 73652f4
7 7 
old mode 100644
8 8 
new mode 100755
NAMESPACE
History View file @ 73652f4
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)
NEWS
History View file @ 73652f4
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 
+
R/AllGenerics.R
History View file @ 73652f4
... ... 
@@ -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 
-
R/GMQLtoGRanges.R
History View file @ 73652f4
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 
-
R/GRangesToGMQL.R
History View file @ 73652f4
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 
-
R/S3Aggregates.R
History View file @ 73652f4
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 
-
R/S3Cover-Param.R
History View file @ 73652f4
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 
 }
R/S3Distal.R
History View file @ 73652f4
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
R/S3Operator.R
History View file @ 73652f4
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 
-
R/Utils.R
History View file @ 73652f4
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