1

I have a model object described as a named list of vector and matrix parameters. Two basic operations with this class of objects are the loading and storing from/to a numeric vector, based on a mapping between the elements of each parameter vector or matrix and the indices in the vector. Here is a simplified example:

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
}

I don't like the above example because it replicates the mapping in two places in the code. Instead, I would like to have this mapping in one place. I thought that this could be elegantly done using an abstraction of the assignment operator <-:

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)}

The above code generates the error "Error: object '->' not found". Both operators, '->' and '<-', are documented in the R help page ?assignOps from the package base.

Thriving For Perfection
  • 76
  • 1
  • 7
  • possible duplicate of: https://stackoverflow.com/questions/23309687/parsing-assignment-operator-in-r – clemens Mar 07 '18 at 08:01
  • @clemens: thanks for the hint. Your suggested post discusses a slightly different problem but one of its answers points to https://stackoverflow.com/questions/34599027/how-exactly-does-r-parse-the-right-assignment-operator . This one clearly answers my question. – Thriving For Perfection Mar 07 '18 at 08:30

2 Answers2

1

`<-` in console returns

.Primitive("<-") ie. <- is a primitive function in R

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

Also, if we look into all the functions of base package and try searching for <- and ->

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

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

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

This returns that there is no `->` function in base package

Hope this helps.

parth
  • 1,571
  • 15
  • 24
0

The following modification of my example seems to work fine (also fixed some syntax typos):

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

I've also tried some other variants of the line commented as "key-change". These did not work:

# 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
Thriving For Perfection
  • 76
  • 1
  • 7