1. RGMQL
  2. R
  3. Utils.R
Browse code

biocheck

Simone authored on 17/05/2021 09:41:45
Showing 1 changed files
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")
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)
87 87 
 }
88 88
89 89
90 90 
 # meta join condition
91 91 
 .join_condition <- function(cond) {
92 
-  cond_matrix <- NULL
93 
-  def <- cond$condition$def
94 
-  if(!is.null(def))
95 
-    cond_matrix <- rbind(cond_matrix, def)
96 
-
97 
-  exact <- cond$condition$exact
98 
-  if(!is.null(exact))
99 
-    cond_matrix <- rbind(cond_matrix, exact)
100 
-
101 
-  full <- cond$condition$full
102 
-  if(!is.null(full))
103 
-    cond_matrix <- rbind(cond_matrix, full)
104 
-  cond_matrix
92 
+    cond_matrix <- NULL
93 
+    def <- cond$condition$def
94 
+    if(!is.null(def))
95 
+        cond_matrix <- rbind(cond_matrix, def)
96 
+
97 
+    exact <- cond$condition$exact
98 
+    if(!is.null(exact))
99 
+        cond_matrix <- rbind(cond_matrix, exact)
100 
+
101 
+    full <- cond$condition$full
102 
+    if(!is.null(full))
103 
+        cond_matrix <- rbind(cond_matrix, full)
104 
+    cond_matrix
105 105 
 }
106 106
107 107 
 .check_input <- function(value) {
108 
-  if(!is.character(value))
109 
-    stop("no valid data")
110 
-
111 
-  if(length(value)>1)
112 
-    stop("no multiple string")
108 
+    if(!is.character(value))
109 
+        stop("no valid data")
110 
+
111 
+    if(length(value)>1)
112 
+        stop("no multiple string")
113 113 
 }
114 114
115 115 
 .check_logical <- function(value) {
116 
-  if(!is.logical(value))
117 
-    stop("no valid data")
118 
-
119 
-  if(length(value)>1)
120 
-    stop("no multiple string")
116 
+    if(!is.logical(value))
117 
+        stop("no valid data")
118 
+
119 
+    if(length(value)>1)
120 
+        stop("no multiple string")
121 121 
 }
122 122
123 123 
 .is_login_expired <- function(url) {
124 
-  if(exists("GMQL_credentials", envir = .GlobalEnv)) {
125 
-    if(exists("authToken", where = GMQL_credentials)) {
126 
-      authToken <- GMQL_credentials$authToken
127 
-      url <- sub("/*[/]$","",url)
128 
-      h <- c('Accept' = 'Application/json', 'X-Auth-Token' = authToken)
129 
-      URL <- paste0(url,"/user")
130 
-      req <- httr::GET(URL,httr::add_headers(h))
131 
-      if(req$status_code != 200)
132 
-        return(TRUE)
133 
-      else
134 
-        return(FALSE)
124 
+    if(exists("GMQL_credentials", envir = .GlobalEnv)) {
125 
+        if(exists("authToken", where = GMQL_credentials)) {
126 
+            authToken <- GMQL_credentials$authToken
127 
+            url <- sub("/*[/]$","",url)
128 
+            h <- c('Accept' = 'Application/json', 'X-Auth-Token' = authToken)
129 
+            URL <- paste0(url,"/user")
130 
+            req <- httr::GET(URL,httr::add_headers(h))
131 
+            if(req$status_code != 200)
132 
+                return(TRUE)
133 
+            else
134 
+                return(FALSE)
135 
+        }
135 136 
     }
136 
-  }
137 
-  return(TRUE)
137 
+    return(TRUE)
138 138 
 }
Browse code

update with some news

Simone authored on 21/03/2021 14:34:30
Showing 1 changed files
R/Utils.R
History View file @ 73652f4
1 1 
old mode 100644
2 2 
new mode 100755
... ... 
@@ -1,133 +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(datasetName, pattern = "*.schema$",
19 
-                                full.names = TRUE)
20 
-
21 
-    schema_name_xml <- list.files(datasetName, pattern = "*.xml$",
22 
-                                full.names = TRUE)
23 
-
24 
-    if(!length(schema_name) && !length(schema_name_xml))
25 
-        stop("schema not present")
26 
-
27 
-    if(!length(schema_name))
28 
-        xml_schema <- xml2::read_xml(schema_name_xml)
29 
-    else
30 
-        xml_schema <- xml2::read_xml(schema_name)
31 
-
32 
-    list_field <- xml2::as_list(xml_schema)
33 
-    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)
34 38 
 }
