Browse code

map to s4 - start new build

Simone authored on 16/11/2017 10:37:54
Showing 74 changed files

... ...
@@ -1,10 +1,10 @@
1 1
 Package: RGMQL
2 2
 Type: Package
3 3
 Title: GenoMetric Query Language for R/Bioconductor
4
-Version: 0.99.31
4
+Version: 0.99.32
5 5
 Author: Simone Pallotta, Marco Masseroli
6 6
 Maintainer: Simone Pallotta <simonepallotta@hotmail.com>
7
-Description: This RGMQL package brings the GenoMetric Query Language (GMQL)
7
+Description: This package brings the GenoMetric Query Language (GMQL)
8 8
     functionalities into the R environment. GMQL is a high-level, declarative
9 9
     language to query and compare multiple and heterogeneous genomic datasets
10 10
     for biomedical knowledge discovery. It allows expressing easily queries and
... ...
@@ -63,12 +63,47 @@ Imports:
63 63
     methods,
64 64
     S4Vectors,
65 65
     dplyr,
66
-    stats
66
+    stats,
67
+    BiocGenerics
67 68
 Depends:
68 69
     R(>= 3.4.2)
69 70
 VignetteBuilder: knitr
70
-Suggests:
71
+Suggests: 
71 72
     BiocStyle,
72 73
     knitr,
73 74
     rmarkdown
74
-biocViews: Software,Infrastructure,DataImport,Network,SingleCell
75
+biocViews:
76
+    Software,
77
+    Infrastructure,
78
+    DataImport,
79
+    Network,
80
+    SingleCell
81
+Collate: 
82
+    'GMQLDataset-class.R'
83
+    'Cover.R'
84
+    'Difference.R'
85
+    'Extend.R'
86
+    'GMQL4TFarm.R'
87
+    'GMQLtoGRanges.R'
88
+    'GRangesToGMQL.R'
89
+    'Join.R'
90
+    'Map.R'
91
+    'Materialize.R'
92
+    'Merge.R'
93
+    'Order.R'
94
+    'Project.R'
95
+    'Read.R'
96
+    'Select.R'
97
+    'Union.R'
98
+    'Utils.R'
99
+    'aggregate-class.R'
100
+    'authOp.R'
101
+    'browseOp.R'
102
+    'condition-class.R'
103
+    'cover_param-class.R'
104
+    'datasetOp.R'
105
+    'distal-class.R'
106
+    'onLoad.R'
107
+    'operator-class.R'
108
+    'ordering-class.R'
109
+    'queryOp.R'
... ...
@@ -30,7 +30,6 @@ export(SUM)
30 30
 export(UP)
31 31
 export(compile_query)
32 32
 export(compile_query_fromfile)
33
-export(cover)
34 33
 export(delete_dataset)
35 34
 export(download_as_GRangesList)
36 35
 export(download_dataset)
... ...
@@ -41,7 +40,6 @@ export(import_gmql)
41 40
 export(init_gmql)
42 41
 export(login_gmql)
43 42
 export(logout_gmql)
44
-export(map)
45 43
 export(materialize)
46 44
 export(read)
47 45
 export(read_dataset)
... ...
@@ -64,10 +62,11 @@ export(trace_job)
64 62
 export(upload_dataset)
65 63
 exportMethods(aggregate)
66 64
 exportMethods(cover)
65
+exportMethods(extend)
67 66
 exportMethods(filter)
68 67
 exportMethods(join)
68
+exportMethods(map)
69 69
 exportMethods(materialize)
70
-exportMethods(mutate)
71 70
 exportMethods(setdiff)
72 71
 exportMethods(sort)
73 72
 exportMethods(subset)
... ...
@@ -77,6 +76,7 @@ import(httr)
77 76
 import(xml2)
78 77
 importClassesFrom(GenomicRanges,GRangesList)
79 78
 importClassesFrom(S4Vectors,DataTable)
79
+importFrom(BiocGenerics,subset)
80 80
 importFrom(GenomicRanges,makeGRangesFromDataFrame)
81 81
 importFrom(S4Vectors,metadata)
82 82
 importFrom(data.table,fread)
... ...
@@ -21,14 +21,15 @@
21 21
 #' yielding to one sample in the result for each group.
22 22
 #' Input samples that do not satisfy the \emph{groupby} condition 
23 23
 #' are disregarded.
24
-#'
24
+#' 
25
+#' @include GMQLDataset-class.R
25 26
 #' @importFrom methods is
26 27
 #' @importFrom rJava J
27 28
 #' @importFrom rJava .jnull
28 29
 #' @importFrom rJava .jarray
29 30
 #' 
30 31
 #' @param data GMQLDataset class object
31
-#' @param minAcc minimum number of overlapping regions to be considered 
32
+#' @param min_acc minimum number of overlapping regions to be considered 
32 33
 #' during execution
33 34
 #' Is a integer number, declared also as string.
34 35
 #' minAcc accept also:
... ...
@@ -38,7 +39,7 @@
38 39
 #' \item{and expression built using PARAMETER object: (ALL() + N) / K or
39 40
 #' ALL() / K }
40 41
 #' }
41
-#' @param maxAcc maximum number of overlapping regions to be considered 
42
+#' @param max_acc maximum number of overlapping regions to be considered 
42 43
 #' during execution
43 44
 #' Is a integer number, declared also as string.
44 45
 #' maxAcc accept also:
... ...
@@ -99,7 +100,8 @@
99 100
 #' the AccIndex region attribute.}
100 101
 #' \item{cover: default value.}
101 102
 #' }
102
-#'
103
+#' @param ... Additional arguments for use in specific methods.
104
+#' 
103 105
 #' @return GMQLDataset class object. It contains the value to use as input 
104 106
 #' for the subsequent GMQL function
105 107
 #' 
... ...
@@ -113,7 +115,7 @@
113 115
 #' init_gmql()
114 116
 #' test_path <- system.file("example","DATASET",package = "RGMQL")
115 117
 #' exp = read_dataset(test_path)
116
-#' res = cover(exp, 2, ANY())
118
+#' res = cover(exp, 2, "ANY")
117 119
 #'
118 120
 #' \dontrun{
119 121
 #' ## This GMQL statement computes the result grouping the input exp samples 
... ...
@@ -129,44 +131,25 @@
129 131
 #' res = cover(exp, 2, 3, c("cell"), list(min_pValue = MIN("pvalue")))
130 132
 #' }
131 133
 #' 
132
-#' 
133
-#' @rdname GMQLDataset-class
134
-#' @aliases cover, GMQLDataset--method
135
-#' 
136
-#' @export
137
-#' 
138
-setGeneric("cover", function(data, minAcc, maxAcc, ...)
139
-{
140
-    minAcc <- .trasform_cover(deparse(substitute(minAcc)))
141
-    maxAcc <- .trasform_cover(deparse(substitute(maxAcc)))
142
-    
143
-    min <- .check_cover_param(minAcc,TRUE)
144
-    max <- .check_cover_param(maxAcc,FALSE)
145
-    
146
-    gmql_cover(data,min,max,NULL,NULL,"COVER")
147
-})
148
-
149
-#' @rdname GMQLDataset-class
150
-#' @aliases cover, GMQLDataset--method
134
+#' @aliases cover, cover-method
151 135
 #' @export
