¥È¥Ã¥× º¹Ê¬ °ìÍ÷ ¥½¡¼¥¹ ¸¡º÷ ¥Ø¥ë¥× RSS ¥í¥°¥¤¥ó

BugTrack-£ÒÈ÷˺Ͽ/56

£ÒÈ÷˺Ͽ /¾õÂÖ¶õ´Ö¥â¥Ç¥ê¥ó¥°/donlp2/¤½¤Î¾¤Î¥á¥â

£ÒÈ÷˺Ͽ - µ­»ö°ìÍ÷

R¡ÊR¸À¸ì¡Ë¤«¤éC¤ò¸Æ¤Ö¡ÊLinuxÊÔ¡Ë

  • Åê¹Æ¼Ô¡§ ¤ß¤å
  • ¥«¥Æ¥´¥ê¡§ ¤Ê¤·
  • Í¥ÀèÅÙ¡§ ÉáÄÌ
  • ¾õÂÖ¡§ ´°Î»
  • Æü»þ¡§ 2010ǯ01·î23Æü 19»þ40ʬ27ÉÃ

ÆâÍÆ

  • R¤«¤éC¤ò¸Æ¤Ö
    • £Ò¤Ï¤Ê¤Ë¤«¥¢¥¤¥Ç¥¢¤È¤«»×¤¤¤Ä¤¤¤¿¤³¤È¤ò¤¹¤°¤Ë»î¤¹¤Ë¤Ï¤è¤¤¤·¡¢¤È¤Æ¤â»È¤¤¤ä¤¹¤¤¤Î¤Ç¤¹¤¬¡¢¤µ¤¹¤¬¤Ë¥¤¥ó¥¿¡¼¥×¥ê¥¿¡¼¤À¤±¤¢¤Ã¤Æ¡¢£Ã¸À¸ì¤Ê¤ó¤«¤ËÈæ¤Ù¤ë¤È¤È¤Æ¤âÃÙ¤¤¤Î¤Ç¤¹¡¥¤½¤ó¤Ê¤È¤­¤Ï»þ´Ö¤Î¤«¤«¤ëÉôʬ¤ò£Ã¤È¤«¤Ç½ñ¤¤¤Æ£Ò¤«¤é¤½¤ì¤ò¸Æ¤Ó½Ð¤¹¤È¤¤¤¦¤³¤È¤¬¤Ç¤­¤Þ¤¹¡¥¤Ï¤¤¡¢¤Ð¤ê¤Ð¤ê»È¤¤¤Þ¤¯¤Ã¤Æ¤Þ¤¹¡¥
  • ¤È¤Ë¤«¤¯¤á¤Á¤ã¤¯¤Á¤ã®¤¤¤Ç¤¹¡¥¤¤¤äR¤¬ÃÙ¤¤¤È¤¤¤¦¤Ù¤­¤«¡©
  • ¥Ð¥°Êó¹ð¤ä¼ÁÌä¤ÏÊ̴ۤǤª´ê¤¤¤·¤Þ¤¹¡¥

Makefile¤òÍÑ°Õ¤¹¤ë

  • Makefile¤òÍÑ°Õ¤·¤Þ¤¹¡¥°Ê²¼¤Î¥ê¥ó¥¯¤Ê¤ó¤«¤â»²¹Í¤Ë¤·¤Æ¤ß¤Æ¤¯¤À¤µ¤¤¡¥
    • BugTrack-£ÒÈ÷˺Ͽ/28 - R¤Ç¥í¡¼¥É¤Ç¤­¤ë¥é¥¤¥Ö¥é¥ê¡Ê.so¥Õ¥¡¥¤¥ë¡Ë¤Î¥³¥ó¥Ñ¥¤¥ë¤Î¤ªºîË¡¡©¡ÊLinux¡Ë
  • Makefile¥µ¥ó¥×¥ë
R_SHARE_DIR = ${R_HOME}/share/
R_INCLUDE_DIR = ${R_HOME}/include
include ${R_HOME}/etc${R_ARCH}/Makeconf
HEADER = test.h

