###############################################################
###############################################################
## CLASSES DEFINITION FOR THE GEOGRAPH PACKAGE
###############################################################
###############################################################
#' @import methods
#' @import graph
NULL
######################
## CLASSES DEFINITION
######################
#' Formal class "gGraph"
#'
#' The class \code{gGraph} is a formal (S4) class storing geographic data.\cr
#' Such data are composed of a set of geographic coordinates of vertices (or
#' 'nodes'), and a graph describing connectivity between these vertices. Data
#' associated to the nodes can also be stored ('nodes attributes'), as well as
#' meta-information used when plotting the object, or when computing weights
#' associated to the edges based on nodes attributes.\cr
#'
#' In all slots, nodes are uniquely identified by their name (reference is
#' taken from the row names of \code{@coords} slot).
#'
#'
#' @name gGraph-class
#' @aliases gGraph gGraph-class [,gGraph-method [,gGraph,ANY,ANY-method
#' [,gGraph,ANY,ANY,ANY-method getCoords,gGraph-method getGraph,gGraph-method
#' getNodes,gGraph-method initialize,gGraph-method dropCosts,gGraph-method
#' dropCosts show,gGraph-method is.gGraph getGraph getCoords getNodes
#' @docType class
#' @section Objects from the class gGraph: \code{gGraph} objects can be created
#' by calls to \code{new("gGraph", ...)}, where '...' can be the following
#' arguments:
#'
#' @slot coords a matrix of spatial coordinates with two
#' columns, being respectively longitude (from -180 to 180) and latitude.
#' Positive numbers are intended as 'east' and 'north', respectively.
#' @slot nodes.attr a data.frame whose rows are nodes, and whose
#' columns are different variables associated to the nodes.
#' @slot meta list, most likely containing named data.frames (see
#' Slots).
#' @slot graph an object of the class \linkS4class{graphNEL},
#' from the \code{graph} package (see \code{class?graphNEL}), describing
#' connectivity among nodes.
#'
#' Note that none of these is mandatory: \code{new("gGraph")} would work, and
#' create an empty \code{gGraph} object.
#' @seealso Related classes are:\cr % - \code{\linkS4class{graphNEL}}
#' (graph package): slot \code{@graph} in \code{gGraph}.\cr
#' @keywords classes spatial graphs
#' @exportClass gGraph
#' @examples
#'
#' ## create an empty object
#' new("gGraph")
#'
#'
#' ## plotting the object
#' plot(rawgraph.10k, reset = TRUE)
#'
#' ## zooming in
#' geo.zoomin(list(x = c(-6, 38), y = c(35, 73)))
#' title("Europe")
#'
#' ## to play interactively with graphics, use:
#' # geo.zoomin()
#' # geo.zoomout()
#' # geo.slide()
#' # geo.back()
#'
#' ## defining a new object restrained to visible nodes
#' x <- rawgraph.10k[isInArea(rawgraph.10k)]
#' plot(x, reset = TRUE, edges = TRUE)
#' title("x does just contain these visible nodes.")
#'
#' ## define weights for edges
#' x <- setCosts(x, attr.name = "habitat", method = "prod")
#' plot(x, edges = TRUE)
#' title("costs defined by habitat (land/land=1, other=100)")
#'
#' ## drop 'dead edges' (i.e. with weight 0)
#' x <- dropDeadEdges(x, thres = 10)
#' plot(x, edges = TRUE)
#' title("after droping edges with null weight")
#'
setClass(
"gGraph",
representation(
coords = "matrix", nodes.attr = "data.frame", meta = "list",
graph = "graphNEL"
),
prototype(
coords = matrix(numeric(0), ncol = 2, dimnames = list(NULL, c("lon", "lat"))),
nodes.attr = data.frame(),
meta = list(),
graph = new("graphNEL")
)
)
#' Formal class "gData"
#'
#' The class \code{gData} is a formal (S4) class storing georeferenced data,
#' consisting in a set of locations (longitude and latitude) where one or
#' several variables have been measured. These data are designed to be matched
#' against a \linkS4class{gGraph} object, each location being assigned to the
#' closest node of the \linkS4class{gGraph} object.\cr
#'
#' Note that for several operations on a \code{gData} object, the
#' \linkS4class{gGraph} object to which it is linked will have to be present in
#' the same environment.
#'
#'
#' @name gData-class
#' @aliases gData gData-class [,gData-method [,gData,ANY,ANY-method
#' [,gData,ANY,ANY,ANY-method getCoords,gData-method getData-methods
#' getData,gData-method getData getNodes,gData-method initialize,gData-method
#' show,gData-method is.gData getGraph,gData-method
#' @docType class
#' @section Objects from the class gData: \code{gData} objects can be created
#' by calls to \code{new("gData", ...)}, where '...' can be the following
#' arguments:
#'
#' @slot coords a matrix of spatial coordinates with two
#' columns, being respectively longitude (from -180 to 180) and latitude.
#' Positive numbers are intended as 'east' and 'north', respectively.
#' @slot nodes.id a vector of character strings giving the name of the
#' nodes (of the \linkS4class{gGraph} object) associated to the locations.
#' @slot data any kind of data associated to the locations in coords.
#' For matrix-like objects, rows should correspond to locations.
#' @slot gGraph.name a character string the name of the
#' \linkS4class{gGraph} object against which the object is matched.
#'
#' Note
#' that none of these is mandatory: \code{new("gData")} would work, and create
#' an empty \code{gGraph} object. Also note that a finer matching of locations
#' against the nodes of a \code{gGraph} object can be achieved after creating
#' the object, for instance using the \code{closestNode} method.
#' @seealso Related class:\cr - \code{\linkS4class{gGraph}}\cr
#' @examples
#'
#' hgdp
#'
#' ## plot data
#' plot(worldgraph.40k, pch = "")
#' points(hgdp)
#'
#' ## subset and plot data
#' onlyNorth <- hgdp[hgdp@data$Latitude > 0] # only northern populations
#'
#' plot(worldgraph.40k, reset = TRUE)
#' abline(h = 0) # equator
#' points(onlyNorth, pch.node = 20, cex = 2, col.node = "purple")
#'
#' @exportClass gData
setClass(
"gData", representation(
coords = "matrix", nodes.id = "character", data = "ANY",
gGraph.name = "character"
),
prototype(
coords = matrix(numeric(0), ncol = 2, dimnames = list(NULL, c("lon", "lat"))),
nodes.id = character(0),
data = NULL,
gGraph.name = ""
)
)
####################
## VALIDITY METHODS
####################
#' @export
.gGraph.valid <- function(object) {
x <- object
N <- nrow(x@coords)
if (N == 0) {
return(TRUE)
} # empty object always valid
## several cases of non-validity
## coords not numeric
if (!is.numeric(x@coords)) {
cat("\n Content of coords is not numeric.")
return(FALSE)
}
## wrong nrow for nodes attributes
temp <- nrow(x@nodes.attr)
if (temp > 0 && temp != N) {
cat("\n Number of coords do not match number of node attributes.")
return(FALSE)
}
## NAs in coords
if (any(is.na(x@coords))) {
cat("\n NAs in coords coordinates.")
return(FALSE)
}
## node labels consistency
if (!all(rownames(x@coords) == nodes(x@graph))) {
cat("\n Row names of @coords do not match node names of @graph.")
return(FALSE)
}
return(TRUE)
} # end .gGprah.valid
#' @export
.gData.valid <- function(object) {
x <- object
Ncoords <- nrow(x@coords)
Nnodes <- length(x@nodes.id)
## dim matching
if (Ncoords != Nnodes) {
cat("\n Number of coordinates and of nodes do not match.")
return(FALSE)
}
## gGraph object
if (!exists(x@gGraph.name, envir = .GlobalEnv)) {
warning(paste("The gGraph object", x@gGraph.name, "is missing."))
}
return(TRUE)
} # end .gData.valid
#' @export
setValidity("gGraph", .gGraph.valid)
## setValidity("gGraphHistory", .gGprahHistory.valid)
#' @export
setValidity("gData", .gData.valid)
#' @export
is.gGraph <- function(x) {
res <- (is(x, "gGraph") & validObject(x))
return(res)
}
#' @export
is.gData <- function(x) {
res <- (is(x, "gData") & validObject(x))
return(res)
}
################
## CONSTRUCTORS
################
##########
## gGraph
##########
#' @export
setMethod("initialize", "gGraph", function(.Object, ...) {
x <- .Object
input <- list(...)
## handle @coords ##
if (!is.null(input$coords)) {
if (is.list(input$coords) && length(input$coords) == 2) {
input$coords <- as.data.frame(input$coords)
}
if (is.data.frame(input$coords)) {
input$coords <- as.matrix(input$coords)
}
if (nrow(input$coords) > 0 && !is.numeric(input$coords)) stop("Argument coords has to be numeric.")
## names of the matrix
colnames(input$coords) <- c("lon", "lat")
rownames(input$coords) <- as.character(1:nrow(input$coords))
## check/rectify longitudes
temp <- input$coords[, "lon"] > 180
input$coords[temp, "lon"] <- input$coords[temp, "lon"] - 360
x@coords <- input$coords
}
## handle @nodes.attr ##
if (!is.null(input$nodes.attr)) {
input$nodes.attr <- as.data.frame(input$nodes.attr)
if (nrow(input$nodes.attr) != nrow(x@coords)) {
stop("Number of rows in nodes.attr differ from that of coords.")
}
x@nodes.attr <- input$nodes.attr
}
## handle @graph ##
if (is.null(input$graph)) { # graph not provided
if (nrow(x@coords) > 0) {
input$graph <- new("graphNEL", nodes = rownames(x@coords))
} else {
input$graph <- new("graphNEL")
}
} else { # graph provided
if (nrow(x@coords) > 0) {
nodes(input$graph) <- rownames(x@coords)
}
}
x@graph <- input$graph
## return object
return(x)
}) # end gGraph constructor
##########
## gData
##########
#' @export
setMethod("initialize", "gData", function(.Object, ...) {
x <- .Object
input <- list(...)
inputClasses <- sapply(input, class)
## handle @coords ##
if (!is.null(input$coords)) {
if (is.list(input$coords) && length(input$coords) == 2) {
input$coords <- as.data.frame(input$coords)
}
if (is.data.frame(input$coords)) {
input$coords <- as.matrix(input$coords)
}
if (nrow(input$coords) > 0 && !is.numeric(input$coords)) stop("Argument coords has to be numeric.")
## names of the matrix
colnames(input$coords) <- c("lon", "lat")
rownames(input$coords) <- as.character(1:nrow(input$coords))
## check/rectify longitudes
temp <- input$coords[, "lon"] > 180
input$coords[temp, "lon"] <- input$coords[temp, "lon"] - 360
x@coords <- input$coords
}
## handle gGraph.name and gGraph.version
if (!is.null(input$gGraph.name)) {
if (!exists(input$gGraph.name, envir = .GlobalEnv)) {
warning(paste("The gGraph object", input$gGraphName, "is missing."))
myGraph <- NULL
} else {
myGraph <- get(input$gGraph.name, envir = .GlobalEnv) # used later for node.id
x@gGraph.name <- input$gGraph.name
}
## if(is.null(input$gGraph.version) & !is.null(myGraph)){
## x@gGraph.version <- myGraph@history@dates[length(myGraph@history@dates)]
## }
} else {
myGraph <- NULL
}
## handle nodes.id ##
if (is.null(input$nodes.id)) { # if nodes.id is not provided...
if (!is.null(myGraph)) { # ... and if the gGraph is available
x@nodes.id <- closestNode(myGraph, loc = x@coords) # deduce nodes.id from the gGraph
}
} else {
x@nodes.id <- as.character(x@nodes.id)
if (!is.null(myGraph)) {
if (!all(x@nodes.id %in% getNodes(myGraph))) {
warning(paste("Some nodes were not found in the gGraph object", x@gGraphName, "."))
}
}
}
## handle data ##
if (!is.null(input$data)) {
x@data <- input$data
}
return(x)
}) # end gData constructor
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.