35 39
36 40 
 .schema_type_coordinate <- function(datasetName) {
37 
-    schema_name <- list.files(datasetName, pattern = "*.schema$",
38 
-                              full.names = TRUE)
39 
-
40 
-    schema_name_xml <- list.files(datasetName, pattern = "*.xml$",
41 
-                                  full.names = TRUE)
42 
-
43 
-    if(!length(schema_name) && !length(schema_name_xml))
44 
-        stop("schema not present")
45 
-
46 
-    if(!length(schema_name))
47 
-        xml_schema <- xml2::read_xml(schema_name_xml)
48 
-    else
49 
-        xml_schema <- xml2::read_xml(schema_name)
50 
-
51 
-    gmql_schema_tag <- xml2::xml_children(xml_schema)
52 
-    all_attrs <- xml2::xml_attrs(gmql_schema_tag)
53 
-    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]])
54 62 
 }
55 63
56 64 
 # aggregates factory
57 65 
 .aggregates <- function(meta_data,class) {
58 
-    if(!is.list(meta_data))
59 
-        stop("meta_data: invalid input")
60 
-
61 
-    if(!all(vapply(meta_data, function(x) is(x,class), logical(1))))
62 
-        stop("All elements must be META_AGGREGATES object")
63 
-
64 
-    names <- names(meta_data)
65 
-    if(is.null(names))
66 
-    {
67 
-        warning("You did not assign a names to a list.\nWe build it for you")
68 
-        names <- vapply(meta_data, take_value.META_AGGREGATES,character(1))
69 
-    }
70 
-    else
71 
-    {
72 
-        if("" %in% names)
73 
-            stop("No partial names assignment is allowed")
74 
-    }
75 
-    aggregate_matrix <- t(vapply(meta_data, function(x) {
76 
-        new_value = as.character(x)
77 
-        matrix <- matrix(new_value)
78 
-    },character(2)))
79 
-
80 
-    m_names <- matrix(names)
81 
-    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")
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)
82 87 
 }
83 88
84 89
85 90 
 # meta join condition
86 91 
 .join_condition <- function(cond) {
87 
-    cond_matrix <- NULL
88 
-    def <- cond$condition$def
89 
-    if(!is.null(def))
90 
-        cond_matrix <- rbind(cond_matrix, def)
91 
-
92 
-    exact <- cond$condition$exact
93 
-    if(!is.null(exact))
94 
-        cond_matrix <- rbind(cond_matrix, exact)
95 
-
96 
-    full <- cond$condition$full
97 
-    if(!is.null(full))
98 
-        cond_matrix <- rbind(cond_matrix, full)
99 
-    cond_matrix
92 
+  cond_matrix <- NULL
93 
+  def <- cond$condition$def
94 
+  if(!is.null(def))
95 
+    cond_matrix <- rbind(cond_matrix, def)
96 
+
97 
+  exact <- cond$condition$exact
98 
+  if(!is.null(exact))
99 
+    cond_matrix <- rbind(cond_matrix, exact)
100 
+
101 
+  full <- cond$condition$full
102 
+  if(!is.null(full))
103 
+    cond_matrix <- rbind(cond_matrix, full)
104 
+  cond_matrix
100 105 
 }
