Search code examples
rreference-class

What is the best way of removing an element from a list of objects in R


While playing with reference classes in R i ran into something that does not feel pretty. If I have a list of objects is there a way to remove an individual item from that list that does not involve finding its index? In the (working) example below I would like a better way to implement removeContent() i.e. some way to remove the item from the list without having to loop. I am trying to stick to base R if at all possible.

Element <- setRefClass(
  Class ="Element",
  fields = list(
    m_name = "character",
    contentList = "list"
  ),
  methods = list(
    initialize = function(name = NULL) {
      "Element constructor, @param name, The name of the tag (optional)"
      if(!is.null(name)) {
        m_name <<- name
      }
    },

    addContent = function(content) {
      "Appends the child to the end of the content list. return the parent (the calling object)"
      idx <- length(contentList) + 1
      contentList[[idx]] <<- content
      return(.self)
    },

    findContentIndex = function(content) {
      "Find the position of the content in the contentList or -1 if not found"
      for (idx in seq_along(contentList)) {
        if(identical(content, contentList[[idx]])) {
          return(idx)
        }
      }
    -1
    },

    removeContent = function(content) {
      "Remove the specified content from this element"
      index <- findContentIndex(content)
      if ( index != -1){
        contentList <<- contentList[- index]
      } else {
        stop("There is no such content belonging to this Element")
      }
    }
  )
)

foo <- Element$new("foo")
foo$addContent(Element$new("Bar"))
baz <- Element$new("Baz")
foo$addContent(baz)
foo$removeContent(baz)
tryCatch(
  {
    foo$removeContent(baz)
  },
  error=function(cond) {
    print(paste("Expected this error, ", cond$message))
  }
)

Solution

  • The way to do it without using explicit indexing would be to use sapply(contentList, identical, content) to find a matching object. We can simplify your whole class definition, preserving functionality, like this:

    Element <- setRefClass(
      Class   = "Element",
      fields  = list(m_name = "character", contentList = "list"),
      methods = list(initialize    = function(name = NULL)
                                     {
                                       if (!is.null(name)) m_name <<- name
                                     },
    
                     addContent    = function(content) 
                                     {
                                       contentList <<- append(contentList, content)
                                     },
    
                     removeContent = function(content) 
                                     {
                                       idx <- sapply(contentList, identical, content)
                                       if (all(!idx)) stop("Content not found")
                                       contentList <<- contentList[!idx]
                                     })
      )
    

    Now we can test it out on your examples:

    foo <- Element$new("foo")
    foo$addContent(Element$new("Bar"))
    baz <- Element$new("Baz")
    foo$addContent(baz)
    foo
    #> Reference class object of class "Element"
    #> Field "m_name":
    #> [1] "foo"
    #> Field "contentList":
    #> [[1]]
    #> Reference class object of class "Element"
    #> Field "m_name":
    #> [1] "Bar"
    #> Field "contentList":
    #> list()
    #> 
    #> [[2]]
    #> Reference class object of class "Element"
    #> Field "m_name":
    #> [1] "Baz"
    #> Field "contentList":
    #> list()
    foo$removeContent(baz)
    foo
    #> Reference class object of class "Element"
    #> Field "m_name":
    #> [1] "foo"
    #> Field "contentList":
    #> [[1]]
    #> Reference class object of class "Element"
    #> Field "m_name":
    #> [1] "Bar"
    #> Field "contentList":
    #> list()
    

    and with your tryCatch:

    tryCatch(
      {
        foo$removeContent(baz)
      },
      error=function(cond) {
        print(paste("Expected this error, ", cond$message))
      }
    )
    #> [1] "Expected this error,  Content not found"
    

    Created on 2020-04-08 by the reprex package (v0.3.0)