Custom class inheriting `data.frame` and replacement method - r

I defined a class (tdtfile), which inherits data.frame. I am now trying to define a [.data.frame-equivalent replacement method to return an appropriate object of class tdtfile rather than data.frame, but am having trouble.
Here is What I'm doing:
# Define Class
setClass("tdtfile",
representation(Comment = "character"),
prototype(Comment = NULL),
contains = c("data.frame"))
# Construct instance and populate
test <- new("tdtfile",Comment="Blabla")
df <- data.frame(A=seq(26),B=LETTERS)
for(sName in names(getSlots("data.frame"))){
slot(test,sName) <- slot(df,sName)
}
# "Normal" data.frame behavior (loss of slot "Comment")
str(test[1])
# Works as well - will be trying to use that below
`[.data.frame`(test,1)
# Try to change replacement method in order to preserve slot structure
# while accessing data.frame functionality
setMethod(
`[`,
signature=signature(x="tdtfile"),
function(x, ...){
# Save the original
storedtdt <- x
# Use the fact that x is a subclass to "data.frame"
tmpDF <- `[.data.frame`(x, ...)
# Reintegrate the results
if(inherits(x=tmpDF,what="data.frame")){
for(sName in names(getSlots("data.frame"))){
slot(storedtdt,sName) <- slot(tmpDF,sName)
}
return(storedtdt)
} else {
return(tmpDF)
}
})
# Method does not work - data.frame remains complete. WHY?
str(test[1])
# Cleanup
#removeMethod(
# `[`,
# signature=signature(x="tdtfile"))
When calling something like
tdtfile[1]
this returns a a tdtfile object with all contained data.frame columns rather than just the first ... can anyone spot what I'm missing?
Thank you for your help.
Sincerely, Joh

The reason your method is misbehaving is that i, j, and drop are automatically made available inside your [ method, I believe simply as a consequence of how the [ generic works. This means you need to pass these arguments by name to [.data.frame rather than relying on .... Unfortunately, this in turn puts the onus on you to handle the various forms of indexing correctly.
Here is a modified method definition that does a decent job, though it may not behave exactly analogously to the pure data frame indexing under certain uses of the drop argument:
setMethod(
`[`,
signature=signature(x="tdtfile"),
function(x, ...){
# Save the original
storedtdt <- x
# Use the fact that x is a subclass to "data.frame"
Nargs <- nargs()
hasdrop <- "drop" %in% names(sys.call())
if(Nargs==2) {
tmpDF <- `[.data.frame`(x, i=TRUE, j=i, ..., drop=FALSE)
} else if((Nargs==3 && hasdrop)) {
tmpDF <- `[.data.frame`(x, i=TRUE, j=i, ..., drop)
} else if(hasdrop) {
tmpDF <- `[.data.frame`(x, i, j, ..., drop)
} else {
tmpDF <- `[.data.frame`(x, i, j, ...)
}
# Reintegrate the results
if (inherits(x=tmpDF, what="data.frame")){
for(sName in names(getSlots("data.frame"))){
slot(storedtdt, sName) <- slot(tmpDF, sName)
}
return(storedtdt)
} else {
return(tmpDF)
}
})
A few examples with your test object:
> head(test[1])
Object of class "tdtfile"
A
1 1
2 2
3 3
4 4
5 5
6 6
Slot "Comment":
[1] "Blabla"
> test[1:2,]
Object of class "tdtfile"
A B
1 1 A
2 2 B
Slot "Comment":
[1] "Blabla"
I'm not sure if there is a more canonical way of doing this. Perhaps trying looking at the source code of some S4 packages?
Edit: Here is a replacement method in spirit similar to the extraction method above. This one explicitly coerces the object to a data frame before calling [<- directly on it, mostly to avoid a warning you get if [<-.data.frame does it. Again, behavior is not exactly identical to the pure data frame replacement method, though with more work it could be made so.
setMethod(
`[<-`,
signature=signature(x="tdtfile"),
function(x, ..., value){
# Save the original
storedtdt <- x
# Use the fact that x is a subclass to "data.frame"
Nargs <- nargs()
if (any(!names(sys.call()) %in% c("", "i", "j", "value"))) {
stop("extra arguments are not allowed")
}
tmpDF <- data.frame(x)
if(Nargs==3) {
if (missing(i)) i <- j
tmpDF[i] <- value
} else if(Nargs==4) {
tmpDF[i, j] <- value
}
# Reintegrate the results
for(sName in names(getSlots("data.frame"))){
slot(storedtdt, sName) <- slot(tmpDF, sName)
}
return(storedtdt)
})
Examples:
> test[2] <- letters
> test[1,"B"] <- "z"
> test$A[1:3] <- 99
> head(test)
Object of class "tdtfile"
A B
1 99 z
2 99 b
3 99 c
4 4 d
5 5 e
6 6 f
Slot "Comment":
[1] "Blabla"
As an aside, if it's critical that extract/replace work exactly as they do on data frames, I'd consider rewriting the class to have a slot containing the data frame, rather than having data.frame as a superclass. Composition over inheritance!

Related

Can I access the assignment of a function from inside that function? [duplicate]

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"

How can I add additional arguments to methods for internal generics?

I want to implement an inset method for my class myClass for the internal generic [<- (~ help(Extract)).
This method should run a bunch of tests, before passing on the actual insetting off to [<- via NextMethod().
I understand that:
any method has to include at least the arguments of the generic (mine does, I think)
the NextMethod() call does not usually need any arguments (though supplying them manually doesn't seem to help either).
Here's my reprex:
x <- c(1,2)
class(x) <- c("myClass", "numeric")
`[<-.myClass` <- function(x, i, j, value, foo = TRUE, ...) {
if (foo) {
stop("'foo' must be false!")
}
NextMethod()
}
x[1] <- 3 # this errors out with *expected* error message, so dispatch works
x[1, foo = FALSE] <- 3 # this fails with "incorrect number of subscripts
What seems to be happening is that NextMethod() also passes on foo to the internal generic [<-, which mistakes foo for another index, and, consequently errors out (because, in this case, x has no second dimension to index on).
I also tried supplying the arguments explicitly no NextMethod(), but this also fails (see reprex below the break).
How can I avoid choking up NextMethod() with additional arguments to my method?
(Bonus: Does anyone know good resources for building methods for internal generics? #Hadleys adv-r is a bit short on the matter).
Reprex with explicit arguments:
x <- c(1,2)
class(x) <- c("myClass", "numeric")
`[<-.myClass` <- function(x, i = NULL, j = NULL, value, foo = TRUE, ...) {
if (foo) {
stop("'foo' must be false!")
}
NextMethod(generic = "`[<-`", object = x, i = i, j = j, value = value, ...)
}
x[1] <- 3 # this errors out with expected error message, so dispatch works
x[1, foo = FALSE] <- 3 # this fails with "incorrect number of subscripts
I don't see an easy way around this except to strip the class (which makes a copy of x)
`[<-.myClass` <- function(x, i, value, ..., foo = TRUE) {
if (foo) {
cat("hi!")
x
} else {
class_x <- class(x)
x <- unclass(x)
x[i] <- value
class(x) <- class_x
x
}
}
x <- structure(1:2, class = "myClass")
x[1] <- 3
#> hi!
x[1, foo = FALSE] <- 3
x
#> [1] 3 2
#> attr(,"class")
#> [1] "myClass"
This is not a general approach - it's only needed for [, [<-, etc because they don't use the regular rules for argument matching:
Note that these operations do not match their index arguments in the standard way: argument names are ignored and positional matching only is used. So m[j = 2, i = 1] is equivalent to m[2, 1] and not to m[1, 2].
(from the "Argument matching" section in ?`[`)
That means your x[1, foo = FALSE] is equivalent to x[1, FALSE] and then you get an error message because x is not a matrix.
Approaches that don't work:
Supplying additional arguments to NextMethod(): this can only increase the number of arguments, not decrease it
Unbinding foo with rm(foo): this leads to an error about undefined foo.
Replacing foo with a missing symbol: this leads to an error that foo is not supplied with no default argument.
Here's how I understand it, but I don't know so much about that subject so I hope I don't say too many wrong things.
From ?NextMethod
NextMethod invokes the next method (determined by the class vector,
either of the object supplied to the generic, or of the first argument
to the function containing NextMethod if a method was invoked
directly).
Your class vector is :
x <- c(1,2)
class(x) <- "myClass" # note: you might want class(x) <- c("myClass", class(x))
class(x) # [1] "myClass"
So you have no "next method" here, and [<-.default, doesn't exist.
What would happen if we define it ?
`[<-.default` <- function(x, i, j, value, ...) {print("default"); value}
x[1, foo = FALSE] <- 3
# [1] "default"
x
# [1] 3
If there was a default method with a ... argument it would work fine as the foo argument would go there, but it's not the case so I believe NextMethod just cannot be called as is.
You could do the following to hack around the fact that whatever is called doesn't like to be fed a foo argument:
`[<-.myClass` <- function(x, i, j, value, foo = FALSE, ...) {
if (foo) {
stop("'foo' must be false!")
}
`[<-.myClass` <- function(x, i, j, value, ...) NextMethod()
args <- as.list(match.call())[-1]
args <- args[names(args) %in% c("","x","i","j","value")]
do.call("[<-",args)
}
x[1, foo = FALSE] <- 3
x
# [1] 3 2
# attr(,"class")
# [1] "myClass"
Another example, with a more complex class :
library(data.table)
x <- as.data.table(iris[1:2,1:2])
class(x) <- c("myClass",class(x))
x[1, 2, foo = FALSE] <- 9999
# Sepal.Length Sepal.Width
# 1: 5.1 9999
# 2: 4.9 3
class(x)
# [1] "myClass" "data.table" "data.frame"
This would fail if the next method had other arguments than x, i, j and value, in that case better to be explicit about our additional arguments and run args <- args[! names(args) %in% c("foo","bar")]. Then it might work (as long as arguments are given explicitly as match.call doesn't catch default arguments). I couldn't test this though as I don't know such method for [<-.

How can I see which columns I tried to select when "undefined columns selected"?

I'm building a package that interfaces with a git repository and works with historical versions of R functions. The trouble is that sometimes, these old functions are expecting the input data.frame to have columns it doesn't have. These columns don't affect the functionality, but they used to be in the data and they were hard-coded in these old functions. So of course, I'm getting an "undefined columns selected" error.
I want to use tryCatch to see which columns are missing and add them as dummies to my data.frame. For example,
old_fn <- function(x) {
print(x[, "c"])
return(x)
}
df <- data.frame(a = c(1,2,3), b = c(3,4,5))
result <- 0
while(result == 0) {
result <- tryCatch(
old_fn(df),
error = function(cond) {
if (grepl("undefined columns selected", cond, fixed = T)) {
missing_cols <- # ????
for (col in missing_cols) {
df[[eval(col)]] <- NA
}
return(0)
} else {
return(1)
}
}
)
}
I've tried calling traceback() and grepping the missing_cols from there but that doesn't seem to work during runtime the way I'd expect. Is there no way to see which columns are undefined?
Here's one way you could do this,
but I would feel very uncomfortable about doing it in an R package that's meant to be used by others.
I don't know if R's CMD check would flag it.
You can see the default function used to subset data frames by typing `[.data.frame` in the console.
There you can see the formal arguments and the body.
You would see that the default formals are function (x, i, j, drop = if (missing(i)) TRUE else length(cols) == 1).
You could then use trace to inject an expression that would be evaluated at the start of the function evaluation:
create_missing_cols <- function(x, j) {
missing_cols <- setdiff(j, colnames(x))
if (length(missing_cols) > 0L) {
for (column in missing_cols) {
x[[column]] <- NA
}
}
# return
x
}
trace(`[.data.frame`,
print = FALSE,
tracer = quote(x <- create_missing_cols(x, j)))
df <- data.frame(a = 1:2)
df[, c("a", "b", "c")]
a b c
1 1 NA NA
2 2 NA NA
untrace(`[.data.frame`)
This assumes that you will be using it only when j is a character vector.
EDIT: if you do end up using this,
definitely consider using on.exit(untrace(`[.data.frame`)) right after the call to trace,
so that the function is untraced even if errors occur.

How to write coercion methods

I'm having a bunch of custom-made Reference Classes and would like to write coercion methods for some of them. It'd be nice if a function call would look like this:
objectCoerce(src=obj, to="list", ...)
where ... is the crucial part as sometimes I want to pass additional stuff for certain coercions (see do.deep = TRUE/FALSE below.
However, in order to do that, do I need to implement sort of a "transformer" that takes the to argument, tries to instantiate an empty object of the class specified by to and then calls the "regular" method dispatch? Or is there a better way?
Below you'll find my current solution. It works, but I'm "loosing" the option to coerce to class character" as this class is used to process things to the regular dispatcher and a to = "character would result in infinite recursion. Plus, it's a lot of overhead.
EDIT 2011-12-02
Of course setAs would be the first address to check. But the function specified by arg def in setAs can only take one argument, and often that's too rigid for me. For example, I don't see how I could include the do.deep = TRUE/FALSE switch when using setAs.
Class Defs
setRefClass(Class="MyVirtual")
setRefClass(
Class="A",
contains="MyVirtual",
fields=list(
x="character"
)
)
setRefClass(
Class="B",
contains="MyVirtual",
fields=list(
x.a="A",
x.b="numeric",
x.c="data.frame"
)
)
setGeneric(
name="objectCoerce",
signature=c("src", "to"),
def=function(src, to, ...){
standardGeneric("objectCoerce")
}
)
Generic Method
setGeneric(
name="objectCoerce",
signature=c("src", "to"),
def=function(src, to, ...){
standardGeneric("objectCoerce")
}
)
Intermediate Transformer
setMethod(
f="objectCoerce",
signature=signature(src="ANY", to="character"),
definition=function(src, to, do.deep=FALSE, ...){
# Transform 'to' to a dummy object of class 'to'
to.0 <- to
# For standard R classes
try.res <- try(eval(substitute(
to <- CLASS(),
list(CLASS=as.name(to.0))
)), silent=TRUE)
# For S4 classes
if(inherits(try.res, "try-error")){
try.res <- try(eval(substitute(
to <- new(CLASS),
list(CLASS=to.0)
)), silent=TRUE)
# For my classes. In order to get an 'hollow' object, some of them
# need to be instantiated by 'do.hollow=TRUE'
if(inherits(try.res, "try-error")){
try.res <- try(eval(substitute(
to <- new(CLASS, do.hollow=TRUE),
list(CLASS=to.0)
)), silent=TRUE)
if(inherits(try.res, "try-error")){
stop(try.res)
}
}
}
# Pass transformed 'to' along so the standard method
# dispatcher can kick in.
out <- objectCoerce(src=src, to=to, do.deep=do.deep, ...)
return(out)
}
)
Coercion Method 'MyVirtual' to 'list'
setMethod(
f="objectCoerce",
signature=signature(src="MyVirtual", to="list"),
definition=function(src, to, do.deep=FALSE, ...){
fields <- names(getRefClass(class(src))$fields())
out <- lapply(fields, function(x.field){
src$field(x.field)
})
names(out) <- fields
if(do.deep){
out <- lapply(out, function(x){
out <- x
if(inherits(x, "MyVirtual")){
out <- objectCoerce(src=x, to=to, do.deep=do.deep, .ARGS=.ARGS)
}
return(out)
})
}
return(out)
}
)
Test Run
x <- new("B", x.a=new("A", x="hello world!"), x.b=1:5,
x.c=data.frame(a=c(TRUE, TRUE, FALSE)))
> objectCoerce(src=x, to="list")
$x.a
Reference class object of class "A"
Field "x":
[1] "hello world!"
$x.b
[1] 1 2 3 4 5
$x.c
a
1 TRUE
2 TRUE
3 FALSE
> objectCoerce(src=x, to="list", do.deep=TRUE)
$x.a
$x.a$x
[1] "hello world!"
$x.b
[1] 1 2 3 4 5
$x.c
a
1 TRUE
2 TRUE
3 FALSE
Maybe use setAs to create a coerce method (though one would rather have one's own base class to write the method on, rather than doing this for envRefClass)
setAs("envRefClass", "list", function(from) {
fields <- names(getRefClass(class(from))$fields())
Map(from$field, fields)
})
and then
> as(new("B"), "list")
$x.a
Reference class object of class "A"
Field "x":
character(0)
$x.b
numeric(0)
$x.c
data frame with 0 columns and 0 rows
? The deep version might be like
setAs("envRefClass", "list", function(from) {
fields <- names(getRefClass(class(from))$fields())
curr <- Map(from$field, fields)
recurr <- sapply(curr, is, "envRefClass")
curr[recurr] <- lapply(curr[recurr], as, "list")
curr
})
I don't have good ideas for combining these, other than to create a psuedo-class 'deep_list' and a coerce method to that. I feel like I'm not understanding your post.

Writing functions to handle multiple data types in R/Splus?

I would like to write a function that handles multiple data types. Below is an example that works but seems clunky. Is there a standard (or better) way of doing this?
(It's times like this I miss Matlab where everything is one type :>)
myfunc = function(x) {
# does some stuff to x and returns a value
# at some point the function will need to find out the number of elements
# at some point the function will need to access an element of x.
#
# args:
# x: a column of data taking on many possible types
# e.g., vector, matrix, data.frame, timeSeries, list
x.vec <- as.vector(as.matrix(as.data.frame(x)))
n <- length(x.vec)
ret <- x.vec[n/3] # this line only for concreteness
return(ret)
}
Use S3 methods. A quick example to get you started:
myfunc <- function(x) {
UseMethod("myfunc",x)
}
myfunc.data.frame <- function(x) {
x.vec <- as.vector(as.matrix(x))
myfunc(x.vec)
}
myfunc.numeric <- function(x) {
n <- length(x)
ret <- x[n/3]
return(ret)
}
myfunc.default <- function(x) {
stop("myfunc not defined for class",class(x),"\n")
}
Two notes:
The ... syntax passes any additional arguments on to functions. If you're extending an existing S3 method (e.g. writing something like summary.myobject), then including the ... is a good idea, because you can pass along arguments conventionally given to the canonical function.
print.myclass <- function(x,...) {
print(x$keyData,...)
}
You can call functions from other functions and keep things nice and parsimonious.
Hmm, your documentation for the function is
# args:
# x: a column of data taking on many possible types
# e.g., vector, matrix, data.frame, timeSeries, list
and if one supplies an object as you claim is require, isn't it already a vector and not a matrix or a data frame, hence obviating the need for separate methods/specific handling?
> dat <- data.frame(A = 1:10, B = runif(10))
> class(dat[,1])
[1] "integer"
> is.vector(dat[,1])
[1] TRUE
> is.vector(dat$A)
[1] TRUE
> is.numeric(dat$A)
[1] TRUE
> is.data.frame(dat$A)
[1] FALSE
I would:
myfunc <- function(x) {
# args:
# x: a column of data taking on many possible types
# e.g., vector, matrix, data.frame, timeSeries, list
n <- length(x)
ret <- x[n/3] # this line only for concreteness
return(ret)
}
> myfunc(dat[,1])
[1] 3
Now, if you want to handle different types of objects and extract a column, then S3 methods would be a way to go. Perhaps your example is over simplified for actual use? Anyway, S3 methods would be something like:
myfunc <- function(x, ...)
UseMethod("myfunc", x)
myfunc.matrix <- function(x, j = 1, ...) {
x <- x[, j]
myfunc.default(x, ...)
}
myfunc.data.frame <- function(x, j = 1, ...) {
x <- data.matrix(x)
myfunc.matrix(x, j, ...)
}
myfunc.default <- function(x, ...) {
n <- length(x)
x[n/3]
}
Giving:
> myfunc(dat)
[1] 3
> myfunc(data.matrix(dat))
[1] 3
> myfunc(data.matrix(dat), j = 2)
[1] 0.2789631
> myfunc(dat[,2])
[1] 0.2789631
You probably should try to use an S3 method for writing a function that will handle multiple datatypes.
A good reference is here: http://www.biostat.jhsph.edu/~rpeng/biostat776/classes-methods.pdf

Resources