152 136
 setMethod("cover", "GMQLDataset",
153
-            function(data, minAcc, maxAcc, groupBy = NULL, aggregates = NULL, 
137
+            function(data, min_acc, max_acc, groupBy = NULL, aggregates = NULL, 
154 138
                         variation = "cover")
155 139
             {
156
-                minAcc <- .trasform_cover(deparse(substitute(minAcc)))
157
-                maxAcc <- .trasform_cover(deparse(substitute(maxAcc)))
158
-                
159
-                min <- .check_cover_param(minAcc,TRUE)
160
-                max <- .check_cover_param(maxAcc,FALSE)
140
+                val <- data@value
141
+                q_max <- .check_cover_param(max_acc,FALSE)
142
+                q_min <- .check_cover_param(min_acc,FALSE)
161 143
                 flag = toupper(variation)
162
-                
163
-                gmql_cover(data@value, min, max, groupBy, aggregates, 
164
-                           flag)
144
+                gmql_cover(val, q_min, q_max, groupBy, aggregates, flag)
165 145
             })
166 146
 
167
-gmql_cover <- function(data, minAcc, maxAcc, groupBy = NULL, 
147
+
148
+
149
+gmql_cover <- function(data, min_acc, max_acc, groupBy = NULL, 
168 150
                         aggregates = NULL, flag)
169 151
 {
152
+    
170 153
     if(!is.null(groupBy))
171 154
         join_condition_matrix <- .jarray(.join_condition(groupBy),
172 155
                                             dispatch = TRUE)
... ...
@@ -181,14 +164,14 @@ gmql_cover <- function(data, minAcc, maxAcc, groupBy = NULL,
181 164
 
182 165
     WrappeR <- J("it/polimi/genomics/r/Wrapper")
183 166
     response <- switch(flag,
184
-                "COVER" = WrappeR$cover(minAcc, maxAcc, join_condition_matrix,
167
+        "COVER" = WrappeR$cover(min_acc, max_acc, join_condition_matrix,
185 168
                                     metadata_matrix, data),
186
-                "FLAT" = WrappeR$flat(minAcc, maxAcc, join_condition_matrix,
169
+        "FLAT" = WrappeR$flat(min_acc, max_acc, join_condition_matrix,
187 170
                                     metadata_matrix, data),
188
-                "SUMMIT" = WrappeR$summit(minAcc,maxAcc, join_condition_matrix,
171
+        "SUMMIT" = WrappeR$summit(min_acc,max_acc, join_condition_matrix,
189 172
                                     metadata_matrix, data),
190
-                "HISTOGRAM" = WrappeR$histogram(minAcc, maxAcc, 
191
-                                join_condition_matrix, metadata_matrix, data))
173
+        "HISTOGRAM" = WrappeR$histogram(min_acc, max_acc, 
174
+                        join_condition_matrix, metadata_matrix, data))
192 175
     if(is.null(response))
193 176
         stop("no admissible variation: cover, flat, summit, histogram")
194 177
     
... ...
@@ -200,7 +183,7 @@ gmql_cover <- function(data, minAcc, maxAcc, groupBy = NULL,
200 183
         GMQLDataset(data)
201 184
 }
202 185
 
203
-.check_cover_param <- function(param,is_min)
186
+.check_cover_param <- function(param, is_min)
204 187
 {
205 188
     if(length(param)>1)
206 189
         stop("length > 1")
... ...
@@ -214,12 +197,19 @@ gmql_cover <- function(data, minAcc, maxAcc, groupBy = NULL,
214 197
     }
215 198
     else if(is.character(param))
216 199
     {
217
-        if(is_min && identical(param,"ANY"))
218
-            stop("min cannot assume ANY as value")
200
+        if(is.na(as.numeric(param)))
201
+        {
202
+            if(is_min && identical(param,"ANY"))
203
+                stop("min cannot assume ANY as value")
204
+            
205
+            if(!identical(param,"ANY") && !identical(param,"ALL"))
206
+                stop("invalid input data")
207
+        }
219 208
         return(param)
220 209
     }
221 210
     else
222 211
         stop("invalid input data")
212
+    
223 213
 }
224 214
 
225 215
 .trasform_cover <- function(predicate=NULL)
... ...
@@ -15,10 +15,10 @@
15 15
 #' @importFrom rJava .jnull
16 16
 #' @importFrom rJava .jarray
17 17
 #' 
18
-#' @param x returned object from any GMQL function
19
-#' @param y returned object from any GMQL function
20
-#' @param joinBy list of CONDITION objects where every object contains 
21
-#' the name of metadata to be used in semijoin, or simple string concatenation 
18
+#' @param x GMQLDataset class object
19
+#' @param y GMQLDataset class object
20
+#' @param joinBy vector of CONDITION objects where every object contains 
21
+#' the name of metadata to be used in semijoin, or string concatenation 
22 22
 #' of name of metadata, e.g. c("cell_type", "attribute_tag", "size") 
23 23
 #' without declaring condition.
24 24
 #' The CONDITION's available are:
... ...
@@ -30,9 +30,9 @@
30 30
 #' as value will match; no further prefixes are allowed. }
31 31
 #' }
32 32
 #' Every condition accepts only one string value. (e.g. FULL("cell_type") )
33
-#' In case of single concatenation with no CONDITION or list with some value 
34
-#' without conditon, the metadata are considered having default 
35
-#' evaluation: the two attributes match if both end with value.
33
+#' In case of single concatenation with no CONDITION the metadata are 
34
+#' considered having default evaluation: 
35
+#' the two attributes match if both end with value.
36 36
 #' 
37 37
 #' @param is_exact single logical value: TRUE means that the region difference 
38 38
 #' is executed only on regions in left_input_data with exactly the same 
... ...
@@ -41,7 +41,7 @@
41 41
 #' left_input_data that overlap with at least one region in right_input_data 
42 42
 #' (even just one base).
43 43
 #'
44
-#' @return DataSet class object. It contains the value to use as input 
44
+#' @return GMQLDataset class object. It contains the value to use as input 
45 45
 #' for the subsequent GMQL function
46 46
 #' 
47 47
 #'
... ...
@@ -69,23 +69,21 @@
69 69
 #' test_path2 <- system.file("example", "DATASET_GDM", package = "RGMQL")
70 70
 #' exp1 = read_dataset(test_path)
71 71
 #' exp2 = read_dataset(test_path2)
72
-#' out = setdiff(exp1, exp2, c("antibody_target"))
72
+#' out = setdiff(exp1, exp2, joinBy = c("antibody_target"))
73 73
 #'
74 74
 #' }
75
-#'
76
-#' @rdname setdiff-methods
77
-#' @aliases setdiff, setdiff-methods
75
+#' 
76
+#' @aliases setdiff, setdiff-method
78 77
 #' @export
79 78
 setMethod("setdiff", c("GMQLDataset","GMQLDataset"),
80
-            function(x, y, joinBy = NULL, is_exact = FALSE)
79
+            function(x, y, is_exact = FALSE, joinBy = NULL)
81 80
             {
82 81
                 val_x = x@value
83 82
                 val_y = y@value
84
-                gmql_difference(val_x, val_y, joinBy, is_exact)
83
+                gmql_difference(val_x, val_y, is_exact, joinBy)
85 84
             })
86 85
 
87
-gmql_difference <- function(left_data, right_data, joinBy = NULL, 
88
-                                is_exact = FALSE)
86
+gmql_difference <- function(left_data, right_data, is_exact, joinBy)
89 87
 {
90 88
     if(!is.null(joinBy))
91 89
         join_condition_matrix <- .jarray(.join_condition(joinBy),
... ...
@@ -104,3 +102,4 @@ gmql_difference <- function(left_data, right_data, joinBy = NULL,
104 102
         GMQLDataset(data)
105 103
 }
106 104
 
105
+
... ...
@@ -1,3 +1,11 @@
1
+#' @name extend
2
+#' @rdname extend-GMQLDataset-method
3
+#' @aliases extend, GMQLDataset-method
4
+#' @exportMethod extend
5
+setGeneric("extend", function(.data, ...) 
6
+    standardGeneric("extend"))
7
+
8
+
1 9
 #' GMQL Operation: EXTEND
2 10
 #'
3 11
 #' It generates new metadata attributes as result of aggregate functions 
... ...
@@ -10,7 +18,9 @@
10 18
 #' @importFrom rJava .jarray
11 19
 #'
12 20
 #' @param .data GMQLDataset class object 
13
-#' @param metadata list of element in the form \emph{key} = \emph{aggregate}.
21
+#' @param ... Additional arguments for use in specific methods.
22
+#' 
23
+#' In this case a series of element in the form \emph{key} = \emph{aggregate}.
14 24
 #' The \emph{aggregate} is an object of class AGGREGATES
15 25
 #' The aggregate functions available are: \code{\link{SUM}}, 
16 26
 #' \code{\link{COUNT}}, \code{\link{MIN}}, \code{\link{MAX}}, 
... ...
@@ -27,7 +37,7 @@
27 37
 #' }
28 38
 #' "mixed style" is not allowed
29 39
 #'
30
-#' @return DataSet class object. It contains the value to use as input 
40
+#' @return GMQLDataset class object. It contains the value to use as input 
31 41
 #' for the subsequent GMQL function
32 42
 #' 
33 43
 #' @examples
... ...
@@ -37,7 +47,7 @@
37 47
 #' init_gmql()
38 48
 #' test_path <- system.file("example", "DATASET", package = "RGMQL")
39 49
 #' r <- read_dataset(test_path)
40
-#' e <- mutate(input_data = r, list(RegionCount = COUNT()))
50
+#' e <- extend(r, RegionCount = COUNT())
41 51
 #' 
42 52
 #' \dontrun{
43 53
 #' 
... ...
@@ -50,27 +60,25 @@
50 60
 #' init_gmql()
51 61
 #' test_path <- system.file("example", "DATASET", package = "RGMQL")
52 62
 #' exp = read_dataset(test_path)
53
-#' res = mutate(input_data = exp, list(RegionCount = COUNT(),
54
-#' MinP = MIN("pvalue")))
63
+#' res = extend(exp, RegionCount = COUNT(), MinP = MIN("pvalue")))
55 64
 #' 
56 65
 #' }
57
-#' 
58
-#' @name mutate
59
-#' @rdname mutate-methods
60
-#' @aliases mutate, mutate-methods
66
+
67
+#' @aliases extend-method
61 68
 #' @export
62
-setMethod("mutate", "GMQLDataset",
63
-            function(.data, metadata = NULL)
69
+setMethod("extend", "GMQLDataset",
70
+            function(.data, ...)
64 71
             {
65 72
                 val_x = .data@value
66
-                gmql_extend(val_x, metadata)
73
+                meta <- list(...)
74
+                gmql_extend(val_x, meta)
67 75
             })
68 76
 
69 77
 
70
-gmql_extend <-function(input_data, metadata = NULL)
78
+gmql_extend <-function(input_data, meta)
71 79
 {
72
-    if(!is.null(metadata))
73
-        metadata_matrix <- .jarray(.aggregates(metadata,"META_AGGREGATES"),
80
+    if(!is.null(meta) && !length(meta)==0)
81
+        metadata_matrix <- .jarray(.aggregates(meta,"META_AGGREGATES"),
74 82
                                     dispatch = TRUE)
75 83
     else
76 84
         metadata_matrix <- .jnull("java/lang/String")
77 85
similarity index 62%
78 86
rename from R/Dataset-class.R
79 87
rename to R/GMQLDataset-class.R
... ...
@@ -7,6 +7,8 @@
7 7
 #' @name GMQLDataset-class
8 8
 #' @rdname GMQLDataset-class
9 9
 #' 
10
+#' @return instance of GMQL dataset
11
+
10 12
 setClass("GMQLDataset",
11 13
             contains = c("DataTable"),
12 14
             representation(value = "character"))
... ...
@@ -30,15 +32,6 @@ setMethod("show", "GMQLDataset",
30 32
             })
31 33
 
32 34
 
33
-#' Method mutate
34
-#' 
35
-#' Wrapper to GMQL extend function
36
-#' 
37
-#' @name mutate
38
-#' @rdname mutate-methods
39
-#' 
40
-setGeneric("mutate", function(.data, metadata = NULL) 
41
-                                standardGeneric("mutate"))
42 35
 
43 36
 # insted of GMQL order
44 37
 # setGeneric("sort", function(data, metadata_ordering = NULL, 
... ...
@@ -51,8 +44,9 @@ setGeneric("mutate", function(.data, metadata = NULL)
51 44
 #' Wrapper to GMQL merge function
52 45
 #' 
53 46
 #' @name aggregate
54
-#' @rdname aggregate-methods
55
-#' 
47
+#' @rdname aggregate-GMQLDataset-method
48
+#' @aliases aggregate
49
+#'  
56 50
 setGeneric("aggregate", function(data, groupBy = NULL) 
57 51
                                     standardGeneric("aggregate"))
58 52
 
... ...
@@ -62,9 +56,42 @@ setGeneric("aggregate", function(data, groupBy = NULL)
62 56
 #' Wrapper to GMQL join function
63 57
 #' 
64 58
 #' @name join
65
-#' @rdname join-methods
59
+#' @rdname join-GMQLDataset-method
66 60
 #' @aliases join
67 61
 #' 
68
-setGeneric("join", function(x, y, by = NULL, ...) standardGeneric("join"))
62
+setGeneric("join", function(x, y, by = NULL,...) standardGeneric("join"))
63
+
64
+
65
+#' Method filter
66
+#' 
67
+#' Wrapper to GMQL select function
68
+#' 
69
+#' @name filter
70
+#' @rdname filter-GMQLDataset-method
71
+#' @aliases filter
72
+#' 
73
+setGeneric("filter", function(.data,...) standardGeneric("filter"))
74
+
75
+#' Method cover
76
+#' 
77
+#' Wrapper to GMQL cover function
78
+#' 
79
+#' @name cover
80
+#' @rdname cover-GMQLDataset-method
81
+#' @aliases cover
82
+#' 
83
+setGeneric("cover", function(data, ...) standardGeneric("cover"))
84
+
85
+#' Method map
86
+#' 
87
+#' Wrapper to GMQL map function
88
+#' 
89
+#' @name map
90
+#' @rdname map-GMQLDataset-method
91
+#' @aliases map
92
+#' 
93
+setGeneric("map", function(x, y, ...) standardGeneric("map"))
94
+
95
+
69 96
 
70 97
 
... ...
@@ -22,7 +22,7 @@
22 22
 #' For details of DISTAL objects see:
23 23
 #' \code{\link{DLE}}, \code{\link{DGE}}, \code{\link{DL}}, \code{\link{DG}},
24 24
 #' \code{\link{MD}}, \code{\link{UP}}, \code{\link{DOWN}}
25
-#' 
25
+#' @param ... Additional arguments for use in specific methods.
26 26
 #' @param by list of CONDITION objects where every object contains 
27 27
 #' the name of metadata to be used in semijoin, or simple string concatenation 
28 28
 #' of name of metadata, e.g. c("cell_type", "attribute_tag", "size") 
... ...
@@ -84,9 +84,7 @@
84 84
 #' region_output="RIGHT")
85 85
 #' 
86 86
 
87
-#' @name join
88
-#' @rdname join-methods
89
-#' @aliases join, join-methods
87
+#' @aliases join-method
90 88
 #' @export
91 89
 setMethod("join", "GMQLDataset",
92 90
                 function(x, y, by = NULL, genometric_predicate = NULL, 
... ...
@@ -94,7 +92,7 @@ setMethod("join", "GMQLDataset",
94 92
                 {
95 93
                     r_data <- x@value
96 94
                     l_data <- y@value
97
-                    gmql_join(x, y, genometric_predicate, by, 
95
+                    gmql_join(r_data, l_data, genometric_predicate, by, 
98 96
                             region_output="contig")
99 97
                 })
100 98
 
... ...
@@ -19,9 +19,12 @@
19 19
 #' present with equal values in both M1 and  M2
20 20
 #'
21 21
 #'
22
-#' @param left_input_data returned object from any GMQL function
23
-#' @param right_input_data returned object from any GMQL function
24
-#' @param aggregates list of element in the form \emph{key} = \emph{aggregate}.
22
+#' @param x GMQLDataset class object
23
+#' @param y GMQLDataset class object 
24
+#' 
25
+#' @param ... Additional arguments for use in specific methods.
26
+#' 
27
+#' In this case a series of element in the form \emph{key} = \emph{aggregate}.
25 28
 #' The \emph{aggregate} is an object of class AGGREGATES
26 29
 #' The aggregate functions available are: \code{\link{SUM}}, 
27 30
 #' \code{\link{COUNT}}, \code{\link{MIN}}, \code{\link{MAX}}, 
... ...
@@ -54,7 +57,7 @@
54 57
 #' without conditon, the metadata are considered having default 
55 58
 #' evaluation: the two attributes match if both end with value.
56 59
 #' 
57
-#' @return DataSet class object. It contains the value to use as input 
60
+#' @return GMQLDataset class object. It contains the value to use as input 
58 61
 #' for the subsequent GMQL function
59 62
 #' 
60 63
 #'
... ...
@@ -74,16 +77,23 @@
74 77
 #' test_path2 <- system.file("example", "DATASET_GDM", package = "RGMQL")
75 78
 #' exp = read_dataset(test_path)
76 79
 #' ref = read_dataset(test_path2)
77
-#' out = map(ref,exp, list(minScore = MIN("score")), 
78
-#' joinBy = c("cell_tissue"))
79
-#' 
80
+#' out = map(ref,exp, minScore = MIN("score"), joinBy = c("cell_tissue"))
80 81
 #' 
82
+#' @aliases map-method
81 83
 #' @export
82
-#'
83
-map <- function(left_input_data, right_input_data, aggregates = NULL, 
84
-                    joinBy = NULL)
84
+setMethod("map", "GMQLDataset",
85
+            function(x, y, ..., joinBy = NULL)
86
+            {
87
+                r_data <- x@value
88
+                l_data <- y@value
89
+                aggregates = list(...)
90
+                gmql_map(r_data, l_data, aggregates, joinBy)
91
+            })
92
+
93
+
94
+gmql_map <- function(l_data, r_data, aggregates, joinBy)
85 95
 {
86
-    if(!is.null(aggregates))
96
+    if(!is.null(aggregates) && !length(aggregates) == 0)
87 97
         metadata_matrix <- .jarray(.aggregates(aggregates,"AGGREGATES"),
88 98
                                     dispatch = TRUE)
89 99
     else
... ...
@@ -96,8 +106,8 @@ map <- function(left_input_data, right_input_data, aggregates = NULL,
96 106
         join_condition_matrix <- .jnull("java/lang/String")
97 107
     
98 108
     WrappeR <- J("it/polimi/genomics/r/Wrapper")
99
-    response<-WrappeR$map(join_condition_matrix, metadata_matrix, 
100
-                            left_input_data@value, right_input_data@value)
109
+    response<-WrappeR$map(join_condition_matrix, metadata_matrix, l_data, 
110
+                            r_data)
101 111
     error <- strtoi(response[1])
102 112
     data <- response[2]
103 113
     if(error!=0)
... ...
@@ -12,9 +12,9 @@
12 12
 #' init_gmql()
13 13
 #' test_path <- system.file("example","DATASET",package = "RGMQL")
14 14
 #' r = read_dataset(test_path)
15
-#' s = filter(input_data = r)
16
-#' m = aggregate(groupBy = c("antibody_targer","cell_karyotype"),input_data = s)
17
-#' materialize(input_data = m, dir_out = test_path)
15
+#' s = filter(r)
16
+#' m = aggregate(s, groupBy = c("antibody_targer","cell_karyotype"))
17
+#' materialize(m, dir_out = test_path)
18 18
 #' 
19 19
 #' \dontrun{
20 20
 #' execute()
... ...
@@ -65,9 +65,7 @@ execute <- function()
65 65
     }
66 66
 }
67 67
 
68
-#' @name materialize
69
-#' @rdname materialize-methods
70
-#' @aliases materialize
68
+#' @rdname materialize-GMQLDataset-method
71 69
 #' @export
72 70
 setGeneric("materialize", function(data, ...) standardGeneric("materialize"))
73 71
 
... ...
@@ -86,7 +84,7 @@ setGeneric("materialize", function(data, ...) standardGeneric("materialize"))
86 84
 #' @param data GMQLDataset class object
87 85
 #' @param dir_out destination folder path.
88 86
 #' by default is current working directory of the R process
89
-#'
87
+#' @param ... Additional arguments for use in specific methods.
90 88
 #' @return None
91 89
 #'
92 90
 #' @examples
... ...
@@ -94,13 +92,11 @@ setGeneric("materialize", function(data, ...) standardGeneric("materialize"))
94 92
 #' init_gmql()
95 93
 #' test_path <- system.file("example","DATASET",package = "RGMQL")
96 94
 #' r = read_dataset(test_path)
97
-#' s = filter(input_data = r)
95
+#' s = filter(r)
98 96
 #' m = aggregate(s, groupBy = c("antibody_targer","cell_karyotype"))
99
-#' materialize(input_data = m, dir_out = test_path)
97
+#' materialize(m, dir_out = test_path)
100 98
 #' 
101
-#' @name materialize
102
-#' @rdname materialize-methods
103
-#' @aliases materialize, materialize-methods
99
+#' @aliases materialize-method
104 100
 #' @export
105 101
 setMethod("materialize", "GMQLDataset",
106 102
             function(data, dir_out = getwd())
... ...
@@ -149,7 +145,7 @@ gmql_materialize <- function(data, dir_out)
149 145
 #' test_path <- system.file("example", "DATASET", package = "RGMQL")
150 146
 #' r = read_dataset(test_path)
151 147
 #' m = aggregate(r, groupBy = c("antibody_target", "cell_karyotype"))
152
-#' g <- take(input_data = m, rows = 45)
148
+#' g <- take(m, rows = 45)
153 149
 #' 
154 150
 #' @export
155 151
 #'
... ...
@@ -46,18 +46,16 @@
46 46
 #' init_gmql()
47 47
 #' test_path <- system.file("example","DATASET",package = "RGMQL")
48 48
 #' exp = read_dataset(test_path)
49
-#' merged = aggregate(input_data = exp, groupBy = c("antibody_target"))
49
+#' merged = aggregate(exp, groupBy = c("antibody_target"))
50 50
 #' 
51
-#' @name aggregate
52
-#' @rdname aggregate-methods
53
-#' @aliases aggregate, aggregate-methods
51
+#' @aliases aggregate-method
54 52
 #' @export
55 53
 #' 
56 54
 setMethod("aggregate", "GMQLDataset",
57 55
             function(data, groupBy = NULL)
58 56
             {
59 57
                 val = data@value
60
-                gmql_merge(val, metadata)
58
+                gmql_merge(val, groupBy)
61 59
             })
62 60
 
63 61
 gmql_merge <- function(data, groupBy = NULL)
... ...
@@ -81,9 +81,8 @@
81 81
 #' num_fetch = 2)
82 82
 #' 
83 83
 #' }
84
-#' @name sort
85
-#' @rdname sort-methods
86
-#' @aliases sort, sort-methods
84
+#' 
85
+#' @aliases sort-method
87 86
 #' @export
88 87
 setMethod("sort", "GMQLDataset",
89 88
             function(x, decreasing = FALSE, metadata_ordering = NULL, 
... ...
@@ -14,6 +14,7 @@
14 14
 #' @importFrom rJava J
15 15
 #' @importFrom rJava .jnull
16 16
 #' @importFrom rJava .jarray
17
+#' @importFrom BiocGenerics subset
17 18
 #' 
18 19
 #' @param x GMQLDataset class object
19 20
 #' @param metadata vector of string made up by metadata attribute
... ...
@@ -84,11 +85,8 @@
84 85
 #' 
85 86
 #' }
86 87
 #' 
87
-#' @export
88 88
 #'
89
-#' @name subset
90
-#' @rdname subset-methods
91
-#' @aliases subset, subset-methods
89
+#' @aliases subset
92 90
 #' @export
93 91
 setMethod("subset", "GMQLDataset",
94 92
             function(x, metadata = NULL, metadata_update=NULL, 
... ...
@@ -96,9 +94,27 @@ setMethod("subset", "GMQLDataset",
96 94
                         regions_update = NULL, all_but_reg=FALSE)
97 95
             {
98 96
                 data = x@value
99
-                gmql_project(data, metadata, metadata_update,
97
+                r_update <- substitute(regions_update)
98
+                if(!is.null(r_update))
99
+                {
100
+                    reg_update <- .trasform_update(deparse(r_update))
101
+                    reg_update <- paste(reg_update,collapse = "")
102
+                }
103
+                else
104
+                    reg_update <- .jnull("java/lang/String")
105
+                
106
+                m_update <- substitute(metadata_update)
107
+                if(!is.null(m_update))
108
+                {
109
+                    meta_update <- .trasform_update(deparse(m_update))
110
+                    meta_update <- paste(meta_update,collapse = "")
111
+                }
112
+                else
113
+                    meta_update <- .jnull("java/lang/String")
114
+                
115
+                gmql_project(data, metadata, meta_update,
100 116
                                 all_but_meta, regions, 
101
-                                regions_update, all_but_reg)
117
+                                reg_update, all_but_reg)
102 118
             })
103 119
 
104 120
 gmql_project <-function(input_data, metadata = NULL, metadata_update=NULL, 
... ...
@@ -137,24 +153,7 @@ gmql_project <-function(input_data, metadata = NULL, metadata_update=NULL,
137 153
     else
138 154
         regions <- .jnull("java/lang/String")
139 155
     
140
-    reg_update <- substitute(regions_update)
141
-    if(!is.null(reg_update))
142
-    {
143
-        regions_update <- .trasform_update(deparse(reg_update))
144
-        regions_update <- paste(regions_update,collapse = "")
145
-    }
146
-    else
147
-        regions_update <- .jnull("java/lang/String")
148
-    
149
-    meta_update <- substitute(metadata_update)
150
-    if(!is.null(meta_update))
151
-    {
152
-        metadata_update <- .trasform_update(deparse(meta_update))
153
-        metadata_update <- paste(metadata_update,collapse = "")
154
-    }
155
-    else
156
-        metadata_update <- .jnull("java/lang/String")
157
-    
156
+
158 157
     if(length(all_but_meta)>1)
159 158
         warning("all_but_meta: no multiple values")
160 159
     
... ...
@@ -167,7 +166,7 @@ gmql_project <-function(input_data, metadata = NULL, metadata_update=NULL,
167 166
     WrappeR <- J("it/polimi/genomics/r/Wrapper")
168 167
     response <- WrappeR$project(metadata,metadata_update,all_but_meta,
169 168
                                 regions,regions_update,
170
-                                all_but_reg,input_data$value)
169
+                                all_but_reg,input_data)
171 170
     error <- strtoi(response[1])
172 171
     data <- response[2]
173 172
     if(error!=0)
... ...
@@ -15,14 +15,14 @@
15 15
 #' @importFrom rJava .jarray
16 16
 #' @importFrom methods isClass
17 17
 #'
18
-#' @param x GMQLDataset class object
18
+#' @param .data GMQLDataset class object
19 19
 #' @param m_predicate logical predicate made up by R logical operation 
20 20
 #' on metadata attribute. 
21 21
 #' Only !, |, ||, &, && are admitted.
22 22
 #' @param r_predicate logical predicate made up by R logical operation 
23 23
 #' on chema region values. 
24 24
 #' Only !, |, ||, &, && are admitted.
25
-#' @param semi_join list of CONDITION objects where every object contains 
25
+#' @param semi_join vector of CONDITION objects where every object contains 
26 26
 #' the name of metadata to be used in semijoin, or simple string concatenation 
27 27
 #' of name of metadata, e.g. c("cell_type", "attribute_tag", "size") 
28 28
 #' without declaring condition.
... ...
@@ -35,16 +35,17 @@
35 35
 #' as value will match; no further prefixes are allowed. }
36 36
 #' }
37 37
 #' Every condition accepts only one string value. (e.g. FULL("cell_type") )
38
-#' In case of single concatenation with no CONDITION or list with some value 
39
-#' without conditon, the metadata are considered having default 
40
-#' evaluation: the two attributes match if both end with value.
38
+#' In case of single concatenation with no CONDITION the metadata are 
39
+#' considered having default evaluation: 
40
+#' the two attributes match if both end with value.
41 41
 #' 
42
-#' @param semi_join_negation logical value: T => semijoin is perfomed 
42
+#' @param not_in logical value: T => semijoin is perfomed 
43 43
 #' considering semi_join NOT IN semi_join_dataset, F => semijoin is performed 
44 44
 #' considering semi_join IN semi_join_dataset
45 45
 #' 
46 46
 #' @param semi_join_dataset GMQLDataset class object
47
-#'
47
+#' @param ... Additional arguments for use in specific methods.
48
+#' 
48 49
 #' @return GMQLDataset class object. It contains the value to use as input 
49 50
 #' for the subsequent GMQL function
50 51
 #' 
... ...
@@ -56,7 +57,7 @@
56 57
 #' init_gmql()
57 58
 #' test_path <- system.file("example", "DATASET", package = "RGMQL")
58 59
 #' input <- read_dataset(test_path)
59
-#' s <- subset(input, Patient_age < 70)
60
+#' s <- filter(input, Patient_age < 70)
60 61
 #' 
61 62
 #' 
62 63
 #' \dontrun{
... ...
@@ -84,25 +85,14 @@
84 85
 #' 
85 86
 #' }
86 87
 #' 
87
-#' @name filter
88
-#' @rdname GMQLDataset-class
89
-#' @aliases filter, filter-methods
90
-#' 
91
-setGeneric("filter", function(data, m_predicate = NULL, r_predicate = NULL, 
92
-                    semi_join = NULL, semi_join_negation = FALSE, 
93
-                    semi_join_dataset = NULL) 
94
-    standardGeneric("filter"))
95
-
96
-#' @name filter
97
-#' @rdname filter-methods
98
-#' @aliases filter, filter-methods
88
+#' @aliases filter, filter-method
99 89
 #' @export
100 90
 setMethod("filter", "GMQLDataset",
101
-            function(data, m_predicate = NULL, r_predicate = NULL, 
102
-                    semi_join = NULL, semi_join_negation = FALSE, 
91
+            function(.data, m_predicate = NULL, r_predicate = NULL, 
92
+                    semi_join = NULL, not_in = FALSE, 
103 93
                     semi_join_dataset = NULL)
104 94
             {
105
-                val <- data@value
95
+                val <- .data@value
106 96
                 meta_pred <- substitute(m_predicate)
107 97
                 if(!is.null(meta_pred))
108 98
                 {
... ...
@@ -122,12 +112,11 @@ setMethod("filter", "GMQLDataset",
122 112
                     region_predicate <- .jnull("java/lang/String")
123 113
             
124 114
                 gmql_select(val, predicate, region_predicate, 
125
-                        semi_join, semi_join_negation, semi_join_dataset)
115
+                        semi_join, not_in, semi_join_dataset)
126 116
             })
127 117
 
128
-gmql_select <- function(input_data, predicate = NULL, region_predicate = NULL, 
129
-                    semi_join = NULL, semi_join_negation = FALSE, 
130
-                    semi_join_dataset = NULL)
118
+gmql_select <- function(input_data, predicate, region_predicate, semi_join, 
119
+                            semi_join_negation, semi_join_dataset)
131 120
 {
132 121
     if(is.null(semi_join) && is.null(semi_join_dataset))
133 122
     {
... ...
@@ -42,9 +42,9 @@
42 42
 #' 
43 43
 #' res <- union(data1, data2)
44 44
 #' 
45
-#' @rdname union-method
46
-#' @aliases union, union-method
47
-#' @export
45
+#' @rdname union-GMQLDataset-method
46
+#' @aliases union, union-method, 
47
+#' @export 
48 48
 #' 
49 49
 setMethod("union", c("GMQLDataset","GMQLDataset"),
50 50
             function(x, y)
... ...
@@ -59,11 +59,11 @@
59 59
 
60 60
 
61 61
 # meta join condition
62
-.join_condition <- function(conditions)
62
+.join_condition <- function(cond)
63 63
 {
64
-    if(is.list(conditions))
64
+    if(is.list(cond))
65 65
     {
66
-        join_condition_matrix <- t(sapply(conditions, function(x) {
66
+        join_condition_matrix <- t(sapply(cond, function(x) {
67 67
             new_value = as.character(x)
68 68
             if(length(new_value)==1)
69 69
                 new_value = c("DEF",new_value)
... ...
@@ -73,15 +73,15 @@
73 73
             matrix <- matrix(new_value)
74 74
         }))
75 75
     }
76
-    else if(is.character(conditions))
76
+    else if(is.character(cond))
77 77
     {
78
-        conditions = conditions[!conditions %in% ""]
79
-        conditions = conditions[!duplicated(conditions)]
80
-        if(length(conditions)<=0)
78
+        cond = cond[!cond %in% ""]
79
+        cond = cond[!duplicated(cond)]
80
+        if(length(cond)<=0)
81 81
             join_condition_matrix <- ""
82 82
         else
83 83
         {
84
-            join_condition_matrix <- t(sapply(conditions, function(x) {
84
+            join_condition_matrix <- t(sapply(cond, function(x) {
85 85
                 new_value = c("DEF",x)
86 86
                 matrix <- matrix(new_value)
87 87
             }))
... ...
@@ -86,7 +86,7 @@ take_value.META_AGGREGATES <- function(obj){
86 86
 #' ## then calculates new metadata attributes for each of them: 
87 87
 #' ## sum_score is the sum of score of the sample regions.
88 88
 #' 
89
-#' res = mutate(input_data = exp, list(sum_score = SUM("score")))
89
+#' res = extend(exp, sum_score = SUM("score"))
90 90
 #' 
91 91
 #' @export
92 92
 #'
... ...
@@ -128,7 +128,7 @@ SUM <- function(value)
128 128
 #' ## and then calculates new metadata attributes for each of them: 
129 129
 #' ## MinP is the minimum pvalue of the sample regions.
130 130
 #' 
131
-#' res = mutate(input_data = exp, list(minP = MIN("pvalue")))
131
+#' res = extend(exp, minP = MIN("pvalue"))
132 132
 #' 
133 133
 #' @export
134 134
 #'
... ...
@@ -171,7 +171,7 @@ MIN <- function(value)
171 171
 #' ## and then calculates new metadata attributes for each of them: 
172 172
 #' ## max_score is the maximum score of the sample regions.
173 173
 #' 
174
-#' res = mutate(input_data = exp, list(max_score = MAX("score")))
174
+#' res = extend(exp, max_score = MAX("score"))
175 175
 #' 
176 176
 #' 
177 177
 #' @export
... ...
@@ -215,7 +215,7 @@ MAX <- function(value)
215 215
 #' ## attributes the average signal of the overlapping regions; 
216 216
 #' ## the result has one sample for each input cell.
217 217
 #' 
218
-#' res = cover(input_data = exp,2,3, c("cell"), 
218
+#' res = cover(exp, 2, 3, c("cell"), 
219 219
 #' list(avg_signal = AVG("signal")))
220 220
 #'
221 221
 #' @export
... ...
@@ -259,7 +259,7 @@ AVG <- function(value)
259 259
 #' ## which is the aggregation comma-separated list of all the values 
260 260
 #' ## that the region attribute score takes in the sample.
261 261
 #' 
262
-#' out = mutate(input_data = data, list(allScore = BAG("score")))
262
+#' out = extend(data, allScore = BAG("score"))
263 263
 #'
264 264
 #' @export
265 265
 #'
... ...
@@ -297,7 +297,7 @@ BAG <- function(value)
297 297
 #' ## counts the regions in each sample and stores their number as value 
298 298
 #' ## of the new metadata RegionCount attribute of the sample.
299 299
 #' 
300
-#' out = mutate(input_data = exp, list(RegionCount = COUNT()))
300
+#' out = extend(exp, RegionCount = COUNT())
301 301
 #'
302 302
 #' @export
303 303
 #'
... ...
@@ -342,7 +342,7 @@ check.COUNT <- function(obj){}
342 342
 #' ## and then calculates new metadata attributes for each of them: 
343 343
 #' ## std_score is the standard deviation score of the sample regions.
344 344
 #' 
345
-#' res = mutate(input_data = exp, list(std_score = STD("score")))
345
+#' res = extend(exp, std_score = STD("score"))
346 346
 #'
347 347
 #' @export
348 348
 #'
... ...
@@ -383,7 +383,7 @@ STD <- function(value)
383 383
 #' ## and then calculates new metadata attributes for each of them: 
384 384
 #' ## m_score is the median score of the sample regions.
385 385
 #' 
386
-#' res = mutate(input_data = exp, list(m_score = MEDIAN("score")))
386
+#' res = extend(exp, m_score = MEDIAN("score"))
387 387
 #'
388 388
 #' @export
389 389
 #'
... ...
@@ -424,7 +424,7 @@ MEDIAN <- function(value)
424 424
 #' ## and then calculates new metadata attributes for each of them: 
425 425
 #' ## q1_score is the first quartile of score of the sample regions.
426 426
 #' 
427
-#' res = mutate(input_data = exp, list(q1_score = Q1("score")))
427
+#' res = extend(exp, q1_score = Q1("score"))
428 428
 #'
429 429
 #'
430 430
 #' @export
... ...
@@ -466,7 +466,7 @@ Q1 <- function(value)
466 466
 #' ## and then calculates new metadata attributes for each of them: 
467 467
 #' ## q2_score is the second quartile of score of the sample regions.
468 468
 #' 
469
-#' res = mutate(input_data = exp, list(q2_score = Q2("score")))
469
+#' res = extend(exp, q2_score = Q2("score"))
470 470
 #'
471 471
 #' @export
472 472
 #'
... ...
@@ -506,7 +506,7 @@ Q2 <- function(value)
506 506
 #' ## and then calculates new metadata attributes for each of them: 
507 507
 #' ## q3_score is the third quartile of score of the sample regions.
508 508
 #' 
509
-#' res = mutate(input_data = exp, list(q3_score = Q3("score")))
509
+#' res = extend(exp, q3_score = Q3("score"))
510 510
 #' 
511 511
 #' @export
512 512
 #'
... ...
@@ -549,7 +549,7 @@ Q3 <- function(value)
549 549
 #' ## aggregation comma-separated list of all the distinct values that 
550 550
 #' ## the region attribute score takes in the sample.
551 551
 #' 
552
-#' out = mutate(input_data = data, list(allScore = BAGD("score")))
552
+#' out = extend(data, allScore = BAGD("score"))
553 553
 #'
554 554
 #' @export
555 555
 #'
... ...
@@ -32,15 +32,21 @@ if(getRversion() >= "3.1.0")
32 32
 #' @return None
33 33
 #'
34 34
 #' @examples
35
-#' 
36
-#' ### login as guest
35
+#' ## login as guest
37 36
 #' remote_url = "http://130.186.13.219/gmql-rest"
37
+#' \dontrun{
38 38
 #' login_gmql(remote_url)
39
-#'
39
+#' }
40 40
 #' @export
41
-#'
41
+
42
+#' 
42 43
 login_gmql <- function(url, username = NULL, password = NULL)
43 44
 {
45
+    if(exists("authToken",envir = .GlobalEnv))
46
+    {
47
+        print("You are already logged")
48
+        return(invisible(NULL))
49
+    }
44 50
     as_guest <- TRUE
45 51
     
46 52
     if(!is.null(username) || !is.null(password))
... ...
@@ -77,7 +83,7 @@ login_gmql <- function(url, username = NULL, password = NULL)
77 83
 #' 
78 84
 #' Logout from GMQL REST services suite
79 85
 #' using the proper GMQL web service available on a remote server
80
-#'
86
+#' 
81 87
 #' @import httr
82 88
 #' @importFrom rJava J
83 89
 #' 
... ...
@@ -92,12 +98,12 @@ login_gmql <- function(url, username = NULL, password = NULL)
92 98
 #' If error occures a specific error is printed
93 99
 #' 
94 100
 #' @examples
95
-#'
96
-#' #### login as guest, then logout
101
+#' #' ## login as guest, then logout
97 102
 #' remote_url = "http://130.186.13.219/gmql-rest"
103
+#' \dontrun{
98 104
 #' login_gmql(remote_url)
99 105
 #' logout_gmql(remote_url)
100
-#'
106
+#' }
101 107
 #' @return None
102 108
 #'
103 109
 #' @export
... ...
@@ -2,7 +2,7 @@
2 2
 #'
3 3
 #' It shows all the GMQL query saved on repository 
4 4
 #' using the proper GMQL web service available on a remote server
5
-#'
5
+#' 
6 6
 #' @import httr
7 7
 #'
8 8
 #' @param url string url of server: It must contain the server address 
... ...
@@ -19,13 +19,13 @@
19 19
 #' @details
20 20
 #' if error occures, a specific error is printed
21 21
 #'
22
-#' @examples
23
-#'
22
+#' @examples 
24 23
 #' remote_url = "http://130.186.13.219/gmql-rest"
25 24
 #' 
25
+#' \dontrun{
26 26
 #' login_gmql(remote_url)
27 27
 #' list <- show_queries_list(remote_url)
28
-#'
28
+#' }
29 29
 #' @export
30 30
 #'
31 31
 show_queries_list <- function(url)
... ...
@@ -44,7 +44,7 @@ show_queries_list <- function(url)
44 44
 #'
45 45
 #' It saves the GMQL query into repository
46 46
 #' using the proper GMQL web service available on a remote server
47
-#'
47
+#' 
48 48
 #' @import httr
49 49
 #'
50 50
 #' @param url string url of server: It must contain the server address 
... ...
@@ -63,12 +63,13 @@ show_queries_list <- function(url)
63 63
 #' if no error occures print "Saved" otherwise print the content error
64 64
 #'
65 65
 #' @examples
66
-#'
67 66
 #' remote_url = "http://130.186.13.219/gmql-rest"
67
+#' \dontrun{
68
+#' 
68 69
 #' login_gmql(remote_url)
69 70
 #' save_query(remote_url, "dna_query", "DATASET = SELECT() HG19_TCGA_dnaseq; 
70 71
 #' MATERIALIZE DATASET INTO RESULT_DS;")
71
-#'
72
+#' }
72 73
 #' @export
73 74
 #'
74 75
 save_query <- function(url, queryName, queryTxt)
... ...
@@ -90,7 +91,8 @@ save_query <- function(url, queryName, queryTxt)
90 91
 #' It saves the GMQL query into repository taken from file
91 92
 #' using the proper GMQL web service available on a remote server
92 93
 #'
93
-#'
94
+#' 
95
+#' 
94 96
 #' @param url string url of server: It must contain the server address 
95 97
 #' and base url; service name is added automatically
96 98
 #' @param queryName string name of the GMQL query
... ...
@@ -106,14 +108,14 @@ save_query <- function(url, queryName, queryTxt)
106 108
 #' if no error occures print "Saved" otherwise print the content error
107 109
 #'
108 110
 #' @examples
109
-#'
110 111
 #' test_path <- system.file("example", package = "RGMQL")
111 112
 #' test_query <- file.path(test_path, "query1.txt")
112
-#'
113 113
 #' remote_url = "http://130.186.13.219/gmql-rest"
114
+#' \dontrun{
115
+#' 
114 116
 #' login_gmql(remote_url)
115 117
 #' save_query_fromfile(remote_url, "query1", test_query)
116
-#'
118
+#' }
117 119
 #' @export
118 120
 #'
119 121
 save_query_fromfile <- function(url, queryName, filePath)
... ...
@@ -22,13 +22,16 @@ print.CONDITION <- function(obj){
22 22
 }
23 23
 
24 24
 c.CONDITION <- function(...){
25
-    a <- list(...)
25
+    cond <- list(...)
26 26
 }
27 27
 
28 28
 check.CONDITION <- function(value)
29 29
 {
30
-    if(!is.character(value) || length(value)>1)
31
-        stop("value: no valid input or length > 1")
30
+    if(is.character(value) && length(value)>1)
31
+        stop("value: no multiple string")
32
+    
33
+    if(!is.character(value))
34
+        stop("value: is not a string")
32 35
 }
33 36
 
34 37
 
... ...
@@ -40,7 +40,7 @@ print.PARAMETER <- function(obj){
40 40
 #' init_gmql()
41 41
 #' test_path <- system.file("example", "DATASET", package = "RGMQL")
42 42
 #' exp = read_dataset(test_path)
43
-#' res = cover(input_data = exp, 2, ALL())
43
+#' res = cover(exp, 2, "ALL")
44 44
 #' 
45 45
 #' @export
46 46
 #'
... ...
@@ -72,8 +72,8 @@ ALL <- function()
72 72
 #' 
73 73
 #' init_gmql()
74 74
 #' test_path <- system.file("example", "DATASET", package = "RGMQL")
75
-#' exp = read_dataset(test_path)
76
-#' res = cover(input_data = exp, 2, ANY())
75
+#' dataset = read_dataset(test_path)
76
+#' res = cover(dataset, 2, "ANY")
77 77
 #'
78 78
 #'
79 79
 #' @export
... ...
@@ -2,7 +2,8 @@
2 2
 #'
3 3
 #' It show all GMQL dataset stored in repository using the proper GMQL 
4 4
 #' web service available on a remote server
5
-#'
5
+#' 
6
+#' 
6 7
 #' @import httr
7 8
 #' @param url single string url of server: It must contain the server address 
8 9
 #' and base url; service name is added automatically
... ...
@@ -21,13 +22,13 @@
21 22
 #' If error occures a specific error is printed
22 23
 #'
23 24
 #' @examples
24
-#'
25
-#' ## show dataset when logged as guest
26 25
 #' 
27
-#' remote_url <- "http://130.186.13.219/gmql-rest"
26
+#' @examples
27
+#' remote_url = "http://130.186.13.219/gmql-rest"
28
+#' \dontrun{
28 29
 #' login_gmql(remote_url)
29 30
 #' list <- show_datasets_list(remote_url)
30
-#'
31
+#' }
31 32
 #' @export
32 33
 #'
33 34
 show_datasets_list <- function(url)
... ...
@@ -47,7 +48,7 @@ show_datasets_list <- function(url)
47 48
 #'
48 49
 #' It show all sample from a specific GMQL dataset using the proper 
49 50
 #' GMQL web service available on a remote server
50
-#'
51
+#' 
51 52
 #' @import httr
52 53
 #'
53 54
 #' @param url string url of server: It must contain the server address 
... ...
@@ -69,11 +70,11 @@ show_datasets_list <- function(url)
69 70
 #' If error occures a specific error is printed
70 71
 #'
71 72
 #' @examples
72
-#'
73
-#' remote_url <- "http://130.186.13.219/gmql-rest"
73
+#' remote_url = "http://130.186.13.219/gmql-rest"
74
+#' \dontrun{
74 75
 #' login_gmql(remote_url)
75 76
 #' list <- show_samples_list(remote_url, "public.HG19_BED_ANNOTATION")
76
-#'
77
+#' }
77 78
 #' @export
78 79
 #'
79 80
 show_samples_list <- function(url,datasetName)
... ...
@@ -93,7 +94,7 @@ show_samples_list <- function(url,datasetName)
93 94
 #'
94 95
 #' It shows the region attribute schema of a specific GMQL dataset using 
95 96
 #' the proper GMQL web service available on a remote server
96
-#'
97
+#' 
97 98
 #' @import httr
98 99
 #' @param url string url of server: It must contain the server address 
99 100
 #' and base url; service name is added automatically
... ...
@@ -114,12 +115,11 @@ show_samples_list <- function(url,datasetName)
114 115
 #'
115 116
 #'
116 117
 #' @examples
117
-#'
118
-#' ### show schema of public dataset
119
-#' remote_url <- "http://130.186.13.219/gmql-rest"
118
+#' remote_url = "http://130.186.13.219/gmql-rest"
119
+#' \dontrun{
120 120
 #' login_gmql(remote_url)
121 121
 #' list <- show_schema(remote_url, "public.HG19_BED_ANNOTATION")
122
-#'
122
+#'}
123 123
 #' @export
124 124
 #'
125 125
 show_schema <- function(url,datasetName)
... ...
@@ -142,8 +142,7 @@ show_schema <- function(url,datasetName)
142 142
 #' It uploads a folder (GMQL or not) containing sample files using 
143 143
 #' the proper GMQL web service available on a remote server: 
144 144
 #' a new dataset is created on repository
145
-#'
146
-#'
145
+#' 
147 146
 #' @param url string url of server: It must contain the server address 
148 147
 #' and base url; service name is added automatically
149 148
 #' @param datasetName name of dataset to get
... ...
@@ -259,7 +258,7 @@ upload_dataset <- function(url,datasetName,folderPath,schemaName=NULL,
259 258
 #'
260 259
 #' It deletes single private dataset specified by name from repository 
261 260
 #' using the proper GMQL web service available on a remote server
262
-#'
261
+#' 
263 262
 #' @import httr
264 263
 #'
265 264
 #' @param url string url of server: It must contain the server address 
... ...
@@ -279,7 +278,7 @@ upload_dataset <- function(url,datasetName,folderPath,schemaName=NULL,
279 278
 #'
280 279
 #' \dontrun{
281 280
 #' 
282
-#' ### This dataset does not exist
281
+#' ## This dataset does not exist
283 282
 #' 
284 283
 #' remote_url <- "http://130.186.13.219/gmql-rest"
285 284
 #' login_gmql(remote_url)
... ...
@@ -306,7 +305,7 @@ delete_dataset <- function(url,datasetName)
306 305
 #'
307 306
 #' It donwloads private dataset as zip file from repository to local path 
308 307
 #' specified using the proper GMQL web service available on a remote server
309
-#'
308
+#' 
310 309
 #' @import httr
311 310
 #' @importFrom utils unzip
312 311
 #'
... ...
@@ -323,13 +322,15 @@ delete_dataset <- function(url,datasetName)
323 322
 #'
324 323
 #' @examples
325 324
 #'
326
-#' #### download dataset in r working directory
327
-#' #### in this case we try to download public dataset
325
+#' ## download dataset in r working directory
326
+#' ## in this case we try to download public dataset
327
+#' 
328
+#' \dontrun{
328 329
 #' 
329 330
 #' remote_url = "http://130.186.13.219/gmql-rest"
330 331
 #' login_gmql(remote_url)
331 332
 #' download_dataset(remote_url, "public.HG19_BED_ANNOTATION", path = getwd())
332
-#'
333
+#' }
333 334
 #' @export
334 335
 #'
335 336
 download_dataset <- function(url,datasetName,path = getwd())
... ...
@@ -355,7 +356,7 @@ download_dataset <- function(url,datasetName,path = getwd())
355 356
 #'
356 357
 #' It donwloads private dataset from repository saving into R environemnt 
357 358
 #' as GrangesList 
358
-#'
359
+#' 
359 360
 #' @import httr
360 361
 #' @importClassesFrom GenomicRanges GRangesList
361 362
 #' @importFrom S4Vectors metadata
... ...
@@ -415,7 +416,7 @@ download_as_GRangesList <- function(url,datasetName)
415 416
 #'
416 417
 #' It retrieves metadata for a specific sample in dataset using the proper 
417 418
 #' GMQL web service available on a remote server
418
-#'
419
+#' 
419 420
 #' @import httr
420 421
 #'
421 422
 #' @param url string url of server: It must contain the server address 
... ...
@@ -429,12 +430,11 @@ download_as_GRangesList <- function(url,datasetName)
429 430
 #' If error occures a specific error is printed
430 431
 #'
431 432
 #' @examples
432
-#'
433
-#' ## download metadata with real test login
434 433
 #' remote_url = "http://130.186.13.219/gmql-rest"
434
+#' \dontrun{
435 435
 #' login_gmql(remote_url)
436 436
 #' sample_metadata(remote_url, "public.HG19_BED_ANNOTATION", "genes")
437
-#'
437
+#'}
438 438
 #' @export
439 439
 #'
440 440
 sample_metadata <- function(url, datasetName,sampleName)
... ...
@@ -459,14 +459,13 @@ sample_metadata <- function(url, datasetName,sampleName)
459 459
 
460 460
 
461 461
 #' Shows regions from a dataset sample
462
-#'
463
-#'
462
+#' 
464 463
 #' It retrieves regions for a specific sample 
465 464
 #' (whose name is specified in the paramter "sampleName")
466 465
 #' in a specific dataset 
467 466
 #' (whose name is specified in the parameter "datasetName") 
468 467
 #' using the proper GMQL web service available on a remote server
469
-#'
468
+#' 
470 469
 #' @import httr
471 470
 #' @importFrom rtracklayer import
472 471
 #' @importFrom data.table fread
... ...
@@ -484,12 +483,11 @@ sample_metadata <- function(url, datasetName,sampleName)
484 483
 #' If error occures a specific error is printed
485 484
 #'
486 485
 #' @examples
487
-#'
488
-#' 
489 486
 #' remote_url = "http://130.186.13.219/gmql-rest"
487
+#' \dontrun{
490 488
 #' login_gmql(remote_url)
491 489
 #' sample_region(remote_url, "public.HG19_BED_ANNOTATION", "genes")
492
-#' 
490
+#' }
493 491
 #' 
494 492
 #' @export
495 493
 #'
... ...
@@ -58,14 +58,7 @@ as.character.OPERATOR <- function(obj) {
58 58
 #' init_gmql()
59 59
 #' test_path <- system.file("example", "DATASET", package = "RGMQL")
60 60
 #' exp = read_dataset(test_path)
61
-#' data = filter(exp, region_predicate = score > META("avg_score"));
62
-#' 
63
-#' 
64
-#' ## It define a new region attribute with the value of a metadata attribute 
65
-#' ## using the syntax region_attribute AS META(metadata_attribute, type)
66
-#' 
67
-#' out = subset(exp, regions_update = list(signal = META("avg_signal", 
68
-#' "DOUBLE")))
61
+#' data = filter(exp, r_predicate = score > META("avg_score"))
69 62
 #' 
70 63
 #' 
71 64
 #' @export
... ...
@@ -21,12 +21,12 @@ check.ORDER <- function(value)
21 21
 }
22 22
 
23 23
 print.ORDER <- function(obj) {
24
-    as.character(obj)
24
+    as.character(as.character.ORDER(obj))
25 25
 }
26 26
 
27
-c.ORDER <- function(...) {
28
-    a <- list(...)
29
-}
27
+#c.ORDER <- function(...) {
28
+#    a <- list(...)
29
+#}
30