%.o: %.c $(HEADER)
	$(CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -c $< -o $@

%.so : %.o
	$(SHLIB_LINK) -o $@ $< $(ALL_LIBS) $(BLAS_LIBS) $(LAPACK_LIBS)

clean :
	rm -f *.o

¥µ¥ó¥×¥ë­¡

  • ¡ÖBugTrack-£ÒÈ÷˺Ͽ/53 - Writing R Extensions(Version 2.7.1 (2008-06-23)):::5 ¥·¥¹¥Æ¥à¤È³°Éô¸À¸ì¤Ø¤Î¥¤¥ó¥¿¡¼¥Õ¥§¡¼¥¹¡×
  • ¤³¤Î¤¢¤¿¤ê¤Î¥µ¥ó¥×¥ë¤«¤é»Ï¤á¤Æ¤ß¤Þ¤·¤ç¤¦¡¥
void convolve(double *a, int *na, double *b, int *nb, double *ab)
{
    int i, j, nab = *na + *nb - 1;
    for(i = 0; i < nab; i++)
        ab[i] = 0.0;
    for(i = 0; i < *na; i++)
        for(j = 0; j < *nb; j++)
            ab[i + j] += a[i] * b[j];
}
  • ¤Ê¤Ë¤ò¤ä¤Ã¤Æ¤¤¤ë´Ø¿ô¤Ê¤ó¤Ç¤·¤ç¤¦¤Í¡Ê¾Ð¡¥convolve¤À¤«¤é¾ö¤ß¹þ¤ß±é»»¤Ê¤ó¤Ç¤·¤ç¤¦¤±¤É¡Ê¾Ð
  • ¤È¤Ë¤«¤¯¤³¤ì¤Çtest.c¤È¤¤¤¦¥Õ¥¡¥¤¥ë¤òºîÀ®¤·¤Þ¤¹¡¥
  • test.c
//£ÒÍÑ £Ã

void convolve(double *a, int *na, double *b, int *nb, double *ab)
{
    int i, j, nab = *na + *nb - 1;
    for(i = 0; i < nab; i++)
        ab[i] = 0.0;
    for(i = 0; i < *na; i++)
        for(j = 0; j < *nb; j++)
            ab[i + j] += a[i] * b[j];
}
  • ¥³¥ó¥Ñ¥¤¥ë¤·¤Æ¡¢¤½¤Î¸åR¤«¤é¸Æ¤Ö¤³¤È¤¬¤Ç¤­¤ë¥À¥¤¥Ê¥ß¥Ã¥¯¥ê¥ó¥¯¥é¥¤¥Ö¥é¥ê¤òºîÀ®¤¹¤ë¤Î¤Ç¤¹¤¬¡¢¤µ¤Ã¤­ºî¤Ã¤¿Makefile¤Ç¡¢¥³¥Þ¥ó¥É°ìȯ¤Ç¤¹¡¥
make test.so
  • ¤³¤ì¤Ë¤è¤Ã¤Æ¡¢¥³¥ó¥Ñ¥¤¥ë>>>.so¥Õ¥¡¥¤¥ëºîÀ®Á´Éô¤ä¤Ã¤Æ¤¯¤ì¤Þ¤¹¡¥¤é¤¯¤Á¤ó¡¥
$ make test.so
gcc -std=gnu99 -I/usr/local/lib/R/include  -I/usr/local/include    -fpic  -O2 -m
tune=i686 -c test.c -o test.o
gcc -std=gnu99 -shared -L/usr/local/lib -o test.so test.o   -L/usr/local/lib/R/l
ib -lR -L/usr/lib/lapack/atlas -llapack -L/usr/lib/blas/atlas -lblas -L/usr/lib
-latlas
rm test.o
  • ¤µ¤Æ½ÐÍè¾å¤¬¤Ã¤¿¡Ö.so¡×¥Õ¥¡¥¤¥ë¤ò¸Æ¤Ó¤Þ¤¹¡¥¤Þ¤ºR¤òΩ¤Á¾å¤²¤Þ¤·¤ç¤¦¡¥
dyn.load("test.so")
  • ¡Ö.so¡×¤¬¤¢¤ë¥Ç¥£¥ì¥¯¥È¥ê¤ÈƱ¤¸¾ì½ê¤ÇR¤òΩ¤Á¾å¤²¤ë¤È¡¢¾å¤Î¤è¤¦¤ËÂǤĤÀ¤±¤Ç¡¢¡Ö.so¡×¤¬Æɤ߹þ¤Þ¤ì¤Æ¤¤¤Þ¤¹¡¥¤Á¤ã¤ó¤È´Ø¿ô¤Î̾Á°¤¬Ç§¼±¤Ç¤­¤Æ¤¤¤ë¤«³Îǧ¤·¤Æ¤ß¤Þ¤¹¡¥
> is.loaded("convolve")
[1] TRUE
  • convolve¤È¤¤¤¦C¤Î¥¨¥ó¥È¥ê¤òǧ¼±¤·¤Æ¤¤¤Þ¤¹¡¥
  • ¤µ¤Æ¤³¤ÎC¤ÇºîÀ®¤·¤¿´Ø¿ô¤ò¸Æ¤Ö¤¿¤á¤Ë¡Ö.C¡×¤È¤¤¤¦R¤Î´Ø¿ô¤ò»È¤¤¤Þ¤¹¡¥
conv <- function(a, b)
     .C("convolve",
    as.double(a),
    as.integer(length(a)),
    as.double(b),
    as.integer(length(b)),
    ab = double(length(a) + length(b) - 1))$ab
  • £±ÈÖÌܤΰú¿ô¤¬C´Ø¿ô¤Î̾Á°¤Ç¡¢¤½¤Î¸å¤ÏC¤ÇºîÀ®¤·¤¿´Ø¿ô¤Î°ú¿ô¤Î½çÈ֤ɤª¤ê¤Ë°ú¿ô¤òµ­½Ò¤·¤Þ¤¹¡¥
> conv(1:3,2:6)
[1]  2  7 16 22 28 27 18
  • ¤È¤Ê¤ê¡¢¤­¤Á¤ó¤ÈC¤¬¸Æ¤Ù¤Æ¤¤¤Þ¤¹¡¥

¥µ¥ó¥×¥ë­¢

  • BugTrack-£ÒÈ÷˺Ͽ/53¤Î£µ¡¥£¹¤Î¥µ¥ó¥×¥ë¤Ç¤¹¡¥º£Å٤ϡÖ.Call¡×´Ø¿ô¤Ç¤¹¡¥
  • Àè¤Û¤É¤Îtest.c¤Ë¤Ä¤Å¤±¤Æ½ñ¤¤¤Æ¤·¤Þ¤Ã¤Æ¤«¤Þ¤¤¤Þ¤»¤ó¡¥
  • <R.h>¤È<Rdefines.h>¤âÄɲ䷤Ƥ¯¤À¤µ¤¤¡¥
//£ÒÍÑ £Ã
#include <R.h>
#include <Rdefines.h>

void convolve(double *a, int *na, double *b, int *nb, double *ab)
{
    int i, j, nab = *na + *nb - 1;
    for(i = 0; i < nab; i++)
        ab[i] = 0.0;
    for(i = 0; i < *na; i++)
        for(j = 0; j < *nb; j++)
            ab[i + j] += a[i] * b[j];
}

SEXP convolve2(SEXP a, SEXP b)
{
  int i, j, na, nb, nab;
  double *xa, *xb, *xab;
  SEXP ab;
  PROTECT(a = AS_NUMERIC(a));
  PROTECT(b = AS_NUMERIC(b));
  na = LENGTH(a); nb = LENGTH(b); nab = na + nb - 1;
  PROTECT(ab = NEW_NUMERIC(nab));
  xa = NUMERIC_POINTER(a); xb = NUMERIC_POINTER(b);
  xab = NUMERIC_POINTER(ab);
  for(i = 0; i < nab; i++) xab[i] = 0.0;
  for(i = 0; i < na; i++)
    for(j = 0; j < nb; j++) xab[i + j] += xa[i] * xb[j];
      UNPROTECT(3);
  return(ab);
}
  • ¤³¤Î¤è¤¦¤Ë½ñ¤¤¤Æmake¡¥R¤òΩ¤Á¾å¤²¤Æ¡¢
> dyn.load("test.so")
> is.loaded("convolve")
[1] TRUE
> is.loaded("convolve2")
[1] TRUE
> conv2 <- function(a, b) .Call("convolve2", a, b)
> conv2(1:3,2:6)
[1]  2  7 16 22 28 27 18
  • ¤Ï¤¤¡¢¤Ç¤­¤¢¤¬¤ê¡¥
  • ¤³¤Á¤é¤Î¥¿¥¤¥×¤ÏR¤Î¥ª¥Ö¥¸¥§¥¯¥È¤ò¤½¤Î¤Þ¤ÞC¤ËÅϤ¹¤³¤È¤¬¤Ç¤­¤Þ¤¹¡¥¤½¤Î¤«¤ï¤êC¤ÎÃæ¤Ç¡¢¤½¤ÎR¤Î¥ª¥Ö¥¸¥§¥¯¥È¤¬¤­¤Á¤ó¤È°·¤¨¤ë¤è¤¦¤Ê¥Þ¥¯¥í¤ò¶î»È¤·¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó¤¬¡Ê¶ì¾Ð
  • ¤É¤Á¤é¤ò»È¤¦¤«¤Ï¡¢¥±¡¼¥¹¥Ð¥¤¥±¡¼¥¹¤Ç¤·¤ç¤¦¡¥¤Ç¤¹¤¬´ÉÍý¿Í¤ß¤å¤ÏºÇ¶á¤Ï¡Ö.Call¡×¤ò»È¤¦¤³¤È¤¬Â¿¤¤¤Ç¤¹¤Í¡¥

¥³¥á¥ó¥È