混合编程中C的小伎俩系列

lyxmoo

1.如何给一个SEXP对象写列名。

<br />
//setting SEXP result dims names</p>
<p>#define BRIEFs 9</p>
<p>        SEXP dimNames, dnames, rnames;<br />
        int p;</p>
<p>        p = 0;</p>
<p>        PROTECT(dimNames = allocVector(VECSXP, 2));<br />
        p++;<br />
        PROTECT(dnames = allocVector(VECSXP, BRIEFs));<br />
        p++;</p>
<p>        SET_VECTOR_ELT(dnames, 0, mkChar("bid"));       // total bid;<br />
        SET_VECTOR_ELT(dnames, 1, mkChar("ask"));       // total ask;<br />
        SET_VECTOR_ELT(dnames, 2, mkChar("buy"));       // deal by buyin<br />
        SET_VECTOR_ELT(dnames, 3, mkChar("bp"));        // buyin price<br />
        SET_VECTOR_ELT(dnames, 4, mkChar("sold"));      // deal by soldout<br />
        SET_VECTOR_ELT(dnames, 5, mkChar("sp"));        // soldout price<br />
        SET_VECTOR_ELT(dnames, 6, mkChar("biv"));       // vary bid<br />
        SET_VECTOR_ELT(dnames, 7, mkChar("akv"));       // vary ask<br />
        SET_VECTOR_ELT(dnames, 8, mkChar("masq"));      // masquade deal</p>
<p>        SET_VECTOR_ELT(dimNames, 1, dnames);<br />
        rnames = R_NilValue;<br />
        SET_VECTOR_ELT(dimNames, 0, rnames);</p>
<p>        setAttrib(result, R_DimNamesSymbol, dimNames);</p>
<p>        UNPROTECT(p);</p>
<p>

忘记说了，这个对象必须按照楼下的设置完行列，且大小要合适才可以。[s:13]

lyxmoo

回复第1楼的 lyxmoo：

如何将一个SEXP对象设置维度,相当于dim(result)<-c(nCol,nRow),大概齐就是这个意思。[s:15]

<br />
int setDim(SEXP result, int nCol, int nRow)<br />
{<br />
        int retval = 0;<br />
        SEXP dims;</p>
<p>        PROTECT(dims = allocVector(INTSXP, 2));</p>
<p>        INTEGER(dims)[0] = nCol;<br />
        INTEGER(dims)[1] = nRow;</p>
<p>        setAttrib(result, R_DimSymbol, dims);<br />
        UNPROTECT(1);</p>
<p>        return (retval);</p>
<p>}<br />

lyxmoo

如何取到 .Call 调用传入的参数的名

<br />
SEXP R_doingdoingdoing(SEXP initList)<br />
{<br />
        SEXP result,element;<br />
        int i;</p>
<p>        char *sptr;</p>
<p>        result = getAttrib(initList, R_NamesSymbol);</p>
<p>        for (i = 0; i < LENGTH(result); i++) {</p>
<p>                sptr = strdup(CHAR(STRING_ELT(result, i)));</p>
<p>                if (strcmp(sptr, "data") == 0) {<br />
                      ;;;<br />
                }<br />
                if (strcmp(sptr, "method") == 0) {<br />
                      ;;;<br />
                }<br />
                if (strcmp(sptr, "tims") == 0) {<br />
                      ;;;<br />
                }<br />
            free(sptr);  // this line not being tested. i think there should be a free for strdup.<br />
        }</p>
<p>    return(result);  // for something to return</p>
<p>}</p>
<p>// in R function calling stack as is:<br />
//<br />
//  'staticalMono' <- function(Mono,...) {<br />
//     return ( .Call("R_doingdoingdoing",list(...)) )<br />
//   }<br />
//<br />
// staticalMono(data=sth,method=somewhat,tims=asyoulike)</p>
<p>

lyxmoo

如何分配一块数据区

</p>
<p>double *xptr;<br />
SEXP result;</p>
<p>PROTECT( result = allocVector(REALSXP, nCols * nRows) );<br />
xptr = NUMERIC_POINTER(result);<br />
     // you could deal with this double pointer xptr.<br />
UNPROTECT(1);</p>
<p>

lyxmoo

给一个SEXP对象赋字串类型的值；

</p>
<p>      PROTECT(result = allocVector(STRSXP, 1));<br />
      SET_STRING_ELT(result, 0, mkChar("Hello world"));<br />
      UNPROTECT(1);</p>
<p>      return(result);</p>
<p>

lyxmoo

如何将对象设置为nan的值

</p>
<p>// warn: not prompted a pre-allocation<br />
//       not defined a constant EMPTYROWS value</p>
<p>    xptr = NUMERIC_POINTER(result);<br />
    memset(xptr, NA_REAL, sizeof(double) * EMPTYROWS);</p>
<p>// NA for string element<br />
    SET_STRING_ELT(result, i, NA_STRING);</p>
<p>

lyxmoo

编译环境设置, tested under linux.

<br />
#cat  Makevars </p>
<p>    PKG_CFLAGS+=-D_MONO_USE_GETADDRINFO -DR_SAFETY_NET<br />
    PKG_LIBS+=-lcurl</p>
<p>

lyxmoo

来个复杂的, C 生成 external global preferer object；我也不说话。

