R/Node.R

In redland: RDF Library Bindings in R

#
#   This work was created by the National Center for Ecological Analysis and Synthesis.
#
#     Copyright 2015 Regents of the University of California
#
#   Licensed under the Apache License, Version 2.0 (the "License");
#   you may not use this file except in compliance with the License.
#   You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
#   Unless required by applicable law or agreed to in writing, software
#   distributed under the License is distributed on an "AS IS" BASIS,
#   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#   See the License for the specific language governing permissions and
#   limitations under the License.
#

#' @title A Redland Node, used to store one node in an RDF triple statement.
#' @description A Node represents a RDF Resource, Property, Literal or an RDF blank Node.
#' @slot librdf_node A redland node object
#' @include redland.R
#' @include World.R
#' @rdname Node-class
#' @encoding UTF-8
#' @aliases Node
#' @keywords classes
#' @export
#' @section Methods:
#' \itemize{
#'   \code{\link{Node-initialize}}: Initialize a Node object.
#'   \code{\link{getNodeType}}: Determine the node type and return as a string.
#'   \code{\link{getNodeValue}}: Determine the node type and return as a string.
#'   \code{\link{getBlankNodeId}}: Get the value of the node as a string.
#' }
#' @seealso \code{\link{redland}}: redland package
#' @examples
#' world <- new("World")
#' # a blank node is created with a unique identifier generated by librdf
#' node <- new("Node", world)
#' # a blank node is created with a unique identifier generated by librdf
#' node <- new("Node", world, blank=NULL)
#' # a blank node is created with the user specified identifier, i.e. "_:id1"
#' node <- new("Node", world, blank="someid")
#' # a node type of 'literal' is created
#' node <- new("Node", world, literal="A Node Value")
#' # a Node type of 'resource' is created
#' node <- new("Node", world, uri="http://www.example.com")
#' # Create a literal node, specifying a language encoding
#' node <- new("Node", world, literal="Gérard de La Martinière", language="fr")
setClass("Node", slots = c(librdf_node = "_p_librdf_node_s"))

#' Initialize a Node object.
#' @description A Node has an associated type corresponding to the RDF component that it is representing. The list of possible
#' types is "resource", "literal" or "blank".
#' @details The url=' and 'literal=' arguments determine which type of Node is created. The Node type affects how the Node is processed
#' in serialization, for example a Node created with 'node1 <- new("Node", literal="http://www.example.com")' is processed
#' differently that a Node created with 'node1 <- new("Node", url="http://www.example.com")', with the former being processed
#' as an RDF literal and the latter processed as an RDF resource.
#' @rdname Node-initialize
#' @aliases Node-initialize
#' @param .Object the Node object to be initialized
#' @param world a World object
#' @param literal a literal character value to be assigned to the node
#' @param uri a uri character value to be assigned to the node
#' @param blank a blank node identifier to be assigned to the node
#' @param datatype_uri a uri used to specify the datatype of a literal node, i.e. "http://www.w3.org/2001/XMLSchema#string"
#' @param language a character value specifying the RDF language tag (excluding the "@" symbol), i.e. "fr"
#' @note Refer to https://www.w3.org/TR/rdf11-concepts information on language tags.
#' @return the Node object
#' @export
setMethod("initialize", signature = "Node", definition = function(.Object, world, literal, uri, blank, datatype_uri, language) {
  stopifnot(!is.null(world))
  
  # Neither 'literal' nor 'uri', nor 'blank' was specified, so create a blank node with librdf generated id
  if(missing(literal) && missing(uri) && missing(blank)) {
    .Object@librdf_node <- librdf_new_node(world@librdf_world)
  } else if (!missing(uri)) {
    # 'uri=' was specified
    librdf_uri <- librdf_new_uri(world@librdf_world, uri)
    .Object@librdf_node <- librdf_new_node_from_uri(world@librdf_world, librdf_uri)
  } else if (!missing(literal)) {
    # a literal value was specified, but a blank value is not valid
    if(missing(language)) language="" # No default for language, so if not specified, set to blank
    #if(!grepl(language, "@")) language <- sprintf("@%s", language)
    if(literal == "") {
      stop(sprintf("Invalid value specified for Node type of literal: \"%s\"", literal))
    } else {
      if (missing(datatype_uri)) {
        .Object@librdf_node <- librdf_new_node_from_literal(world@librdf_world, literal, language, 0)
      } else {
          # The datatype_uri specifies the RDF type to be associated with this node
          # and can only be applied to a literal value, therefor only to an object node
          # that has a literal value. When a statement with such a node is serialize to RDF/XML, the
          # rdf type is serialized as an XML attribute, i.e. for the literal node "John Smith" below
          # the datatype is an xsd:string:
          #   <rdf:RDF xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">
          #     <rdf:Description rdf:about="http://www.johnsmith.com/">
          #     <dc:creator rdf:datatype="http://www.w3.org/2001/XMLSchema#string">John Smith</dc:creator>
          #     </rdf:Description>
          #   </rdf:RDF>
        type_uri <- librdf_new_uri(world@librdf_world, datatype_uri)
        .Object@librdf_node <- librdf_new_node_from_typed_literal(world@librdf_world, literal, language, type_uri)
      }
    }
  } else if (!missing(blank)) {
    # Create a blank node with a librdf generated unique identifier
    if(is.null(blank) || blank == "") {
      .Object@librdf_node <- librdf_new_node(world@librdf_world)
    } else {
      # Create a blank node with a user specified identifier
      .Object@librdf_node <- librdf_new_node_from_blank_identifier(world@librdf_world, blank)
    }
  } else {
    # If not creating a blank node, either 'literal' or 'uri' must be specified
    stop("Please specify either 'literal=\"value\"', 'uri=\"value\"' or 'blank=\"value\"'")
  }
  return(.Object)
})

