... | ... |
@@ -1,7 +1,7 @@ |
1 | 1 |
Package: RGMQL |
2 | 2 |
Type: Package |
3 | 3 |
Title: GenoMetric Query Language for R/Bioconductor |
4 |
-Version: 0.99.4 |
|
4 |
+Version: 0.99.5 |
|
5 | 5 |
Author: Simone Pallotta, Marco Masseroli |
6 | 6 |
Maintainer: Simone Pallotta <simonepallotta@hotmail.com> |
7 | 7 |
Description: This package brings GMQL functionalities into R environemnt. |
... | ... |
@@ -22,7 +22,7 @@ Encoding: UTF-8 |
22 | 22 |
LazyData: true |
23 | 23 |
RoxygenNote: 6.0.1 |
24 | 24 |
Imports: httr, rJava,GenomicRanges, rtracklayer, data.table, utils, plyr, xml2, methods, S4Vectors, dplyr, stats |
25 |
-Depends: R(>= 3.3.3) |
|
25 |
+Depends: R(>= 3.4.0) |
|
26 | 26 |
VignetteBuilder: knitr |
27 | 27 |
Suggests: BiocStyle, knitr, rmarkdown |
28 | 28 |
biocViews: Software,Infrastructure,DataImport |
... | ... |
@@ -26,8 +26,10 @@ |
26 | 26 |
#' |
27 | 27 |
importGMQL.gtf <- function(datasetName) |
28 | 28 |
{ |
29 |
- datasetName <- paste0(datasetName,"/files") |
|
30 |
- |
|
29 |
+ datasetName <- sub("/*[/]$","",datasetName) |
|
30 |
+ if(basename(datasetName) !="files") |
|
31 |
+ datasetName <- paste0(datasetName,"/files") |
|
32 |
+ |
|
31 | 33 |
if(!dir.exists(datasetName)) |
32 | 34 |
stop("Directory does not exists") |
33 | 35 |
|
... | ... |
@@ -86,7 +88,9 @@ importGMQL.gtf <- function(datasetName) |
86 | 88 |
#' |
87 | 89 |
importGMQL.gdm <- function(datasetName) |
88 | 90 |
{ |
89 |
- datasetName <- paste0(datasetName,"/files") |
|
91 |
+ datasetName <- sub("/*[/]$","",datasetName) |
|
92 |
+ if(basename(datasetName) !="files") |
|
93 |
+ datasetName <- paste0(datasetName,"/files") |
|
90 | 94 |
|
91 | 95 |
if(!dir.exists(datasetName)) |
92 | 96 |
stop("Directory does not exists") |
... | ... |
@@ -154,6 +154,9 @@ readDataset <- function(dataset, parser = "CustomParser", is_local=TRUE, |
154 | 154 |
#' |
155 | 155 |
#' |
156 | 156 |
#' @importFrom S4Vectors metadata |
157 |
+#' @importFrom rJava J |
|
158 |
+#' @importFrom rJava .jarray |
|
159 |
+#' |
|
157 | 160 |
#' @param samples GrangesList |
158 | 161 |
#' |
159 | 162 |
#' |
... | ... |
@@ -171,9 +174,14 @@ read <- function(samples) |
171 | 174 |
stop("only GrangesList") |
172 | 175 |
|
173 | 176 |
meta <- S4Vectors::metadata(samples) |
174 |
- if(is.null(meta)) { |
|
177 |
+ if(is.null(meta) || length(meta)==0) { |
|
178 |
+ #repeat meta for each sample in samples list |
|
179 |
+ len <- length(samples) |
|
175 | 180 |
warning("GrangesList has no metadata. we provide two metadata for you") |
176 |
- meta_matrix <- matrix(c("Provider","Polimi", "Application", "R-GMQL"),ncol = 2,byrow = TRUE) |
|
181 |
+ index_meta <- rep(1:len,each = len) |
|
182 |
+ rep_meta <- rep(c("Provider","Polimi", "Application", "R-GMQL"),times=len) |
|
183 |
+ meta_matrix <- matrix(rep_meta,ncol = 2,byrow = TRUE) |
|
184 |
+ meta_matrix <- cbind(index_meta,meta_matrix) |
|
177 | 185 |
} |
178 | 186 |
else { |
179 | 187 |
unlist_meta <- unlist(meta) |
... | ... |
@@ -185,7 +193,8 @@ read <- function(samples) |
185 | 193 |
df <- data.frame(samples) |
186 | 194 |
df <- df[-2] #delete group_name |
187 | 195 |
region_matrix <- as.matrix(sapply(df, as.character)) |
188 |
- region_matrix<- region_matrix[,setdiff(colnames(region_matrix),"width")] |
|
196 |
+ region_matrix[is.na(region_matrix)] <- "NA" |
|
197 |
+ region_matrix <- region_matrix[,setdiff(colnames(region_matrix),"width")] |
|
189 | 198 |
col_types <- sapply(df,class) |
190 | 199 |
col_names <- names(col_types) |
191 | 200 |
#re order the schema? |
... | ... |
@@ -203,6 +212,12 @@ read <- function(samples) |
203 | 212 |
} |
204 | 213 |
rownames(schema_matrix) <- NULL |
205 | 214 |
colnames(schema_matrix) <- NULL |
215 |
+ |
|
216 |
+ schema_matrix <- .jarray(schema_matrix,dispatch = TRUE) |
|
217 |
+ meta_matrix <- .jarray(meta_matrix,dispatch = TRUE) |
|
218 |
+ region_matrix <- .jarray(region_matrix,dispatch = TRUE) |
|
219 |
+ |
|
220 |
+ |
|
206 | 221 |
WrappeR <- J("it/polimi/genomics/r/Wrapper") |
207 | 222 |
response <- WrappeR$read(meta_matrix,region_matrix,schema_matrix) |
208 | 223 |
DAGgraph(response) |
... | ... |
@@ -233,7 +248,9 @@ read <- function(samples) |
233 | 248 |
#' |
234 | 249 |
#' @param is_remote single logical value used in order to set the processing mode. |
235 | 250 |
#' TRUE you will set a remote query processing mode otherwise will be local |
236 |
-#' |
|
251 |
+#' |
|
252 |
+#' @return None |
|
253 |
+#' |
|
237 | 254 |
#' @examples |
238 | 255 |
#' |
239 | 256 |
#' # initialize with remote processing off |
... | ... |
@@ -2,8 +2,8 @@ |
2 | 2 |
# source("https://bioconductor.org/biocLite.R") |
3 | 3 |
# biocLite("RGMQL") |
4 | 4 |
|
5 |
-## ---- initialization, eval=FALSE----------------------------------------- |
|
6 |
-# library('RGMQL') |
|
5 |
+## ---- initialization, eval=TRUE------------------------------------------ |
|
6 |
+library('RGMQL') |
|
7 | 7 |
|
8 | 8 |
## ---- init, eval=FALSE--------------------------------------------------- |
9 | 9 |
# initGMQL() |
... | ... |
@@ -21,6 +21,7 @@ |
21 | 21 |
# data_out = readDataset("dataset_name_on_repo") |
22 | 22 |
|
23 | 23 |
## ---- read GRangesList, eval=FALSE--------------------------------------- |
24 |
+# library("GenomicRanges") |
|
24 | 25 |
# gr1 <- GRanges(seqnames = "chr2", |
25 | 26 |
# ranges = IRanges(103, 106), |
26 | 27 |
# strand = "+", |
... | ... |
@@ -62,9 +63,9 @@ library("RGMQL") |
62 | 63 |
test_url = "http://130.186.13.219/gmql-rest" |
63 | 64 |
login.GMQL(test_url) |
64 | 65 |
|
65 |
-## ---- eval=FALSE--------------------------------------------------------- |
|
66 |
-# test_url = "http://130.186.13.219/gmql-rest" |
|
67 |
-# login.GMQL(test_url) |
|
68 |
-# runQuery(test_url, "query_1", "DATA_SET_VAR = SELECT() HG19_TCGA_dnaseq; |
|
69 |
-# MATERIALIZE DATA_SET_VAR INTO RESULT_DS;", output_gtf = FALSE) |
|
66 |
+## ---- eval=TRUE---------------------------------------------------------- |
|
67 |
+test_url = "http://130.186.13.219/gmql-rest" |
|
68 |
+login.GMQL(test_url) |
|
69 |
+runQuery(test_url, "query_1", "DATA_SET_VAR = SELECT() HG19_TCGA_dnaseq; |
|
70 |
+ MATERIALIZE DATA_SET_VAR INTO RESULT_DS;", output_gtf = FALSE) |
|
70 | 71 |
|
... | ... |
@@ -84,7 +84,7 @@ managing datasets (both GMQL or generic text plain dataset). |
84 | 84 |
### Initialization |
85 | 85 |
|
86 | 86 |
Load and attach the GMQL package in an R session using library function: |
87 |
-```{r, initialization, eval=FALSE} |
|
87 |
+```{r, initialization, eval=TRUE} |
|
88 | 88 |
library('RGMQL') |
89 | 89 |
``` |
90 | 90 |
Before starting using any GMQL operation we need to initialise the GMQL context |
... | ... |
@@ -128,6 +128,7 @@ There is no need to explicitally download data since execution will trigger down |
128 | 128 |
Also, for better integration in R environment and with other packages, we provide a function |
129 | 129 |
to read from GrangesList, for example: |
130 | 130 |
```{r, read GRangesList, eval=FALSE} |
131 |
+library("GenomicRanges") |
|
131 | 132 |
gr1 <- GRanges(seqnames = "chr2", |
132 | 133 |
ranges = IRanges(103, 106), |
133 | 134 |
strand = "+", |
... | ... |
@@ -223,7 +224,7 @@ wit this token you can call all the funciton in web services suite. |
223 | 224 |
#### Execution |
224 | 225 |
|
225 | 226 |
User can write the query as in the following example, as the second parameter of *runQuery*. |
226 |
-```{r, eval=FALSE} |
|
227 |
+```{r, eval=TRUE} |
|
227 | 228 |
test_url = "http://130.186.13.219/gmql-rest" |
228 | 229 |
login.GMQL(test_url) |
229 | 230 |
runQuery(test_url, "query_1", "DATA_SET_VAR = SELECT() HG19_TCGA_dnaseq; |
... | ... |
@@ -10,6 +10,9 @@ remote_processing(is_remote) |
10 | 10 |
\item{is_remote}{single logical value used in order to set the processing mode. |
11 | 11 |
TRUE you will set a remote query processing mode otherwise will be local} |
12 | 12 |
} |
13 |
+\value{ |
|
14 |
+None |
|
15 |
+} |
|
13 | 16 |
\description{ |
14 | 17 |
It allows to enable or disable remote processing |
15 | 18 |
} |
... | ... |
@@ -84,7 +84,7 @@ managing datasets (both GMQL or generic text plain dataset). |
84 | 84 |
### Initialization |
85 | 85 |
|
86 | 86 |
Load and attach the GMQL package in an R session using library function: |
87 |
-```{r, initialization, eval=FALSE} |
|
87 |
+```{r, initialization, eval=TRUE} |
|
88 | 88 |
library('RGMQL') |
89 | 89 |
``` |
90 | 90 |
Before starting using any GMQL operation we need to initialise the GMQL context |
... | ... |
@@ -127,7 +127,8 @@ There is no need to explicitally download data since execution will trigger down |
127 | 127 |
4. GrangesList:\newline |
128 | 128 |
Also, for better integration in R environment and with other packages, we provide a function |
129 | 129 |
to read from GrangesList, for example: |
130 |
-```{r, read GRangesList, eval=FALSE} |
|
130 |
+```{r, read GRangesList, eval=TRUE} |
|
131 |
+library("GenomicRanges") |
|
131 | 132 |
gr1 <- GRanges(seqnames = "chr2", |
132 | 133 |
ranges = IRanges(103, 106), |
133 | 134 |
strand = "+", |
... | ... |
@@ -223,7 +224,7 @@ wit this token you can call all the funciton in web services suite. |
223 | 224 |
#### Execution |
224 | 225 |
|
225 | 226 |
User can write the query as in the following example, as the second parameter of *runQuery*. |
226 |
-```{r, eval=FALSE} |
|
227 |
+```{r, eval=TRUE} |
|
227 | 228 |
test_url = "http://130.186.13.219/gmql-rest" |
228 | 229 |
login.GMQL(test_url) |
229 | 230 |
runQuery(test_url, "query_1", "DATA_SET_VAR = SELECT() HG19_TCGA_dnaseq; |