Search code examples
crsyntaxinternals

Inconsistency when getting class attribute of different R objects using C function


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

Solution

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