#' Determine the node type and return as a string
#' @description A Node has a type that is assigned at initialization and can have one of the following values:
#' 'resource', 'literal', 'blank' and 'unknown'.
#' @rdname getNodeType
#' @param .Object a Node object
#' @return a character vector containing the Node type
#' @examples
#' world <- new("World")
#' node <- new("Node", world, uri="http://www.example.com")
#' nodeType <- getNodeType(node)
#' @export
setGeneric("getNodeType", function(.Object) {
  standardGeneric("getNodeType")
})

#' @rdname getNodeType
setMethod("getNodeType", signature("Node"), function(.Object) {
  
  if(librdf_node_is_resource(.Object@librdf_node)) {
    return("resource")
  } else if (librdf_node_is_literal(.Object@librdf_node)) {
    return("literal")
  } else if (librdf_node_is_blank(.Object@librdf_node)) {
    return("blank")
  } else {
    return("unknown")
  }
})

#' Get the blank identifier that has been assigned for a specified Node object
#' @details When a Node object is initialized with no value specified, i.e. node <- Node(""),
#' a blank node is created and a locally unique identifier is generated by librdf. This method
#' retrieves this identifier and returns in to the caller.
#' @rdname getBlankNodeId
#' @param .Object a Node object
#' @return a blank node identifier
#' @examples 
#' world <- new("World")
#' # a blank node is created with a unique identifier generated by librdf
#' node <- new("Node", world, blank=NULL)
#' nodeId <- getBlankNodeId(node)
#' @export
setGeneric("getBlankNodeId", function(.Object) {
  standardGeneric("getBlankNodeId")
})

#' @rdname getBlankNodeId
setMethod("getBlankNodeId", signature("Node"), function(.Object) {
  if(librdf_node_is_blank(.Object@librdf_node)) {
    return(librdf_node_get_blank_identifier(.Object@librdf_node))
  } else {
    return(as.character(NA))
  }
})

#' Get the value of the node as a string
#' @details The value of the node is returned as a string. If the node type is
#' 'blank', then the blank node identifier is returned. If the node type is
#' 'literal', then the literal value is returned with the form "string@language,
#' e.g. "¡Hola, amigo! ¿Cómo estás?"@es". If the node type is 'uri'
#' then the value is returned as a string.
#' @rdname getNodeValue
#' @encoding UTF-8
#' @param .Object a Node object
#' @return a string representation of the Node's value
#' @examples 
#' world <- new("World")
#' node <- new("Node", world, literal="¡Hola, amigo! ¿Cómo estás?", language="es")
#' value <- getNodeValue(node)
#' @export
setGeneric("getNodeValue", function(.Object) {
  standardGeneric("getNodeValue")
})

#' @rdname getNodeValue
setMethod("getNodeValue", signature("Node"), function(.Object) {
  if(librdf_node_is_resource(.Object@librdf_node)) {
    librdf_uri <- librdf_node_get_uri(.Object@librdf_node) 
    val <- librdf_uri_to_string(librdf_uri)
    librdf_free_uri(librdf_uri)
    return(val)
  } else if (librdf_node_is_literal(.Object@librdf_node)) {
    val <- librdf_node_get_literal_value(.Object@librdf_node)
    lang <- librdf_node_get_literal_value_language(.Object@librdf_node)
    # If the node has a language tag defined, then include it, otherwise don't
    if(is.null(lang) || is.na(lang) || lang == "") {
        literal <- sprintf("%s", val)
    } else {
        literal <- sprintf("\"%s\"@%s\"", val, lang)
    }
    return(literal)
  } else if (librdf_node_is_blank(.Object@librdf_node)) {
    return(getBlankNodeId(.Object))
  } else {
    stop("Node type unknown, cannot get the node value")
  }
})