101 106
102 107 
 .check_input <- function(value) {
103 
-    if(!is.character(value))
104 
-        stop("no valid data")
105 
-
106 
-    if(length(value)>1)
107 
-        stop("no multiple string")
108 
+  if(!is.character(value))
109 
+    stop("no valid data")
110 
+
111 
+  if(length(value)>1)
112 
+    stop("no multiple string")
108 113 
 }
109 114
110 115 
 .check_logical <- function(value) {
111 
-    if(!is.logical(value))
112 
-        stop("no valid data")
113 
-
114 
-    if(length(value)>1)
115 
-        stop("no multiple string")
116 
+  if(!is.logical(value))
117 
+    stop("no valid data")
118 
+
119 
+  if(length(value)>1)
120 
+    stop("no multiple string")
116 121 
 }
117 122
118 123 
 .is_login_expired <- function(url) {
119 
-    if(exists("GMQL_credentials", envir = .GlobalEnv)) {
120 
-        if(exists("authToken", where = GMQL_credentials)) {
121 
-            authToken <- GMQL_credentials$authToken
122 
-            url <- sub("/*[/]$","",url)
123 
-            h <- c('Accept' = 'Application/json', 'X-Auth-Token' = authToken)
124 
-            URL <- paste0(url,"/user")
125 
-            req <- httr::GET(URL,httr::add_headers(h))
126 
-            if(req$status_code != 200)
127 
-                return(TRUE)
128 
-            else
129 
-                return(FALSE)
130 
-        }
124 
+  if(exists("GMQL_credentials", envir = .GlobalEnv)) {
125 
+    if(exists("authToken", where = GMQL_credentials)) {
126 
+      authToken <- GMQL_credentials$authToken
127 
+      url <- sub("/*[/]$","",url)
128 
+      h <- c('Accept' = 'Application/json', 'X-Auth-Token' = authToken)
129 
+      URL <- paste0(url,"/user")
130 
+      req <- httr::GET(URL,httr::add_headers(h))
131 
+      if(req$status_code != 200)
132 
+        return(TRUE)
133 
+      else
134 
+        return(FALSE)
131 135 
     }
132 
-    return(TRUE)
136 
+  }
137 
+  return(TRUE)
133 138 
 }
Browse code

fix take and read

Simone authored on 09/02/2021 09:07:32
Showing 1 changed files
R/Utils.R
History View file @ 4ad2435
... ... 
@@ -1,6 +1,5 @@
1 1
2 
-.counter <- function(zero = 0)
3 
-{
2 
+.counter <- function(zero = 0) {
4 3 
     i <- zero
5 4 
     function() {
6 5 
         i <<- i + 1
... ... 
@@ -8,16 +7,14 @@
8 7 
     }
9 8 
 }
10 9
11 
-.add_metadata <- function(files)
12 
-{
10 
+.add_metadata <- function(files) {
13 11 
     x <- scan(files, what="", sep="\n")
14 12 
     y <- strsplit(x, "\t")
15 13 
     names(y) <- vapply(y, `[[`,character(1), 1)
16 14 
     listMeta <- lapply(y, `[`, -1)
17 15 
 }
18 16
19 
-.schema_header <- function(datasetName)
20 
-{
17 
+.schema_header <- function(datasetName) {
21 18 
     schema_name <- list.files(datasetName, pattern = "*.schema$",
22 19 
                                 full.names = TRUE)
23 20
... ... 
@@ -36,8 +33,7 @@
36 33 
     vector_field <- unlist(list_field)
37 34 
 }
38 35
39 
-.schema_type_coordinate <- function(datasetName)
40 
-{
36 
+.schema_type_coordinate <- function(datasetName) {
41 37 
     schema_name <- list.files(datasetName, pattern = "*.schema$",
42 38 
                               full.names = TRUE)
43 39
... ... 
@@ -58,8 +54,7 @@
58 54 
 }
59 55
60 56 
 # aggregates factory
61 
-.aggregates <- function(meta_data,class)
62 
-{
57 
+.aggregates <- function(meta_data,class) {
63 58 
     if(!is.list(meta_data))
64 59 
         stop("meta_data: invalid input")
65 60
... ... 
@@ -88,8 +83,7 @@
88 83
89 84
90 85 
 # meta join condition
91 
-.join_condition <- function(cond)
92 
-{
86 
+.join_condition <- function(cond) {
93 87 
     cond_matrix <- NULL
94 88 
     def <- cond$condition$def
95 89 
     if(!is.null(def))
... ... 
@@ -105,8 +99,7 @@
105 99 
     cond_matrix
106 100 
 }
107 101
108 
-.check_input <- function(value)
109 
-{
102 
+.check_input <- function(value) {
110 103 
     if(!is.character(value))
111 104 
         stop("no valid data")
112 105
... ... 
@@ -114,8 +107,7 @@
114 107 
         stop("no multiple string")
115 108 
 }
116 109
117 
-.check_logical <- function(value)
118 
-{
110 
+.check_logical <- function(value) {
119 111 
     if(!is.logical(value))
120 112 
         stop("no valid data")
121 113
... ... 
@@ -123,18 +115,15 @@
123 115 
         stop("no multiple string")
124 116 
 }
125 117
126 
-.is_login_expired <- function(url)
127 
-{
128 
-    if(exists("GMQL_credentials", envir = .GlobalEnv))
129 
-    {
130 
-        if(exists("authToken", where = GMQL_credentials))
131 
-        {
118 
+.is_login_expired <- function(url) {
119 
+    if(exists("GMQL_credentials", envir = .GlobalEnv)) {
120 
+        if(exists("authToken", where = GMQL_credentials)) {
132 121 
             authToken <- GMQL_credentials$authToken
133 122 
             url <- sub("/*[/]$","",url)
134 123 
             h <- c('Accept' = 'Application/json', 'X-Auth-Token' = authToken)
135 124 
             URL <- paste0(url,"/user")
136 125 
             req <- httr::GET(URL,httr::add_headers(h))
137 
-            if(req$status_code !=200)
126 
+            if(req$status_code != 200)
138 127 
                 return(TRUE)
139 128 
             else
140 129 
                 return(FALSE)
... ... 
@@ -142,5 +131,3 @@
142 131 
     }
143 132 
     return(TRUE)
144 133 
 }
145 
-
146 
-
Browse code

vignette, add conversion 0-based/1-based

Simone authored on 18/02/2018 15:45:34
Showing 1 changed files
R/Utils.R
History View file @ a5e2122
... ... 
@@ -36,6 +36,27 @@
36 36 
     vector_field <- unlist(list_field)
37 37 
 }
38 38
39 
+.schema_type_coordinate <- function(datasetName)
40 
+{
41 
+    schema_name <- list.files(datasetName, pattern = "*.schema$",
42 
+                              full.names = TRUE)
43 
+
44 
+    schema_name_xml <- list.files(datasetName, pattern = "*.xml$",
45 
+                                  full.names = TRUE)
46 
+
47 
+    if(!length(schema_name) && !length(schema_name_xml))
48 
+        stop("schema not present")
49 
+
50 
+    if(!length(schema_name))
51 
+        xml_schema <- xml2::read_xml(schema_name_xml)
52 
+    else
53 
+        xml_schema <- xml2::read_xml(schema_name)
54 
+
55 
+    gmql_schema_tag <- xml2::xml_children(xml_schema)
56 
+    all_attrs <- xml2::xml_attrs(gmql_schema_tag)
57 
+    all_attrs_list <- as.list(all_attrs[[1]])
58 
+}
59 
+
39 60 
 # aggregates factory
40 61 
 .aggregates <- function(meta_data,class)
41 62 
 {
Browse code

fix

Simone authored on 19/01/2018 11:06:58
Showing 1 changed files
R/Utils.R
History View file @ dda0cfa
... ... 
@@ -20,13 +20,18 @@
20 20 
 {
21 21 
     schema_name <- list.files(datasetName, pattern = "*.schema$",
22 22 
                                 full.names = TRUE)
23 
+
23 24 
     schema_name_xml <- list.files(datasetName, pattern = "*.xml$",
24 25 
                                 full.names = TRUE)
25 26
26 27 
     if(!length(schema_name) && !length(schema_name_xml))
27 28 
         stop("schema not present")
28 29
29 
-    xml_schema <- xml2::read_xml(schema_name)
30 
+    if(!length(schema_name))
31 
+        xml_schema <- xml2::read_xml(schema_name_xml)
32 
+    else
33 
+        xml_schema <- xml2::read_xml(schema_name)
34 
+
30 35 
     list_field <- xml2::as_list(xml_schema)
31 36 
     vector_field <- unlist(list_field)
32 37 
 }
Browse code

minor fix

Simone authored on 11/01/2018 13:10:15
Showing 1 changed files
R/Utils.R
History View file @ 1869707
... ... 
@@ -96,3 +96,25 @@
96 96 
     if(length(value)>1)
97 97 
         stop("no multiple string")
98 98 
 }
99 
+
100 
+.is_login_expired <- function(url)
101 
+{
102 
+    if(exists("GMQL_credentials", envir = .GlobalEnv))
103 
+    {
104 
+        if(exists("authToken", where = GMQL_credentials))
105 
+        {
106 
+            authToken <- GMQL_credentials$authToken
107 
+            url <- sub("/*[/]$","",url)
108 
+            h <- c('Accept' = 'Application/json', 'X-Auth-Token' = authToken)
109 
+            URL <- paste0(url,"/user")
110 
+            req <- httr::GET(URL,httr::add_headers(h))
111 
+            if(req$status_code !=200)
112 
+                return(TRUE)
113 
+            else
114 
+                return(FALSE)
115 
+        }
116 
+    }
117 
+    return(TRUE)
118 
+}
119 
+
120 
+
Browse code

delete jar

Simone authored on 01/01/2018 13:44:59
Showing 1 changed files
R/Utils.R
History View file @ 40ec852
... ... 
@@ -12,7 +12,7 @@
12 12 
 {
13 13 
     x <- scan(files, what="", sep="\n")
14 14 
     y <- strsplit(x, "\t")
15 
-    names(y) <- sapply(y, `[[`, 1)
15 
+    names(y) <- vapply(y, `[[`,character(1), 1)
16 16 
     listMeta <- lapply(y, `[`, -1)
17 17 
 }
18 18
... ... 
@@ -23,7 +23,7 @@
23 23 
     schema_name_xml <- list.files(datasetName, pattern = "*.xml$",
24 24 
                                 full.names = TRUE)
25 25
26 
-    if(length(schema_name)==0 && length(schema_name_xml) == 0)
26 
+    if(!length(schema_name) && !length(schema_name_xml))
27 27 
         stop("schema not present")
28 28
29 29 
     xml_schema <- xml2::read_xml(schema_name)
... ... 
@@ -37,24 +37,24 @@
37 37 
     if(!is.list(meta_data))
38 38 
         stop("meta_data: invalid input")
39 39
40 
-    if(!all(sapply(meta_data, function(x) is(x,class))))
40 
+    if(!all(vapply(meta_data, function(x) is(x,class), logical(1))))
41 41 
         stop("All elements must be META_AGGREGATES object")
42 42
43 43 
     names <- names(meta_data)
44 44 
     if(is.null(names))
45 45 
     {
46 46 
         warning("You did not assign a names to a list.\nWe build it for you")
47 
-        names <- sapply(meta_data, take_value.META_AGGREGATES)
47 
+        names <- vapply(meta_data, take_value.META_AGGREGATES,character(1))
48 48 
     }
49 49 
     else
50 50 
     {
51 51 
         if("" %in% names)
52 52 
             stop("No partial names assignment is allowed")
53 53 
     }
54 
-    aggregate_matrix <- t(sapply(meta_data, function(x) {
54 
+    aggregate_matrix <- t(vapply(meta_data, function(x) {
55 55 
         new_value = as.character(x)
56 56 
         matrix <- matrix(new_value)
57 
-    }))
57 
+    },character(2)))
58 58
59 59 
     m_names <- matrix(names)
60 60 
     metadata_matrix <- cbind(m_names,aggregate_matrix)
Browse code

minor fix

Simone authored on 24/12/2017 11:42:33
Showing 1 changed files
R/Utils.R
History View file @ 0ad65e7
... ... 
@@ -65,15 +65,15 @@
65 65 
 .join_condition <- function(cond)
66 66 
 {
67 67 
     cond_matrix <- NULL
68 
-    def <- cond$def
68 
+    def <- cond$condition$def
69 69 
     if(!is.null(def))
70 70 
         cond_matrix <- rbind(cond_matrix, def)
71 71
72 
-    exact <- cond$exact
72 
+    exact <- cond$condition$exact
73 73 
     if(!is.null(exact))
74 74 
         cond_matrix <- rbind(cond_matrix, exact)
75 75
76 
-    full <- cond$full
76 
+    full <- cond$condition$full
77 77 
     if(!is.null(full))
78 78 
         cond_matrix <- rbind(cond_matrix, full)
79 79 
     cond_matrix
Browse code

fix error

Simone authored on 15/12/2017 12:37:00
Showing 1 changed files
R/Utils.R
History View file @ c93d851
... ... 
@@ -64,8 +64,19 @@
64 64 
 # meta join condition
65 65 
 .join_condition <- function(cond)
66 66 
 {
67 
-    join_condition_matrix <- do.call(rbind, cond)
68 
-    join_condition_matrix
67 
+    cond_matrix <- NULL
68 
+    def <- cond$def
69 
+    if(!is.null(def))
70 
+        cond_matrix <- rbind(cond_matrix, def)
71 
+
72 
+    exact <- cond$exact
73 
+    if(!is.null(exact))
74 
+        cond_matrix <- rbind(cond_matrix, exact)
75 
+
76 
+    full <- cond$full
77 
+    if(!is.null(full))
78 
+        cond_matrix <- rbind(cond_matrix, full)
79 
+    cond_matrix
69 80 
 }
70 81
71 82 
 .check_input <- function(value)
Browse code

add group, fixed some function

Simone authored on 05/12/2017 10:34:47
Showing 1 changed files
R/Utils.R
History View file @ c760228
... ... 
@@ -23,7 +23,7 @@
23 23 
     schema_name_xml <- list.files(datasetName, pattern = "*.xml$",
24 24 
                                 full.names = TRUE)
25 25
26 
-    if(length(schema_name)==0 || length(schema_name_xml) == 0)
26 
+    if(length(schema_name)==0 && length(schema_name_xml) == 0)
27 27 
         stop("schema not present")
28 28
29 29 
     xml_schema <- xml2::read_xml(schema_name)
Browse code

fix join

Simone authored on 24/11/2017 20:25:53
Showing 1 changed files
R/Utils.R
History View file @ 971c90b
... ... 
@@ -20,7 +20,10 @@
20 20 
 {
21 21 
     schema_name <- list.files(datasetName, pattern = "*.schema$",
22 22 
                                 full.names = TRUE)
23 
-    if(length(schema_name)==0)
23 
+    schema_name_xml <- list.files(datasetName, pattern = "*.xml$",
24 
+                                full.names = TRUE)
25 
+
26 
+    if(length(schema_name)==0 || length(schema_name_xml) == 0)
24 27 
         stop("schema not present")
25 28
26 29 
     xml_schema <- xml2::read_xml(schema_name)
Browse code

S4 methods and change help

Simone authored on 17/11/2017 14:45:18
Showing 1 changed files
R/Utils.R
History View file @ 65260a4
... ... 
@@ -61,34 +61,8 @@
61 61 
 # meta join condition
62 62 
 .join_condition <- function(cond)
63 63 
 {
64 
-    if(is.list(cond))
65 
-    {
66 
-        join_condition_matrix <- t(sapply(cond, function(x) {
67 
-            new_value = as.character(x)
68 
-            if(length(new_value)==1)
69 
-                new_value = c("DEF",new_value)
70 
-            else if(!identical("FULL",new_value[1]) &&
71 
-                    !identical("EXACT",new_value[1]))
72 
-                stop("no valid condition")
73 
-            matrix <- matrix(new_value)
74 
-        }))
75 
-    }
76 
-    else if(is.character(cond))
77 
-    {
78 
-        cond = cond[!cond %in% ""]
79 
-        cond = cond[!duplicated(cond)]
80 
-        if(length(cond)<=0)
81 
-            join_condition_matrix <- ""
82 
-        else
83 
-        {
84 
-            join_condition_matrix <- t(sapply(cond, function(x) {
85 
-                new_value = c("DEF",x)
86 
-                matrix <- matrix(new_value)
87 
-            }))
88 
-        }
89 
-    }
90 
-    else
91 
-        stop("only list or character")
64 
+    join_condition_matrix <- do.call(rbind, cond)
65 
+    join_condition_matrix
92 66 
 }
93 67
94 68 
 .check_input <- function(value)
Browse code

map to s4 - start new build

Simone authored on 16/11/2017 10:37:54
Showing 1 changed files
R/Utils.R
History View file @ b3e9c8a
... ... 
@@ -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 
             }))
Browse code

fix not

Simone authored on 09/11/2017 23:11:46
Showing 1 changed files
R/Utils.R
History View file @ 45ada54
... ... 
@@ -22,7 +22,7 @@
22 22 
                                 full.names = TRUE)
23 23 
     if(length(schema_name)==0)
24 24 
         stop("schema not present")
25 
-
25 
+
26 26 
     xml_schema <- xml2::read_xml(schema_name)
27 27 
     list_field <- xml2::as_list(xml_schema)
28 28 
     vector_field <- unlist(list_field)
... ... 
@@ -33,10 +33,10 @@
33 33 
 {
34 34 
     if(!is.list(meta_data))
35 35 
         stop("meta_data: invalid input")
36 
-
36 
+
37 37 
     if(!all(sapply(meta_data, function(x) is(x,class))))
38 38 
         stop("All elements must be META_AGGREGATES object")
39 
-
39 
+
40 40 
     names <- names(meta_data)
41 41 
     if(is.null(names))
42 42 
     {
... ... 
@@ -46,12 +46,13 @@
46 46 
     else
47 47 
     {
48 48 
         if("" %in% names)
49 
-        stop("No partial names assignment is allowed")
49 
+            stop("No partial names assignment is allowed")
50 50 
     }
51 51 
     aggregate_matrix <- t(sapply(meta_data, function(x) {
52 52 
         new_value = as.character(x)
53 53 
         matrix <- matrix(new_value)
54 54 
     }))
55 
+
55 56 
     m_names <- matrix(names)
56 57 
     metadata_matrix <- cbind(m_names,aggregate_matrix)
57 58 
 }
... ... 
@@ -94,7 +95,7 @@
94 95 
 {
95 96 
     if(!is.character(value))
96 97 
         stop("no valid data")
97 
-
98 
+
98 99 
     if(length(value)>1)
99 100 
         stop("no multiple string")
100 101 
 }
... ... 
@@ -103,7 +104,7 @@
103 104 
 {
104