在 R 中链接多个替换函数

Question

我正在使用 R 来处理大型 JS 对象（使用库 rjsonio）。因此，我有很多嵌套列表，使用起来有些麻烦。我在下面有一个简化的例子。我试图通过创建某种形式的“getter”和“setter”函数来处理这个对象。环顾四周后，我发现了一个非常不错的“getter”函数，它通过对象递归并返回第一个匹配的标签。这特别好，因为它有助于将函数链接在一起。但是，我想不出一种方法来为“setter”函数获得相同的效果。关于如何创建一个可以以类似方式链接在一起的“setter”函数有什么想法吗？

#example, simplified, object
app = list(
  1,
  2,
  d=list(a=123,
         b=456,
         list(
           FirstKey=list(attr1='good stuff', attr2=12345),
           SecondKey=list(attr1='also good stuff', attr2=4321)
           )
         )
  )


#Return a function that returns the value 
#associated with first label that matches 'name'
getByName <- function(name){
  rmatch <- function(x) {
    pos <- match(name, names(x))
    if (!is.na(pos))
      return(x[[pos]])
    for (el in x) {
      if (class(el) == "list") {
        out <- Recall(el)
        if (!is.null(out)) return(out)
      }
    }
  }
  rmatch
}

getFirstKey <- getByName("FirstKey")
getAttr1 <- getByName("attr1")
getAttr2 <- getByName("attr2")

#I like that I can chain these functions together
getAttr1(getFirstKey(app))
getAttr2(getFirstKey(app))

# I would like to be able to do something like this
# But this won't work
###    getAttr1(getFirstKey(app)) <- 9876

# This does work,,, but I loose the ability to chain functions together
# Closure around a replacement function
setterKeyAttr <- function(keyName, attr){
  function(x, value){
    x$d[[3]][[keyName]][[attr]] <- value
    x
  }
}

`setFirstKeyAttr2<-` <- setterKeyAttr("FirstKey", "attr2")
setFirstKeyAttr2(app) <- 22222
#check the answer is correct
getAttr2(getFirstKey(app))

参考： R decorator to change both input and output

http://r.789695.n4.nabble.com/How-to-get-a-specific-named-element-in-a-nested-list-td3037430.html

http://adv-r.had.co.nz/Functions.html

Answer 1

这就是我想出的。它使递归函数返回“名称”的位置，并且仍然能够将调用链接在一起。我不确定这是否是一个很好的方法......但它似乎正在工作......这是基于 app[[c(3,3,1,)]] 是一种有效方式的事实在 R 中建立索引。

 rmatch.pos <- function(object, name, seq=NA, level=NULL){
  ##return the vector of integers corresponding to the first match 
  ##of 'name' to a label in object or NULL if no match is found
    ###object: a list, likely deeply nested
    ##name: the name of the label to look for
    ##seq: starting point to search for 'name' in 'object' i.e. c(2,3,3)
    ##level: don't touch this; it keeps track of how deep the recursive execution is
  ##can be chained together to reduce ambiguity or result:
    ##obj <- list(a=1, b=list(c=2, d=list(e=1, attr1="really?", f=list(attr1 = "found me!"))))
    ##obj[[rmatch.pos(obj, "attr1", rmatch.pos(obj, "f"))]]

  if(is.null(seq)){
    #short circuit if NULL gets passed 
    #when chaining, this forces the whole 'chain'
    #to NULL when any 'link' is NULL
    return(NULL)
  }
  if(is.null(level)){
    level <- length(na.omit(seq))
  }
  if(any(is.na(seq))){
    temp <- object
  }else{
    temp <- object[[seq]]
  }
  level <- level + 1
  pos <- match(name, names(temp))
  if(!is.na(pos)){
    seq[level] <- pos
    return(seq)
  }
  for(el in seq_along(temp)){
    if(class(temp[[el]]) == "list"){
      seq[level] <- el
      out <- Recall(object, name, seq, level)
      if(!is.null(out)){
        return(out)
      }
    }
  }
}


###Examples
rmatch.pos(app, "ThirdKey")
rmatch.pos(app, "attr2")
###chaining example
rmatch.pos(app, "attr2", rmatch.pos(app, "FirstKey"))
rmatch.pos(app, "attr2", rmatch.pos(app, "SecondKey"))
rmatch.pos(app, "attr1", rmatch.pos(app, "ERROR"))
rmatch.pos(app, "ERROR", rmatch.pos(app, "attr1"))