| ... | ... |
@@ -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 |
