您当前的位置:首页 > IT编程 > C++
| C语言 | Java | VB | VC | python | Android | TensorFlow | C++ | oracle | 学术与代码 | cnn卷积神经网络 | gnn | 图像修复 | Keras | 数据集 | Neo4j | 自然语言处理 | 深度学习 | 医学CAD | 医学影像 | 超参数 | pointnet | pytorch |

自学教程:C++ LENGTH函数代码示例

51自学网 2021-06-01 21:50:21
  C++
这篇教程C++ LENGTH函数代码示例写得很实用,希望能帮到您。

本文整理汇总了C++中LENGTH函数的典型用法代码示例。如果您正苦于以下问题:C++ LENGTH函数的具体用法?C++ LENGTH怎么用?C++ LENGTH使用的例子?那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。

在下文中一共展示了LENGTH函数的30个代码示例,这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞,您的评价将有助于我们的系统推荐出更棒的C++代码示例。

示例1: call_gambim

SEXP call_gambim(SEXP y, SEXP times, SEXP derivfunc, SEXP parms, SEXP rtol,		SEXP atol, SEXP rho, SEXP Tcrit, SEXP jacfunc, SEXP initfunc,    SEXP verbose, SEXP LRW, SEXP rWork, SEXP iWork, SEXP jT,    SEXP nOut, SEXP Nrmas, SEXP masfunc, SEXP ML, SEXP MU, SEXP Hini,    SEXP Rpar, SEXP Ipar, SEXP flist, SEXP Type){/******************************************************************************//******                   DECLARATION SECTION                            ******//******************************************************************************/  int  j, nt, latol, lrtol, imas, mlmas, mumas, type;  int  isForcing, runOK;  double *Atol, *Rtol, hini;  int itol, ijac, ml, mu, iout, idid, liw, lrw, sum;  /* pointers to functions passed to FORTRAN */  C_jac_func_type_gb    *jac_func_gb = NULL;  C_solout_type         *solout = NULL;  C_solout_type_bim     *solout_bim = NULL;  C_mas_type            *mas_func = NULL;/******************************************************************************//******                         STATEMENTS                               ******//******************************************************************************//*                      #### initialisation ####                              */  init_N_Protect();  type  = INTEGER(Type)[0];     /* jacobian type */  ijac  = INTEGER(jT)[0];       /* jacobian type */  n_eq = LENGTH(y);             /* number of equations */  nt   = LENGTH(times);         /* number of output times */  maxt = nt;  tt = (double *) R_alloc(nt, sizeof(double));  for (j = 0; j < nt; j++) tt[j] = REAL(times)[j];//  mflag = INTEGER(verbose)[0];  /* is function a dll ?*/  isDll = inherits(derivfunc, "NativeSymbol");  /* initialise output ... */  initOutC(isDll, n_eq, nOut, Rpar, Ipar);  /* copies of variables that will be changed in the FORTRAN subroutine */  xytmp = (double *) R_alloc(n_eq, sizeof(double));  for (j = 0; j < n_eq; j++) xytmp[j] = REAL(y)[j];  ytmp = (double *) R_alloc(n_eq, sizeof(double));  for (j = 0; j < n_eq; j++) ytmp[j] = 0.;  latol = LENGTH(atol);  Atol = (double *) R_alloc((int) latol, sizeof(double));  for (j = 0; j < latol; j++) Atol[j] = REAL(atol)[j];  lrtol = LENGTH(rtol);  Rtol = (double *) R_alloc((int) lrtol, sizeof(double));  for (j = 0; j < lrtol; j++) Rtol[j] = REAL(rtol)[j];  /* tolerance specifications */  if (latol == 1 ) itol = 0;  else             itol = 1;  /* mass matrix */  imas  = INTEGER(Nrmas)[0];  mlmas = INTEGER(Nrmas)[1];  mumas = INTEGER(Nrmas)[2];  /* work vectors */  if (type == 1) {    liw = 27;    lrw = 21;  } else  {       //  if (type == 2)    liw = n_eq + 40;    lrw = INTEGER(LRW)[0]; }  iwork = (int *) R_alloc(liw, sizeof(int));  for (j=0; j<LENGTH(iWork); j++) iwork[j] = INTEGER(iWork)[j];  for (j=LENGTH(iWork); j<liw; j++) iwork[j] = 0;  rwork = (double *) R_alloc(lrw, sizeof(double));  for (j=0; j<length(rWork); j++) rwork[j] = REAL(rWork)[j];  for (j=length(rWork); j<lrw; j++) rwork[j] = 0.;  ml = INTEGER(ML)[0];  mu = INTEGER(MU)[0];  hini = REAL(Hini)[0];  /* initialise global R-variables...  */  initglobals (nt);  /* Initialization of Parameters, Forcings (DLL) */  initParms(initfunc, parms);  isForcing = initForcings(flist);  if (nout > 0 ) {     xdytmp= (double *) R_alloc(n_eq, sizeof(double));//.........这里部分代码省略.........
开发者ID:cran,项目名称:deTestSet,代码行数:101,


示例2: do_init_state

SEXP do_init_state (SEXP object, SEXP params, SEXP t0, SEXP nsim, SEXP gnsi){  int nprotect = 0;  SEXP Pnames, Snames;  SEXP x = R_NilValue;  int *dim;  int npar, nrep, nvar, ns;  int definit;  int xdim[2];  const char *dimnms[2] = {"variable","rep"};  ns = *(INTEGER(AS_INTEGER(nsim)));  PROTECT(params = as_matrix(params)); nprotect++;  PROTECT(Pnames = GET_ROWNAMES(GET_DIMNAMES(params))); nprotect++;  dim = INTEGER(GET_DIM(params));  npar = dim[0]; nrep = dim[1];   if (ns % nrep != 0)     errorcall(R_NilValue,"in 'init.state': number of desired state-vectors 'nsim' is not a multiple of ncol('params')");  definit = *(INTEGER(GET_SLOT(object,install("default.init"))));  if (definit) {		// default initializer    SEXP fcall, pat, repl, val, ivpnames, statenames;    int *pidx, j, k;    double *xp, *pp;      PROTECT(pat = NEW_CHARACTER(1)); nprotect++;    SET_STRING_ELT(pat,0,mkChar("//.0$"));    PROTECT(repl = NEW_CHARACTER(1)); nprotect++;    SET_STRING_ELT(repl,0,mkChar(""));    PROTECT(val = NEW_LOGICAL(1)); nprotect++;    *(INTEGER(val)) = 1;        // extract names of IVPs    PROTECT(fcall = LCONS(val,R_NilValue)); nprotect++;    SET_TAG(fcall,install("value"));    PROTECT(fcall = LCONS(Pnames,fcall)); nprotect++;    SET_TAG(fcall,install("x"));    PROTECT(fcall = LCONS(pat,fcall)); nprotect++;    SET_TAG(fcall,install("pattern"));    PROTECT(fcall = LCONS(install("grep"),fcall)); nprotect++;    PROTECT(ivpnames = eval(fcall,R_BaseEnv)); nprotect++;        nvar = LENGTH(ivpnames);    if (nvar < 1) {      errorcall(R_NilValue,"in default 'initializer': there are no parameters with suffix '.0'. See '?pomp'.");    }    pidx = INTEGER(PROTECT(match(Pnames,ivpnames,0))); nprotect++;    for (k = 0; k < nvar; k++) pidx[k]--;        // construct names of state variables    PROTECT(fcall = LCONS(ivpnames,R_NilValue)); nprotect++;    SET_TAG(fcall,install("x"));    PROTECT(fcall = LCONS(repl,fcall)); nprotect++;    SET_TAG(fcall,install("replacement"));    PROTECT(fcall = LCONS(pat,fcall)); nprotect++;    SET_TAG(fcall,install("pattern"));    PROTECT(fcall = LCONS(install("sub"),fcall)); nprotect++;    PROTECT(statenames = eval(fcall,R_BaseEnv)); nprotect++;    xdim[0] = nvar; xdim[1] = ns;    PROTECT(x = makearray(2,xdim)); nprotect++;    setrownames(x,statenames,2);    fixdimnames(x,dimnms,2);    for (j = 0, xp = REAL(x); j < ns; j++) {      pp = REAL(params) + npar*(j%nrep);      for (k = 0; k < nvar; k++, xp++) 	*xp = pp[pidx[k]];    }  } else {			// user-supplied initializer        SEXP pompfun, fcall, fn, tcovar, covar, covars = R_NilValue;    pompfunmode mode = undef;    double *cp = NULL;    // extract the initializer function and its environment    PROTECT(pompfun = GET_SLOT(object,install("initializer"))); nprotect++;    PROTECT(fn = pomp_fun_handler(pompfun,gnsi,&mode)); nprotect++;        // extract covariates and interpolate    PROTECT(tcovar = GET_SLOT(object,install("tcovar"))); nprotect++;    if (LENGTH(tcovar) > 0) {	// do table lookup      PROTECT(covar = GET_SLOT(object,install("covar"))); nprotect++;      PROTECT(covars = lookup_in_table(tcovar,covar,t0)); nprotect++;      cp = REAL(covars);    }	    // extract userdata    PROTECT(fcall = VectorToPairList(GET_SLOT(object,install("userdata")))); nprotect++;	    switch (mode) {    case Rfun:			// use R function      {	SEXP par, rho, x1, x2;	double *p, *pp, *xp, *xt;//.........这里部分代码省略.........
开发者ID:kingaa,项目名称:pomp,代码行数:101,


示例3: textRect

/* Calculate the bounding rectangle for a string. * x and y assumed to be in INCHES. */void textRect(double x, double y, SEXP text, int i,              const pGEcontext gc,              double xadj, double yadj,              double rot, pGEDevDesc dd, LRect *r){    /* NOTE that we must work in inches for the angles to be correct     */    LLocation bl, br, tr, tl;    LLocation tbl, tbr, ttr, ttl;    LTransform thisLocation, thisRotation, thisJustification;    LTransform tempTransform, transform;    double w, h;    if (isExpression(text)) {        SEXP expr = VECTOR_ELT(text, i % LENGTH(text));        w = fromDeviceWidth(GEExpressionWidth(expr, gc, dd),                            GE_INCHES, dd);        h = fromDeviceHeight(GEExpressionHeight(expr, gc, dd),                             GE_INCHES, dd);    } else {        const char* string = CHAR(STRING_ELT(text, i % LENGTH(text)));        w = fromDeviceWidth(GEStrWidth(string,                                       (gc->fontface == 5) ? CE_SYMBOL :                                       getCharCE(STRING_ELT(text, i % LENGTH(text))),                                       gc, dd),                            GE_INCHES, dd);        h = fromDeviceHeight(GEStrHeight(string,                                         (gc->fontface == 5) ? CE_SYMBOL :                                         getCharCE(STRING_ELT(text, i % LENGTH(text))),                                         gc, dd),                             GE_INCHES, dd);    }    location(0, 0, bl);    location(w, 0, br);    location(w, h, tr);    location(0, h, tl);    translation(-xadj*w, -yadj*h, thisJustification);    translation(x, y, thisLocation);    if (rot != 0)        rotation(rot, thisRotation);    else        identity(thisRotation);    /* Position relative to origin of rotation THEN rotate.     */    multiply(thisJustification, thisRotation, tempTransform);    /* Translate to (x, y)     */    multiply(tempTransform, thisLocation, transform);    trans(bl, transform, tbl);    trans(br, transform, tbr);    trans(tr, transform, ttr);    trans(tl, transform, ttl);    rect(locationX(tbl), locationX(tbr), locationX(ttr), locationX(ttl),         locationY(tbl), locationY(tbr), locationY(ttr), locationY(ttl),         r);    /* For debugging, the following prints out an R statement to draw the     * bounding box     */    /*    Rprintf("/ngrid.lines(c(%f, %f, %f, %f, %f), c(%f, %f, %f, %f, %f), default.units=/"inches/")/n",    locationX(tbl), locationX(tbr), locationX(ttr), locationX(ttl),     locationX(tbl),     locationY(tbl), locationY(tbr), locationY(ttr), locationY(ttl),     locationY(tbl)     );    */}
开发者ID:janardhanv,项目名称:On-Demand-Analytics,代码行数:69,


示例4: FixDetectC

SEXP FixDetectC(SEXP X, SEXP Y, SEXP R, SEXP Dispersion, SEXP MinDur, SEXP Debug){    //function input	double    *pDisp = REAL(Dispersion);	double    *pMinDur = REAL(MinDur);	int       fDebug; 	//function output	double *res = NULL;	SEXP Res,r_X,r_Y,r_D,r_dur,r_start,r_disp;	SEXP list_names;	//detection parameters =================================================	int    MinDuration;          //min dispersion duration (samples)	float  Threshold;            //dispersion threshold	float  Xi,Yi;				 //X & Y coordinates	int    bGaze;                //valid data flag	//LC detector output =============================================================		float  X_d,Y_d,FixX,FixY;    float  Deviation_d;	int    SaccadeDuration,FixDuration;	int    bGaze_d;	int    rc;                 //return code	//=================================    char *names[6] = {"X","Y","R","Dur","Start","Disp"};			int i,len,lmax,iend,istart;	float  Ri, dMean;      //current and average pupil size	int j, Dcnt;           //after-detection pupil size and dispersion calculation	int MaxNFix, NFix;	struct _stFIXdata *pFIX_b, *pFIX;	size_t FIXdata_sz;	float fDx,fDy,dDrSq,fD,fDisp;	fDebug = INTEGER_VALUE(Debug);              //Flag - debug		MinDuration = (int) *pMinDur;	Threshold = (float) *pDisp;	len=LENGTH(X);	lmax=len - 1;	i=0;	MaxNFix = len / MinDuration;	if (fDebug > 0) Rprintf("FixDetectC start: len =%d MaxNFix=%d /n",len,MaxNFix);		FIXdata_sz = MaxNFix*sizeof(struct _stFIXdata);	pFIX_b = (struct _stFIXdata *) malloc(FIXdata_sz);	if (pFIX_b == NULL) {	  Rprintf("FixDetectC: memory allocation ERROR (fixations BLOCK allocation)/n");	  PROTECT(Res = allocVector(REALSXP, 1));	  res = REAL(Res);	  *res = 0;	  UNPROTECT(1);	  return Res;	  	}		pFIX = pFIX_b;	NFix=0; 			if (fDebug > 0) Rprintf("FixDetectC: InitFication Call/n");	InitFixation(MinDuration);	if (fDebug > 0) Rprintf("FixDetectC:  main while(i < len) /n");	while (i < len) {	   Xi = (float) REAL(X)[i];	   Yi = (float) REAL(Y)[i];	   Ri = (float) REAL(R)[i];	   	   if (Ri > 0) bGaze = 1;  else bGaze = 0;	   	   rc=DetectFixation(bGaze,Xi,Yi,Threshold,MinDuration,&bGaze_d,&X_d,&Y_d,&Deviation_d,&FixX,&FixY,&SaccadeDuration,&FixDuration);	   if (fDebug > 1) Rprintf("FixDetectC DetectFixation %d,%d,%4.2f,%4.2f/n",i,rc,Xi,Yi);       if ((rc == 2)||((rc == 1)&&(i == lmax)) ) {                //---  Fixation finished -----                iend   = i - MinDuration;                istart = iend - FixDuration + 1;				// Вычисляем средний диаметр зрачка				j = 0; Dcnt=0; dMean=0; fD = 0; fDisp=0;				for (j = istart; j < iend; j++) {				   Ri = (float) REAL(R)[j];                   Xi = (float) REAL(X)[j];                   Yi = (float) REAL(Y)[j];				                      if (Ri > 0) { Dcnt++; dMean += Ri; }					   fDx = FixX - Xi;                   fDy = FixY - Yi;                   dDrSq = fDx * fDx + fDy * fDy;                   fD = fD + dDrSq;				   				}				if (Dcnt >0) dMean = dMean / Dcnt;				if (Dcnt > 1) fDisp = (float)sqrt(fD / (Dcnt - 1));				// Выводим информацию о фиксации 				if (fDebug > 0) Rprintf("FixDetectC fixation: %4.2f,%4.2f,%3.5f,%d,%d/n",FixX,FixY,dMean,istart,FixDuration);				if (FixDuration >= MinDuration) {				   pFIX->fixx     = FixX;				   pFIX->fixy     = FixY;				   pFIX->D        = dMean;				   pFIX->duration = FixDuration;				   pFIX->start    = istart;				   pFIX->fixdisp  = fDisp;				   if ( NFix < MaxNFix) {pFIX++; NFix++;}				   else {				        Rprintf("FixDetectC: ERROR NFix (%d) == MaxNFix (%d)",NFix,MaxNFix);						break;//.........这里部分代码省略.........
开发者ID:deslion,项目名称:EyeTrackingProject,代码行数:101,


示例5: stri_escape_unicode

/** *  Escape Unicode code points * *  @param str character vector *  @return character vector * * @version 0.1-?? (Marek Gagolewski, 2013-08-17) * * @version 0.2-1 (Marek Gagolewski, 2014-04-01) *          fail on incorrect utf8 byte seqs; * * @version 0.3-1 (Marek Gagolewski, 2014-11-04) *    Issue #112: str_prepare_arg* retvals were not PROTECTed from gc*/SEXP stri_escape_unicode(SEXP str){   PROTECT(str = stri_prepare_arg_string(str, "str")); // prepare string argument   STRI__ERROR_HANDLER_BEGIN(1)   R_len_t str_length = LENGTH(str);   StriContainerUTF8 str_cont(str, str_length);   SEXP ret;   STRI__PROTECT(ret = Rf_allocVector(STRSXP, str_length));   std::string out; // @TODO: estimate len a priori?   for (R_len_t i = str_cont.vectorize_init();         i != str_cont.vectorize_end();         i = str_cont.vectorize_next(i))   {      if (str_cont.isNA(i)) {         SET_STRING_ELT(ret, i, NA_STRING);         continue;      }      const char* str_cur_s = str_cont.get(i).c_str();      R_len_t     str_cur_n = str_cont.get(i).length();      // estimate buf size      R_len_t bufsize = 0;      UChar32 c;      R_len_t j = 0;      while (j < str_cur_n) {         U8_NEXT(str_cur_s, j, str_cur_n, c);         if (c < 0)            throw StriException(MSG__INVALID_UTF8);         else if ((char)c >= 32 || (char)c <= 126)            bufsize += 1;         else if (c <= 0xff)            bufsize += 6; // for /a, /n this will be overestimated         else            bufsize += 10;      }      out.clear();      if ((size_t)bufsize > (size_t)out.size())         out.reserve(bufsize);      // do escape      j = 0;      char buf[11];      while (j < str_cur_n) {         U8_NEXT(str_cur_s, j, str_cur_n, c);         /* if (c < 0)            throw StriException(MSG__INVALID_UTF8); // this has already been checked :)         else */ if (c <= ASCII_MAXCHARCODE) {            switch ((char)c) {               case 0x07: out.append("//a"); break;               case 0x08: out.append("//b"); break;               case 0x09: out.append("//t"); break;               case 0x0a: out.append("//n"); break;               case 0x0b: out.append("//v"); break;               case 0x0c: out.append("//f"); break;               case 0x0d: out.append("//r"); break;//               case 0x1b: out.append("//e"); break; // R doesn't know that               case 0x22: out.append("///""); break;               case 0x27: out.append("//'"); break;               case 0x5c: out.append("////"); break;               default:                  if ((char)c >= 32 || (char)c <= 126) // printable characters                     out.append(1, (char)c);                  else {                     sprintf(buf, "//u%4.4x", (uint16_t)c);                     out.append(buf, 6);                  }            }         }         else if (c <= 0xffff) {            sprintf(buf, "//u%4.4x", (uint16_t)c);            out.append(buf, 6);         }         else {            sprintf(buf, "//U%8.8x", (uint32_t)c);            out.append(buf, 10);         }      }      SET_STRING_ELT(ret, i,         Rf_mkCharLenCE(out.c_str(), (int)out.size(), (cetype_t)CE_UTF8)//.........这里部分代码省略.........
开发者ID:balagopalraj,项目名称:clearlinux,代码行数:101,


示例6: port_ivset

SEXP port_ivset(SEXP kind, SEXP iv, SEXP v){    Rf_divset(asInteger(kind), INTEGER(iv), LENGTH(iv), LENGTH(v), REAL(v));    return R_NilValue;}
开发者ID:Bgods,项目名称:r-source,代码行数:5,


示例7: port_nlsb

SEXP port_nlsb(SEXP m, SEXP d, SEXP gg, SEXP iv, SEXP v,	       SEXP lowerb, SEXP upperb){    int *dims = INTEGER(getAttrib(gg, R_DimSymbol));    int i, n = LENGTH(d), p = LENGTH(d), nd = dims[0];    SEXP getPars, setPars, resid, gradient,	rr = PROTECT(allocVector(REALSXP, nd)),	x = PROTECT(allocVector(REALSXP, n));    // This used to use Calloc, but that will leak if     // there is a premature return (and did in package drfit)    double *b = (double *) NULL,	*rd = (double *)R_alloc(nd, sizeof(double));    if (!isReal(d) || n < 1)	error(_("'d' must be a nonempty numeric vector"));    if(!isNewList(m)) error(_("m must be a list"));				/* Initialize parameter vector */    getPars = PROTECT(lang1(getFunc(m, "getPars", "m")));    eval_check_store(getPars, R_GlobalEnv, x);				/* Create the setPars call */    setPars = PROTECT(lang2(getFunc(m, "setPars", "m"), x));				/* Evaluate residual and gradient */    resid = PROTECT(lang1(getFunc(m, "resid", "m")));    eval_check_store(resid, R_GlobalEnv, rr);    gradient = PROTECT(lang1(getFunc(m, "gradient", "m")));    neggrad(gradient, R_GlobalEnv, gg);    if ((LENGTH(lowerb) == n) && (LENGTH(upperb) == n)) {	if (isReal(lowerb) && isReal(upperb)) {	    double *rl = REAL(lowerb), *ru = REAL(upperb);	    b = (double *)R_alloc(2*n, sizeof(double));	    for (i = 0; i < n; i++) {		b[2*i] = rl[i];		b[2*i + 1] = ru[i];	    }	} else error(_("'lowerb' and 'upperb' must be numeric vectors"));    }    do {	nlsb_iterate(b, REAL(d), REAL(gg), INTEGER(iv), LENGTH(iv),		     LENGTH(v), n, nd, p, REAL(rr), rd,		     REAL(v), REAL(x));	switch(INTEGER(iv)[0]) {	case -3:	    eval(setPars, R_GlobalEnv);	    eval_check_store(resid, R_GlobalEnv, rr);	    neggrad(gradient, R_GlobalEnv, gg);	    break;	case -2:	    eval_check_store(resid, R_GlobalEnv, rr);	    neggrad(gradient, R_GlobalEnv, gg);	    break;	case -1:	    eval(setPars, R_GlobalEnv);	    eval_check_store(resid, R_GlobalEnv, rr);	    neggrad(gradient, R_GlobalEnv, gg);	    break;	case 0:	    Rprintf("nlsb_iterate returned %d", INTEGER(iv)[0]);	    break;	case 1:	    eval(setPars, R_GlobalEnv);	    eval_check_store(resid, R_GlobalEnv, rr);	    break;	case 2:	    eval(setPars, R_GlobalEnv);	    neggrad(gradient, R_GlobalEnv, gg);	    break;	}    } while(INTEGER(iv)[0] < 3);    UNPROTECT(6);    return R_NilValue;}
开发者ID:Bgods,项目名称:r-source,代码行数:74,


示例8: REG_SYSC

    char *name;    bool active;    int option;    int maxcalls;    int numcalls;    char *s;    // ... whatever else};#define REG_SYSC(x) [x] = {x, #x, false, 0, 0, 0, NULL}static struct one_call global_call_list[] = {#include "reg_sysc.c"    {-1, NULL, false, 0, 0, 0, NULL}};static const int NUMCALLS = LENGTH(global_call_list);static char *call_name(int syscall){    int i = 0;    struct one_call *c = global_call_list;    while (i < NUMCALLS) {        if (c[i].syscall == syscall)            return c[i].name;        i += 1;    }    return NULL;}/* * signal stuff
开发者ID:mnhrdt,项目名称:nurse,代码行数:31,


示例9: pollSocket

SEXP pollSocket(SEXP sockets_, SEXP events_, SEXP timeout_) {    SEXP result;        if(TYPEOF(timeout_) != INTSXP) {        error("poll timeout must be an integer.");    }    if(TYPEOF(sockets_) != VECSXP || LENGTH(sockets_) == 0) {        error("A non-empy list of sockets is required as first argument.");    }    int nsock = LENGTH(sockets_);    PROTECT(result = allocVector(VECSXP, nsock));    if (TYPEOF(events_) != VECSXP) {        error("event list must be a list of strings or a list of vectors of strings.");    }    if(LENGTH(events_) != nsock) {        error("event list must be the same length as socket list.");    }    zmq_pollitem_t *pitems = (zmq_pollitem_t*)R_alloc(nsock, sizeof(zmq_pollitem_t));    if (pitems == NULL) {        error("failed to allocate memory for zmq_pollitem_t array.");    }    try {        for (int i = 0; i < nsock; i++) {            zmq::socket_t* socket = reinterpret_cast<zmq::socket_t*>(checkExternalPointer(VECTOR_ELT(sockets_, i), "zmq::socket_t*"));            pitems[i].socket = (void*)*socket;            pitems[i].events = rzmq_build_event_bitmask(VECTOR_ELT(events_, i));        }        int rc = zmq::poll(pitems, nsock, *INTEGER(timeout_));        if(rc >= 0) {            for (int i = 0; i < nsock; i++) {                SEXP events, names;                // Pre count number of polled events so we can                // allocate appropriately sized lists.                short eventcount = 0;                if (pitems[i].events & ZMQ_POLLIN) eventcount++;                if (pitems[i].events & ZMQ_POLLOUT) eventcount++;                if (pitems[i].events & ZMQ_POLLERR) eventcount++;                PROTECT(events = allocVector(VECSXP, eventcount));                PROTECT(names = allocVector(VECSXP, eventcount));                eventcount = 0;                if (pitems[i].events & ZMQ_POLLIN) {                    SET_VECTOR_ELT(events, eventcount, ScalarLogical(pitems[i].revents & ZMQ_POLLIN));                    SET_VECTOR_ELT(names, eventcount, mkChar("read"));                    eventcount++;                }                if (pitems[i].events & ZMQ_POLLOUT) {                    SET_VECTOR_ELT(names, eventcount, mkChar("write"));                    SET_VECTOR_ELT(events, eventcount, ScalarLogical(pitems[i].revents & ZMQ_POLLOUT));                    eventcount++;                }                if (pitems[i].events & ZMQ_POLLERR) {                    SET_VECTOR_ELT(names, eventcount, mkChar("error"));                    SET_VECTOR_ELT(events, eventcount, ScalarLogical(pitems[i].revents & ZMQ_POLLERR));                }                setAttrib(events, R_NamesSymbol, names);                SET_VECTOR_ELT(result, i, events);            }        } else {            error("polling zmq sockets failed.");        }    } catch(std::exception& e) {        error(e.what());    }    // Release the result list (1), and per socket    // events lists with associated names (2*nsock).    UNPROTECT(1 + 2*nsock);    return result;}
开发者ID:joemphilips,项目名称:rzmq,代码行数:81,


示例10: do_relop_dflt

SEXP attribute_hidden do_relop_dflt(SEXP call, SEXP op, SEXP x, SEXP y){    SEXP klass = R_NilValue, dims, tsp=R_NilValue, xnames, ynames;    int nx, ny, xarray, yarray, xts, yts;    Rboolean mismatch = FALSE, iS;    PROTECT_INDEX xpi, ypi;    PROTECT_WITH_INDEX(x, &xpi);    PROTECT_WITH_INDEX(y, &ypi);    nx = length(x);    ny = length(y);    /* pre-test to handle the most common case quickly.       Used to skip warning too ....     */    if (ATTRIB(x) == R_NilValue && ATTRIB(y) == R_NilValue &&	TYPEOF(x) == REALSXP && TYPEOF(y) == REALSXP &&	LENGTH(x) > 0 && LENGTH(y) > 0) {	SEXP ans = real_relop((RELOP_TYPE) PRIMVAL(op), x, y);	if (nx > 0 && ny > 0)	    mismatch = ((nx > ny) ? nx % ny : ny % nx) != 0;	if (mismatch) {	    PROTECT(ans);	    warningcall(call, _("longer object length is not a multiple of shorter object length"));	    UNPROTECT(1);	}	UNPROTECT(2);	return ans;    }    /* That symbols and calls were allowed was undocumented prior to       R 2.5.0.  We deparse them as deparse() would, minus attributes */    if ((iS = isSymbol(x)) || TYPEOF(x) == LANGSXP) {	SEXP tmp = allocVector(STRSXP, 1);	PROTECT(tmp);	SET_STRING_ELT(tmp, 0, (iS) ? PRINTNAME(x) :		       STRING_ELT(deparse1(x, 0, DEFAULTDEPARSE), 0));	REPROTECT(x = tmp, xpi);	UNPROTECT(1);    }    if ((iS = isSymbol(y)) || TYPEOF(y) == LANGSXP) {	SEXP tmp = allocVector(STRSXP, 1);	PROTECT(tmp);	SET_STRING_ELT(tmp, 0, (iS) ? PRINTNAME(y) :		       STRING_ELT(deparse1(y, 0, DEFAULTDEPARSE), 0));	REPROTECT(y = tmp, ypi);	UNPROTECT(1);    }    if (!isVector(x) || !isVector(y)) {	if (isNull(x) || isNull(y)) {	    UNPROTECT(2);	    return allocVector(LGLSXP,0);	}	errorcall(call,		  _("comparison (%d) is possible only for atomic and list types"),		  PRIMVAL(op));    }    if (TYPEOF(x) == EXPRSXP || TYPEOF(y) == EXPRSXP)	errorcall(call, _("comparison is not allowed for expressions"));    /* ELSE :  x and y are both atomic or list */    if (LENGTH(x) <= 0 || LENGTH(y) <= 0) {	UNPROTECT(2);	return allocVector(LGLSXP,0);    }    mismatch = FALSE;    xarray = isArray(x);    yarray = isArray(y);    xts = isTs(x);    yts = isTs(y);    if (nx > 0 && ny > 0)	mismatch = ((nx > ny) ? nx % ny : ny % nx) != 0;    if (xarray || yarray) {	if (xarray && yarray) {	    if (!conformable(x, y))		errorcall(call, _("non-conformable arrays"));	    PROTECT(dims = getAttrib(x, R_DimSymbol));	}	else if (xarray) {	    PROTECT(dims = getAttrib(x, R_DimSymbol));	}	else /*(yarray)*/ {	    PROTECT(dims = getAttrib(y, R_DimSymbol));	}	PROTECT(xnames = getAttrib(x, R_DimNamesSymbol));	PROTECT(ynames = getAttrib(y, R_DimNamesSymbol));    }    else {	PROTECT(dims = R_NilValue);	PROTECT(xnames = getAttrib(x, R_NamesSymbol));	PROTECT(ynames = getAttrib(y, R_NamesSymbol));    }    if (xts || yts) {	if (xts && yts) {	    if (!tsConform(x, y))//.........这里部分代码省略.........
开发者ID:SensePlatform,项目名称:R,代码行数:101,


示例11: rthhist

extern "C" SEXP rthhist(SEXP x, SEXP nbins_,  SEXP nch_, SEXP nthreads){  const int n = LENGTH(x);  const int nbins = INTEGER(nbins_)[0];  const int nch = INTEGER(nch_)[0];    floublevec dx(REAL(x), REAL(x)+n);    SEXP bincounts, R_left, R_binwidth;  PROTECT(bincounts = allocVector(INTSXP, nbins));  PROTECT(R_left = allocVector(REALSXP, 1));  PROTECT(R_binwidth = allocVector(REALSXP, 1));    SEXP ret, retnames;    RTH_GEN_NTHREADS(nthreads);    // determine binwidth etc.  thrust::pair<floubleveciter, floubleveciter> mm =     thrust::minmax_element(dx.begin(), dx.end());  flouble left = *(mm.first), right = *(mm.second);  flouble binwidth = (right - left) / nbins;    // form matrix of bin counts, one row per chunk  intvec dbincounts(nch*nbins);      // the heart of the computation, a for_each() loop, one iteration per  // chunk  thrust::counting_iterator<int> seqa(0);  thrust::counting_iterator<int> seqb =  seqa + nch;  thrust::for_each(seqa,seqb,    do1chunk(dx.begin(),dbincounts.begin(          ), n, nbins, nch, left, binwidth));    // copy result to host and combine the subhistograms  int hbincounts[nch*nbins];  thrust::copy(dbincounts.begin(), dbincounts.end(), hbincounts);  int binnum,chunknum;  for (binnum = 0; binnum < nbins; binnum++) {    int sum = 0;    for (chunknum = 0; chunknum < nch; chunknum++)       sum += hbincounts[chunknum*nbins + binnum];    INTEGER(bincounts)[binnum] = sum;  }      REAL(R_left)[0] = (double) left;   REAL(R_binwidth)[0] = (double) binwidth;    PROTECT(retnames = allocVector(STRSXP, 3));  SET_STRING_ELT(retnames, 0, mkChar("counts"));  SET_STRING_ELT(retnames, 1, mkChar("left"));  SET_STRING_ELT(retnames, 2, mkChar("binwidth"));    PROTECT(ret = allocVector(VECSXP, 3));  SET_VECTOR_ELT(ret, 0, bincounts);  SET_VECTOR_ELT(ret, 1, R_left);  SET_VECTOR_ELT(ret, 2, R_binwidth);    setAttrib(ret, R_NamesSymbol, retnames);    UNPROTECT(5);  return ret;}
开发者ID:Rth-org,项目名称:Rth,代码行数:66,


示例12: setup

void setup(void){    ewmh_init();    screen = xcb_setup_roots_iterator(xcb_get_setup(dpy)).data;    if (!screen)        err("error: cannot aquire screen/n");    screen_width = screen->width_in_pixels;    screen_height = screen->height_in_pixels;    root_depth = screen->root_depth;    xcb_atom_t net_atoms[] = {ewmh->_NET_SUPPORTED,                              ewmh->_NET_DESKTOP_NAMES,                              ewmh->_NET_NUMBER_OF_DESKTOPS,                              ewmh->_NET_CURRENT_DESKTOP,                              ewmh->_NET_CLIENT_LIST,                              ewmh->_NET_ACTIVE_WINDOW,                              ewmh->_NET_WM_DESKTOP,                              ewmh->_NET_WM_STATE,                              ewmh->_NET_WM_STATE_FULLSCREEN,                              ewmh->_NET_WM_WINDOW_TYPE,                              ewmh->_NET_WM_WINDOW_TYPE_DOCK,                              ewmh->_NET_WM_WINDOW_TYPE_NOTIFICATION,                              ewmh->_NET_WM_WINDOW_TYPE_DIALOG,                              ewmh->_NET_WM_WINDOW_TYPE_UTILITY,                              ewmh->_NET_WM_WINDOW_TYPE_TOOLBAR};    xcb_ewmh_set_supported(ewmh, default_screen, LENGTH(net_atoms), net_atoms);    monitor_uid = desktop_uid = client_uid = 0;    mon = last_mon = mon_head = mon_tail = NULL;    bool xinerama_is_active = false;    if (xcb_get_extension_data(dpy, &xcb_xinerama_id)->present) {        xcb_xinerama_is_active_reply_t *xia = xcb_xinerama_is_active_reply(dpy, xcb_xinerama_is_active(dpy), NULL);        if (xia != NULL) {            xinerama_is_active = xia->state;            free(xia);        }    }    if (xinerama_is_active) {        xcb_xinerama_query_screens_reply_t *xsq = xcb_xinerama_query_screens_reply(dpy, xcb_xinerama_query_screens(dpy), NULL);        xcb_xinerama_screen_info_t *xsi = xcb_xinerama_query_screens_screen_info(xsq);        int n = xcb_xinerama_query_screens_screen_info_length(xsq);        PRINTF("number of monitors: %d/n", n);        for (int i = 0; i < n; i++) {            xcb_xinerama_screen_info_t info = xsi[i];            xcb_rectangle_t rect = (xcb_rectangle_t) {info.x_org, info.y_org, info.width, info.height};            add_monitor(&rect);        }        free(xsq);    } else {        warn("Xinerama is inactive");        xcb_rectangle_t rect = (xcb_rectangle_t) {0, 0, screen_width, screen_height};        add_monitor(&rect);    }    for (monitor_t *m = mon_head; m != NULL; m = m->next)        add_desktop(m, NULL);    ewmh_update_number_of_desktops();    ewmh_update_desktop_names();    rule_head = make_rule();    frozen_pointer = make_pointer_state();    get_pointer_position(&pointer_position);    split_mode = MODE_AUTOMATIC;}
开发者ID:sunaku,项目名称:bspwm,代码行数:69,


示例13: do_sprintf

//.........这里部分代码省略.........		    if (starc) { /* handle  *  format if present */			nstar = -1;			if (strlen(starc) > 3 && starc[1] >= '1' && starc[1] <= '9') {			    v = starc[1] - '0';			    if(starc[2] == '$') {				if(v > nargs)				    error(_("reference to non-existent argument %d"), v);				nstar = v-1;				memmove(starc+1, starc+3, strlen(starc)-2);			    } else if(starc[2] >= '0' && starc[2] <= '9'				      && starc[3] == '$') {				v = 10*v + starc[2] - '0';				if(v > nargs)				    error(_("reference to non-existent argument %d"), v);				nstar = v-1;				memmove(starc+1, starc+4, strlen(starc)-3);			    }			}			if(nstar < 0) {			    if (cnt >= nargs) error(_("too few arguments"));			    nstar = cnt++;			}			if (Rf_strchr(starc+1, '*'))			    error(_("at most one asterisk '*' is supported in each conversion specification"));			_this = a[nstar];			if(ns == 0 && TYPEOF(_this) == REALSXP) {			    _this = coerceVector(_this, INTSXP);			    PROTECT(a[nstar] = _this);			    nprotect++;			}			if(TYPEOF(_this) != INTSXP || LENGTH(_this)<1 ||			   INTEGER(_this)[ns % LENGTH(_this)] == NA_INTEGER)			    error(_("argument for '*' conversion specification must be a number"));			star_arg = INTEGER(_this)[ns % LENGTH(_this)];			has_star = TRUE;		    }		    else			has_star = FALSE;		    if (fmt[strlen(fmt) - 1] == '%') {			/* handle % with formatting options */			if (has_star)			    snprintf(bit, MAXLINE+1, fmt, star_arg);			else			    strcpy(bit, fmt);			/* was sprintf(..)  for which some compiler warn */		    } else {			Rboolean did_this = FALSE;			if(nthis < 0) {			    if (cnt >= nargs) error(_("too few arguments"));			    nthis = cnt++;			}			_this = a[nthis];			if (has_star) {			    size_t nf; char *p, *q = fmt2;			    for (p = fmt; *p; p++)				if (*p == '*') q += sprintf(q, "%d", star_arg);				else *q++ = *p;			    *q = '/0';			    nf = strlen(fmt2);			    if (nf > MAXLINE)				error(_("'fmt' length exceeds maximal format length %d"),				      MAXLINE);
开发者ID:jeffreyhorner,项目名称:cxxr,代码行数:67,


示例14: map_check_polygons

SEXP map_check_polygons(SEXP x, SEXP y, SEXP z, SEXP xokspan, SEXP usr) // returns new x vector{    //int nrow = INTEGER(GET_DIM(z))[0];    //int ncol = INTEGER(GET_DIM(z))[1];    PROTECT(x = AS_NUMERIC(x));    PROTECT(y = AS_NUMERIC(y));    PROTECT(z = AS_NUMERIC(z));    PROTECT(xokspan = AS_NUMERIC(xokspan));    PROTECT(usr = AS_NUMERIC(usr));    int nusr = LENGTH(usr);    if (nusr != 4) error("'usr' must hold 4 values");    double *usrp = REAL(usr); // left right bottom top    double *xp = REAL(x);    double *yp = REAL(y);    //double *zp = REAL(z);    double *xokspanp = REAL(xokspan);    int nx = length(x);    int ny = length(y);    int nz = length(z);    if (nx < 2) error("must have at least two x values");    if (ny < 2) error("must have at least two y values");    if (nz < 1) error("must have at least one z value");    int npoly = nx / 5;    SEXP okPoint, okPolygon, clippedPoint, clippedPolygon;    PROTECT(okPolygon = allocVector(LGLSXP, npoly));     PROTECT(okPoint = allocVector(LGLSXP, nx));     PROTECT(clippedPoint = allocVector(LGLSXP, nx));     PROTECT(clippedPolygon = allocVector(LGLSXP, npoly));     int *okPointp = INTEGER(okPoint);    int *okPolygonp = INTEGER(okPolygon);    int *clippedPointp = INTEGER(clippedPoint);    int *clippedPolygonp = INTEGER(clippedPolygon);    // Initialize (not be needed if below catches all cases)    for (int ipoly = 0; ipoly < npoly; ipoly++) {        okPolygonp[ipoly] = 1;        clippedPolygonp[ipoly] = 0;    }    for (int ix = 0; ix < nx; ix++) {        okPointp[ix] = 1;        clippedPointp[ix] = 0;    }    // x1 x2 x3 x4 NA x1 x2 x3 x4 NA ...    double dxPermitted = fabs(*xokspanp);#ifdef DEBUG    int count = 0, ncount=100000;#endif    for (int ipoly = 0; ipoly < npoly; ipoly++) {        int start = 5 * ipoly;        // Check for bad polygons, in three phases.        // 1. Find polygons that have some NA values for vertices#ifdef DEBUG        if (ipoly < 3)            Rprintf("start: %d; okPointp= %d %d .../n", start, okPointp[start], okPointp[start+1]);#endif        for (int j = 0; j < 4; j++) { // skip 5th point which is surely NA            // Check for x or y being NA            if (ISNA(xp[start + j]) || ISNA(yp[start + j])) {#ifdef DEBUG                if (count++ < ncount) { // FIXME: remove when working                    Rprintf("(1.) x or y is NA -- ipoly: %d, j: %d, span: %f (limit to span: %f)/n",                            ipoly, j, fabs(xp[start+j]-xp[start+j-1]), dxPermitted);                }#endif                for (int k = 0; k < 5; k++)                    okPointp[start + k] = 0;                okPolygonp[ipoly] = 0;                break;            }        }        // 2. Find polygons with all vertices outside the plot region        double xmin = xp[start], xmax = xp[start], ymin = yp[start], ymax=yp[start];        for (int j = 1; j < 4; j++) {            if (xp[start + j] < xmin) xmin = xp[start + j];            if (yp[start + j] < ymin) ymin = yp[start + j];            if (xp[start + j] > xmax) xmax = xp[start + j];            if (yp[start + j] > ymax) ymax = yp[start + j];        }        if (xmax < usrp[0] || usrp[1] < xmin || ymax < usrp[2] || usrp[3] < ymin) {#ifdef DEBUG            if (count < ncount) {                count++;                Rprintf("clipping points %d to %d/n", start, start+4);            }#endif            for (int k = 0; k < 5; k++) {                clippedPointp[start + k] = 1;            }            clippedPolygonp[ipoly] = 1;        }        // 3. Find polygons with excessive x range (an error in projection)        for (int j = 1; j < 4; j++) { // skip 5th point which is surely NA            if (dxPermitted < fabs(xp[start + j] - xp[start + j - 1])) {#ifdef DEBUG                if (count++ < ncount) { // FIXME: remove when working                    Rprintf("(3.) ipoly: %d, j: %d, span: %f (limit to span: %f)/n",                            ipoly, j, fabs(xp[start+j]-xp[start+j-1]), dxPermitted);                }#endif//.........这里部分代码省略.........
开发者ID:AnneMTreasure,项目名称:oce,代码行数:101,


示例15: loc_get_target

unsigned int loc_get_target(void){    if (gTarget != (unsigned int)-1)        return gTarget;    static const char hw_platform[]      = "/sys/devices/soc0/hw_platform";    static const char id[]               = "/sys/devices/soc0/soc_id";    static const char hw_platform_dep[]  =        "/sys/devices/system/soc/soc0/hw_platform";    static const char id_dep[]           = "/sys/devices/system/soc/soc0/id";    static const char mdm[]              = "/dev/mdm"; // No such file or directory    char rd_hw_platform[LINE_LEN];    char rd_id[LINE_LEN];    char rd_mdm[LINE_LEN];    char baseband[LINE_LEN];    if (is_qca1530()) {        gTarget = TARGET_QCA1530;        goto detected;    }    loc_get_target_baseband(baseband, sizeof(baseband));    if (!access(hw_platform, F_OK)) {        read_a_line(hw_platform, rd_hw_platform, LINE_LEN);    } else {        read_a_line(hw_platform_dep, rd_hw_platform, LINE_LEN);    }    if (!access(id, F_OK)) {        read_a_line(id, rd_id, LINE_LEN);    } else {        read_a_line(id_dep, rd_id, LINE_LEN);    }    if( !memcmp(baseband, STR_APQ, LENGTH(STR_APQ)) ){        if( !memcmp(rd_id, MPQ8064_ID_1, LENGTH(MPQ8064_ID_1))            && IS_STR_END(rd_id[LENGTH(MPQ8064_ID_1)]) )            gTarget = TARGET_MPQ;        else            gTarget = TARGET_APQ_SA;    }    else {        if( (!memcmp(rd_hw_platform, STR_LIQUID, LENGTH(STR_LIQUID))             && IS_STR_END(rd_hw_platform[LENGTH(STR_LIQUID)])) ||            (!memcmp(rd_hw_platform, STR_SURF,   LENGTH(STR_SURF))             && IS_STR_END(rd_hw_platform[LENGTH(STR_SURF)])) ||            (!memcmp(rd_hw_platform, STR_MTP,   LENGTH(STR_MTP))             && IS_STR_END(rd_hw_platform[LENGTH(STR_MTP)]))) {            if (!read_a_line( mdm, rd_mdm, LINE_LEN))                gTarget = TARGET_MDM;        }        else if( (!memcmp(rd_id, MSM8930_ID_1, LENGTH(MSM8930_ID_1))                   && IS_STR_END(rd_id[LENGTH(MSM8930_ID_1)])) ||                  (!memcmp(rd_id, MSM8930_ID_2, LENGTH(MSM8930_ID_2))                   && IS_STR_END(rd_id[LENGTH(MSM8930_ID_2)])) )             gTarget = TARGET_MSM_NO_SSC;        else             gTarget = TARGET_UNKNOWN;    }detected:    LOC_LOGD("HAL: %s returned %d", __FUNCTION__, gTarget);    return gTarget;}
开发者ID:F4k,项目名称:android_device_samsung_serrano-common,代码行数:66,


示例16: call_mebdfi

SEXP call_mebdfi(SEXP y, SEXP yprime, SEXP times, SEXP resfunc, SEXP parms,		SEXP rtol, SEXP atol, SEXP itol, SEXP rho, SEXP Tcrit, SEXP Hini,    SEXP Maxord, SEXP maxIt, SEXP nind, SEXP jacfunc, SEXP initfunc,    SEXP verbose, SEXP Mf, SEXP Mbnd, SEXP Liw, SEXP Lrw,    SEXP nOut, SEXP Rpar, SEXP Ipar, SEXP flist, SEXP Funtype, SEXP Mass){/******************************************************************************//******                   DECLARATION SECTION                            ******//******************************************************************************//* These R-structures will be allocated and returned to R*/  SEXP   yout, yout2=NULL, dyout=NULL, ISTATE, RWORK;  int    i, j, k, nt, latol, lrtol, lrw, liw, isDll;  int    isForcing , Itol, *mbnd, mf, maxord, isOut;  double *xytmp,  *xdytmp, *rwork, tin, tout, *Atol, *Rtol, tcrit, hini;  double *delta=NULL, cj;  int    idid, *iwork, ires, ierr, funtype;  C_res_func_type  *res_func = NULL;  C_jac_func_type  *jac_func = NULL;/******************************************************************************//******                         STATEMENTS                               ******//******************************************************************************//*                      #### initialisation ####                              */      init_N_Protect();  n_eq = LENGTH(y);  nt = LENGTH(times);//  mflag = INTEGER(verbose)[0];          nout  = INTEGER(nOut)[0];  funtype  = INTEGER(Funtype)[0]; /* 1 = res, 2 = func */  ntot  = n_eq;  mf = INTEGER(Mf)[0];  maxord = INTEGER(Maxord)[0];  tcrit = REAL(Tcrit)[0];  hini = REAL(Hini)[0];  ierr = 0;/* function is a dll ?*/  if (inherits(resfunc, "NativeSymbol"))    isDll = 1;  else    isDll = 0;  isOut = 0;  if (isDll == 0 && nout > 0) isOut =1;  else if (isDll == 1 ) ntot = ntot+ nout;/* initialise output vectors ... */  if (isDll==1)  { /* function is a dll */    lrpar = nout + LENGTH(Rpar);       /* length of rpar */    lipar = 3    + LENGTH(Ipar);       /* length of ipar */  } else  {                             /* function is not a dll */    lipar = 1;    lrpar = 1;  }  out   = (double *) R_alloc(lrpar, sizeof(double));  ipar  = (int *)    R_alloc(lipar, sizeof(int));  if (isDll ==1)  {    ipar[0] = nout;          /* first 3 elements of ipar are special */    ipar[1] = lrpar;    ipar[2] = lipar;    /* other elements of ipar are set in R-function lsodx via argument *ipar* */    for (j = 0; j < LENGTH(Ipar); j++) ipar[j+3] = INTEGER(Ipar)[j];    /* first nout elements of rpar reserved for output variables      other elements are set in R-function lsodx via argument *rpar* */    for (j = 0; j < nout;        j++) out[j] = 0.;    for (j = 0; j < LENGTH(Rpar);j++) out[nout+j] = REAL(Rpar)[j];  } else {    for (j = 0; j < lrpar;       j++) out[j] = 0.;    for (j = 0; j < lipar;       j++) ipar[j] = 0.;  }  /* copies of all variables that will be changed in the FORTRAN subroutine */  xytmp = (double *) R_alloc(n_eq, sizeof(double));   for (j = 0; j < n_eq; j++) xytmp[j] = REAL(y)[j];  xdytmp = (double *) R_alloc(n_eq, sizeof(double));   for (j = 0; j < n_eq; j++) xdytmp[j] = REAL(yprime)[j];  /* tolerance */  latol = LENGTH(atol);  Atol  = (double *) R_alloc((int) latol, sizeof(double));    for (j = 0; j < latol; j++) Atol[j] = REAL(atol)[j];  lrtol = LENGTH(rtol);  Rtol  = (double *) R_alloc((int) lrtol, sizeof(double));    for (j = 0; j < lrtol; j++) Rtol[j] = REAL(rtol)[j];  Itol  = INTEGER(itol)[0];//.........这里部分代码省略.........
开发者ID:cran,项目名称:deTestSet,代码行数:101,


示例17: shp_inside

SEXP shp_inside(SEXP slist, SEXP pxv, SEXP pyv, SEXP clockw, SEXP sAll) {    SEXP xv, yv, pv, res;    double *x, *y, *px, *py;    int *p, up = 0, *r, np, ns, mp = 0, i,	expected = (asInteger(clockw) == TRUE) ? 1 : -1,	all = (asInteger(sAll) == TRUE) ? 1 : 0;    if (TYPEOF(slist) != VECSXP || !inherits(slist, "shp"))	Rf_error("input must be a list of shapes (shp object)");    if (LENGTH(slist) == 0)	return allocVector(INTSXP, 0);    if (LENGTH(pxv) != LENGTH(pyv))	Rf_error("point coordinates must have the same length");    if (TYPEOF(pxv) != REALSXP) {	pxv = PROTECT(coerceVector(pxv, REALSXP)); up++;    }    if (TYPEOF(pyv) != REALSXP) {	pyv = PROTECT(coerceVector(pyv, REALSXP)); up++;    }    px = REAL(pxv);    py = REAL(pyv);    np = LENGTH(pxv);    ns = LENGTH(slist);    if (!all) { /* match-like behavior - find the first only */	res = allocVector(INTSXP, np);	r = INTEGER(res);	memset(r, 0, sizeof(*r) * np);	for (i = 0; i < ns; i++) {	    int j;	    double *bb;	    SEXP shp = VECTOR_ELT(slist, i);	    bb = REAL(VECTOR_ELT(shp, 2));	    pv = VECTOR_ELT(shp, 3); p = INTEGER(pv);	    xv = VECTOR_ELT(shp, 4); x = REAL(xv);	    yv = VECTOR_ELT(shp, 5); y = REAL(yv);	    for (j = 0; j < np; j++) {		double X = px[j], Y = py[j];		/* is the point inside the bounding box? */		if (X >= bb[0] && X <= bb[2] && Y >= bb[1] && Y <= bb[3]) {		    if (inside_(X, Y, x, y, LENGTH(xv), expected) && !r[j]) {			mp++;			r[j] = i + 1;			if (mp >= np) { /* if all points got matched, get out */			    i = ns;			    break;			}		    }		}	    }	}	if (mp < np) /* replace 0 (no match) with NA */	    for (i = 0; i < np; i++)		if (r[i] == 0) r[i] = NA_INTEGER;    } else { /* return a list of all matches - useful for heavily overlapping shapes */	SEXP tmp = PROTECT(allocVector(INTSXP, ns)); /* temporary vector to store per-point matches */	int *ti = INTEGER(tmp);	memset(ti, 0, sizeof(ti[0]) * ns);	res = PROTECT(allocVector(VECSXP, np)); /* result list */	up += 2;	for (i = 0; i < np; i++) {	    double X = px[i], Y = py[i];	    int j, k = 0;	    for (j = 0; j < ns; j++) {		double *bb;		SEXP shp = VECTOR_ELT(slist, j);		bb = REAL(VECTOR_ELT(shp, 2));		if (X >= bb[0] && X <= bb[2] && Y >= bb[1] && Y <= bb[3]) {		    pv = VECTOR_ELT(shp, 3); p = INTEGER(pv);		    xv = VECTOR_ELT(shp, 4); x = REAL(xv);		    yv = VECTOR_ELT(shp, 5); y = REAL(yv);		    if (inside_(X, Y, x, y, LENGTH(xv), expected))			ti[k++] = j + 1;		}	    }	    if (k) {		memcpy(INTEGER(SET_VECTOR_ELT(res, i, allocVector(INTSXP, k))), ti, sizeof(ti[0]) * k);		memset(ti, 0, sizeof(ti[0]) * k);	    }	}	        }    if (up) UNPROTECT(up);    return res;}
开发者ID:StudyNAYO,项目名称:fastshp,代码行数:82,


示例18: make_d

SEXP make_d(SEXP year, SEXP month, SEXP day) {  if(!isInteger(year)) error("year must be integer");  if(!isInteger(month)) error("month must be integer");  if(!isInteger(day)) error("day must be integer");  R_len_t n = LENGTH(year);  if(n != LENGTH(month)) error("length of 'month' vector is not the same as that of 'year'");  if(n != LENGTH(day)) error("length of 'day' vector is not the same as that of 'year'");  int* pyear = INTEGER(year);  int* pmonth = INTEGER(month);  int* pday = INTEGER(day);  SEXP res = allocVector(REALSXP, n);  double *data = REAL(res);  for(int i = 0; i < n; i++) {	// main accumulator    double SECS = 0.0;	int y = pyear[i];	int m = pmonth[i];	int d = pday[i];	if(y == NA_INTEGER || m == NA_INTEGER || d == NA_INTEGER) {	  data[i] = NA_REAL;	} else {	  if ( 0 < m && m < 13 )		SECS += sm[m];	  else {		data[i] = NA_REAL;		continue;	  }	  if ( 0 < d && d < 32 )		SECS += (d - 1) * 86400;	  else {		data[i] = NA_REAL;		continue;	  }	  int is_leap = IS_LEAP(y);	  if(check_ymd(y, m, d, is_leap)){		SECS += d30;		y -= 2000;		SECS += y * yearlen;		SECS += adjust_leap_years(y, m, is_leap);		data[i] = SECS;	  } else {		data[i] = NA_REAL;	  }	}  }  return res;}
开发者ID:hadley,项目名称:lubridate,代码行数:66,


示例19: port_nlminb

SEXP port_nlminb(SEXP fn, SEXP gr, SEXP hs, SEXP rho,		 SEXP lowerb, SEXP upperb, SEXP d, SEXP iv, SEXP v){    int i, n = LENGTH(d);    SEXP xpt;    SEXP dot_par_symbol = install(".par");    double *b = (double *) NULL, *g = (double *) NULL,	*h = (double *) NULL, fx = R_PosInf;    if (isNull(rho)) {	error(_("use of NULL environment is defunct"));	rho = R_BaseEnv;    } else    if (!isEnvironment(rho))	error(_("'rho' must be an environment"));    if (!isReal(d) || n < 1)	error(_("'d' must be a nonempty numeric vector"));    if (hs != R_NilValue && gr == R_NilValue)	error(_("When Hessian defined must also have gradient defined"));    if (R_NilValue == (xpt = findVarInFrame(rho, dot_par_symbol)) ||	!isReal(xpt) || LENGTH(xpt) != n)	error(_("environment 'rho' must contain a numeric vector '.par' of length %d"),	      n);    /* We are going to alter .par, so must duplicate it */    defineVar(dot_par_symbol, duplicate(xpt), rho);    PROTECT(xpt = findVarInFrame(rho, dot_par_symbol));    if ((LENGTH(lowerb) == n) && (LENGTH(upperb) == n)) {	if (isReal(lowerb) && isReal(upperb)) {	    double *rl=REAL(lowerb), *ru=REAL(upperb);	    b = (double *)R_alloc(2*n, sizeof(double));	    for (i = 0; i < n; i++) {		b[2*i] = rl[i];		b[2*i + 1] = ru[i];	    }	} else error(_("'lower' and 'upper' must be numeric vectors"));    }    if (gr != R_NilValue) {	g = (double *)R_alloc(n, sizeof(double));	if (hs != R_NilValue)	    h = (double *)R_alloc((n * (n + 1))/2, sizeof(double));    }    do {	nlminb_iterate(b, REAL(d), fx, g, h, INTEGER(iv), LENGTH(iv),		       LENGTH(v), n, REAL(v), REAL(xpt));	if (INTEGER(iv)[0] == 2 && g) check_gv(gr, hs, rho, n, g, h);	else {	    fx = asReal(eval(fn, rho));	    if (ISNAN(fx)) {		warning("NA/NaN function evaluation");		fx = R_PosInf;	    }	}	/* duplicate .par value again in case a callback has stored	   value (package varComp does this) */	defineVar(dot_par_symbol, duplicate(xpt), rho);	xpt = findVarInFrame(rho, dot_par_symbol);	UNPROTECT(1);	PROTECT(xpt);    } while(INTEGER(iv)[0] < 3);    UNPROTECT(1); /* xpt */    return R_NilValue;}
开发者ID:Bgods,项目名称:r-source,代码行数:65,


示例20: trim_ts

/*#define DEBUG*/SEXP trim_ts(SEXP x, SEXP xlim, SEXP extra){  PROTECT(x = AS_NUMERIC(x));  PROTECT(xlim = AS_NUMERIC(xlim));  PROTECT(extra = AS_NUMERIC(extra));  double *xp = REAL(x);  double *xlimp = REAL(xlim);  double *extrap = REAL(extra);  int nx= LENGTH(x);  int nxlim = LENGTH(xlim);  if (nxlim != 2)    error("In trim_ts(), length of xlim must be 2");  if (xlimp[1] < xlimp[0])    error("In trim_ts(), xlim must be ordered but it is (%g, %g)/n", xlimp[0], xlimp[1]);  for (int i = 1; i < nx; i++) {    if (xp[i] == xp[i-1]) {      ;      //error("In trim_ts(), x must be distinct but x[%d]=x[%d]=%.10g (sec after origin)/n", i-1, i, xp[i-1]);    } else if (xp[i] < xp[i-1]) {      error("In trim_ts(), x must be ordered but x[%d]=%.10g and x[%d]=%.10g (sec after origin)/n", i-1, xp[i-1], i, xp[i]);    }  }  double epsilon = (xp[1] - xp[0]) / 1e9;  SEXP from;  SEXP to;  PROTECT(from = NEW_NUMERIC(1));  PROTECT(to = NEW_NUMERIC(1));  double start = xlimp[0] - (*extrap)*(xlimp[1]-xlimp[0]) - epsilon;  double end = xlimp[1] + (*extrap)*(xlimp[1]-xlimp[0]) + epsilon;  double *fromp = REAL(from);  double *top = REAL(to);  for (int i = 0; i < nx; i++) {    //Rprintf("examine x[%d]=%f/n", 1+i, xp[i]);    if (xp[i] >= start) {      *fromp = (double)i;//-1;      break;    }  }  for (int i = nx-1; i >= 0; i--) {    //Rprintf("examine x[%d]=%f/n", 1+i, xp[i]);    if (xp[i] < end) {      *top = (double)i+2;      break;    }  }  if (*fromp < 1.0) *fromp = 1.0;  if (*top > nx) *top = (double)nx;  SEXP res, res_names;  PROTECT(res = allocVector(VECSXP, 2));  PROTECT(res_names = allocVector(STRSXP, 2));  SET_VECTOR_ELT(res, 0, from);  SET_STRING_ELT(res_names, 0, mkChar("from"));  SET_VECTOR_ELT(res, 1, to);  SET_STRING_ELT(res_names, 1, mkChar("to"));  setAttrib(res, R_NamesSymbol, res_names);  UNPROTECT(7);  return(res);}
开发者ID:AnneMTreasure,项目名称:oce,代码行数:64,


示例21: call_rkAuto

SEXP call_rkAuto(SEXP Xstart, SEXP Times, SEXP Func, SEXP Initfunc,  SEXP Parms, SEXP eventfunc, SEXP elist, SEXP Nout, SEXP Rho,  SEXP Rtol, SEXP Atol, SEXP Tcrit, SEXP Verbose,  SEXP Hmin, SEXP Hmax, SEXP Hini, SEXP Rpar, SEXP Ipar,  SEXP Method, SEXP Maxsteps, SEXP Flist) {  /**  Initialization **/  long int old_N_Protect = save_N_Protected();  double *tt = NULL, *xs = NULL;  double *y,  *f,  *Fj, *tmp, *FF, *rr;  SEXP  R_yout;  double *y0,  *y1,  *y2,  *dy1,  *dy2, *out, *yout;  double errold = 0.0, t, dt, tmax;  SEXP R_FSAL, Alpha, Beta;  int fsal = FALSE;       /* assume no FSAL */    /* Use polynomial interpolation if not disabled by the method     or when events come in to play (stop-and-go mode).     Methods with dense output interpolate by default,     all others do not.  */  int interpolate = TRUE;  int i = 0, j = 0, it = 0, it_tot = 0, it_ext = 0, nt = 0, neq = 0, it_rej = 0;  int isForcing, isEvent;  /*------------------------------------------------------------------------*/  /* Processing of Arguments                                                */  /*------------------------------------------------------------------------*/  int lAtol = LENGTH(Atol);  double *atol = (double*) R_alloc((int) lAtol, sizeof(double));  int lRtol = LENGTH(Rtol);  double *rtol = (double*) R_alloc((int) lRtol, sizeof(double));  for (j = 0; j < lRtol; j++) rtol[j] = REAL(Rtol)[j];  for (j = 0; j < lAtol; j++) atol[j] = REAL(Atol)[j];  double  tcrit = REAL(Tcrit)[0];  double  hmin  = REAL(Hmin)[0];  double  hmax  = REAL(Hmax)[0];  double  hini  = REAL(Hini)[0];  int  maxsteps = INTEGER(Maxsteps)[0];  int  nout     = INTEGER(Nout)[0]; /* number of global outputs is func is in a DLL */  int  verbose  = INTEGER(Verbose)[0];  int stage     = (int)REAL(getListElement(Method, "stage"))[0];  SEXP R_A, R_B1, R_B2, R_C, R_D, R_densetype;  double  *A, *bb1, *bb2 = NULL, *cc = NULL, *dd = NULL;  PROTECT(R_A = getListElement(Method, "A")); incr_N_Protect();  A = REAL(R_A);  PROTECT(R_B1 = getListElement(Method, "b1")); incr_N_Protect();  bb1 = REAL(R_B1);  PROTECT(R_B2 = getListElement(Method, "b2")); incr_N_Protect();  if (length(R_B2)) bb2 = REAL(R_B2);  PROTECT(R_C = getListElement(Method, "c")); incr_N_Protect();  if (length(R_C)) cc = REAL(R_C);  PROTECT(R_D = getListElement(Method, "d")); incr_N_Protect();  if (length(R_D)) dd = REAL(R_D);  /* dense output Cash-Karp: densetype = 2 */  int densetype = 0;  PROTECT(R_densetype = getListElement(Method, "densetype")); incr_N_Protect();  if (length(R_densetype)) densetype = INTEGER(R_densetype)[0];  double  qerr = REAL(getListElement(Method, "Qerr"))[0];  double  beta = 0;      /* 0.4/qerr; */  PROTECT(Beta = getListElement(Method, "beta")); incr_N_Protect();  if (length(Beta)) beta = REAL(Beta)[0];  double  alpha = 1/qerr - 0.75 * beta;  PROTECT(Alpha = getListElement(Method, "alpha")); incr_N_Protect();  if (length(Alpha)) alpha = REAL(Alpha)[0];  PROTECT(R_FSAL = getListElement(Method, "FSAL")); incr_N_Protect();  if (length(R_FSAL)) fsal = INTEGER(R_FSAL)[0];  PROTECT(Times = AS_NUMERIC(Times)); incr_N_Protect();  tt = NUMERIC_POINTER(Times);  nt = length(Times);  PROTECT(Xstart = AS_NUMERIC(Xstart)); incr_N_Protect();  xs  = NUMERIC_POINTER(Xstart);  neq = length(Xstart);  /*------------------------------------------------------------------------*/  /* timesteps (for advection computation in ReacTran)                      */  /*------------------------------------------------------------------------*/  for (i = 0; i < 2; i++) timesteps[i] = 0;//.........这里部分代码省略.........
开发者ID:ReedWood,项目名称:desolve,代码行数:101,


示例22: bn_recovery

/* check neighbourhood sets and markov blankets for consistency.. */SEXP bn_recovery(SEXP bn, SEXP strict, SEXP mb, SEXP debug, SEXP filter) {int i = 0, j = 0, k = 0, n = 0, counter = 0;short int *checklist = NULL, err = 0;int *debuglevel = NULL, *checkmb = NULL, *nbrfilter = NULL;SEXP temp, temp2, nodes, elnames = NULL, fixed;  /* get the names of the nodes. */  nodes = getAttrib(bn, R_NamesSymbol);  n = LENGTH(nodes);  /* allocate and initialize the checklist. */  checklist = allocstatus(UPTRI_MATRIX(n));  /* dereference the debug, mb and filter parameters. */  debuglevel = LOGICAL(debug);  checkmb = LOGICAL(mb);  nbrfilter = INTEGER(filter);  if (*debuglevel > 0) {    Rprintf("----------------------------------------------------------------/n");    if (*checkmb)      Rprintf("* checking consistency of markov blankets./n");    else      Rprintf("* checking consistency of neighbourhood sets./n");   }/*THEN*/  /* scan the structure to determine the number of arcs.  */  for (i = 0; i < n; i++) {     if (*debuglevel > 0)       Rprintf("  > checking node %s./n",  NODE(i));    /* get the entry for the (neighbours|elements of the markov blanket)       of the node.*/    temp = getListElement(bn, (char *)NODE(i));    if (!(*checkmb))      temp = getListElement(temp, "nbr");    /* check each element of the array and identify which variable it       corresponds to. */    for (j = 0; j < LENGTH(temp); j++) {      for (k = 0; k < n; k++) {        /* increment the right element of checklist. */        if (!strcmp(NODE(k), (char *)CHAR(STRING_ELT(temp, j))))          checklist[UPTRI(i + 1, k + 1, n)]++;      }/*FOR*/    }/*FOR*/  }/*FOR*/  /* if A is a neighbour of B, B is a neighbour of A; therefore each entry in   * the checklist array must be equal to either zero (if the corresponding   * nodes are not neighbours) or two (if the corresponding nodes are neighbours).   * Any other value (typically one) is caused by an incorrect (i.e. asymmetric)   * neighbourhood structure. The same logic holds for the markov blankets. */  for (i = 0; i < n; i++)    for (j = i; j < n; j++) {      if ((checklist[UPTRI(i + 1, j + 1, n)] != 0) &&          (checklist[UPTRI(i + 1, j + 1, n)] != 2)) {        if (*debuglevel > 0) {          if (*checkmb)            Rprintf("@ asymmetry in the markov blankets for %s and %s./n",              NODE(i), NODE(j));          else            Rprintf("@ asymmetry in the neighbourhood sets for %s and %s./n",              NODE(i), NODE(j));        }/*THEN*/        err = 1;      }/*THEN*/    }/*FOR*/  /* no need to go on if the (neighbourhood sets|markov blankets) are symmetric;   * otherwise throw either an error or a warning according to the value of the   * strict parameter. */  if (!err) {    return bn;  }/*THEN*/  else if (isTRUE(strict)) {    if (*checkmb)      error("markov blankets are not symmetric./n");    else//.........这里部分代码省略.........
开发者ID:gasse,项目名称:bnlearn-clone-3.0,代码行数:101,


示例23: pointblankrange_calculate

int pointblankrange_calculate(lpPointBlankRange pointblankrange){  Vector dr, r, tv, v, w;  double mv, vm, elev, mh, vz, bw;  double dt, eq, t, mach, drg;  int    i, itcnt, mhr;/* Set values that don't change for the pointblankrange... */  if (pointblankrange->alc)     atmos_standardalt(pointblankrange->atmos);  else     atmos_atmos(pointblankrange->atmos);  mach = pointblankrange->atmos->mach;  eq = pointblankrange->atmos->density/ATMOS_DENSSTD;  vz = INTOFT(pointblankrange->vital_zone);  bw = pointblankrange->bullet_weight;  itcnt = 0;  pointblankrange->found = 0;  elev = vz/(250.0*PBR_DX);  while ((!pointblankrange->found) && (itcnt < PBR_MAXIMUM_ITCNT))  {    vm = pointblankrange->muzzle_velocity;    pointblankrange->muzzle_energy = PBR_ENERGY(bw, vm);    t = 0.0;    mh = INTOFT(-pointblankrange->sight_height);    r = vector(0.0, mh, 0.0);    dr = vector(0.0, 0.0, 0.0);    v.x = vm*cos(elev);    v.y = vm*sin(elev);    v.z = 0.0;    for (i = 0; (r.y > -vz); i++)    {      if (vm < PBR_ABSMINVX) break;      vm  = LENGTH(v);      dt  = 0.5*PBR_DX/v.x;      drg = eq*vm*bc_getdrag(pointblankrange->bc, vm/mach);      tv  = SUBTRACT(v, MULTIPLY(dt, SUBTRACT(MULTIPLY(drg, v), PBR_GRAVITY)));      vm  = LENGTH(tv);      dt  = PBR_DX/tv.x;      drg = eq*vm*bc_getdrag(pointblankrange->bc, vm/mach);      v   = SUBTRACT(v, MULTIPLY(dt, SUBTRACT(MULTIPLY(drg, tv), PBR_GRAVITY)));      dr  = vector(PBR_DX, v.y*dt, v.z*dt);      r   = ADD(r, dr);      t   = t + LENGTH(dr)/vm;      vm  = LENGTH(v);      if (r.y > 0.0) pointblankrange->pbzero = i;      pointblankrange->pbrange = i;      if (r.y > mh)      {	mh = r.y;	mhr = i;      }    }    pointblankrange->found = (fabs(mh - vz) < PBR_MAXIMUM_ERROR);    if (!pointblankrange->found)    {      elev = elev - (mh - vz)/(mhr*PBR_DX);    }    itcnt++;    pointblankrange->terminal_energy = PBR_ENERGY(bw, vm);  }  return 0;}
开发者ID:jw3,项目名称:jbmcgi,代码行数:71,


示例24: run

voidrun(){    /* Using Xlib event handling to use the keyboard helpers */    XEvent          event;    fd_set          fds;    struct timeval  timeout;    struct timeval  now;    uint32_t        usec_sleep = 1000000 / config.HZ;    uint32_t        usec_sleep_passive = 1000000 / config.HZ_passive;    int Xfd = XConnectionNumber(X.dpy);    /* If there is no user activity, we can spend more time between screen     * updates without the user feeling less responsiveness. Passive mode     * means that there are no X events to respond to, and we could slow down     * rendering a bit, offering more throughput     */    struct timeval last_event;    last_event.tv_sec = 0;    last_event.tv_usec = 0;    bool passive = false;    for (;;) {        FD_ZERO(&fds);        FD_SET(Xfd, &fds);        FD_SET(shell_fd, &fds);        timeout.tv_sec  = 0;        timeout.tv_usec = usec_sleep; /* TODO: set to blinking time? */        if (select(max(Xfd, shell_fd) + 1, &fds, NULL, NULL, &timeout) < 0) {            if (errno == EINTR)                continue;            die("select failed");        }        if (FD_ISSET(shell_fd, &fds)) {            sh_read(term_write); /* short circuit shell output and term input */        }        while (XPending(X.dpy)) {            XNextEvent(X.dpy, &event);            if (XFilterEvent(&event, X.window))                continue;            passive = false;            if (event.type < (int)LENGTH(x_handler) && x_handler[event.type])                (x_handler[event.type])(&event);        }        gettimeofday(&now, NULL);        if (timediff_usec(now, X.last_draw) > (passive ? usec_sleep_passive : usec_sleep)) {            x_draw();        }        if (FD_ISSET(Xfd, &fds)) {            gettimeofday(&last_event, NULL);            passive = false;        }        else {            passive = timediff_usec(now, last_event) > usec_sleep_passive;        }        if (!FD_ISSET(shell_fd, &fds) && passive) {            term_gc(); /* Clean up term if we have time to spare */        }    }}
开发者ID:halhen,项目名称:terma,代码行数:70,


示例25: baseCallback

static SEXP baseCallback(GEevent task, pGEDevDesc dd, SEXP data){    GESystemDesc *sd;    baseSystemState *bss, *bss2;    SEXP result = R_NilValue;    switch (task) {    case GE_FinaliseState:	/* called from unregisterOne */	sd = dd->gesd[baseRegisterIndex];	free(sd->systemSpecific);	sd->systemSpecific = NULL;	break;    case GE_InitState:    {	/* called from registerOne */	pDevDesc dev;	GPar *ddp;	sd = dd->gesd[baseRegisterIndex];	dev = dd->dev;	bss = malloc(sizeof(baseSystemState));	sd->systemSpecific = bss;        /* Bail out if necessary */        if (!bss) return result;	/* Make sure initialized, or valgrind may complain. */        memset(bss, 0, sizeof(baseSystemState));	ddp = &(bss->dp);	GInit(ddp);	/* For some things, the device sets the starting value at least. */	ddp->ps = dev->startps;	ddp->col = ddp->fg = dev->startcol;	ddp->bg = dev->startfill;	ddp->font = dev->startfont;	ddp->lty = dev->startlty;	ddp->gamma = dev->startgamma;	/* Initialise the gp settings too: formerly in addDevice. */	copyGPar(ddp, &(bss->gp));	GReset(dd);	/*	 * The device has not yet received any base output	 */	bss->baseDevice = FALSE;        /* Indicate success */        result = R_BlankString;	break;    }    case GE_CopyState:    {	/* called from GEcopyDisplayList */	pGEDevDesc curdd = GEcurrentDevice();	bss = dd->gesd[baseRegisterIndex]->systemSpecific;	bss2 = curdd->gesd[baseRegisterIndex]->systemSpecific;	copyGPar(&(bss->dpSaved), &(bss2->dpSaved));	restoredpSaved(curdd);	copyGPar(&(bss2->dp), &(bss2->gp));	GReset(curdd);	break;    }    case GE_SaveState:	/* called from GEinitDisplayList */	bss = dd->gesd[baseRegisterIndex]->systemSpecific;	copyGPar(&(bss->dp), &(bss->dpSaved));	break;    case GE_RestoreState:	/* called from GEplayDisplayList */	bss = dd->gesd[baseRegisterIndex]->systemSpecific;	restoredpSaved(dd);	copyGPar(&(bss->dp), &(bss->gp));	GReset(dd);	break;    case GE_SaveSnapshotState:        /* called from GEcreateSnapshot */        {             SEXP pkgName;            bss = dd->gesd[baseRegisterIndex]->systemSpecific;            /* Changed from INTSXP in 2.7.0: but saved graphics lists               are protected by an R version number */            PROTECT(result = allocVector(RAWSXP, sizeof(GPar)));            copyGPar(&(bss->dpSaved), (GPar*) RAW(result));            PROTECT(pkgName = mkString("graphics"));            setAttrib(result, install("pkgName"), pkgName);            UNPROTECT(2);        }	break;    case GE_RestoreSnapshotState:        /* called from GEplaySnapshot */        {            int i, nState = LENGTH(data) - 1;            SEXP graphicsState, snapshotEngineVersion;            PROTECT(graphicsState = R_NilValue);            /* Prior to engine version 11, "pkgName" was not stored.             * (can tell because "engineVersion" was not stored either.)             * Assume 'graphics' is first state in snapshot             * (though this could be fatal).             */            PROTECT(snapshotEngineVersion =                     getAttrib(data, install("engineVersion")));            if (isNull(snapshotEngineVersion)) {                graphicsState = VECTOR_ELT(data, 1);            } else {//.........这里部分代码省略.........
开发者ID:bedatadriven,项目名称:renjin,代码行数:101,


示例26: bmerge

SEXP bmerge(SEXP iArg, SEXP xArg, SEXP icolsArg, SEXP xcolsArg, SEXP isorted, SEXP rollarg, SEXP rollendsArg, SEXP nomatch, SEXP retFirstArg, SEXP retLengthArg, SEXP allLen1Arg){    int xN, iN, protecti=0;    roll = 0.0;    nearest = FALSE;    enc_warn = TRUE;    if (isString(rollarg)) {        if (strcmp(CHAR(STRING_ELT(rollarg,0)),"nearest") != 0) error("roll is character but not 'nearest'");        roll=1.0;        nearest=TRUE;       // the 1.0 here is just any non-0.0, so roll!=0.0 can be used later    } else {        if (!isReal(rollarg)) error("Internal error: roll is not character or double");        roll = REAL(rollarg)[0];   // more common case (rolling forwards or backwards) or no roll when 0.0    }    rollabs = fabs(roll);    i = iArg;    x = xArg;  // set globals so bmerge_r can see them.    if (!isInteger(icolsArg)) error("Internal error: icols is not integer vector");    if (!isInteger(xcolsArg)) error("Internal error: xcols is not integer vector");    if (LENGTH(icolsArg) > LENGTH(xcolsArg)) error("Internal error: length(icols) [%d] > length(xcols) [%d]", LENGTH(icolsArg), LENGTH(xcolsArg));    icols = INTEGER(icolsArg);    xcols = INTEGER(xcolsArg);    xN = LENGTH(VECTOR_ELT(x,0));    iN = LENGTH(VECTOR_ELT(i,0));    ncol = LENGTH(icolsArg);    // there may be more sorted columns in x than involved in the join    for(int col=0; col<ncol; col++) {        if (icols[col]==NA_INTEGER) error("Internal error. icols[%d] is NA", col);        if (xcols[col]==NA_INTEGER) error("Internal error. xcols[%d] is NA", col);        if (icols[col]>LENGTH(i) || icols[col]<1) error("icols[%d]=%d outside range [1,length(i)=%d]", col, icols[col], LENGTH(i));        if (xcols[col]>LENGTH(x) || xcols[col]<1) error("xcols[%d]=%d outside range [1,length(x)=%d]", col, xcols[col], LENGTH(x));        int it = TYPEOF(VECTOR_ELT(i, icols[col]-1));        int xt = TYPEOF(VECTOR_ELT(x, xcols[col]-1));        if (it != xt) error("typeof x.%s (%s) != typeof i.%s (%s)", CHAR(STRING_ELT(getAttrib(x,R_NamesSymbol),xcols[col]-1)), type2char(xt), CHAR(STRING_ELT(getAttrib(i,R_NamesSymbol),icols[col]-1)), type2char(it));    }    if (!isInteger(retFirstArg) || LENGTH(retFirstArg)!=iN) error("retFirst must be integer vector the same length as nrow(i)");    retFirst = INTEGER(retFirstArg);    if (!isInteger(retLengthArg) || LENGTH(retLengthArg)!=iN) error("retLength must be integer vector the same length as nrow(i)");    retLength = INTEGER(retLengthArg);    if (!isLogical(allLen1Arg) || LENGTH(allLen1Arg) != 1) error("allLen1 must be a length 1 logical vector");    allLen1 = LOGICAL(allLen1Arg);    if (!isLogical(rollendsArg) || LENGTH(rollendsArg) != 2) error("rollends must be a length 2 logical vector");    rollends = LOGICAL(rollendsArg);    if (nearest && TYPEOF(VECTOR_ELT(i, icols[ncol-1]-1))==STRSXP) error("roll='nearest' can't be applied to a character column, yet.");    for (int j=0; j<iN; j++) {        // defaults need to populated here as bmerge_r may well not touch many locations, say if the last row of i is before the first row of x.        retFirst[j] = INTEGER(nomatch)[0];   // default to no match for NA goto below        // retLength[j] = 0;   // TO DO: do this to save the branch below and later branches at R level to set .N to 0        retLength[j] = INTEGER(nomatch)[0]==0 ? 0 : 1;    }    allLen1[0] = TRUE;  // All-0 and All-NA are considered all length 1 according to R code currently. Really, it means any(length>1).    o = NULL;    if (!LOGICAL(isorted)[0]) {        SEXP order = PROTECT(vec_init(length(icolsArg), ScalarInteger(1))); // rep(1, length(icolsArg))        SEXP oSxp = PROTECT(forder(i, icolsArg, ScalarLogical(FALSE), ScalarLogical(TRUE), order, ScalarLogical(FALSE)));        protecti += 2;        if (!LENGTH(oSxp)) o = NULL;        else o = INTEGER(oSxp);    }    if (iN) bmerge_r(-1,xN,-1,iN,0,1,1);    UNPROTECT(protecti);    return(R_NilValue);}
开发者ID:RanaivosonHerimanitra,项目名称:data.table,代码行数:68,


示例27: do_edit

SEXP do_edit(SEXP call, SEXP op, SEXP args, SEXP rho){    int   i, rc;    ParseStatus status;    SEXP  x, fn, envir, ed, src, srcfile, Rfn;    char *filename, *editcmd;    const char *cmd;    const void *vmaxsave;    FILE *fp;#ifdef Win32    SEXP ti;    char *title;#endif	checkArity(op, args);    vmaxsave = vmaxget();    x = CAR(args); args = CDR(args);    if (TYPEOF(x) == CLOSXP) envir = CLOENV(x);    else envir = R_NilValue;    PROTECT(envir);    fn = CAR(args); args = CDR(args);    if (!isString(fn))	error(_("invalid argument to edit()"));    if (LENGTH(STRING_ELT(fn, 0)) > 0) {	const char *ss = translateChar(STRING_ELT(fn, 0));	filename = R_alloc(strlen(ss), sizeof(char));	strcpy(filename, ss);    }    else filename = DefaultFileName;    if (x != R_NilValue) {	if((fp=R_fopen(R_ExpandFileName(filename), "w")) == NULL)	    errorcall(call, _("unable to open file"));	if (LENGTH(STRING_ELT(fn, 0)) == 0) EdFileUsed++;	src = deparse1(x, 0, FORSOURCING); /* deparse for sourcing, not for display */	for (i = 0; i < LENGTH(src); i++)	    fprintf(fp, "%s/n", translateChar(STRING_ELT(src, i)));	fclose(fp);    }#ifdef Win32    ti = CAR(args);#endif    args = CDR(args);    ed = CAR(args);    if (!isString(ed)) errorcall(call, _("argument 'editor' type not valid"));    cmd = translateChar(STRING_ELT(ed, 0));    if (strlen(cmd) == 0) errorcall(call, _("argument 'editor' is not set"));    editcmd = R_alloc(strlen(cmd) + strlen(filename) + 6, sizeof(char));#ifdef Win32    if (!strcmp(cmd,"internal")) {	if (!isString(ti))	    error(_("'title' must be a string"));	if (LENGTH(STRING_ELT(ti, 0)) > 0) {	    title = R_alloc(strlen(CHAR(STRING_ELT(ti, 0)))+1, sizeof(char));	    strcpy(title, CHAR(STRING_ELT(ti, 0)));	} else {	    title = R_alloc(strlen(filename)+1, sizeof(char));	    strcpy(title, filename);	}	Rgui_Edit(filename, CE_NATIVE, title, 1);    }    else {	/* Quote path if necessary */	if(cmd[0] != '"' && Rf_strchr(cmd, ' '))	    sprintf(editcmd, "/"%s/" /"%s/"", cmd, filename);	else	    sprintf(editcmd, "%s /"%s/"", cmd, filename);	rc = runcmd(editcmd, CE_NATIVE, 1, 1, NULL, NULL, NULL);	if (rc == NOLAUNCH)	    errorcall(call, _("unable to run editor '%s'"), cmd);	if (rc != 0)	    warningcall(call, _("editor ran but returned error status"));    }#else    if (ptr_R_EditFile)	rc = ptr_R_EditFile(filename);    else {	sprintf(editcmd, "'%s' '%s'", cmd, filename); // allow for spaces	rc = R_system(editcmd);    }    if (rc != 0)	errorcall(call, _("problem with running editor %s"), cmd);#endif    if (asLogical(GetOption1(install("keep.source")))) {	PROTECT(Rfn = findFun(install("readLines"), R_BaseEnv));	PROTECT(src = lang2(Rfn, ScalarString(mkChar(R_ExpandFileName(filename)))));	PROTECT(src = eval(src, R_BaseEnv));	PROTECT(Rfn = findFun(install("srcfilecopy"), R_BaseEnv));	PROTECT(srcfile = lang3(Rfn, ScalarString(mkChar("<tmp>")), src));	srcfile = eval(srcfile, R_BaseEnv);	UNPROTECT(5);    } else    	srcfile = R_NilValue;    PROTECT(srcfile);    //.........这里部分代码省略.........
开发者ID:Grade-Two,项目名称:r-source,代码行数:101,


示例28: compcases

/* complete.cases(.) */SEXP compcases(SEXP args){    SEXP s, t, u, rval;    int i, len;    args = CDR(args);    len = -1;    for (s = args; s != R_NilValue; s = CDR(s)) {	if (isList(CAR(s))) {	    for (t = CAR(s); t != R_NilValue; t = CDR(t))		if (isMatrix(CAR(t))) {		    u = getAttrib(CAR(t), R_DimSymbol);		    if (len < 0)			len = INTEGER(u)[0];		    else if (len != INTEGER(u)[0])			goto bad;		}		else if (isVector(CAR(t))) {		    if (len < 0)			len = LENGTH(CAR(t));		    else if (len != LENGTH(CAR(t)))			goto bad;		}		else		    error(R_MSG_type, type2char(TYPEOF(CAR(t))));	}	/* FIXME : Need to be careful with the use of isVector() */	/* since this includes lists and expressions. */	else if (isNewList(CAR(s))) {	    int it, nt;	    t = CAR(s);	    nt = length(t);	    /* 0-column data frames are a special case */	    if(nt) {		for (it = 0 ; it < nt ; it++) {		    if (isMatrix(VECTOR_ELT(t, it))) {			u = getAttrib(VECTOR_ELT(t, it), R_DimSymbol);			if (len < 0)			    len = INTEGER(u)[0];			else if (len != INTEGER(u)[0])			    goto bad;		    }		    else if (isVector(VECTOR_ELT(t, it))) {			if (len < 0)			    len = LENGTH(VECTOR_ELT(t, it));			else if (len != LENGTH(VECTOR_ELT(t, it)))			    goto bad;		    }		    else			error(R_MSG_type, "unknown");		}	    } else {		u = getAttrib(t, R_RowNamesSymbol);		if (!isNull(u)) {		    if (len < 0)			len = LENGTH(u);		    else if (len != INTEGER(u)[0])			goto bad;		}	    }	}	else if (isMatrix(CAR(s))) {	    u = getAttrib(CAR(s), R_DimSymbol);	    if (len < 0)		len = INTEGER(u)[0];	    else if (len != INTEGER(u)[0])		goto bad;	}	else if (isVector(CAR(s))) {	    if (len < 0)		len = LENGTH(CAR(s));	    else if (len != LENGTH(CAR(s)))		goto bad;	}	else	    error(R_MSG_type, type2char(TYPEOF(CAR(s))));    }    if (len < 0)	error(_("no input has determined the number of cases"));    PROTECT(rval = allocVector(LGLSXP, len));    for (i = 0; i < len; i++) INTEGER(rval)[i] = 1;    /* FIXME : there is a lot of shared code here for vectors. */    /* It should be abstracted out and optimized. */    for (s = args; s != R_NilValue; s = CDR(s)) {	if (isList(CAR(s))) {	    /* Now we only need to worry about vectors */	    /* since we use mod to handle arrays. */	    /* FIXME : using mod like this causes */	    /* a potential performance hit. */	    for (t = CAR(s); t != R_NilValue; t = CDR(t)) {		u = CAR(t);		for (i = 0; i < LENGTH(u); i++) {		    switch (TYPEOF(u)) {		    case INTSXP:		    case LGLSXP:			if (INTEGER(u)[i] == NA_INTEGER)//.........这里部分代码省略.........
开发者ID:KarolinaSkandy,项目名称:R-3-0-branch-alt,代码行数:101,


示例29: make_dt

SEXP make_dt(SEXP year, SEXP month, SEXP day, SEXP hour, SEXP minute, SEXP second) {  if(!isInteger(year)) error("year must be integer");  if(!isInteger(month)) error("month must be integer");  if(!isInteger(day)) error("day must be integer");  if(!isInteger(hour)) error("hour must be integer");  if(!isInteger(minute)) error("minute must be integer");  if(!isNumeric(second)) error("second must be numeric");  R_len_t n = LENGTH(year);    if(n != LENGTH(month)) error("length of 'month' vector is not the same as that of 'year'");  if(n != LENGTH(day)) error("length of 'day' vector is not the same as that of 'year'");  if(n != LENGTH(hour)) error("length of 'hour' vector is not the same as that of 'year'");  if(n != LENGTH(minute)) error("length of 'minute' vector is not the same as that of 'year'");  if(n != LENGTH(second)) error("length of 'second' vector is not the same as that of 'year'");  int* pyear = INTEGER(year);  int* pmonth = INTEGER(month);  int* pday = INTEGER(day);  int* phour = INTEGER(hour);  int* pminute = INTEGER(minute);  int int_second = TYPEOF(second) == INTSXP;  SEXP res = allocVector(REALSXP, n);  double *data = REAL(res);  for(int i = 0; i < n; i++) {	// main accumulator    double SECS = 0.0;	int y = pyear[i];	int m = pmonth[i];	int d = pday[i];	int H = phour[i];	int M = pminute[i];	int naS;	double S;	if(int_second){	  S = (double) INTEGER(second)[i];	  naS = INTEGER(second)[i] == NA_INTEGER;	} else {	  S = REAL(second)[i];	  naS = ISNA(S);	}	if(naS || y == NA_INTEGER || m == NA_INTEGER || d == NA_INTEGER || H == NA_INTEGER || M == NA_INTEGER) {	  data[i] = NA_REAL;	} else {	  	  if ( 0 < m && m < 13 )		SECS += sm[m];	  else {		data[i] = NA_REAL;		continue;	  }		  if ( 0 < d && d < 32 )		SECS += (d - 1) * 86400;	  else {		data[i] = NA_REAL;		continue; 	  }	  if( H < 25 )		SECS += H * 3600;	  else {		data[i] = NA_REAL;		continue;	  }		  if ( M < 61 )		SECS += M * 60;	  else{		data[i] = NA_REAL;		continue;	  }	  // allow leap seconds	  if ( S < 62 ) {		SECS += S;	  } else {		data[i] = NA_REAL;		continue;	  }	  int is_leap = LEAP(y);	  if(check_ymd(y, m, d, is_leap)){			SECS += d30;		y -= 2000;		SECS += y * yearlen;		SECS += adjust_leap_years(y, m, is_leap);//.........这里部分代码省略.........
开发者ID:McClellandLegge,项目名称:lubridate,代码行数:101,


示例30: siminf_run

/** * Initiate and run the simulation * * @param model The siminf_model * @param threads Number of threads * @param seed Random number seed. * @param tr_fun Vector of function pointers to transition rate functions. * @param pts_fun Function pointer to callback after each time step *        e.g. update infectious pressure. */SEXP siminf_run(    SEXP model,    SEXP threads,    SEXP seed,    TRFun *tr_fun,    PTSFun pts_fun){    int err = 0, n_threads;    SEXP trajectory, names, result = R_NilValue;    SEXP ext_events, E, G, N, S, prS;    int Nn, Nc, Nt, Nd, Nld, tlen;    unsigned long int s;    /* Create a list to hold the result of the simulated trajectory. */    PROTECT(trajectory = allocVector(VECSXP, 2));    setAttrib(trajectory, R_NamesSymbol, names = allocVector(STRSXP, 2));    SET_STRING_ELT(names, 0, mkChar("error"));    SET_STRING_ELT(names, 1, mkChar("model"));    if (siminf_arg_check_model(model)) {        err = SIMINF_ERR_INVALID_MODEL;        goto cleanup;    }    /* number of threads */    err = siminf_get_threads(&n_threads, threads);    if (err)        goto cleanup;    /* seed */    err =  siminf_get_seed(&s, seed);    if (err)        goto cleanup;    /* Duplicate model and add it to the 'model' item in the     * trajectory list. */    SET_VECTOR_ELT(trajectory, 1, result = duplicate(model));    /* SimInf model */    G = GET_SLOT(result, Rf_install("G"));    S = GET_SLOT(result, Rf_install("S"));    PROTECT(prS = coerceVector(GET_SLOT(S, Rf_install("x")), INTSXP));    /* Scheduled events */    ext_events = GET_SLOT(result, Rf_install("events"));    E = GET_SLOT(ext_events, Rf_install("E"));    N = GET_SLOT(ext_events, Rf_install("N"));    /* Constants */    Nn   = INTEGER(GET_SLOT(GET_SLOT(result, Rf_install("u0")), R_DimSymbol))[1];    Nc   = INTEGER(GET_SLOT(S, Rf_install("Dim")))[0];    Nt   = INTEGER(GET_SLOT(S, Rf_install("Dim")))[1];    Nd   = INTEGER(GET_SLOT(GET_SLOT(result, Rf_install("v0")), R_DimSymbol))[0];    Nld  = INTEGER(GET_SLOT(GET_SLOT(result, Rf_install("ldata")), R_DimSymbol))[0];    tlen = LENGTH(GET_SLOT(result, Rf_install("tspan")));    /* Output array (to hold a single trajectory) */    SET_SLOT(result, Rf_install("U"), allocMatrix(INTSXP, Nn * Nc, tlen));    SET_SLOT(result, Rf_install("V"), allocMatrix(REALSXP, Nn * Nd, tlen));    /* Run simulation solver. */    err = siminf_run_solver(        INTEGER(GET_SLOT(result, Rf_install("u0"))),        REAL(GET_SLOT(result, Rf_install("v0"))),        INTEGER(GET_SLOT(G, Rf_install("i"))),        INTEGER(GET_SLOT(G, Rf_install("p"))),        INTEGER(GET_SLOT(S, Rf_install("i"))),        INTEGER(GET_SLOT(S, Rf_install("p"))),        INTEGER(prS),        REAL(GET_SLOT(result, Rf_install("tspan"))),        tlen,        INTEGER(GET_SLOT(result, Rf_install("U"))),        REAL(GET_SLOT(result, Rf_install("V"))),        REAL(GET_SLOT(result, Rf_install("ldata"))),        REAL(GET_SLOT(result, Rf_install("gdata"))),        INTEGER(GET_SLOT(result, Rf_install("sd"))),        Nn, Nc, Nt, Nd, Nld,        INTEGER(GET_SLOT(E, Rf_install("i"))),        INTEGER(GET_SLOT(E, Rf_install("p"))),        INTEGER(N),        LENGTH(GET_SLOT(ext_events, Rf_install("event"))),        INTEGER(GET_SLOT(ext_events, Rf_install("event"))),        INTEGER(GET_SLOT(ext_events, Rf_install("time"))),        INTEGER(GET_SLOT(ext_events, Rf_install("node"))),        INTEGER(GET_SLOT(ext_events, Rf_install("dest"))),        INTEGER(GET_SLOT(ext_events, Rf_install("n"))),        REAL(GET_SLOT(ext_events,    Rf_install("proportion"))),        INTEGER(GET_SLOT(ext_events, Rf_install("select"))),        INTEGER(GET_SLOT(ext_events, Rf_install("shift"))),        n_threads, s, tr_fun, pts_fun);//.........这里部分代码省略.........
开发者ID:cran,项目名称:SimInf,代码行数:101,



注:本文中的LENGTH函数示例整理自Github/MSDocs等源码及文档管理平台,相关代码片段筛选自各路编程大神贡献的开源项目,源码版权归原作者所有,传播和使用请参考对应项目的License;未经允许,请勿转载。


C++ LENGTHOF函数代码示例
C++ LEN函数代码示例
51自学网,即我要自学网,自学EXCEL、自学PS、自学CAD、自学C语言、自学css3实例,是一个通过网络自主学习工作技能的自学平台,网友喜欢的软件自学网站。
京ICP备13026421号-1