R/RDF_object_code.R

In mariyad/openbiodiving: Linking the Open Biodiversity Knowledge Management System With BOLD Systems to Retrieve Specimen Voucher Metadata

#' @export
ResourceDescriptionFramework = R6::R6Class(
  classname = "ResourceDescriptionFramework",
  
  public = list(
    
    prefix_list = NULL, # DynVector
    context = NULL, # identifer
    
    #Initialise the size to be 10x4 
    initialize = function(size = 10000)
    {
      private$triples = DynVector$new(size = size)
      self$prefix_list = DynVector$new(size = size)
    },
    
    set_context = function(context)
    {
      stopifnot(is.identifier(context))
      self$context = context
    },
    
    get_prefixes = function()
    {
      un = unlist(self$prefix_list$get())
      un[!duplicated(un)]
    },
    
    add_triple = function(subject, predicate, object)
    {
      if (!is.identifier(subject) || !is.identifier(predicate) || !(is.literal(object) || is.identifier(object) || is.ResourceDescriptionFramework(object))) {
        return (FALSE)
      }
      else {
        self$prefix_list$add(subject$prefix)
        self$prefix_list$add(predicate$prefix)
        if (is.identifier(object)) {
          self$prefix_list$add(object$prefix)
        }
        private$triples$add(list(subject = subject, predicate = predicate, object = object))
        return(TRUE)
      }
    },
    
    add_triples = function(ll)
    {
      
      if(!is.ResourceDescriptionFramework(ll)) return (FALSE)
      if(length(ll$get_list()) == 0) return (FALSE)
      else {
        self$prefix_list$add_list(ll$prefix_list$get())
        private$triples$add_list(ll$get_list())
      }
    },
    
    get_list = function()
    {
      private$triples$get()
    },
    
    serialize = function()
    {
      if (is.null(self$context)) {
        error("context not set. cannot serialize")
      }
      if (length(self$get_list()) == 0) {
        return("")
      }
      # TODO prepend the prefiexes
      serialization = DynVector$new(10)
      
      serialization$add(
        prefix_serializer(self$get_prefixes(), lang = "Turtle")
      )
      
      serialization$add(c(paste(self$context$qname, "{\n")))
      # qnames of subjects and kick out NULL
      subjects = sapply(private$triples$get(), function(t)
      {
        t$subject$qname
      })
      
      next_object = FALSE
      for (s in unique(subjects)) {
        couplet = private$write_couplet(subject = s, triples = private$triples$get())
        if (next_object == FALSE) {
          serialization$add_list(couplet$get())
          next_object = TRUE
        }
        else{
          serialization$add(c(". \n"))
          serialization$add_list(couplet$get())
        }
      }
      serialization$add(". }")
      return (unlist(serialization$get()))
    }
  ),
  
  
  
  
  
  
  
  
  
  private = list(
    
    triples = NULL, # DynVector
    
    # --- Serialization Functions ---
    write_couplet = function(subject, triples)
    {
      local_serialization = DynVector$new(10)
      local_serialization$add(c(paste(subject, " ")))
      # subset the triples with only this subject
      triples = lapply(triples, function(t)
      {
        if (t$subject$qname == subject) return(t)
      })
      triples = triples[!sapply(triples,is.null)]
      # find the unique predicates
      predicates = (sapply(triples, function (t)
      {
        t$predicate$qname
      }))
      
      next_object = FALSE
      for (p in unique( predicates )) {
        predicate_stanza = private$write_predicate_stanza(p, triples)
        if (next_object == FALSE) {
          local_serialization$add_list(predicate_stanza$get())
          next_object = TRUE
        }
        else{
          local_serialization$add(c(";\n\t"))
          local_serialization$add_list(predicate_stanza$get())
        }
      }
      
      return(local_serialization)
    },
    
    
    
    
    
    
    
    
    
    
    write_predicate_stanza = function(predicate, triples)
    {
      local_serialization = DynVector$new(10)
      local_serialization$add(c(predicate, " "))
      # subset only for this predicate
      triples = lapply(triples, function (t) {
        if (t$predicate$qname == predicate) return (t)
      })
      triples = triples[!sapply(triples,is.null)]
      # We fucking do care about uniqueness of objects!!!!!!!
      objects = lapply(triples, function (t) {
        t$object
      })
      next_object = FALSE
      for (o in unique(objects) ) {
        end_stanza = private$write_end_stanza( o, triples )
        if (next_object == FALSE) {
          local_serialization$add_list(end_stanza$get())
          next_object = TRUE
        }
        else {
          local_serialization$add(c(", "))
          local_serialization$add_list(end_stanza$get())
        }
      }
      return (local_serialization)
    },
    
    
    
    
    
    
    
    
    
    
    write_end_stanza = function (object, triples)
    {
      local_serialization = DynVector$new(10)
      if (is.literal(object)) {
        local_serialization$add(object$squote)
      }
      else if (is.identifier(object)) {
        local_serialization$add(object$qname)
      }
      else {
        # object is RDF with blank nodes --> recursion
        local_serialization$add(c(" [ "))
        local_serialization$add_list(private$write_couplet(subject = blank_node, triples = object))
        local_serialization$add(c(" ] "))
      }
      return(local_serialization)
    }
    
  )
)




#' Is the object an Triples List (RDF)?
#'
#' @param x object to check
#'
#' @return logical
#'
#' @export
#' @family rdf
is.ResourceDescriptionFramework = function(x)
{
  if ("ResourceDescriptionFramework" %in% class(x)) TRUE
  else FALSE
}





#' Create a list of RDF statements that all share the same blank subject node
#' @export
#' @family anonymous rdf
AnonRDF = R6::R6Class(
  classname = "anonymous_rdf",
  inherit = ResourceDescriptionFramework,
  
  public = list(
    
    add_triple = function(predicate, object)
    {
      if (!is.identifier(predicate) || !is.list(object)) {
        return (FALSE);
      }
      else {
        super$add(list(subject = blank_node, predicate = predicate, object = object))
        return(TRUE)
      }
    },
    
    add_triples = function(ll)
    {
      if(!is.AnonRDF(ll)) return (FALSE)
      else {
        self$add_list(ll$get())
      }
    },
    
    serialize = function(context)
    {
      # you cannot serialize anonymous RDF
      return (FALSE)
    }
  )
)



#' Is the object an Anonymous Triples List (RDF)?
#' @export
#' @family anonymous rdf
is.AnonRDF = function(x)
{
  if ("anonymous_rdf" %in% class(x)) TRUE
  else FALSE
}







#' RDF Class with \code{rdflib} backend
#'
#' @inheritParams ResourceDescriptionFramework
#'
#' @export
RdfLibBackend = R6::R6Class(
  inherit = ResourceDescriptionFramework,
  classname = "RdfLibBackend",
  
  public = list(
    
    initialize = function(context)
    {
      super$initialize()
      super$set_context(context)
    },
    
    nquad = function(subject, predicate, object, context)
    {
      paste(represent(subject), represent(predicate), represent(object), represent(self$context), ".")
    }
    
  )
)