I wrote a simple C function to use with inline in R which should take any object and return that objects class. I have tried to follow the Writing R Extensions manual, which states

The getAttrib and setAttrib functions get and set individual attributes. Their second argument is a SEXP defining the name in the symbol table of the attribute we want; these and many such symbols are defined in the header file Rinternals.h.

In addition it also states..

In R the class is just the attribute named "class" so it can be handled as such.

So I wrote this...

#  required package
require( inline )

#  Simple C function to get "class" attribute of an R object
classC <- cfunction( c(x = "ANY") , '

  SEXP out;
  PROTECT(out = allocVector(STRSXP, 1));
  SET_STRING_ELT(out, 0, mkChar("class"));
  UNPROTECT(1);
  return  getAttrib(x, out) ;

')

But testing it on various different classes of R object sometimes return the class, but usually returns NULL. I don't see the connection between the object types it does work on, so not sure where I have gone wrong...

#  Various classes of objects
con <- file("text.txt")
d <- data.frame( a = 1 )
e <- new.env()
f <- y ~ 1
fun <- function(x) x^2
i <- 1L:10L
l <- list( 1 , 2 , 3 )
m <- matrix( 1 , 10 , 10 )
n <- runif(1)
v <- 1:10

And running the function I get...

#  Output from the function
classC(con)
#[1] "file"       "connection"
classC(d)
#[1] "data.frame"
classC(e)
#NULL
classC(f)
#[1] "formula"
classC(fun)
NULL
classC(i)
NULL
classC(l)
#NULL
classC(m)
#NULL
classC(n)
#NULL
classC(v)
#NULL

What am I missing? I am interested because I eventually I would like to write a little helper function that returns a vector of all object names in the globalenvironment that are of a particular class. But mainly it's for my own curiosity and learning, I am aware that I could do something like:

sapply( ls() , function(x) class( get( x ) ) )
有帮助吗?

解决方案

The documentation lies :) What you did is equivalent to the R function:

classR = function(x) attributes(x)$class

What R does when you call class is this:

SEXP R_data_class(SEXP obj, Rboolean singleString)
{
    SEXP value, klass = getAttrib(obj, R_ClassSymbol);
    int n = length(klass);
    if(n == 1 || (n > 0 && !singleString))
        return(klass);
    if(n == 0) {
        SEXP dim = getAttrib(obj, R_DimSymbol);
        int nd = length(dim);
        if(nd > 0) {
            if(nd == 2)
                klass = mkChar("matrix");
            else
                klass = mkChar("array");
        }
        else {
          SEXPTYPE t = TYPEOF(obj);
          switch(t) {
          case CLOSXP: case SPECIALSXP: case BUILTINSXP:
            klass = mkChar("function");
            break;
          case REALSXP:
            klass = mkChar("numeric");
            break;
          case SYMSXP:
            klass = mkChar("name");
            break;
          case LANGSXP:
            klass = lang2str(obj, t);
            break;
          default:
            klass = type2str(t);
          }
        }
    }
    else
        klass = asChar(klass);
    PROTECT(klass);
    value = ScalarString(klass);
    UNPROTECT(1);
    return value;
}

So you can see that it does a bunch of checks for all those cases where you got NULL.

An easy option for you is to just call class from your function:

eval(lang2(install("class"), x), R_GlobalEnv)
许可以下: CC-BY-SA归因
不隶属于 StackOverflow
scroll top