Question

我有一个模型对象被描述为矢量和矩阵参数的命名列表。基于每个参数向量或矩阵的元素与向量中的索引之间的映射，对这类对象的两个基本操作是从/向数据向量加载和存储。这是一个简化的例子：

LoadModelFromVector <- function(vecParams) {
    model <- list(
        A = diag(5),            # a diagonal square matrix
        B = matrix(0, 5, 5)     # un upper triangular square matrix
    ) 
    attr(model, "p") <- 15

    diag(model$A) <- vecParams[1:5]
    model$B[upper.tri[model$B]] <- vecParams[5 + (1:(5*(5-1)/2)))]

    model
}

StoreModelToVector <- function(model) {
    vecParams <- double(length = attr(model, "p"))
    vecParams[1:5] <- diag(model$A)
    vecParams[5 + (1:(5*(5-1)/2)))] <- model$B[upper.tri[model$B]]

    vecParams
}

我不喜欢上面的例子，因为它在代码中的两个位置复制了映射。相反，我想在一个地方进行这种映射。我认为这可以使用赋值运算符<-的抽象来优雅地完成：

LoadStoreModel <- function(vecParams, model = NULL) {
    if(is.null(model)) {
        model <- list(
            A = diag(5),            # a diagonal square matrix
            B = matrix(0, 5, 5)     # un upper triangular square matrix
        )
        `%op%` <- `<-`              # WORKS FINE :-)
        mode <- "load"
    } else {
        vecParams <- double(length = attr(model, "p"))
        `%op%` <- `->` # GENERATES "Error: object '->' not found" :-(
        mode <- "store"
    } 

    diag(model$A) %op% vecParams[1:5]
    model$B[upper.tri[model$B]] %op% vecParams[5 + (1:(5*(5-1)/2)))]

    if(mode == "load") {
        model
    } else {
        vecParams
    }
}

LoadModelFromVector(vecParams) {LoadStoreModel(vecParams)}
StoreModelToVector(model) {LoadStoreModel(NULL, model)}

以上代码生成错误＆＃34;错误：对象＆＃39; - ＆gt;＆＃39;找不到＆＃34;。两个运营商，＆＃39; - ＆gt;＆＃39;和＆＃39;＆lt; - ＆＃39;，记录在软件包基础的R帮助页面?assignOps中。

Answer 1

`＆LT; -` 在控制台中返回

.Primitive("<-")即。 <-是R
中的原始函数

> `<-`
.Primitive("<-")
> `->`
Error: object '->' not found

此外，如果我们查看base包的所有功能，并尝试搜索<-和->

#find all functions in package    
r <- unclass(lsf.str(envir = asNamespace("base"), all = T))

> r[grep("^<-$", r)]
[1] "<-"

> r[grep("^->$", r)]
character(0)

这返回base包

中没有` - ＆gt;`函数

希望这有帮助。

Answer 2

我的示例的以下修改似乎工作正常（也修复了一些语法拼写错误）：

LoadStoreModel <- function(vecParams, model = NULL) {
  if(is.null(model)) {
    model <- list(
      A = diag(5),            # a diagonal square matrix
      B = matrix(0, 5, 5)     # un upper triangular square matrix
    )
    attr(model, "p")<-15
    "%op%" <- `<-`             
    mode <- "load"
  } else {
    vecParams <- double(length = attr(model, "p"))

    "%op%"<- function(a,b) eval(substitute(b<-a), parent.frame()) # key-chage

    mode <- "store"
  } 

  diag(model$A) %op% vecParams[1:5]
  model$B[upper.tri(model$B)] %op% vecParams[5 + (1:(5*(5-1)/2))]

  if(mode == "load") {
    model
  } else {
    vecParams
  }
}

LoadModelFromVector <- function(vecParams) LoadStoreModel(vecParams)
StoreModelToVector <- function(model) LoadStoreModel(NULL, model)

> StoreModelToVector(m)
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15
> m <- LoadModelFromVector(1:15)
> m
$A
     [,1] [,2] [,3] [,4] [,5]
[1,]    1    0    0    0    0
[2,]    0    2    0    0    0
[3,]    0    0    3    0    0
[4,]    0    0    0    4    0
[5,]    0    0    0    0    5

$B
     [,1] [,2] [,3] [,4] [,5]
[1,]    0    6    7    9   12
[2,]    0    0    8   10   13
[3,]    0    0    0   11   14
[4,]    0    0    0    0   15
[5,]    0    0    0    0    0

attr(,"p")
[1] 15
> StoreModelToVector(m)
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15

我还尝试过该行的其他一些变体注释为＆＃34; key-change＆＃34;。这些不起作用：

# evaluation happens locally in the environment of the operator function,
# so the actual objects a and b in the parent environment are not affected:
"%op%"<- function(a,b) eval(substitute(b<-a)) 

# not sure why this did not work, but it seems that changes are made on local 
# copies of the objects as well.
"%op%"<- function(a,b) eval(quote(b<-a), parent.frame())

> StoreModelToVector(m)
 [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

错误：对象＆＃39; - ＆gt;＆＃39;在R中找不到

2 个答案: