1#' Reads gexf (.gexf) file
2#'
3#' `read.gexf` reads gexf graph files and imports its elements as a
4#' `gexf` class object
5#'
6#'
7#' @param x String. Path to the gexf file.
8#' @return A `gexf` object.
9#' @note By the time attributes and viz-attributes aren't supported.
10#' @author George Vega Yon
11#'
12#' Jorge Fabrega Lacoa
13#' @references The GEXF project website: https://gephi.org/gexf/format/
14#' @keywords IO
15#' @examples
16#'
17#'   fn <- system.file("gexf-graphs/lesmiserables.gexf", package = "rgexf")
18#'   mygraph <- read.gexf(fn)
19#'
20#' @export read.gexf
21read.gexf <- function(x) {
22
23  oldstrf <- getOption("stringsAsFactors")
24  on.exit(options(stringsAsFactors = oldstrf))
25  options(stringsAsFactors = FALSE)
26
27  # Reads the graph
28  gfile <- XML::xmlParse(x, encoding="UTF-8")
29
30  # Gets the namespace
31  ns <- XML::xmlNamespace(XML::xmlRoot(gfile))
32
33  graph <- NULL
34  graph$meta <- NULL
35
36  ################################################################################
37  # Creator
38  if (length(y<-XML::getNodeSet(gfile,"/r:gexf/r:meta/r:creator", c(r=ns))) > 0) {
39    graph$meta[["creator"]] <- XML::xmlValue(y[[1]])
40  }
41  else graph$meta[["creator"]] <- NA
42  # Description
43  if (length(y<-XML::getNodeSet(gfile,"/r:gexf/r:meta/r:description", c(r=ns))) > 0) {
44    graph$meta[["description"]] <- XML::xmlValue(y[[1]])
45  }
46  else graph$meta[["description"]] <- NA
47  # Keywords
48  if (length(y<-XML::getNodeSet(gfile,"/r:gexf/r:meta/r:keywords", c(r=ns))) > 0) {
49    graph$meta[["keywords"]] <- XML::xmlValue(y[[1]])
50  }
51  else graph$meta[["keywords"]] <- NA
52  ################################################################################
53
54  # Attributes list
55  graph$atts.definitions <- list(nodes=NULL,edges = NULL)
56  if (length(y<-XML::getNodeSet(gfile,"/r:gexf/r:graph/r:attributes", c(r=ns)))) {
57    while (length(y) > 0) {
58
59      # Gets the class
60      attclass <- paste(XML::xmlAttrs(y[[1]])[["class"]],"s", sep="")
61      z <- XML::getNodeSet(
62        y[[1]], "/r:gexf/r:graph/r:attributes/r:attribute", c(r=ns))
63
64      # Builds a dataframe
65      graph$atts.definitions[[attclass]] <- data.frame(
66        id=sapply(z, XML::xmlGetAttr, name="id"),
67        title=sapply(z, XML::xmlGetAttr, name="title"),
68        type=sapply(z, XML::xmlGetAttr, name="type")
69        )
70
71      # Removes the already analyzed
72      y <- y[-1]
73    }
74  }
75
76  graph$mode <- XML::xmlAttrs(
77    XML::getNodeSet(gfile, "/r:gexf/r:graph", c(r = ns))[[1L]]
78    )
79
80  # Nodes
81  nodes  <- XML::getNodeSet(gfile, "/r:gexf/r:graph/r:nodes/r:node", c(r = ns))
82  ids    <- sapply(nodes, XML::xmlGetAttr, name = "id")
83  labels <- lapply(nodes, XML::xmlGetAttr, name = "label")
84  labels <- sapply(labels, function(x) if (is.null(x)) "" else x)
85
86  if (all(labels == ""))
87    labels <- ids
88
89  graph$nodes <- data.frame(
90    id               = ids,
91    label            = labels,
92    stringsAsFactors = F
93    )
94
95  rm(nodes)
96  rm(ids)
97  rm(labels)
98
99  # Viz attributes -------------------------------------------------------------
100  nodesVizAtt <- NULL
101  edgesVizAtt <- NULL
102
103  # Extracting attributes
104  node.vizattr <- XML::xpathApply(
105    gfile, "/r:gexf/r:graph/r:nodes/r:node", namespaces = c(r = ns, v = "viz"),
106    fun=XML::xmlChildren
107    )
108
109  node.attr <- XML::xpathApply(
110    gfile,
111    "/r:gexf/r:graph/r:nodes/r:node/r:attvalues",
112    namespaces = c(r = ns),
113    fun        = XML::xmlChildren
114  )
115
116  node.attr <- lapply(node.attr, lapply, XML::xmlAttrs)
117
118  node.vizattr <- lapply(node.vizattr, lapply, XML::xmlAttrs)
119  # node.vizattr <- lapply(node.viz)
120
121  # Colors
122  nodesVizAtt$color <- lapply(node.vizattr, function(a) {
123
124    if (length(a$color))
125      return(check_and_map_color(a$color))
126
127    check_and_map_color(default_nodeVizAtt$color())
128
129  })
130
131  nodesVizAtt$color <- do.call(rbind, nodesVizAtt$color)
132
133  nodesVizAtt$color <- as.data.frame(nodesVizAtt$color)
134  dimnames(nodesVizAtt$color) <- list(
135    1L:nrow(nodesVizAtt$color), c("r", "g", "b", "a")
136  )
137
138
139  # Size
140  nodesVizAtt$size <- lapply(node.vizattr, function(a) {
141    if (length(a$size))
142      return(viz_att_checks$size(as.numeric(a$size)))
143
144    viz_att_checks$size(default_nodeVizAtt$size())
145  })
146
147  nodesVizAtt$size <- do.call(rbind, nodesVizAtt$size)
148
149  nodesVizAtt$size <- as.data.frame(nodesVizAtt$size)
150  dimnames(nodesVizAtt$size) <- list(
151    1L:nrow(nodesVizAtt$size), "value"
152  )
153
154
155  # Positions
156  nodesVizAtt$position <- lapply(node.vizattr, function(a) {
157    if (length(a$position))
158      return(viz_att_checks$position(matrix(as.numeric(a$position), nrow = 1)))
159
160    viz_att_checks$position(default_nodeVizAtt$position())
161  })
162
163  nodesVizAtt$position <- do.call(rbind, nodesVizAtt$position)
164  nodesVizAtt$position <- as.data.frame(nodesVizAtt$position)
165  dimnames(nodesVizAtt$position) <- list(
166    1L:nrow(nodesVizAtt$position), c("x", "y", "z")
167  )
168
169
170  # Edges
171  edges <- XML::getNodeSet(gfile, "/r:gexf/r:graph/r:edges/r:edge", c(r = ns))
172
173  graph$edges <- data.frame(
174    id     = sapply(edges, XML::xmlGetAttr, name = "id", default = NA),
175    source = sapply(edges, XML::xmlGetAttr, name = "source"),
176    target = sapply(edges, XML::xmlGetAttr, name = "target"),
177    weight = as.numeric(
178      sapply(edges, XML::xmlGetAttr, name = "weight", default = "1.0")
179      ),
180    stringsAsFactors = FALSE
181    )
182
183  if (any(is.na(graph$edges[, 1L])))
184    graph$edges[, 1] <- 1L:NROW(graph$edges)
185
186  rm(edges)
187
188  graph$graph <- XML::saveXML(gfile, encoding = "UTF-8")
189
190  class(graph) <- "gexf"
191
192  order <- if (inherits(graph$nodes$id, "character"))
193    order(as.integer(as.factor(graph$nodes$id)))
194  else
195    order(as.integer(graph$nodes$id))
196
197  build.and.validate.gexf(
198    nodes            = graph$nodes[order, , drop = FALSE],
199    edges            = graph$edges,
200    atts.definitions = graph$atts.definitions,
201    nodesVizAtt      = lapply(nodesVizAtt, "[", i = order, j =, drop = FALSE),
202    edgesVizAtt      = edgesVizAtt,
203    graph            = graph$graph
204    )
205
206}
207