Is it possible to return an invisible object when using the S3 indexing function "[" on a custom class? For example, in the code below, is there a way to make the last line of code not print anything?
mat <- function(x) {
structure(x, class="mat")
}
"[.mat" <- function(x, i, j) {
invisible(unclass(x)[i,j])
}
m1 <- mat(matrix(1:10, ncol=2))
m1[1:2,]
[,1] [,2]
[1,] 1 6
[2,] 2 7
You are running into issues with the visibility mechanism caused by primitive functions. Consider:
> length.x <- function(x) invisible(23)
> length(structure(1:10, class="x"))
[1] 23
> mean.x <- function(x) invisible(23)
> mean(structure(1:10, class="x"))
> # no output
length is a primitive, but mean is not. From R Internals:
Whether the returned value of a top-level R expression is printed is controlled by the global boolean variable R_Visible. This is set (to true or false) on entry to all primitive and internal functions based on the eval column of the table in file src/main/names.c: the appropriate setting can be extracted by the macro PRIMPRINT.
and
Internal and primitive functions force the documented setting of R_Visible on return, unless the C code is allowed to change it (the exceptions above are indicated by PRIMPRINT having value 2).
So it would seem that you cannot force invisible returns from primitive generics like [, length, etc., and you must resort to workarounds like the one suggested by Alex.
The problem is that the value returned from [.mat is not of class mat since you're using unclass, so it uses the default printing method for whatever class it has. To fix this, just ensure that the returned object is still a mat and define a printing method for mat objects.
mat <- function(x) {
class(x) <- "mat"
x
}
`[.mat` <- function(x, i, j) {
y <- mat(unclass(x)[i, j])
invisible(y)
}
print.mat <- function(x, ...) {
invisible(x)
}
test <- mat(matrix(1:10, ncol = 2))
test[1, 1]
# Nothing is printed
Related
For example, suppose I would like to be able to define a function that returned the name of the assignment variable concatenated with the first argument:
a <- add_str("b")
a
# "ab"
The function in the example above would look something like this:
add_str <- function(x) {
arg0 <- as.list(match.call())[[1]]
return(paste0(arg0, x))
}
but where the arg0 line of the function is replaced by a line that will get the name of the variable being assigned ("a") rather than the name of the function.
I've tried messing around with match.call and sys.call, but I can't get it to work. The idea here is that the assignment operator is being called on the variable and the function result, so that should be the parent call of the function call.
I think that it's not strictly possible, as other solutions explained, and the reasonable alternative is probably Yosi's answer.
However we can have fun with some ideas, starting simple and getting crazier gradually.
1 - define an infix operator that looks similar
`%<-add_str%` <- function(e1, e2) {
e2_ <- e2
e1_ <- as.character(substitute(e1))
eval.parent(substitute(e1 <- paste0(e1_,e2_)))
}
a %<-add_str% "b"
a
# "ab"
2 - Redefine := so that it makes available the name of the lhs to the rhs through a ..lhs() function
I think it's my favourite option :
`:=` <- function(lhs,rhs){
lhs_name <- as.character(substitute(lhs))
assign(lhs_name,eval(substitute(rhs)), envir = parent.frame())
lhs
}
..lhs <- function(){
eval.parent(quote(lhs_name),2)
}
add_str <- function(x){
res <- paste0(..lhs(),x)
res
}
a := add_str("b")
a
# [1] "ab"
There might be a way to redefine <- based on this, but I couldn't figure it out due to recursion issues.
3 - Use memory address dark magic to hunt lhs (if it exists)
This comes straight from: Get name of x when defining `(<-` operator
We'll need to change a bit the syntax and define the function fetch_name for this purpose, which is able to get the name of the rhs from a *<- function, where as.character(substitute(lhs)) would return "*tmp*".
fetch_name <- function(x,env = parent.frame(2)) {
all_addresses <- sapply(ls(env), pryr:::address2, env)
all_addresses <- all_addresses[names(all_addresses) != "*tmp*"]
all_addresses_short <- gsub("(^|<)[0x]*(.*?)(>|$)","\\2",all_addresses)
x_address <- tracemem(x)
untracemem(x)
x_address_short <- tolower(gsub("(^|<)[0x]*(.*?)(>|$)","\\2",x_address))
ind <- match(x_address_short, all_addresses_short)
x_name <- names(all_addresses)[ind]
x_name
}
`add_str<-` <- function(x,value){
x_name <- fetch_name(x)
paste0(x_name,value)
}
a <- NA
add_str(a) <- "b"
a
4- a variant of the latter, using .Last.value :
add_str <- function(value){
x_name <- fetch_name(.Last.value)
assign(x_name,paste0(x_name,value),envir = parent.frame())
paste0(x_name,value)
}
a <- NA;add_str("b")
a
# [1] "ab"
Operations don't need to be on the same line, but they need to follow each other.
5 - Again a variant, using a print method hack
Extremely dirty and convoluted, to please the tortured spirits and troll the others.
This is the only one that really gives the expected output, but it works only in interactive mode.
The trick is that instead of doing all the work in the first operation I also use the second (printing). So in the first step I return an object whose value is "b", but I also assigned a class "weird" to it and a printing method, the printing method then modifies the object's value, resets its class, and destroys itself.
add_str <- function(x){
class(x) <- "weird"
assign("print.weird", function(x) {
env <- parent.frame(2)
x_name <- fetch_name(x, env)
assign(x_name,paste0(x_name,unclass(x)),envir = env)
rm(print.weird,envir = env)
print(paste0(x_name,x))
},envir = parent.frame())
x
}
a <- add_str("b")
a
# [1] "ab"
(a <- add_str("b") will have the same effect as both lines above. print(a <- add_str("b")) would also have the same effect but would work in non interactive code, as well.
This is generally not possible because the operator <- is actually parsed to a call of the <- function:
rapply(as.list(quote(a <- add_str("b"))),
function(x) if (!is.symbol(x)) as.list(x) else x,
how = "list")
#[[1]]
#`<-`
#
#[[2]]
#a
#
#[[3]]
#[[3]][[1]]
#add_str
#
#[[3]][[2]]
#[1] "b"
Now, you can access earlier calls on the call stack by passing negative numbers to sys.call, e.g.,
foo <- function() {
inner <- sys.call()
outer <- sys.call(-1)
list(inner, outer)
}
print(foo())
#[[1]]
#foo()
#[[2]]
#print(foo())
However, help("sys.call") says this (emphasis mine):
Strictly, sys.parent and parent.frame refer to the context of the
parent interpreted function. So internal functions (which may or may
not set contexts and so may or may not appear on the call stack) may
not be counted, and S3 methods can also do surprising things.
<- is such an "internal function":
`<-`
#.Primitive("<-")
`<-`(x, foo())
x
#[[1]]
#foo()
#
#[[2]]
#NULL
As Roland pointed, the <- is outside of the scope of your function and could only be located looking at the stack of function calls, but this fail. So a possible solution could be to redefine the '<-' else than as a primitive or, better, to define something that does the same job and additional things too.
I don't know if the ideas behind following code can fit your needs, but you can define a "verbose assignation" :
`:=` <- function (var, value)
{
call = as.list(match.call())
message(sprintf("Assigning %s to %s.\n",deparse(call$value),deparse(call$var)))
eval(substitute(var <<- value))
return(invisible(value))
}
x := 1:10
# Assigning 1:10 to x.
x
# [1] 1 2 3 4 5 6 7 8 9 10
And it works in some other situation where the '<-' is not really an assignation :
y <- data.frame(c=1:3)
colnames(y) := "b"
# Assigning "b" to colnames(y).
y
# b
#1 1
#2 2
#3 3
z <- 1:4
dim(z) := c(2,2)
#Assigning c(2, 2) to dim(z).
z
# [,1] [,2]
#[1,] 1 3
#[2,] 2 4
>
I don't think the function has access to the variable it is being assigned to. It is outside of the function scope and you do not pass any pointer to it or specify it in any way. If you were to specify it as a parameter, you could do something like this:
add_str <- function(x, y) {
arg0 <-deparse(substitute(x))
return(paste0(arg0, y))
}
a <- 5
add_str(a, 'b')
#"ab"
The problem I am trying to tackle here is needing to apply (execute) an S3 object which is essentially a vector-like structure. This may contain various formulas which at some stage I need to evaluate for a single argument, in order to get back a vector-like object of the original shape, containing the evaluation of its constituent formulas at the given argument.
Examples of this (just to illustrate) might be a matrix of transformation - say rotation - which would take the angle to rotate by, and produce a matrix of values by which to multiply a point, for the given rotation. Another example might be the vector of states in a problem in classical mechanics. Then given t, v, a, etc, it could return s...
Now, I have created my container object in S3, and its working fine in most respects, using generic methods; I also found the Ops.myClass system of operator overloading very useful.
To complete my class, all I need now is a way to specify it as executable.
I see that there are various mechanisms that will do what I want in part, for instance I suppose that as.function() will convert the object to behave as I want, and something like lapply() could be used for the "reverse" application of the argument to the functions. What I am not sure how to do is link it all up so that I can do something like this mock-up:
new_Object <- function(<all my function vector stuff spec>)
vtest <- new_Object(<say, sin, cos, tan>)
vtest(1)
==>
myvec(.8414709848078965 .5403023058681398 1.557407724654902)
(Yes, I have already specified a generic print() routine that will make it appear nice)
All suggestions, sample code, links to examples are welcome.
PS =====
I have added some basic example code as per request.
I am not sure how much would be too much, so the full working minimal example, including operator overloading is in this gist here.
I am only showing the constructor and helper functions below:
# constructor
new_Struct <- function(stype , vec){
stopifnot(is.character(stype)) # enforce up | down
stopifnot(is.vector(vec))
structure(vec,class="Struct", type=stype)
}
# constructor helper functions --- need to allow for nesting!
up <-function(...){
vec <- unlist(list(...),use.names = FALSE)
new_Struct("up",vec)
}
down <-function(...){
vec <- unlist(list(...),use.names = FALSE)
new_Struct("down",vec)
}
The above code behaves thus:
> u1 <- up(1,2,3)
> u2 <- up(3,4,5)
> d1 <- down(u1)
> d1
[1] down(1, 2, 3)
> u1+u2
[1] up(4, 6, 8)
> u1+d1
Error: '+' not defined for opposite tuple types
> u1*d1
[1] 14
> u1*u2
[,1] [,2] [,3]
[1,] 3 4 5
[2,] 6 8 10
[3,] 9 12 15
> u1^2
[1] 14
> s1 <- up(sin,cos,tan)
> s1
[1] up(.Primitive("sin"), .Primitive("cos"), .Primitive("tan"))
> s1(1)
Error in s1(1) : could not find function "s1"
What I need, is for it to be able to do this:
> s1(1)
[1] up(.8414709848078965 .5403023058681398 1.557407724654902)
You can not call each function in a list of functions without a loop.
I'm not fully understanding all requirements, but this should give you a start:
new_Struct <- function(stype , vec){
stopifnot(is.character(stype)) # enforce up | down
stopifnot(is.vector(vec) || is.function(vec))
structure(vec,class="Struct", type=stype)
}
# constructor helper functions --- need to allow for nesting!
up <- function(...) UseMethod("up")
up.default <- function(...){
vals <- list(...)
stopifnot(all(vapply(vals, is.vector, FUN.VALUE = logical(1))))
vec <- unlist(vals, use.names = FALSE)
new_Struct("up",vec)
}
up.function <- function(...){
funs <- list(...)
stopifnot(all(vapply(funs, is.function, FUN.VALUE = logical(1))))
new_Struct("up", function(x) new_Struct("up", sapply(funs, do.call, list(x))))
}
up(1, 2, 3)
#[1] 1 2 3
#attr(,"class")
#[1] "Struct"
#attr(,"type")
#[1] "up"
up(1, 2, sin)
#Error in up.default(1, 2, sin) :
# all(vapply(vals, is.vector, FUN.VALUE = logical(1))) is not TRUE
up(sin, 1, 2)
#Error in up.function(sin, 1, 2) :
# all(vapply(funs, is.function, FUN.VALUE = logical(1))) is not TRUE
s1 <- up(sin, cos, tan)
s1(1)
#[1] 0.8414710 0.5403023 1.5574077
#attr(,"class")
#[1] "Struct"
#attr(,"type")
#[1] "up"
After some thought I have come up with a way to approach this, it's not perfect, it would be great if someone could figure out a way to make the function call implicit/transparent.
So, for now I just use the call() mechanism on the object, and that seems to work fine. Here's the pertinent part of the code, minus checks. I'll put up the latest full version on the same gist as above.
# constructor
new_Struct <- function(stype , vec){
stopifnot(is.character(stype)) # enforce up | down
stopifnot(is.vector(vec))
structure(vec,class="Struct", type=stype)
}
# constructor helper functions --- need to allow for nesting!
up <- function(...){
vec <- unlist(list(...), use.names = FALSE)
new_Struct("up",vec)
}
down <- function(...){
vec <- unlist(list(...), use.names = FALSE)
new_Struct("down",vec)
}
# generic print for tuples
print.Struct <- function(s){
outstr <- sprintf("%s(%s)", attributes(s)$type, paste(c(s), collapse=", "))
print(noquote(outstr))
}
# apply the structure - would be nice if this could be done *implicitly*
call <- function(...) UseMethod("call")
call.Struct <- function(s,x){
new_Struct(attributes(s)$type, sapply(s, do.call, list(x)))
}
Now I can do:
> s1 <- up(sin,cos,tan)
> length(s1)
[1] 3
> call(s1,1)
[1] up(0.841470984807897, 0.54030230586814, 1.5574077246549)
>
Not as nice as my ultimate target of
> s1(1)
[1] up(0.841470984807897, 0.54030230586814, 1.5574077246549)
but it will do for now...
I obtained this from an open source repo on git. This shows the writing of generic and methods for S3 classes. But I do not understand the notations or conventions that the functions are being assigned to. The following are my questions:
The use backticks `` to define the function name. Usually we wouldn't use backticks or even double quotes to assign variables/functions but I see this happening a lot of times. Is this a naming convention?
Why is the . included before the blob name? Usually wouldn't it just be called blob and a method would be method.blob?
Why are there [ brackets there? Especially, [<- and [[<-. Are we performing some sort of double asigning?
Hopefully someone will be able to shed some light on what is ha
#' #export
`[.blob` <- function(x, i, ...) {
new_blob(NextMethod())
}
#' #export
`[<-.blob` <- function(x, i, ..., value) {
if (!is_raw_list(value)) {
stop("RHS must be list of raw vectors", call. = FALSE)
}
NextMethod()
}
#' #export
`[[<-.blob` <- function(x, i, ..., value) {
if (!is.raw(value) && !is.null(value)) {
stop("RHS must be raw vector or NULL", call. = FALSE)
}
if (is.null(value)) {
x[i] <- list(NULL)
x
} else {
NextMethod()
}
}
Summary
If you're creating a new object in R for which you want 'different' subset and assignment behaviour, you should create the associated methods for these operations.
The . IS working in the way you're expecting - method dispatch
[.blob is overriding the S3 [ subset operator
[<-.blob is overriding the S3 [<- operator (i.e. vector-subset assignment)
[[<-.blob is overriding the S3 [[<- operator (i.e. list-subset assignment)
Special symbols (e.g., backticks, brackets, percent-sign, variables with spaces in the name) cannot be "assigned to" by default. To do so, if you surround it in backticks, it can work. As an example, a variable named A B cannot be assigned with A B <- 1, whereas `A B` <- 1 works (credit #r2evans)
Examples
subset
Taking [.blob as an example, this allows you to create your own subset operation for your blob object.
## Create your own blob object (class)
blob <- 1:5
attr(blob, "class") <- "blob"
## create a subset operator, which in this example just calls the next method in the s3 dispatch chain
`[.blob` <- function(x, i, j, ...) NextMethod()
As we're not doing anything special in our own subset method, this works like normal R vectors
blob[3]
# [1] 3
However, we can make the subset operation do whatever we want, for example always return the 1st element of the vector
## define the function to always subset the first element
`[.blob` <- function(x, i, j, ...) { i = 1; NextMethod() }
Now your blob object will only ever return the 1st element.
blob[1]
# [1] 1
blob[2]
# [1] 1
blob[3]
# [1] 1
Assignment
Similarly for one of the assignment operators, if you overload [<- with
`[<-.blob` <- function(x, i, j, ...) { i = 5; NextMethod() }
This will always assign the 5th element of your blob object with the new value
blob[1] <- 100
blob
# [1] 1 2 3 4 100
# attr(,"class")
# [1] "blob"
Back ticks
The back-ticks are used so we can assign functions/variables to special symbols.
For example, try to assign a vector to the [ symbol
[ <- 1:5
# Error: unexpected '[' in "["
Whereas surrounding it with ticks lets it pass (although this example is not recommended)
`[` <- 1:5
`[`
# [1] 1 2 3 4 5
i know might of u think this question and duplicated,but i do really have something kinda freaks me out, i was learning R and i had assignment to do something i do manage to solve it but i wonder why this error appear while the 2 code is very similar, is that something i don't understand in R
the first who has give me an error was :
makeCacheMatrix <- function(x = matrix()) {
#i for invirse
i <- NULL
set <- function(y){
x <<- y
i <<- NULL
}
get <- function(){x}
setinv <- function(solved){i <<- solved}
getinv <- function(){i}
#a list that has the 4 internal methods
list(set = set, get = get,
setinv = setinv,
getinv = getinv)
}
## Write a short comment describing this function
# this method check first if the data already cached,
# if they are it return it with message says "Getting cached data"
# if not it calculated, cache it and then return it
cacheSolve <- function(x, ...) {
## Return a matrix that is the inverse of 'x'
i <- x$getinv()
if(!is.null(i)){
message("Getting cached data")
return(i)
}
#calculate the inverse
x <- x$get()
i <- solve(x)
#print(i)
#print(class(i))
x$setinv(i)
i
}
this is how i call my function and the only result i get is
ps uncomment the print and clas funs will give the correct answers:
> source('~/R/cachematrix[not workng].R')
> x <- makeCacheMatrix(matrix(rnorm(16), 4,4))
> cacheSolve(x)
Error in x$setinv : $ operator is invalid for atomic vectors
after some time i said to myself why using too match variable and i use the methods inside each other for more sample code (one line is better)
but somehow the code works, for me it's the same code the only thing i have did the to pass the methods to each other instead of passing it into variable then pass the variable to method (it's the same really)
the code became like this now :
## Write a short comment describing this function
# this method retuen a matrix that has a list
# this list has 4 method as getters and sitters
makeCacheMatrix <- function(x = matrix()) {
#i for invirse
i <- NULL
set <- function(y){
x <<- y
i <<- NULL
}
get <- function(){x}
setinv <- function(solved){i <<- solved}
getinv <- function(){i}
#a list that has the 4 internal methods
list(set = set, get = get,
setinv = setinv,
getinv = getinv)
}
## Write a short comment describing this function
# this method check first if the data alredy cached,
# if they are it return it with messege sys "Getting cached data"
# if not it calculated, cache it and then return it
cacheSolve <- function(x, ...) {
## Return a matrix that is the inverse of 'x'
i <- x$getinv()
if(!is.null(i)){
message("Getting cached data")
return(i)
}
#calculate the invirse
i <- solve(x$get())
#cache the invirse for later
x$setinv(i)
i
}
and this's how i call my function:
> source('~/R/ProgrammingAssignment2/cachematrix.R')
> x <- makeCacheMatrix(matrix(rnorm(16), 4,4))
> cacheSolve(x)
[,1] [,2] [,3] [,4]
[1,] 0.09904578 -0.4586855 -0.2487849 -0.3421875
[2,] -1.84896897 0.8476203 0.7990204 0.5919526
[3,] 0.70645287 -0.1508695 -0.7141914 -0.2729974
[4,] 1.37441746 -0.9853108 -0.5607929 0.6553295
works good, i just wanna know what happen there, and why the first code give me an error and the second one didn't while both suppose to have the same logic, Thanks in advance mates
ps. i'm using : R version 3.3.2 on linux mint 18.1 with the latest version of rstudio
I am constructing an approximating function recursively (adaboost). I would like to create the resulting learning function along the way (not to apply the approximation directly to my test data but keep the function that leads to it)
unfortunately, it seems that R updates the value to which a variable name refers to long after it is used.
#defined in plyr as well
id <- function(x) {x}
#my first classifier
modelprevious <- function(inputx, k) { k(0)}
#one step of my superb model
modelf <- function(x) 2*x #for instance
#I update my classifier
modelCurrent <- function(inputx, k)
{ modelprevious(inputx, function(res) {k(res + modelf(inputx))})}
#it works
modelCurrent(2,id) #4
#Problem
modelf <- function(x) 3*x
modelCurrent(2,id) #6 WTF !!
The same function with the same argument return something different, which is quite annoying !
So how is it possible to capture the value represented by modelf so that the resulting function only depends on its argument at the time of the binding, and not of some global state ?
Given that problem I dont see how one can do a recursive function building in R if one can not touch local variable, apart going through ugly hacks of quote/parse
You need a factory:
modelCurrent = function(mf){
return(function(inputx,k){
modelprevious(
inputx,
function(res){
k(res+mf(inputx))
} # function(res)
) # modelprevious
} # inner function
) # return
} # top function
Now you use the factory to create models with the modelf function that you want it to use:
> modelf <- function(x) 2*x
> m1 = modelCurrent(modelf)
> m1(2,id)
[1] 4
> modelf <- function(x) 3*x
> m1(2,id) # no change.
[1] 4
You can always make them on an ad-hoc basis:
> modelCurrent(modelf)(2,id)
[1] 6
and there you can see the factory created a function using the current definition of modelf, so it multiplied by three.
There's one last ginormous WTF!?! that will hit you. Watch carefully:
> modelf <- function(x) 2*x
> m1 = modelCurrent(modelf)
> m1(2,id)
[1] 4
>
> m1 = modelCurrent(modelf) # create a function using the 2* modelf
> modelf <- function(x) 3*x # change modelf...
> m1(2,id) # WTF?!
[1] 6
This is because when the factory is called, mf isn't evaluated - that's because the inner function isn't called, and mf isn't used until the inner function is called.
The trick is to force evaluation of the mf in the outer function, typically using force:
modelCurrent = function(mf){
force(mf)
return(function(inputx,k){
modelprevious(
inputx,
function(res){
k(res+mf(inputx))
} # function(res)
) # modelprevious
} # inner function
) # return
} # top function
This has lead me to premature baldness, because if you forget this and think there's some odd bug going on, and then try sticking print(mf) in place to see what's going on, you'll be evaluating mf and thus getting the behaviour you wanted. By inspecting the data, you changed it! A Heisenbug!