本文整理汇总了C++中REprintf函数的典型用法代码示例。如果您正苦于以下问题:C++ REprintf函数的具体用法?C++ REprintf怎么用?C++ REprintf使用的例子?那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。
在下文中一共展示了REprintf函数的20个代码示例,这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞,您的评价将有助于我们的系统推荐出更棒的C++代码示例。
示例1: in_Rsockwrite
void in_Rsockwrite(int *sockp, char **buf, int *start, int *end, int *len)
{
ssize_t n;
if (*end > *len)
*end = *len;
if (*start < 0)
*start = 0;
if (*end < *start) {
*len = -1;
return;
}
check_init();
#ifdef DEBUG
printf("writing %s to %d", *buf, *sockp);
#endif
perr.error = 0;
n = Sock_write(*sockp, *buf + *start, *end - *start, &perr);
*len = (int) n;
if(perr.error) REprintf("socket error: %s\n", strerror(perr.error));
}
开发者ID:Bgods,项目名称:r-source,代码行数:20,代码来源:Rsock.c
示例2: dbExistsTable
SEXP dbExistsTable(SEXP dbi_conn_sexp, SEXP tableName_sexp) {
SEXP ans;
if(TYPEOF(dbi_conn_sexp) != EXTPTRSXP || dbi_conn_sexp == R_NilValue) {
return R_NilValue;
}
DatabaseConnection* conn = reinterpret_cast<DatabaseConnection*>(R_ExternalPtrAddr(dbi_conn_sexp));
if(!conn) {
// throw bad_connection_object
REprintf("bad database connection.\n");
return R_NilValue;
}
const char* tableName = CHAR(STRING_ELT(tableName_sexp,0));
PROTECT(ans = allocVector(LGLSXP,1));
LOGICAL(ans)[0] = static_cast<int>(conn->existsTable(tableName));
UNPROTECT(1);
return ans;
}
开发者ID:armstrtw,项目名称:unifieddbi,代码行数:20,代码来源:interface.cpp
示例3: nvimcom_Stop
void nvimcom_Stop()
{
#ifndef WIN32
if(ih){
removeInputHandler(&R_InputHandlers, ih);
close(ifd);
close(ofd);
}
#endif
if(nvimcom_initialized){
Rf_removeTaskCallbackByName("NVimComHandler");
#ifdef WIN32
closesocket(sfd);
WSACleanup();
#else
close(sfd);
pthread_cancel(tid);
pthread_join(tid, NULL);
#endif
ListStatus *tmp = firstList;
while(tmp){
firstList = tmp->next;
free(tmp->key);
free(tmp);
tmp = firstList;
}
for(int i = 0; i < 64; i++){
free(loadedlibs[i]);
loadedlibs[i] = NULL;
}
if(obbrbuf1)
free(obbrbuf1);
if(obbrbuf2)
free(obbrbuf2);
if(verbose)
REprintf("nvimcom stopped\n");
}
nvimcom_initialized = 0;
}
开发者ID:UglyMelon007,项目名称:Vim,代码行数:40,代码来源:nvimcom.c
示例4: setColnames
void setColnames(const std::vector<std::string> &cnames) {
int protect_count(0);
if (static_cast<R_len_t>(cnames.size()) != Rf_ncols(Robject)) {
REprintf("setColnames: colnames size does not match ncols(Robject).");
return;
}
// check if we have existing dimnames
SEXP dimnames = Rf_getAttrib(Robject, R_DimNamesSymbol);
if (dimnames == R_NilValue) {
PROTECT(dimnames = Rf_allocVector(VECSXP, 2));
++protect_count;
SET_VECTOR_ELT(dimnames, 0, R_NilValue);
}
SEXP cnames_sexp = PROTECT(Rf_allocVector(STRSXP, cnames.size()));
++protect_count;
for (size_t i = 0; i < cnames.size(); ++i) { SET_STRING_ELT(cnames_sexp, i, Rf_mkChar(cnames[i].c_str())); }
SET_VECTOR_ELT(dimnames, 1, cnames_sexp);
Rf_setAttrib(Robject, R_DimNamesSymbol, dimnames);
UNPROTECT(protect_count);
}
开发者ID:armstrtw,项目名称:fts,代码行数:22,代码来源:R.tseries.data.backend.hpp
示例5: R_zmq_poll
/* Poll related. */
SEXP R_zmq_poll(SEXP R_socket, SEXP R_type, SEXP R_timeout){
int C_ret = -1, C_errno, i;
PBD_POLLITEM_LENGTH = LENGTH(R_socket);
if(PBD_POLLITEM_LENGTH > PBD_POLLITEM_MAXSIZE){
REprintf("Too many sockets (%d) are asked.\n", PBD_POLLITEM_LENGTH);
}
PBD_POLLITEM = (zmq_pollitem_t *) malloc(PBD_POLLITEM_LENGTH * sizeof(zmq_pollitem_t));
for(i = 0; i < PBD_POLLITEM_LENGTH; i++){
PBD_POLLITEM[i].socket = R_ExternalPtrAddr(VECTOR_ELT(R_socket, i));
PBD_POLLITEM[i].events = (short) INTEGER(R_type)[i];
}
C_ret = zmq_poll(PBD_POLLITEM, PBD_POLLITEM_LENGTH, (long) INTEGER(R_timeout)[0]);
if(C_ret == -1){
C_errno = zmq_errno();
warning("R_zmq_poll: %d strerror: %s\n",
C_errno, zmq_strerror(C_errno));
}
return(AsInt(C_ret));
} /* End of R_zmq_poll(). */
开发者ID:flying-sheep,项目名称:pbdZMQ,代码行数:23,代码来源:R_zmq_poll.c
示例6: REprintf
void RangeList::filterGeneName(const char* inclusionGeneFileName, const char* geneTableFileName){
// require user input gene list file
if (strlen(geneTableFileName) == 0 && strlen(inclusionGeneFileName) != 0) {
REprintf("Please provide gene list file (e.g. refFlat) until we are able to process gene\n");
return;
//exit(1);
}
// if not specify any gene, return whole range.
if (strlen(inclusionGeneFileName) == 0) {
return;
}
// store which gene do we want if specified
std::set< std::string > inclusionSet;
LineReader lr(inclusionGeneFileName);
std::string gene;
while(lr.readLine(&gene)) {
inclusionSet.insert(gene);
}
std::vector<std::string> fields;
std::string chr;
std::string geneNameTbl;
LineReader geneTable(geneTableFileName);
while (geneTable.readLineBySep(&fields, "\t ")) {
geneNameTbl = fields[0];
if (inclusionSet.find(geneNameTbl) != inclusionSet.end()){ // store gene range
chr = chopChr(fields[2].c_str());
this->rangeCollection.addRange(chr,
atoi(fields[4].c_str()), // start
atoi(fields[5].c_str())); // end
}
}
if (this->rangeCollection.size() == 0){
Rprintf("We cannot find given gene in your geneListFile, so all sites will be outputed\n");
}
}
开发者ID:cran,项目名称:vcf2geno,代码行数:39,代码来源:RangeList.cpp
示例7: R_nc_get_vara_double
void R_nc_get_vara_double( int *ncid, int *varid, int *start,
int *count, double *data, int *retval )
{
int i, err, ndims;
size_t s_start[MAX_NC_DIMS], s_count[MAX_NC_DIMS];
char vn[2048];
err = nc_inq_varndims(*ncid, *varid, &ndims );
if( err != NC_NOERR )
REprintf( "Error in R_nc_get_vara_double while getting ndims: %s\n",
nc_strerror(*retval) );
for( i=0; i<ndims; i++ ) {
s_start[i] = (size_t)start[i];
s_count[i] = (size_t)count[i];
}
*retval = nc_get_vara_double(*ncid, *varid, s_start, s_count, data );
if( *retval != NC_NOERR ) {
nc_inq_varname( *ncid, *varid, vn );
REprintf( "Error in R_nc_get_vara_double: %s\n",
nc_strerror(*retval) );
REprintf( "Var: %s Ndims: %d Start: ", vn, ndims );
for( i=0; i<ndims; i++ ) {
REprintf( "%u", (unsigned int)s_start[i] );
if( i < ndims-1 )
REprintf( "," );
}
REprintf( "Count: " );
for( i=0; i<ndims; i++ ) {
REprintf( "%u", (unsigned int)s_count[i] );
if( i < ndims-1 )
REprintf( "," );
}
}
}
开发者ID:cran,项目名称:ncdf,代码行数:36,代码来源:ncdf.c
示例8: Rf_callToplevelHandlers
/* This is not used in R and in no header */
void
Rf_callToplevelHandlers(SEXP expr, SEXP value, Rboolean succeeded,
Rboolean visible)
{
R_ToplevelCallbackEl *h, *prev = NULL;
Rboolean again;
if(Rf_RunningToplevelHandlers == TRUE)
return;
h = Rf_ToplevelTaskHandlers;
Rf_RunningToplevelHandlers = TRUE;
while(h) {
again = (h->cb)(expr, value, succeeded, visible, h->data);
if(R_CollectWarnings) {
REprintf(_("warning messages from top-level task callback '%s'\n"),
h->name);
PrintWarnings();
}
if(again) {
prev = h;
h = h->next;
} else {
R_ToplevelCallbackEl *tmp;
tmp = h;
if(prev)
prev->next = h->next;
h = h->next;
if(tmp == Rf_ToplevelTaskHandlers)
Rf_ToplevelTaskHandlers = h;
if(tmp->finalizer)
tmp->finalizer(tmp->data);
free(tmp);
}
}
Rf_RunningToplevelHandlers = FALSE;
}
开发者ID:SvenDowideit,项目名称:clearlinux,代码行数:39,代码来源:main.c
示例9: show_family
void show_family(Family *f) {
Offspring *child;
if (f) {
REprintf(" %d: %d + %d / ",
f->pedigree, f->father_id, f->mother_id);
for (child=f->children; child; child=child->next) {
REprintf(" %d", child->id);
if (child->affected==2)
REprintf("*");
if (child->next)
REprintf(",");
}
REprintf("\n");
}
else {
REprintf("*** empty family ***\n");
}
}
开发者ID:cran,项目名称:tdthap,代码行数:18,代码来源:nuc_fam.c
示例10: R_pretty
attribute_hidden
double R_pretty(double *lo, double *up, int *ndiv, int min_n,
double shrink_sml, double high_u_fact[],
int eps_correction, int return_bounds)
{
/* From version 0.65 on, we had rounding_eps := 1e-5, before, r..eps = 0
* then, 1e-7 was consistent with seq.default() and seq.int() till 2010-02-03,
* where it was changed to 1e-10 for seq*(), and in 2017-08-14 for pretty(): */
#define rounding_eps 1e-10
#define h high_u_fact[0]
#define h5 high_u_fact[1]
double dx, cell, unit, base, U;
double ns, nu;
int k;
Rboolean i_small;
dx = *up - *lo;
/* cell := "scale" here */
if(dx == 0 && *up == 0) { /* up == lo == 0 */
cell = 1;
i_small = TRUE;
} else {
cell = fmax2(fabs(*lo),fabs(*up));
/* U = upper bound on cell/unit */
U = 1 + ((h5 >= 1.5*h+.5) ? 1/(1+h) : 1.5/(1+h5));
U *= imax2(1,*ndiv) * DBL_EPSILON; // avoid overflow for large ndiv
/* added times 3, as several calculations here */
i_small = dx < cell * U * 3;
}
/*OLD: cell = FLT_EPSILON+ dx / *ndiv; FLT_EPSILON = 1.192e-07 */
if(i_small) {
if(cell > 10)
cell = 9 + cell/10;
cell *= shrink_sml;
if(min_n > 1) cell /= min_n;
} else {
cell = dx;
if(*ndiv > 1) cell /= *ndiv;
}
if(cell < 20*DBL_MIN) {
warning(_("Internal(pretty()): very small range.. corrected"));
cell = 20*DBL_MIN;
} else if(cell * 10 > DBL_MAX) {
warning(_("Internal(pretty()): very large range.. corrected"));
cell = .1*DBL_MAX;
}
/* NB: the power can be negative and this relies on exact
calculation, which glibc's exp10 does not achieve */
base = pow(10.0, floor(log10(cell))); /* base <= cell < 10*base */
/* unit : from { 1,2,5,10 } * base
* such that |u - cell| is small,
* favoring larger (if h > 1, else smaller) u values;
* favor '5' more than '2' if h5 > h (default h5 = .5 + 1.5 h) */
unit = base;
if((U = 2*base)-cell < h*(cell-unit)) { unit = U;
if((U = 5*base)-cell < h5*(cell-unit)) { unit = U;
if((U =10*base)-cell < h*(cell-unit)) unit = U; }}
/* Result: c := cell, u := unit, b := base
* c in [ 1, (2+ h) /(1+h) ] b ==> u= b
* c in ( (2+ h)/(1+h), (5+2h5)/(1+h5)] b ==> u= 2b
* c in ( (5+2h)/(1+h), (10+5h) /(1+h) ] b ==> u= 5b
* c in ((10+5h)/(1+h), 10 ) b ==> u=10b
*
* ===> 2/5 *(2+h)/(1+h) <= c/u <= (2+h)/(1+h) */
ns = floor(*lo/unit+rounding_eps);
nu = ceil (*up/unit-rounding_eps);
#ifdef DEBUGpr
REprintf("pretty(lo=%g,up=%g,ndiv=%d,min_n=%d,shrink=%g,high_u=(%g,%g),"
"eps=%d)\n\t dx=%g; is.small:%d. ==> cell=%g; unit=%g\n",
*lo, *up, *ndiv, min_n, shrink_sml, h, h5,
eps_correction, dx, (int)i_small, cell, unit);
#endif
if(eps_correction && (eps_correction > 1 || !i_small)) {
if(*lo != 0.) *lo *= (1- DBL_EPSILON); else *lo = -DBL_MIN;
if(*up != 0.) *up *= (1+ DBL_EPSILON); else *up = +DBL_MIN;
}
#ifdef DEBUGpr
if(ns*unit > *lo)
REprintf("\t ns= %.0f -- while(ns*unit > *lo) ns--;\n", ns);
#endif
while(ns*unit > *lo + rounding_eps*unit) ns--;
#ifdef DEBUGpr
if(nu*unit < *up)
REprintf("\t nu= %.0f -- while(nu*unit < *up) nu++;\n", nu);
#endif
while(nu*unit < *up - rounding_eps*unit) nu++;
k = (int)(0.5 + nu - ns);
if(k < min_n) {
/* ensure that nu - ns == min_n */
#ifdef DEBUGpr
REprintf("\tnu-ns=%.0f-%.0f=%d SMALL -> ensure nu-ns= min_n=%d\n",
//.........这里部分代码省略.........
开发者ID:bedatadriven,项目名称:renjin,代码行数:101,代码来源:pretty.c
示例11: do_mrdwt
/*
* Public
*/
SEXP do_mrdwt(SEXP vntX, SEXP vntH, SEXP vntL)
{
SEXP vntOut;
SEXP vntYl;
SEXP vntYh;
SEXP vntLr;
double *x, *h, *yl, *yh;
int m, n, lh, L;
#ifdef DEBUG_RWT
REprintf("In do_mrdwt(x, h, L)...\n");
#endif
/*
* Handle first parameter (numeric matrix)
*/
#ifdef DEBUG_RWT
REprintf("\tfirst param 'x'\n");
#endif
if (GetMatrixDimen(vntX, &m, &n) != 2)
{
error("'x' is not a two dimensional matrix");
/*NOTREACHED*/
}
PROTECT(vntX = AS_NUMERIC(vntX));
x = NUMERIC_POINTER(vntX);
#ifdef DEBUG_RWT
REprintf("x[%d][%d] = 0x%p\n", m, n, x);
#endif
/*
* Handle second parameter (numeric vector)
*/
#ifdef DEBUG_RWT
REprintf("\tsecond param 'h'\n");
#endif
PROTECT(vntH = AS_NUMERIC(vntH));
h = NUMERIC_POINTER(vntH);
lh = GET_LENGTH(vntH);
#ifdef DEBUG_RWT
REprintf("h[%d] = 0x%p\n", GET_LENGTH(vntH), h);
#endif
/*
* Handle third parameter (integer scalar)
*/
#ifdef DEBUG_RWT
REprintf("\tthird param 'L'\n");
#endif
{
PROTECT(vntL = AS_INTEGER(vntL));
{
int *piL = INTEGER_POINTER(vntL);
L = piL[0];
}
UNPROTECT(1);
}
#ifdef DEBUG_RWT
REprintf("L = %d\n", L);
#endif
#ifdef DEBUG_RWT
REprintf("\tcheck number of levels\n");
#endif
if (L < 0)
{
error("The number of levels, L, must be a non-negative integer");
/*NOTREACHED*/
}
#ifdef DEBUG_RWT
REprintf("\tcheck dimen prereqs\n");
#endif
/* Check the ROW dimension of input */
if (m > 1)
{
double mtest = (double) m / pow(2.0, (double) L);
if (!isint(mtest))
{
error("The matrix row dimension must be of size m*2^(L)");
/*NOTREACHED*/
}
}
/* Check the COLUMN dimension of input */
if (n > 1)
{
double ntest = (double) n / pow(2.0, (double) L);
if (!isint(ntest))
{
error("The matrix column dimension must be of size n*2^(L)");
/*NOTREACHED*/
}
}
#ifdef DEBUG_RWT
REprintf("\tcreating value objects\n");
//.........这里部分代码省略.........
开发者ID:cran,项目名称:rwt,代码行数:101,代码来源:do_mrdwt.c
示例12: qnorm5
double qnorm5(double p, double mu, double sigma, int lower_tail, int log_p)
{
double p_, q, r, val;
#ifdef IEEE_754
if (ISNAN(p) || ISNAN(mu) || ISNAN(sigma))
return p + mu + sigma;
#endif
R_Q_P01_boundaries(p, ML_NEGINF, ML_POSINF);
if(sigma < 0) ML_ERR_return_NAN;
if(sigma == 0) return mu;
p_ = R_DT_qIv(p);/* real lower_tail prob. p */
q = p_ - 0.5;
#ifdef DEBUG_qnorm
REprintf("qnorm(p=%10.7g, m=%g, s=%g, l.t.= %d, log= %d): q = %g\n",
p,mu,sigma, lower_tail, log_p, q);
#endif
/*-- use AS 241 --- */
/* double ppnd16_(double *p, long *ifault)*/
/* ALGORITHM AS241 APPL. STATIST. (1988) VOL. 37, NO. 3
Produces the normal deviate Z corresponding to a given lower
tail area of P; Z is accurate to about 1 part in 10**16.
(original fortran code used PARAMETER(..) for the coefficients
and provided hash codes for checking them...)
*/
if (fabs(q) <= .425) {/* 0.075 <= p <= 0.925 */
r = .180625 - q * q;
val =
q * (((((((r * 2509.0809287301226727 +
33430.575583588128105) * r + 67265.770927008700853) * r +
45921.953931549871457) * r + 13731.693765509461125) * r +
1971.5909503065514427) * r + 133.14166789178437745) * r +
3.387132872796366608)
/ (((((((r * 5226.495278852854561 +
28729.085735721942674) * r + 39307.89580009271061) * r +
21213.794301586595867) * r + 5394.1960214247511077) * r +
687.1870074920579083) * r + 42.313330701600911252) * r + 1.);
}
else { /* closer than 0.075 from {0,1} boundary */
/* r = min(p, 1-p) < 0.075 */
if (q > 0)
r = R_DT_CIv(p);/* 1-p */
else
r = p_;/* = R_DT_Iv(p) ^= p */
r = sqrt(- ((log_p &&
((lower_tail && q <= 0) || (!lower_tail && q > 0))) ?
p : /* else */ log(r)));
/* r = sqrt(-log(r)) <==> min(p, 1-p) = exp( - r^2 ) */
#ifdef DEBUG_qnorm
REprintf("\t close to 0 or 1: r = %7g\n", r);
#endif
if (r <= 5.) { /* <==> min(p,1-p) >= exp(-25) ~= 1.3888e-11 */
r += -1.6;
val = (((((((r * 7.7454501427834140764e-4 +
.0227238449892691845833) * r + .24178072517745061177) *
r + 1.27045825245236838258) * r +
3.64784832476320460504) * r + 5.7694972214606914055) *
r + 4.6303378461565452959) * r +
1.42343711074968357734)
/ (((((((r *
1.05075007164441684324e-9 + 5.475938084995344946e-4) *
r + .0151986665636164571966) * r +
.14810397642748007459) * r + .68976733498510000455) *
r + 1.6763848301838038494) * r +
2.05319162663775882187) * r + 1.);
}
else { /* very close to 0 or 1 */
r += -5.;
val = (((((((r * 2.01033439929228813265e-7 +
2.71155556874348757815e-5) * r +
.0012426609473880784386) * r + .026532189526576123093) *
r + .29656057182850489123) * r +
1.7848265399172913358) * r + 5.4637849111641143699) *
r + 6.6579046435011037772)
/ (((((((r *
2.04426310338993978564e-15 + 1.4215117583164458887e-7)*
r + 1.8463183175100546818e-5) * r +
7.868691311456132591e-4) * r + .0148753612908506148525)
* r + .13692988092273580531) * r +
.59983220655588793769) * r + 1.);
}
if(q < 0.0)
val = -val;
/* return (q >= 0.)? r : -r ;*/
}
return mu + sigma * val;
}
开发者ID:ChrisRackauckas,项目名称:Rmath-julia,代码行数:98,代码来源:qnorm.c
示例13: convertRToGenericValue
/* Convert an R value to a GenericValue based on the type expected, given by type. */
bool
convertRToGenericValue(llvm::GenericValue *rv, SEXP rval, const llvm::Type *type)
{
llvm::Type::TypeID ty;
if(!type) {
REprintf("var arg %d\n", TYPEOF(rval));
rv->IntVal = INTEGER(rval)[0];
// rv->IntVal = llvm::APInt((unsigned) 32, INTEGER(rval)[0]);
return(true);
}
// FIX - enhance to cover more situations.
if(type->isPointerTy()) {
const llvm::Type *elType = ((const llvm::PointerType*) type)->getElementType();
ty = elType->getTypeID();
bool ok = true;
switch(ty) {
case llvm::Type::IntegerTyID:
if(elType->isIntegerTy(8)) {
if(TYPEOF(rval) == STRSXP) {
rv->PointerVal = Rf_length(rval) ? (void*) CHAR(STRING_ELT(rval, 0)) : (void *) NULL;
} else if(TYPEOF(rval) == NILSXP) {
rv->PointerVal = (void*) NULL;
} else
ok = false;
} else if(TYPEOF(rval) == INTSXP)
rv->PointerVal = INTEGER(rval);
else
ok = false;
break;
case llvm::Type::DoubleTyID:
if(TYPEOF(rval) == REALSXP)
rv->PointerVal = REAL(rval);
else
ok = false;
break;
case llvm::Type::PointerTyID:
if(TYPEOF(rval) == STRSXP) {
rv->PointerVal = Rf_length(rval) ? (void*) CHAR(STRING_ELT(rval, 0)) : (void *) NULL;
} if(TYPEOF(rval) == NILSXP || rval == R_NilValue) {
rv->PointerVal = (void*) NULL;
} else if(TYPEOF(rval) == RAWSXP)
rv->PointerVal = (void*) RAW(rval);
else
ok = false;
break;
case llvm::Type::VoidTyID:
if(rval == R_NilValue)
rv->PointerVal = (void*) NULL;
else if(TYPEOF(rval) == RAWSXP)
rv->PointerVal = (void*) RAW(rval);
break;
default:
ok = false;
}
if(ok == false) {
int rtype = isSEXPType(type);
if(rtype > 0) {
rv->PointerVal = rval;
ok = true;
}
}
if(ok == false && TYPEOF(rval) == EXTPTRSXP) {
rv->PointerVal = R_ExternalPtrAddr(rval);
ok = true;
}
/* See if this is an S4 object with a "ref" slot that is an external pointer */
SEXP refRVal = NULL;
if(ok == false && IS_S4_OBJECT(rval) && (refRVal = GET_SLOT(rval, Rf_install("ref")))
&& refRVal != R_NilValue && TYPEOF(refRVal) == EXTPTRSXP) {
rv->PointerVal = R_ExternalPtrAddr(refRVal);
ok = true;
}
if(ok == false) {
PROBLEM "no method to convert R object of R type %d to LLVM pointer to type %d", TYPEOF(rval), ty
WARN;
}
return(ok);
}
ty = type->getTypeID();
switch(ty) {
case llvm::Type::IntegerTyID: {
uint64_t val = asInteger(rval);
unsigned BitWidth = llvm::cast<llvm::IntegerType>(type)->getBitWidth();
rv->IntVal = llvm::APInt(BitWidth, val);
return rv;
}
break;
case llvm::Type::DoubleTyID: {
rv->DoubleVal = Rf_asReal(rval);
}
//.........这里部分代码省略.........
开发者ID:duncantl,项目名称:Rllvm,代码行数:101,代码来源:converters.cpp
示例14: mypause
void mypause() {
REprintf("--------------------------------------------------\n");
}
开发者ID:cran,项目名称:seqminer,代码行数:3,代码来源:bgen2genoLoader.cpp
示例15: Rstd_ShowMessage
void attribute_hidden Rstd_ShowMessage(const char *s)
{
REprintf("%s\n", s);
}
开发者ID:lovmoy,项目名称:r-source,代码行数:4,代码来源:sys-std.c
示例16: Rstd_Suicide
void attribute_hidden Rstd_Suicide(const char *s)
{
REprintf("Fatal error: %s\n", s);
/* Might be called before translation is running */
R_CleanUp(SA_SUICIDE, 2, 0);
}
开发者ID:lovmoy,项目名称:r-source,代码行数:6,代码来源:sys-std.c
示例17: qgamma
double qgamma(double p, double alpha, double scale, int lower_tail, int log_p)
/* shape = alpha */
{
#define C7 4.67
#define C8 6.66
#define C9 6.73
#define C10 13.32
#define EPS1 1e-2
#define EPS2 5e-7/* final precision */
#define MAXIT 1000/* was 20 */
#define pMIN 1e-100 /* was 0.000002 = 2e-6 */
#define pMAX (1-1e-12)/* was 0.999998 = 1 - 2e-6 */
const double
i420 = 1./ 420.,
i2520 = 1./ 2520.,
i5040 = 1./ 5040;
double p_, a, b, c, ch, g, p1, v;
double p2, q, s1, s2, s3, s4, s5, s6, t, x;
int i;
/* test arguments and initialise */
#ifdef IEEE_754
if (ISNAN(p) || ISNAN(alpha) || ISNAN(scale))
return p + alpha + scale;
#endif
R_Q_P01_check(p);
if (alpha <= 0) ML_ERR_return_NAN;
/* FIXME: This (cutoff to {0, +Inf}) is far from optimal when log_p: */
p_ = R_DT_qIv(p);/* lower_tail prob (in any case) */
if (/* 0 <= */ p_ < pMIN) return 0;
if (/* 1 >= */ p_ > pMAX) return BOOM::infinity();
v = 2*alpha;
c = alpha-1;
g = lgammafn(alpha);/* log Gamma(v/2) */
/*----- Phase I : Starting Approximation */
#ifdef DEBUG_qgamma
REprintf("qgamma(p=%7g, alpha=%7g, scale=%7g, l.t.=%2d, log_p=%2d): ",
p,alpha,scale, lower_tail, log_p);
#endif
if(v < (-1.24)*R_DT_log(p)) { /* for small chi-squared */
#ifdef DEBUG_qgamma
REprintf(" small chi-sq.\n");
#endif
/* FIXME: Improve this "if (log_p)" :
* (A*exp(b)) ^ 1/al */
ch = pow(p_* alpha*exp(g+alpha*M_LN2), 1/alpha);
if(ch < EPS2) {/* Corrected according to AS 91; MM, May 25, 1999 */
goto END;
}
} else if(v > 0.32) { /* using Wilson and Hilferty estimate */
x = qnorm(p, 0, 1, lower_tail, log_p);
p1 = 0.222222/v;
ch = v*pow(x*sqrt(p1)+1-p1, 3);
#ifdef DEBUG_qgamma
REprintf(" v > .32: Wilson-Hilferty; x = %7g\n", x);
#endif
/* starting approximation for p tending to 1 */
if( ch > 2.2*v + 6 )
ch = -2*(R_DT_Clog(p) - c*log(0.5*ch) + g);
} else { /* for v <= 0.32 */
ch = 0.4;
a = R_DT_Clog(p) + g + c*M_LN2;
#ifdef DEBUG_qgamma
REprintf(" v <= .32: a = %7g\n", a);
#endif
do {
q = ch;
p1 = 1. / (1+ch*(C7+ch));
p2 = ch*(C9+ch*(C8+ch));
t = -0.5 +(C7+2*ch)*p1 - (C9+ch*(C10+3*ch))/p2;
ch -= (1- exp(a+0.5*ch)*p2*p1)/t;
} while(fabs(q - ch) > EPS1*fabs(ch));
}
#ifdef DEBUG_qgamma
REprintf("\t==> ch = %10g:", ch);
#endif
/*----- Phase II: Iteration
* Call pgamma() [AS 239] and calculate seven term taylor series
*/
//.........这里部分代码省略.........
开发者ID:Hkey1,项目名称:boom,代码行数:101,代码来源:qgamma.cpp
示例18: readBGEN2List
SEXP readBGEN2List(BGenFile* bin) {
// Rprintf("vcfColumn.size() = %u\n", FLAG_vcfColumn.size());
// Rprintf("vcfInfo.size() = %u\n", FLAG_infoTag.size());
// Rprintf("vcfIndv.size() = %u\n", FLAG_indvTag.size());
// also append sample names at the end
// 7: chrom, pos, varId, rsId, alleles, isPhased, prob, sampleId
int retListLen = 8;
if (retListLen == 0) {
return R_NilValue;
}
int numAllocated =
0; // record how many times we allocate (using PROTECT in R);
SEXP ret;
PROTECT(ret = allocVector(VECSXP, retListLen));
numAllocated++;
// store results
std::vector<std::string> idVec;
std::vector<std::string> chrom;
std::vector<int> pos;
std::vector<std::string> varId;
std::vector<std::string> rsId;
std::vector<std::string> alleles;
// std::vector<std::vector<bool> > missing;
std::vector<bool> isPhased;
std::vector<std::vector<double> >
prob; // prob[variant][each_sample * (prob1, prob2, ...)]
// std::map<std::string, std::vector<std::string> > infoMap;
// std::map<std::string, std::vector<std::string> > indvMap;
/// int nRow = 0; // # of positions that will be outputed
// get effective sample names
const int N = bin->getNumSample();
std::vector<std::string> sm = bin->getSampleIdentifier(); // all sample names
std::vector<std::string>& names = idVec;
if (!sm.size()) {
char buf[1024];
for (int i = 0; i < N; ++i) {
sprintf(buf, "sample_%d", i);
sm.push_back(buf);
}
}
const size_t sampleSize = bin->getNumEffectiveSample();
for (size_t i = 0; i != sampleSize; ++i) {
names.push_back(sm[bin->getEffectiveIndex(i)]);
}
// real working part
int nRecord = 0;
const int numProbValues =
3; // if multi-allelic/multi-haploid, this value can be different
int maxProbValues = -1;
while (bin->readRecord()) {
// REprintf("read a record\n");
const BGenVariant& var = bin->getVariant();
const size_t sampleSize = bin->getNumEffectiveSample();
// store results here
nRecord++;
chrom.push_back(var.chrom);
pos.push_back(var.pos);
varId.push_back(var.varid);
rsId.push_back(var.rsid);
alleles.push_back(toString(var.alleles, ","));
isPhased.push_back(var.isPhased);
prob.resize(nRecord);
std::vector<double>& p = prob[nRecord - 1];
p.reserve(sampleSize * numProbValues);
for (size_t i = 0; i != sampleSize; ++i) {
int beg = var.index[bin->getEffectiveIndex(i)];
int end = var.index[bin->getEffectiveIndex(i) + 1];
if (end - beg > maxProbValues) {
maxProbValues = end - beg;
}
for (int j = 0; j < numProbValues; ++j) {
if (j < numProbValues) {
p.push_back(var.prob[beg + j]);
} else {
p.push_back(-9);
}
}
// REprintf("beg = %d, end = %d, prob[%d][%d] len = %d\n", beg,end,
// nRecord - 1, i, p[i].size());
}
// Rprintf("Done add indv\n");
} // end while
if (maxProbValues > numProbValues) {
REprintf("some sample has more than %d > %d probabilities per variant!\n",
maxProbValues, numProbValues);
}
// pass value back to R (see Manual Chapter 5)
std::vector<std::string> listNames;
//.........这里部分代码省略.........
开发者ID:cran,项目名称:seqminer,代码行数:101,代码来源:bgen2genoLoader.cpp
示例19: M_Matrix_check_class_etc
// for now still *export* M_Matrix_check_class_etc()
int M_Matrix_check_class_etc(SEXP x, const char **valid)
{
REprintf("M_Matrix_check_class_etc() is deprecated; use R_check_class_etc() instead");
return R_check_class_etc(x, valid);
}
开发者ID:bedatadriven,项目名称:renjin-matrix,代码行数:6,代码来源:Matrix_stubs.c
示例20: pnchisq_raw
double pnchisq_raw(double x, double f, double theta,
double errmax, double reltol, int itrmax)
{
double ans, lam, u, v, x2, f2, t, term, bound, f_x_2n, f_2n, lt;
double lu = -1., l_lam = -1., l_x = -1.; /* initialized for -Wall */
int n;
Rboolean lamSml, tSml, is_r, is_b, is_it;
static const double _dbl_min_exp = M_LN2 * DBL_MIN_EXP;
/*= -708.3964 for IEEE double precision */
if (x <= 0.) return 0.;
if(!R_FINITE(x)) return 1.;
#ifdef DEBUG_pnch
REprintf("pnchisq(x=%g, f=%g, theta=%g): ",x,f,theta);
#endif
lam = .5 * theta;
lamSml = (-lam < _dbl_min_exp);
if(lamSml) {
/* MATHLIB_ERROR(
"non centrality parameter (= %g) too large for current algorithm",
theta) */
u = 0;
lu = -lam;/* == ln(u) */
l_lam = log(lam);
} else {
u = exp(-lam);
}
/* evaluate the first term */
v = u;
x2 = .5 * x;
f2 = .5 * f;
f_x_2n = f - x;
#ifdef DEBUG_pnch
REprintf("-- v=exp(-th/2)=%g, x/2= %g, f/2= %g\n",v,x2,f2);
#endif
if(f2 * DBL_EPSILON > 0.125 && /* very large f and x ~= f: probably needs */
fabs(t = x2 - f2) < /* other algorithm anyway */
sqrt(DBL_EPSILON) * f2) {
/* evade cancellation error */
/* t = exp((1 - t)*(2 - t/(f2 + 1))) / sqrt(2*M_PI*(f2 + 1));*/
lt = (1 - t)*(2 - t/(f2 + 1)) - 0.5 * log(2*M_PI*(f2 + 1));
#ifdef DEBUG_pnch
REprintf(" (case I) ==> ");
#endif
}
else {
/* Usual case 2: careful not to overflow .. : */
lt = f2*log(x2) -x2 - lgammafn(f2 + 1);
}
#ifdef DEBUG_pnch
REprintf(" lt= %g", lt);
#endif
tSml = (lt < _dbl_min_exp);
if(tSml) {
if (x > f + theta + 5* sqrt( 2*(f + 2*theta))) {
/* x > E[X] + 5* sigma(X) */
return 1.; /* better than 0 --- but definitely "FIXME" */
} /* else */
l_x = log(x);
ans = term = t = 0.;
}
else {
t = exp(lt);
#ifdef DEBUG_pnch
REprintf(", t=exp(lt)= %g\n", t);
#endif
ans = term = v * t;
}
for (n = 1, f_2n = f + 2., f_x_2n += 2.; ; n++, f_2n += 2, f_x_2n += 2) {
#ifdef DEBUG_pnch
REprintf("\n _OL_: n=%d",n);
#endif
/* f_2n === f + 2*n
* f_x_2n === f - x + 2*n > 0 <==> (f+2n) > x */
if (f_x_2n > 0) {
/* find the error bound and check for convergence */
bound = t * x / f_x_2n;
#ifdef DEBUG_pnch
REprintf("\n L10: n=%d; term= %g; bound= %g",n,term,bound);
#endif
is_r = is_it = FALSE;
/* convergence only if BOTH absolute and relative error < 'bnd' */
if (((is_b = (bound <= errmax)) &&
(is_r = (term <= reltol * ans))) || (is_it = (n > itrmax)))
{
#ifdef DEBUG_pnch
REprintf("BREAK n=%d %s; bound= %g %s, rel.err= %g %s\n",
n, (is_it ? "> itrmax" : ""),
bound, (is_b ? "<= errmax" : ""),
term/ans, (is_r ? "<= reltol" : ""));
#endif
break; /* out completely */
//.........这里部分代码省略.........
开发者ID:Vladimir84,项目名称:rcc,代码行数:101,代码来源:pnchisq.c
注:本文中的REprintf函数示例由纯净天空整理自Github/MSDocs等源码及文档管理平台,相关代码片段筛选自各路编程大神贡献的开源项目,源码版权归原作者所有,传播和使用请参考对应项目的License;未经允许,请勿转载。 |
请发表评论