1. RGMQL
  2. Commit 9212b3260c30c592b17f1aa72d5c86733e14e6c8
Browse code

biocheck

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