[Rd] How do I access class slots from C?
Martin Morgan
mtmorgan at fhcrc.org
Tue Sep 29 18:17:51 CEST 2009
Simon Urbanek wrote:
> Abhijit,
>
> as for your subject - it's GET_SLOT,
> but why don't you just use ParseVector and eval instead of hand-crafting
> C code that calls the evaluator? That latter is way more error prone and
> the error-handling is a nightmare (your current code is inefficient
> anyway so you don't gain anything).
My 2 cents: constructing language calls seems much more appropriate than
parsing expressions when the values to be used are from programming
variables, as is likely the case in most real applications? And
accessing slots with GET_SLOT seems to break the (hard-won) abstraction
layer of S4, so better to call the R accessors (even when this is
inefficient computationally) especially when using objects from packates
whose internals you do not control.
One particular part of the code below
PROTECT(e=lang4(install("c"),mkString("SBI"),mkString("SPI"),mkString("SII")));
could be re-written as
SEXP x = PROTECT(NEW_CHARACTER(3));
SET_STRING_ELT(x, 0, mkChar("SBI"));
etc
In the original, although the outer PROTECT is unnecessary, I wonder
about the mString()... calls, which are not guaranteed to be evaluated
in order and produce unprotected CHARSXPs (prior to being protected
inside lang4). I'm not really sure about the mkChar() in the above,
either, and whether there is an opportunity for garbage collection in
SET_VECTOR_ELT.
Martin
>
> As for setWeights, you got the code wrong - if you want to mimic the R
> code then it's a call to the assignment "<-" - have a look at the parse
> result of
> "setWeights(ewSpec) <- rep(1/nAssets, times = nAssets)":
>
> @d58774 06 LANGSXP g0c0 []
> @809008 01 SYMSXP g1c0 [MARK,gp=0x4000] "<-"
> @d59540 06 LANGSXP g0c0 []
> @1a1af34 01 SYMSXP g0c0 [] "setWeights"
> @d59498 01 SYMSXP g0c0 [] "ewSpec"
> @d58720 06 LANGSXP g0c0 []
> @814ac4 01 SYMSXP g1c0 [MARK,gp=0x4000] "rep"
> @d595b0 06 LANGSXP g0c0 []
> @80ae44 01 SYMSXP g1c0 [MARK,gp=0x4000] "/"
> @1bf8ce8 14 REALSXP g0c1 [] (len=1, tl=0) 1
> @1dbf1ac 01 SYMSXP g0c0 [MARK] "nAssets"
> TAG: @9450fc 01 SYMSXP g1c0 [MARK] "times"
> @1dbf1ac 01 SYMSXP g0c0 [MARK] "nAssets"
>
> Again, I think you would be far better off just using parse instead...
>
> Cheers,
> Simon
>
> PS: Your PROTECTs are way off-balance, and you don't need almost any of
> them - langX and listX protect all arguments
>
> On Sep 29, 2009, at 10:28 , Abhijit Bera wrote:
>
>> Hi
>>
>> I'm trying to implement something similar to the following R snippet
>> using
>> C. I seem to have hit the wall on accessing class slots using C.
>>
>> library(fPortfolio)
>>
>> lppData <- 100 * LPP2005.RET[, 1:6]
>> ewSpec <- portfolioSpec()
>> nAssets <- ncol(lppData)
>> setWeights(ewSpec) <- rep(1/nAssets, times = nAssets)
>>
>> ewPortfolio <- feasiblePortfolio(
>> data = lppData,
>> spec = ewSpec,
>> constraints = "LongOnly")
>>
>> ewSpec is an object of type Portfolio Spec which has the following slots:
>>
>> model slot
>> type = "MV" a string value
>> optimize = "minRisk" a string value
>> estimator = "covEstimator" a function name
>> tailRisk = list() a list
>> params =
>> list(alpha=0.05, a=1, ...) a list
>> portfolio slot a list
>> weights = NULL a numeric vector
>> targetReturn = NULL a numeric value
>> targetRisk = NULL a numeric value
>> riskFreeRate = 0 a numeric value
>> nFrontierPoints = 50 an integer value
>> status = NA) a integer value
>> optim slot a list
>> solver = "solveRquadprog" a function names
>> objective = NULL function names
>> options = list() a list with parameters
>> control = list() a list with controls
>> trace = FALSE) a logical
>> messages slot: a list
>> list = list() a list
>>
>> I want to set the weights so that I can compute a feasiblePortfolio.
>> Unfortunately I cannot figure out how to do this from C.
>>
>> Here is what I wrote so far:
>>
>> #include <stdio.h>
>> #include <R.h>
>> #include <Rinternals.h>
>> #include <Rdefines.h>
>> #include <Rembedded.h>
>>
>> int main(int argc, char** argv)
>> {
>>
>> SEXP
>> e,c,portSpec,portData,portConstr,portVal,portWeights,tsAssets,tsReturns,nAssets,reciprocal;
>>
>> int errorOccurred,nx,ny,i,j;
>> double *v;
>> const char *x,*y;
>>
>> Rf_initEmbeddedR(argc, argv);
>>
>> // loading fPortfolio
>> PROTECT(e = lang2(install("library"), mkString("fPortfolio")));
>> R_tryEval(e, R_GlobalEnv, NULL);
>> UNPROTECT(1);
>>
>>
>> // creating a default portfolioSpec object
>> PROTECT(e=lang1(install("portfolioSpec")));
>> PROTECT(portSpec=R_tryEval(e,R_GlobalEnv, NULL));
>>
>> // creating a portfolioData object
>>
>>
>> PROTECT(e=lang4(install("c"),mkString("SBI"),mkString("SPI"),mkString("SII")));
>>
>> PROTECT(tsAssets=R_tryEval(e,R_GlobalEnv,NULL));
>>
>>
>> PROTECT(e=lang4(install("["),install("SWX.RET"),R_MissingArg,tsAssets));
>> PROTECT(tsReturns=R_tryEval(e,R_GlobalEnv,NULL));
>>
>> PROTECT(e=lang3(install("*"),ScalarInteger(100),tsReturns));
>> PROTECT(tsReturns=R_tryEval(e,R_GlobalEnv,NULL));
>>
>> PROTECT(e=lang3(install("portfolioData"),tsReturns,portSpec));
>> PROTECT(portData=R_tryEval(e,R_GlobalEnv,NULL));
>>
>> // Creating a portfolio constraints string
>> PROTECT(portConstr=mkString("LongOnly"));
>>
>> // Setting weights
>> PROTECT(e=lang2(install("ncol"),tsReturns));
>> PROTECT(nAssets=R_tryEval(e,R_GlobalEnv,NULL));
>>
>> PROTECT(e=lang3(install("/"),ScalarInteger(1),nAssets));
>> PROTECT(reciprocal=R_tryEval(e,R_GlobalEnv,NULL));
>>
>> PROTECT(e=lang3(install("rep"),reciprocal,nAssets));
>> PROTECT(portWeights=R_tryEval(e,R_GlobalEnv,NULL));
>>
>> // Right now the program crashes here. It says: Cannot find function
>> "setWeights"
>> // How do I set the weights? It's a standard numeric vector. I'm
>> confused on
>> access class slots from C.
>> // Not much is writted on this in the R extensions manual.
>>
>> PROTECT(e=lang3(install("setWeights"),portSpec,portWeights));
>> PROTECT(portSpec=R_tryEval(e,R_GlobalEnv,NULL));
>>
>> PROTECT(e=lang2(install("print"),portSpec));
>> R_tryEval(e,R_GlobalEnv,NULL);
>>
>> UNPROTECT(3);
>>
>> Rf_endEmbeddedR(0);
>>
>> return 0;
>> }
>>
>> Regards
>> Abhijit Bera
>>
>> [[alternative HTML version deleted]]
>>
>> ______________________________________________
>> R-devel at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-devel
>>
>>
>
> ______________________________________________
> R-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
--
Martin Morgan
Computational Biology / Fred Hutchinson Cancer Research Center
1100 Fairview Ave. N.
PO Box 19024 Seattle, WA 98109
Location: Arnold Building M1 B861
Phone: (206) 667-2793
More information about the R-devel
mailing list