Reputation: 76
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.
Upvotes: 1
Views: 5210
Reputation: 76
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
Upvotes: 0
Reputation: 1621
`<-` 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.
Upvotes: 1