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