</p>
<p>SEXP makeGPRObject(monoParam * obj, int addFinalizer)<br />
{<br />
        SEXP ans, klass, ref;<br />
        int p;</p>
<p>        p = 0;</p>
<p>        if (!obj) {<br />
                PROBLEM "NULL MonoApi Interface handle being returned\n" ERROR;<br />
        }<br />
        PROTECT(klass = MAKE_CLASS("MonoHandle"));<br />
        p++;<br />
        PROTECT(ans = NEW(klass));<br />
        p++;<br />
        PROTECT(ref = R_MakeExternalPtr((void *)obj, Rf_install("MonoHandle"), R_NilValue));<br />
        p++;</p>
<p>        if (addFinalizer == TRUE)<br />
                R_RegisterCFinalizerEx(ref, R_finalizeGP, (Rboolean) TRUE);<br />
        ans = SET_SLOT(ans, Rf_install("ref"), ref);</p>
<p>        UNPROTECT(p);</p>
<p>        return (ans);<br />
}</p>
<p>// there should be a R_finalizeGP function to free monoParam</p>
<p>

lyxmoo

接上第8楼的, C 中再取回 Global Preferer Object.

<br />
monoParam *getGPRObject(SEXP obj)<br />
{<br />
        monoParam *retv;<br />
        SEXP ref;</p>
<p>        if (TYPEOF(obj) != EXTPTRSXP) {<br />
                ref = GET_SLOT(obj, Rf_install("ref"));<br />
        } else<br />
                ref = obj;</p>
<p>        retv = (monoParam *) R_ExternalPtrAddr(ref);<br />
        if (!retv) {<br />
                PROBLEM "Stale monoParam handle being passed to " ERROR;<br />
        }</p>
<p>        if (R_ExternalPtrTag(ref) != Rf_install("MonoHandle")) {<br />
                PROBLEM "External pointer with wrong tag passed to gp. Was %s", CHAR(PRINTNAME(R_ExternalPtrTag(ref))) ERROR;<br />
        }</p>
<p>        return (retv);<br />
}</p>
<p>

lyxmoo

传到C里去的是个字串，怎么能取到

<br />
# here is a pre-defined SEXP pname as a string path-name</p>
<p>SEXP getLastAll(SEXP pname, SEXP listdays)<br />
{<br />
        struct stat xstat;</p>
<p>        SEXP result;</p>
<p>        if (stat(CHAR(STRING_ELT(pname, 0)), &xstat) == 0) {<br />
              ;;;<br />
        }</p>
<p>// should set result for return value.<br />
 return (result)<br />
}<br />

lyxmoo

不是伎俩的伎俩，输出错误信息

</p>
<p>if( [!(conditions)TRUE] ) {<br />
    REprintf("error message must be a string.\n");<br />
    return R_NilValue;<br />
  }</p>
<p>// same as sprintf(stderr,"bla-bla...");<br />

lyxmoo

回复第11楼的 lyxmoo：

有时候这样用

<br />
     (int)REAL(VECTOR_ELT(list,n))[0];<br />

有时候要这样用

<br />
    (float)REAL(VECTOR_ELT(list,n))[0];<br />

或者这样用

<br />
    CHAR(STRING_ELT(values,0))<br />

到底要闹羊？

lyxmoo

传一个Matrix 进入，取dim 信息, 相当于dim(Data) 的返回结果给 Rrow, Rcol, 或者反过来，[s:12]

<br />
SEXP somewhat(SEXP Data) {<br />
int Rrow,Rcol;</p>
<p>int *Datadims = INTEGER(getAttrib(Data, R_DimSymbol));<br />
        Rrow = Datadims[0];<br />
        Rcol = Datadims[1];</p>
<p>// ....<br />
// return ...<br />
}</p>
<p>

matrix 在内存中摆放的行列关联位置自己测吧，测过后理解才深刻。

lyxmoo

随便插入调用调试，并记录日志的接口代码，R崩溃了就去看/var/log下的日志。

<br />
int ndebug(char *fmt, ...)<br />
{<br />
        int retval = TRUE;<br />
        FILE *fp;</p>
<p>        va_list args;</p>
<p>        if ((fp = fopen("/var/log/RunningLogFile.log", "a+")) != NULL) {</p>
<p>                va_start(args, fmt);<br />
                vfprintf(fp, fmt, args);<br />
                va_end(args);</p>
<p>                fclose(fp);<br />
        } else<br />
                retval = FALSE;</p>
<p>        return (retval);<br />
}<br />

可以用这个代码完成楼上测的要求

lyxmoo

测量C运行时间的代码，运行花费记录进上面的日志文件中。

<br />
/* Subtracts time values to determine run time */<br />
int timeval_subtract (struct timeval *result, struct timeval *t2, struct timeval *t1)<br />
{<br />
      long int diff = (t2->tv_usec + 100000 * t2->tv_sec) - (t1->tv_usec + 100000 * t1->tv_sec);</p>
<p>        result->tv_sec = diff / 100000;<br />
        result->tv_usec = diff % 100000;</p>
<p>      return (diff < 0);<br />
}</p>
<p>/* Starts timer */<br />
void tic (struct timeval *timer) {<br />
            gettimeofday (timer, NULL);<br />
}</p>
<p>/* Stops timer and prints difference to the screen */<br />
void toc (struct timeval *timer) {<br />
      struct timeval tv_end, tv_diff;</p>
<p>      gettimeofday (&tv_end, NULL);<br />
      timeval_subtract (&tv_diff, &tv_end, timer);<br />
      ndebug("running time is %ld.%06ld\n", tv_diff.tv_sec, tv_diff.tv_usec);</p>
<p>}</p>
<p>//calling  tic(&timer) first , running issue, calling toc(&timer) @ the end.<br />

从这里直到第一楼，M$上系统不包调通

ming_uld

辛苦啦，收藏了[s:13]

Microhimalaya

好东西，嘿嘿

dclong

太麻烦了，还是上Rcpp吧

neo.cryptic

先收藏，以后有需要慢慢看。。

Ihavenothing

R的官方API真心靠猜……

求教一个，列表用字符串取元素要怎么弄？类似于lst[["a"]]。