[Rd] Problem with S4 slots in C code (PR#4073)

[L.T.Kell at cefas.co.uk]

This message is in MIME format. Since your mail reader does not understand
this format, some or all of this message may not be legible.

------_=_NextPart_000_01C3738F.63DE3390
Content-Type: text/plain;
	charset="iso-8859-1"

#I want to be able to create a new S4 class and read data into it using C
code

# Here is a very simple S4 object inheriting from "array", but with 5
specified dimensions 
#(the validity stuff has been stripped out to make it short as I don't think
it is the problem here)

setClass("FLQuant",
	representation("array"),
	prototype=(array(1, dim=c(1,1,1,1,1), dimnames=list(age="0",
year="0", sex="combined", season="all", area="all")))
)

# In R, I can create a new "FLQuant" object:
> fl <- new("FLQuant")
> fl
An object of class "FLQuant"
, , sex = combined, season = all, area = all

   year
age 0
  0 1

# and:
> aa <- array(2, dim=c(1,1,1,1,1), dimnames=list(age="1", year="2000",
sex="combined", season="all", area="all"))
> aa
, , sex = combined, season = all, area = all

   year
age 2000
  1    2

# Putting the array aa into fl is done like this (by the way, is this a
correct way to do it?):
> fl at .Data <- aa
> fl
An object of class "FLQuant"
, , sex = combined, season = all, area = all

   year
age 2000
  1    2

# Now, we want to do the same in C, to interface with existing code.
# However, the .Data slot is not being replaced with the new object


> dyn.load("C:/fl/flr/flr.dll")
> test<-function() .Call("Test")
> test()

An object of class "FLQuant":

, , sex = combined, season = all, area = all

   year
age 0
  0 1
> 

#C code to do the same thing
extern "C" __declspec(dllexport) SEXP __stdcall Test(void)
    {
    SEXP FLQuant, v, 
         d1, d2, d3, d4, d5,  
         dim,   dimnames, names;    

    //Create new S4 object    
    PROTECT(FLQuant = NEW_OBJECT(MAKE_CLASS("FLQuant")));

    //Create array for slot    
    //Set dimensions of array
    PROTECT(dim     = allocVector(INTSXP, 5));       
    INTEGER(dim)[0] = 1;
    INTEGER(dim)[1] = 1;
    INTEGER(dim)[2] = 1; 
    INTEGER(dim)[3] = 1; 
    INTEGER(dim)[4] = 1; 
        
    //Allocate memory
    PROTECT(v = Rf_allocArray(REALSXP, dim)); 
    
    //Create dimension names
    PROTECT(dimnames = allocVector(VECSXP, 5));
    
    PROTECT(d1 = allocVector(INTSXP, 1));
    INTEGER(d1)[0] = 1; 
    SET_VECTOR_ELT(dimnames, 0, d1);
    
    PROTECT(d2 = allocVector(INTSXP, 1));
    INTEGER(d2)[0] = 2000; 
    SET_VECTOR_ELT(dimnames, 1, d2);
     
    PROTECT(d3 = allocVector(STRSXP, 1));
    SET_STRING_ELT(d3, 0, mkChar("combined"));
    SET_VECTOR_ELT(dimnames, 2, d3);
    
    PROTECT(d4 = allocVector(STRSXP, 1));
    SET_STRING_ELT(d4, 0, mkChar("all"));
    SET_VECTOR_ELT(dimnames, 3, d4);
    
    PROTECT(d5 = allocVector(STRSXP, 1));
    SET_STRING_ELT(d5, 0, mkChar("all"));
    SET_VECTOR_ELT(dimnames, 4, d5);
    
    //Create names for dimensions
    PROTECT(names = allocVector(STRSXP, 5));
    SET_STRING_ELT(names, 0, mkChar("age"));
    SET_STRING_ELT(names, 1, mkChar("year"));
    SET_STRING_ELT(names, 2, mkChar("sex"));
    SET_STRING_ELT(names, 3, mkChar("season"));
    SET_STRING_ELT(names, 4, mkChar("area"));
    setAttrib(dimnames, R_NamesSymbol, names);
    setAttrib(v, R_DimNamesSymbol, dimnames);
    
    //Set data
    REAL(v)[0] = 2;
           
    //Set slot
    SET_SLOT(FLQuant, install(".Data"), v);

    UNPROTECT(10);
    
    return FLQuant;
    }


 




--please do not edit the information below--

Version:
 platform = i386-pc-mingw32
 arch = i386
 os = mingw32
 system = i386, mingw32
 status = 
 major = 1
 minor = 7.1
 year = 2003
 month = 06
 day = 16
 language = R

Windows 2000 Professional (build 2195) Service Pack 3.0

Search Path:
 .GlobalEnv, package:methods, package:ctest, package:mva, package:modreg,
package:nls, package:ts, Autoloads, package:base

 <<Laurence Kell (E-mail).vcf>> 

------_=_NextPart_000_01C3738F.63DE3390
Content-Type: application/octet-stream;
	name="Laurence Kell (E-mail).vcf"
Content-Disposition: attachment;
	filename="Laurence Kell (E-mail).vcf"

BEGIN:VCARD
VERSION:2.1
N:Kell;Laurence
FN:Laurence Kell (E-mail)
ORG:CEFAS
TEL;WORK;VOICE:+44 (0) 1502 524257
TEL;WORK;FAX:+44 (0) 1502 524511
ADR;WORK:;;Lowestoft Laboratory;Pakefield Road;Lowestoft,;NR33 0HT;UK
LABEL;WORK;ENCODING=QUOTED-PRINTABLE:Lowestoft Laboratory=0D=0APakefield Road, Lowestoft, NR33 0HT=0D=0AUK
EMAIL;PREF;INTERNET:/o=CEFAS/ou=LOWESTOFT/cn=Recipients/cn=LTK00
REV:20030410T130517Z
END:VCARD

------_=_NextPart_000_01C3738F.63DE3390--