Browse code

show_all_metadata use one rest call API

Simone authored on 26/05/2021 07:14:40
Showing4 changed files

... ...
@@ -1,7 +1,7 @@
1 1
 Package: RGMQL
2 2
 Type: Package
3 3
 Title: GenoMetric Query Language for R/Bioconductor
4
-Version: 1.13.1
4
+Version: 1.13.2
5 5
 Authors@R: c(person(given = "Simone",
6 6
            family = "Pallotta",
7 7
            role = c("aut", "cre"),
... ...
@@ -61,18 +61,34 @@ show_all_metadata <- function(dataset, show_value = FALSE) {
61 61
 .show_all_metadata_remote_dataset <- function(dataset, show_value) {
62 62
     url <- GMQL_credentials$remote_url
63 63
     
64
-    #first we download all the region file name and its ID
65
-    region_list <- show_samples_list(url, dataset)
64
+    metdata_matrix_list <- .metadata_matrix(url, dataset)
66 65
     
67
-    metadata_list <-lapply(region_list$samples, function(x) {
68
-        sample_metadata(url, dataset, x$name)
69
-    })  
66
+    #first we get all the region file name
67
+    name_samples <- vapply(
68
+        metdata_matrix_list$samples, 
69
+        function(x) { x$name }, 
70
+        character(1))
71
+
72
+    #first we get all the attributes name
73
+    metadata_list <- vapply(
74
+        metdata_matrix_list$attributes, 
75
+        function(x) { x$key }, 
76
+        character(1))
77
+    
78
+    list_array <- sapply(metdata_matrix_list$matrix, function(x) {
79
+        x[sapply(x, is.null)] <- NA
80
+        unlist(x)
81
+    })
82
+
83
+    data_frame <- as.data.frame(t(list_array))
84
+    row.names(data_frame) <- metadata_list
85
+    colnames(data_frame) <- name_samples
70 86
     
71
-    name_samples <- sapply(region_list$samples, function(x) {
72
-        x$name
73
-    })  
87
+    if(!show_value) {
88
+        data_frame <- as.data.frame(!is.na(data_frame))
89
+    }
74 90
     
75
-    .create_dataFrame(metadata_list, name_samples, show_value)
91
+    return(data_frame)
76 92
 }
77 93
 
78 94
 .show_all_metadata_downloaded_dataset <- function(dataset, show_value) {
... ...
@@ -113,7 +129,7 @@ show_all_metadata <- function(dataset, show_value = FALSE) {
113 129
 
114 130
 .create_dataFrame <- function(meta_list, name_samples, show_value) {
115 131
     names(meta_list) <- name_samples
116
-    
132
+  
117 133
     set_meta <- unique(
118 134
         unlist(
119 135
             sapply(meta_list, names)
... ...
@@ -1352,3 +1352,25 @@ serialize_query <- function(url,output_gtf,base64) {
1352 1352
     schema
1353 1353
 }
1354 1354
 
1355
+.metadata_matrix <- function(url, datasetName) {
1356
+  url <- sub("/*[/]$", "", url)
1357
+  URL <- paste0(url, "/metadata/", datasetName, "/", "dataset/matrix")
1358
+  authToken = GMQL_credentials$authToken
1359
+  h <- c(
1360
+      'X-Auth-Token' = authToken, 
1361
+      'Accpet' = 'application/json',
1362
+      'Content-Type' = 'application/json')
1363
+  req <- httr::POST(
1364
+      URL, 
1365
+      body = '{"attributes": []}' ,
1366
+      httr::add_headers(h), 
1367
+      encode = "json"
1368
+  )
1369
+  content <- httr::content(req,"parsed")
1370
+
1371
+  if (req$status_code != 200) {
1372
+    stop(content)
1373
+  } else {
1374
+    return(content)
1375
+  }
1376
+}
... ...
@@ -1,4 +1,25 @@
1
-CHANGES IN VERSION 1.11.1
1
+CHANGES IN VERSION 1.12.2
2
+-------------------------
3
+
4
+NEW FEATURES
5
+
6
+    o None
7
+
8
+SIGNIFICANT USER-VISIBLE CHANGES
9
+
10
+    o None
11
+
12
+DEPRECATED AND DEFUNCT
13
+
14
+    o None
15
+    
16
+BUG FIXES
17
+
18
+    o changed implementation show_all_metadata() for better preformance
19
+    
20
+
21
+
22
+CHANGES IN VERSION 1.12.1
2 23
 -------------------------
3 24
 
4 25
 NEW FEATURES