Hi Martin
Here's the code. I'm stuck at one point. I cannot figure out how to print
the dimnames. I've commented it in my code:
int main (int argc, char** argv) {
SEXP e,t1,t2,val;
int errorOccurred,nx,ny,i,j;
double *v;
char x[1024],y[1024];
Rf_initEmbeddedR(argc, argv);
PROTECT(e = lang2(install("library"), mkString("fPortfolio")));
R_tryEval(e, R_GlobalEnv, NULL);
UNPROTECT(1);
PROTECT(e = lang2(install("as.matrix"),install("SWX.RET")));
PROTECT(t1 = (R_tryEval(e, NULL, &errorOccurred)));
v=REAL(t1);
PROTECT(t2=getAttrib(t1,R_DimSymbol));
nx=INTEGER(t2)[0];
ny=INTEGER(t2)[1];
PROTECT(t2=getAttrib(t1,R_DimNamesSymbol));
// I'm getting stuck here.
// I want to print out the dimnames
// so that I can get the dates for the timeseries object.
strcpy(x,(CHAR(VECTOR_ELT(t2,0))[0]));
strcpy(y,(CHAR(VECTOR_ELT(t2,1))[0]));
printf("%d * %d\n %s %s \n Matrix:\n",nx,ny,x,y);
// The matrix is stored in column major order so
// we print it in this manner.
// my previous code was incorrect.
for(i=0;i<nx;i++,j++) {
for(j=0;j<ny;j++)
printf("%f ",v[i+(j*ny)]);
printf("\n");
}
//UNPROTECT(3);
return 0;
}
On Wed, Aug 26, 2009 at 10:25 PM, Martin Morgan <mtmor...@fhcrc.org> wrote:
> Hi Abhijit --
>
> Abhijit Bera wrote:
> > Hi Martin
> >
> > Thanks. I think I got it! Read the R extensions documentation again. I
> > don't even need to convert to a list. This is what I did (just a demo):
> >
> > #include <R.h>
> > #include <Rinternals.h>
> > #include <Rdefines.h>
> > #include <Rembedded.h>
> >
> > int main (int argc, char** argv) {
> >
> > SEXP e,t1,t2,val;
> > int errorOccurred,nx,ny,i,j;
> > double *v;
> >
> > Rf_initEmbeddedR(argc, argv);
> >
> > PROTECT(e = lang2(install("library"), mkString("fPortfolio")));
> > R_tryEval(e, R_GlobalEnv, NULL);
> > UNPROTECT(1);
> >
> > /* We try to evaluate the R expression:
> > * round(cov(100 * SWX.RET), digits = 4)
> > * we shall split it as:
> > * t1<-100*SWX.RET
> > * t2<-cov(t1)
> > * val<-round(t2,4)
> > */
> >
> > PROTECT(e = lang3(install("*"),ScalarInteger(100),
> install("SWX.RET")));
> > PROTECT(t1 = (R_tryEval(e, NULL, &errorOccurred)));
>
> For what it's worth, and realizing that this is sloppiness in my
> original code, ScalarInteger(100) (and mkString("fPortfolio")) returns
> an unprotected SEXP, so it could in principle be garbage collected while
> lang3 is being evaluated...
>
> >
> > PROTECT(e = lang2(install("cov"),t1));
> > PROTECT(t2 = (R_tryEval(e, NULL, &errorOccurred)));
> >
> > PROTECT(e = lang3(install("round"),t2, ScalarInteger(4)));
> > PROTECT(val = (R_tryEval(e, NULL, &errorOccurred)));
> >
> > Rf_PrintValue(val);
> >
> > /* This isn't required, is extraneous.
> > PROTECT(e = lang2(install("as.list"),val));
> > PROTECT(t2 = (R_tryEval(e, NULL, &errorOccurred)));
> >
> > Rf_PrintValue(t2);*/
>
> the reason I recommended using as.list (for example) was to respect the
> implied abstraction between the object (of class 'timeSeries') and it's
> representation. Apparently there is a method as.list.timeSeries, and a
> list is something that I am allowed to know about. Your code below
> works, but doesn't respect the (R-level) abstraction the class author
> wants. I don't know whether this is regular practice in the R community,
> but it seems like the right thing to do.
>
> Martin
>
> >
> > v=REAL(val);
> >
> > PROTECT(t2=getAttrib(val,R_DimSymbol));
> >
> > nx=INTEGER(t2)[0];
> > ny=INTEGER(t2)[1];
> >
> > /* Just printing out the matrix
> > * To understand how I can convert
> > * data types b/w R and C
> > */
> >
> > printf("Matrix:\n");
> >
> > for(i=0,j=0;i<(nx*ny);i++,j++) {
> >
> > printf("%.4f ",v[i]);
> >
> > if(j==ny-1) {
> > printf("\n");
> > j=0;
> > }
> >
> > }
> >
> > UNPROTECT(6);
> >
> > return 0;
> >
> > }
> >
> > Regards
> >
> > Abhijit Bera
> >
> >
> > On Wed, Aug 26, 2009 at 12:37 PM, Abhijit Bera <abhib...@gmail.com
> > <mailto:abhib...@gmail.com>> wrote:
> >
> > Hi Martin
> >
> > Thanks. I think I got the hang of it. I will try it out and post any
> > more queries I have regarding handling data types onto the mailing
> list.
> >
> > Regards
> >
> > Abhijit Bera
> >
> >
> > On Tue, Aug 25, 2009 at 7:15 PM, Martin Morgan <mtmor...@fhcrc.org
> > <mailto:mtmor...@fhcrc.org>> wrote:
> >
> > Abhijit Bera <abhib...@gmail.com <mailto:abhib...@gmail.com>>
> > writes:
> >
> > > Hi
> > >
> > > I think I have asked these questions earlier, but I been able
> > to find
> > > answers from the documentation (which I found poorly written
> > in several
> > > places). Will someone be kind enough to give me answers and
> > enlighten me?
> > > (as in explain with CODE?)
> > >
> > > I want to embed R in my application and use the fPortfolio
> > package for
> > > carrying out risk management computations. Right now I'm
> > reading the
> > > Rmetrics Ebook and trying to convert the various examples into
> > embedded C
> > > code.
> > >
> > > Coming from a strictly C background, I have slight difficulty
> in
> > > comprehending a functional language like R and it gets worse
> > when I try to
> > > embed R into a procedural language like C. So here is a list
> > of my doubts:
> > >
> > > 1) I am very confused on how the lang 1 2 3 4 ... set of
> > functions work. I
> > > haven't found any relevant documentation explaining it
> > clearly. I have a
> > > vague idea but still I cannot understand how I would evaluate
> an R
> > > expression like Covariance <- round(cov(100 * SWX.RET), digits
> > = 4) using
> > > lang, install and R_tryEval.
> >
> > unroll this as
> >
> > tmp0 <- 100 * SWX.RET
> > tmp1 <- cov(tmp0)
> > result <- round(tmp2, 4L)
> >
> > so (untested)
> >
> > PROTECT(expr =
> > lang3(install("*"), scalarNumeric(100), install("SWX.RET")));
> > PROTECT(tmp0 = tryEval(expr, R_GlobalEnv, &errorOccurred));
> > if (errorOccurred)
> > exit(1);
> >
> > PROTECT(expr = lang2(install("cov"), tmp0));
> > PROTECT(tmp1 = tryEval(expr, R_GlobalEnv, &errorOccurred));
> > if (errorOccurred)
> > exit(1);
> >
> > PROTECT(expr = lang3(install("round"), tmp1, scalarInteger(4)));
> > PROTECT(result = tryEval(expr, R_GlobalEnv, &errorOccurred));
> > if (errorOccurred)
> > exit(1);
> >
> > Rf_PrintValue(result);
> > UNPROTECT(6);
> >
> >
> >
> > > 2) What exactly does install do?
> >
> > creates or locates a symbol in the global symbol table. Every
> unique
> > symbol is recorded and stored in the 'global symbol table'. An
> > environment is then a mapping between a symbol from this table,
> > and a
> > value unique to the environment. The symbols are being reused
> across
> > environments.
> >
> > In R
> >
> > x <- 10
> >
> > creates a symbol x in the global symbol table, and in the global
> > environment associates the value 10 with that symbol.
> >
> > env = new.env()
> > env$x <- 20
> >
> > uses the same symbol 'x' from the same global symbol table, but
> > associates the value 20 with it in the environment 'env'.
> >
> > In C
> >
> > install("foo");
> >
> > creates a symbol and returns the appropriate SEXP. And then
> >
> > install("foo")
> >
> > again finds the already-defined symbol and returns the same SEXP.
> >
> > > 3) I wrote the following code:
> > >
> > > #include <Rinternals.h>
> > > #include <Rembedded.h>
> > >
> > > int main (int argc, char** argv) {
> > >
> > > SEXP e,val;
> > > int errorOccurred;
> > >
> > > Rf_initEmbeddedR(argc, argv);
> > >
> > > // library("fPortfolio")
> > > PROTECT(e = lang2(install("library"),
> > mkString("fPortfolio")));
> > > R_tryEval(e, R_GlobalEnv, NULL);
> > > UNPROTECT(1);
> > >
> > > // colMeans(SWX.RET)
> > > PROTECT(e = lang2(install("colMeans"),
> install("SWX.RET")));
> > > val = (R_tryEval(e, NULL, &errorOccurred));
> > >
> > > Rf_PrintValue(val);
> > >
> > > return 0;
> > >
> > > }
> > >
> > > When I tried :
> > >
> > >>mean(SWX.RET)
> > >
> > > in the R prompt I got the following output:
> > >
> > > SBI SPI SII LP25
> LP40
> > > LP60
> > > 4.660521e-06 2.153198e-04 2.033869e-04 1.388886e-04
> 1.349041e-04
> > > 1.226859e-04
> > >
> > >
> > > However when I replaced colMeans with mean in the C code above
> > I got a mean
> > > of the means (0.0001366410) of all the columns when
> > Rf_PrintValue was
> > > called. Using colMeans gave me the output as shown above. Why
> > does this
> > > happen? How do I get the above output using mean?
> >
> > Guessing a little; I don't know what class SWX.RET is, but
> perhaps
> > there is a method mean.class_of_SWX.RET defined in a package that
> is
> > loaded in your R session, but not your C session. In a new R I
> see
> >
> > > library(fPortfolio)
> > > mean(SWX.RET)
> > [1] 0.0001366410
> >
> > > 4) From the above code segment, how can I deal with the
> > SEXPREC val which is
> > > returned by R_tryEval in the above code and convert it to my
> > own local
> > > vector datatype? How do I access the values of val? val will
> > now be a
> > > timeseries so how do i convert it?
> >
> > Convert it to a 'standard' R object using appropriate R
> > functions and
> > access it using C, e.g.,
> >
> > > lst <- as.list(SWX.RET)
> > > str(lst)
> > List of 6
> > $ SBI : num [1:1916] -0.002088 -0.000105 -0.00136 0.000419 0 ...
> > $ SPI : num [1:1916] -0.03439 -0.01041 0.01212 0.02246 0.00211
> ...
> > $ SII : num [1:1916] 1.37e-05 -4.96e-03 3.81e-03 -6.16e-04
> > 2.38e-03 ...
> > $ LP25: num [1:1916] -0.01199 -0.00366 -0.00132 0.00771 0.00303
> ...
> > $ LP40: num [1:1916] -0.01801 -0.00584 -0.00164 0.01166 0.00457
> ...
> > $ LP60: num [1:1916] -0.02616 -0.00901 -0.0024 0.01706 0.00695
> ...
> >
> > so in C, once I have lst, I could
> >
> > sbi = VECTOR_ELT(lst, 0);
> > double *vals = NUMERIC(sbi);
> > printf("%f", vals[0]); # -002088
> >
> > Hope that helps, and is not too misleading, I didn't have time to
> > check carefully.
> >
> > Martin
> >
> > > Thanks
> > >
> > > Abhijit Bera
> > >
> > > [[alternative HTML version deleted]]
> > >
> > > ______________________________________________
> > > R-devel@r-project.org <mailto:R-devel@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
> >
> >
> >
>
>
[[alternative HTML version deleted]]
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
