本文整理汇总了C++中Rprintf函数的典型用法代码示例。如果您正苦于以下问题:C++ Rprintf函数的具体用法?C++ Rprintf怎么用?C++ Rprintf使用的例子?那么, 这里精选的函数代码示例或许可以为您提供帮助。
在下文中一共展示了Rprintf函数的15个代码示例,这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞,您的评价将有助于系统推荐出更棒的C++代码示例。
示例1: number
/* ev_err -- reports error (err_num) in file "file" at line "line_num" and
returns to user error handler;
list_num is an error list number (0 is the basic list
pointed by err_mesg, 1 is the basic list of warnings)
*/
int ev_err(char *file,int err_num,int line_num,char *fn_name,int list_num)
{
int num;
if ( err_num < 0 ) err_num = 0;
#ifndef USING_R
if (list_num < 0 || list_num >= err_list_end ||
err_list[list_num].listp == (char **)NULL) {
fprintf(stderr,
"\n Not (properly) attached list of errors: list_num = %d\n",
list_num);
fprintf(stderr," Call \"err_list_attach\" in your program\n");
if ( ! isatty(fileno(stdout)) ) {
fprintf(stderr,
"\n Not (properly) attached list of errors: list_num = %d\n",
list_num);
fprintf(stderr," Call \"err_list_attach\" in your program\n");
}
printf("\nExiting program\n");
exit(0);
}
#endif
num = err_num;
if ( num >= err_list[list_num].len ) num = 0;
#ifndef USING_R
if ( cnt_errs && ++num_errs >= MAX_ERRS ) /* too many errors */
{
fprintf(stderr,"\n\"%s\", line %d: %s in function %s()\n",
file,line_num,err_list[list_num].listp[num],
isascii(*fn_name) ? fn_name : "???");
if ( ! isatty(fileno(stdout)) )
fprintf(stdout,"\n\"%s\", line %d: %s in function %s()\n",
file,line_num,err_list[list_num].listp[num],
isascii(*fn_name) ? fn_name : "???");
printf("Sorry, too many errors: %d\n",num_errs);
printf("Exiting program\n");
exit(0);
}
#endif
if ( err_list[list_num].warn )
switch ( err_flag )
{
case EF_SILENT: break;
default:
#ifdef USING_R
Rprintf("\n\"%s\", line %d: %s in function %s()\n\n",
file,line_num,err_list[list_num].listp[num],
isascii(*fn_name) ? fn_name : "???");
#else
fprintf(stderr,"\n\"%s\", line %d: %s in function %s()\n\n",
file,line_num,err_list[list_num].listp[num],
isascii(*fn_name) ? fn_name : "???");
if ( ! isatty(fileno(stdout)) )
fprintf(stdout,"\n\"%s\", line %d: %s in function %s()\n\n",
file,line_num,err_list[list_num].listp[num],
isascii(*fn_name) ? fn_name : "???");
#endif
break;
}
else
switch ( err_flag )
{
case EF_SILENT:
longjmp(restart,(err_num==0)? -1 : err_num);
break;
case EF_ABORT:
#ifdef USING_R
Rprintf("\n\"%s\", line %d: %s in function %s()\n",
file,line_num,err_list[list_num].listp[num],
isascii(*fn_name) ? fn_name : "???");
#else
fprintf(stderr,"\n\"%s\", line %d: %s in function %s()\n",
file,line_num,err_list[list_num].listp[num],
isascii(*fn_name) ? fn_name : "???");
if ( ! isatty(fileno(stdout)) )
fprintf(stdout,"\n\"%s\", line %d: %s in function %s()\n",
file,line_num,err_list[list_num].listp[num],
isascii(*fn_name) ? fn_name : "???");
#endif
#ifdef USING_R
Rf_error("");
#else
abort();
#endif
break;
case EF_JUMP:
#ifdef USING_R
Rprintf("\n\"%s\", line %d: %s in function %s()\n",
file,line_num,err_list[list_num].listp[num],
isascii(*fn_name) ? fn_name : "???");
#else
//.........这里部分代码省略.........
示例2: convert_snp_affymetrix_C
void convert_snp_affymetrix_C(char **dirname_, char **filelist, unsigned *files_amount_, char **map_filename_, char **outfilename_, unsigned *skipaffym, char **alleleID_names, char *alleleID, unsigned *alleleID_amount)
{
char *outfilename = *outfilename_;
char *dirname = *dirname_;
char *map_filename = *map_filename_;
unsigned files_amount=*files_amount_;
std::map<std::string, char> coding;
for(unsigned i=0 ; i<*alleleID_amount ; i++)
{
coding[alleleID_names[i]] = alleleID[i];
}
Rprintf("reading map...\n");
//std::cout<<"reading map...\n";
AffymetrixChipMap Map(map_filename, 2, 0, 2, 4, 5, 3, 9, 10, 6);
//std::cout<<"map is read...\n";
Rprintf("map is read...\n");
if(Map.get_exclude_amount() != 0)
{
Rprintf("%i SNPs excluded from annotation because of absent enough information annotation file\n", Map.get_exclude_amount());
}
std::vector<ChipData *> ids_chip;
for(unsigned i=0 ; i<files_amount ; i++)
{
std::string file = (std::string(dirname) + "/" + std::string(filelist[i]));
Rprintf("%i: opening file %s\n", i+1, file.c_str());
ids_chip.push_back(new affymetrix_chip_data(file, 0, 1, *skipaffym));
}
unsigned id_amount=ids_chip.size();
std::ofstream outfile(outfilename);
if(!outfile.is_open()){error("Can not open file \"\"\n",outfilename);}
Rprintf("Save to file %s\n", outfilename);
outfile << "#GenABEL raw data version 0.1\n";
//save IDs
Rprintf("saving Id names...\n");
for(unsigned id=0 ; id<files_amount ; id++)
{
outfile<<replace(std::string(filelist[id]), ' ', '_')<<" ";
}
outfile<<"\n";
std::string snpname;
unsigned long snp_excludet_from_output_data=0;
//save snpnames
Rprintf("saving SNP names...\n");
unsigned snp_amount=ids_chip[0]->get_snp_amount();
for(unsigned snp=0 ; snp<snp_amount ; snp++)
{
snpname = ids_chip[0]->get_snp_name(snp);
if(Map.is_snp_in_map(snpname)){outfile<<Map.recode_snp(snpname.c_str())<<" ";}
else{snp_excludet_from_output_data++;}
}
outfile<<"\n";
//save chromosome
Rprintf("saving chromosome data...\n");
for(unsigned snp=0 ; snp<snp_amount ; snp++)
{
snpname = ids_chip[0]->get_snp_name(snp);
if(Map.is_snp_in_map(snpname)){outfile<<Map.get_chromosome(snpname.c_str())<<" ";}
}
outfile<<"\n";
//save position (map)
Rprintf("saving position data...\n");
for(unsigned snp=0 ; snp<snp_amount ; snp++)
{
snpname = ids_chip[0]->get_snp_name(snp);
if(Map.is_snp_in_map(snpname)){outfile<<Map.get_phisical_position(snpname.c_str())<<" ";}
}
outfile<<"\n";
//.........这里部分代码省略.........
示例3: sslvrg
//.........这里部分代码省略.........
- tol1 = 1e0 + eps
- if (tol1 > 1e0) go to 10
- eps = sqrt(eps)
R Version <= 1.3.x had
eps = .000244 ( = sqrt(5.954 e-8) )
-- now eps is passed as argument
*/
/* initialization */
maxit = *iter;
*iter = 0;
a = ax;
b = bx;
v = a + c_Gold * (b - a);
w = v;
x = v;
e = 0.;
SSPLINE_COMP(x);
fx = *crit;
fv = fx;
fw = fx;
/* main loop
--------- */
while(*ier == 0) { /* L20: */
xm = (a + b) * .5;
tol1 = *eps * fabs(x) + *tol / 3.;
tol2 = tol1 * 2.;
++(*iter);
if(tracing) {
if(*iter == 1) {/* write header */
Rprintf("sbart (ratio = %15.8g) iterations;"
" initial tol1 = %12.6e :\n"
"%11s %14s %9s %11s Kind %11s %12s\n%s\n",
ratio, tol1, "spar",
((*icrit == 1) ? "GCV" :
(*icrit == 2) ? "CV" :
(*icrit == 3) ?"(df0-df)^2" :
/*else (should not happen) */"?f?"),
"b - a", "e", "NEW lspar", "crit",
" ---------------------------------------"
"----------------------------------------");
}
Rprintf("%11.8f %14.9g %9.4e %11.5g", x, CRIT(fx), b - a, e);
Fparabol = FALSE;
}
/* Check the (somewhat peculiar) stopping criterion: note that
the RHS is negative as long as the interval [a,b] is not small:*/
if (fabs(x - xm) <= tol2 - (b - a) * .5 || *iter > maxit)
goto L_End;
/* is golden-section necessary */
if (fabs(e) <= tol1 ||
/* if had Inf then go to golden-section */
fx >= BIG_f || fv >= BIG_f || fw >= BIG_f) goto L_GoldenSect;
/* Fit Parabola */
if(tracing) { Rprintf(" FP"); Fparabol = TRUE; }
r = (x - w) * (fx - fv);
q = (x - v) * (fx - fw);
示例4: print_line
/**
* utility function to print out division lines
*/
static R_INLINE void print_line(){
Rprintf("-----------------------------------------\n");
}
示例5: _computeItemTrace
void _computeItemTrace(vector<double> &itemtrace, const NumericMatrix &Theta,
const List &pars, const NumericVector &ot, const vector<int> &itemloc, const int &which,
const int &nfact, const int &N, const int &USEFIXED)
{
NumericMatrix theta = Theta;
int nfact2 = nfact;
S4 item = pars[which];
int ncat = as<int>(item.slot("ncat"));
vector<double> par = as< vector<double> >(item.slot("par"));
vector<double> P(N*ncat);
int itemclass = as<int>(item.slot("itemclass"));
int correct = 0;
if(itemclass == 8)
correct = as<int>(item.slot("correctcat"));
/*
1 = dich
2 = graded
3 = gpcm
4 = nominal
5 = grsm
6 = rsm
7 = partcomp
8 = nestlogit
9 = custom....have to do in R for now
*/
if(USEFIXED){
NumericMatrix itemFD = item.slot("fixed.design");
nfact2 = nfact + itemFD.ncol();
NumericMatrix NewTheta(Theta.nrow(), nfact2);
for(int i = 0; i < itemFD.ncol(); ++i)
NewTheta(_,i) = itemFD(_,i);
for(int i = 0; i < nfact; ++i)
NewTheta(_,i+itemFD.ncol()) = Theta(_,i);
theta = NewTheta;
}
switch(itemclass){
case 1 :
P_dich(P, par, theta, ot, N, nfact2);
break;
case 2 :
P_graded(P, par, theta, ot, N, nfact2, ncat-1, 1, 0);
break;
case 3 :
P_nominal(P, par, theta, ot, N, nfact2, ncat, 0, 0);
break;
case 4 :
P_nominal(P, par, theta, ot, N, nfact2, ncat, 0, 0);
break;
case 5 :
P_graded(P, par, theta, ot, N, nfact2, ncat-1, 1, 1);
break;
case 6 :
P_nominal(P, par, theta, ot, N, nfact2, ncat, 0, 1);
break;
case 7 :
P_comp(P, par, theta, N, nfact2);
break;
case 8 :
P_nested(P, par, theta, N, nfact2, ncat, correct);
break;
case 9 :
break;
default :
Rprintf("How in the heck did you get here from a switch statement?\n");
break;
}
int where = (itemloc[which]-1) * N;
for(int i = 0; i < N*ncat; ++i)
itemtrace[where + i] = P[i];
}
示例6: AllStatistics
void AllStatistics (
int *tails,
int *heads,
int *dnedges,
int *dn, /* Number of nodes */
int *dflag, /* directed flag */
int *bipartite,
int *nterms,
char **funnames,
char **sonames,
double *inputs,
double *covmat,
int *weightsvector,
int *maxNumDyadTypes) {
Network *nwp;
Vertex n_nodes = (Vertex) *dn;
unsigned int directed_flag = *dflag;
Vertex nodelistlength, rowmax, *nodelist1, *nodelist2;
Vertex bip = (Vertex) *bipartite;
Model *m;
ModelTerm *mtp;
/* Step 1: Initialize empty network and initialize model */
GetRNGstate(); /* Necessary for R random number generator */
nwp=NetworkInitialize((Vertex*)tails, (Vertex*)heads, *dnedges,
n_nodes, directed_flag, bip, 0, 0, NULL);
m=ModelInitialize(*funnames, *sonames, &inputs, *nterms);
/* Step 2: Build nodelist1 and nodelist2, which together give all of the
dyads in the network. */
if (BIPARTITE > 0) { /* Assuming undirected in the bipartite case */
nodelistlength = BIPARTITE * (N_NODES-BIPARTITE);
rowmax = BIPARTITE + 1;
} else {
nodelistlength = N_NODES * (N_NODES-1) / (DIRECTED? 1 : 2);
rowmax = N_NODES;
}
nodelist1 = (Vertex *) R_alloc(nodelistlength, sizeof(int));
nodelist2 = (Vertex *) R_alloc(nodelistlength, sizeof(int));
int count = 0;
for(int i=1; i < rowmax; i++) {
for(int j = MAX(i,BIPARTITE)+1; j <= N_NODES; j++) {
for(int d=0; d <= DIRECTED; d++) { /*trivial loop if undirected*/
nodelist1[count] = d==1? j : i;
nodelist2[count] = d==1? i : j;
count++;
}
}
}
/* Step 3: Initialize values of mtp->dstats so they point to the correct
spots in the newRow vector. These values will never change. */
double *changeStats = (double *) R_alloc(m->n_stats,sizeof(double));
double *cumulativeStats = (double *) R_alloc(m->n_stats,sizeof(double));
for (int i=0; i < m->n_stats; i++) cumulativeStats[i]=0.0;
unsigned int totalStats = 0;
for (mtp=m->termarray; mtp < m->termarray + m->n_terms; mtp++){
mtp->dstats = changeStats + totalStats;
/* Update mtp->dstats pointer to skip atail by mtp->nstats */
totalStats += mtp->nstats;
}
if (totalStats != m->n_stats) {
Rprintf("I thought totalStats=%d and m->nstats=%d should be the same.\n",
totalStats, m->n_stats);
}
/* Step 4: Begin recursion */
RecurseOffOn(nodelist1, nodelist2, nodelistlength, 0, changeStats,
cumulativeStats, covmat, (unsigned int*) weightsvector, *maxNumDyadTypes, nwp, m);
/* Step 5: Deallocate memory and return */
ModelDestroy(m);
NetworkDestroy(nwp);
PutRNGstate(); /* Must be called after GetRNGstate before returning to R */
}
示例7: amcmc
//.........这里部分代码省略.........
if (i < n-1 && branch->one == NULL)
// branch->one = make_node(vars[i+1].prob);
branch->one = make_node(cond_prob(real_model,i+1, n, marg_probs,Cov , delta));
if (i == n-1 && branch->one == NULL)
branch->one = make_node(0.0);
branch = branch->one;
}
else {
for (j=0; j<=i; j++) pigamma[j] *= (1.0 - branch->prob);
if (i < n-1 && branch->zero == NULL)
// branch->zero = make_node(vars[i+1].prob);
branch->zero = make_node(cond_prob(real_model,i+1, n, marg_probs,Cov, delta));
if (i == n-1 && branch->zero == NULL)
branch->zero = make_node(0.0);
branch = branch->zero;
}
model[vars[i].index] = bit;
INTEGER(modeldim)[m] += bit;
}
REAL(sampleprobs)[m] = pigamma[0];
pmodel = INTEGER(modeldim)[m];
// Now subtract off the visited probability mass.
branch=tree;
for (i = 0; i < n; i++) {
bit = model[vars[i].index];
prone = branch->prob;
if (bit == 1) prone -= pigamma[i];
denom = 1.0 - pigamma[i];
if (denom <= 0.0) {
if (denom < 0.0) {
Rprintf("neg denominator %le %le %le !!!\n", pigamma, denom, prone);
if (branch->prob < 0.0 && branch->prob < 1.0)
Rprintf("non extreme %le\n", branch->prob);}
denom = 0.0;}
else {
if (prone <= 0) prone = 0.0;
if (prone > denom) {
if (prone <= eps) prone = 0.0;
else prone = 1.0;
// Rprintf("prone > 1 %le %le %le %le !!!\n", pigamma, denom, prone, eps);
}
else prone = prone/denom;
}
if (prone > 1.0 || prone < 0.0)
Rprintf("%d %d Probability > 1!!! %le %le %le %le \n",
m, i, prone, branch->prob, denom, pigamma);
// if (bit == 1) pigamma /= (branch->prob);
// else pigamma /= (1.0 - branch->prob);
// if (pigamma > 1.0) pigamma = 1.0;
branch->prob = prone;
if (bit == 1) branch = branch->one;
else branch = branch->zero;
// Rprintf("%d %d \n", branch->done, n - i);
// if (log((double) branch->done) < (n - i)*log(2.0)) {
// if (bit == 1) branch = branch->one;
// else branch = branch->zero;
//}
//else {
// branch->one = NULL;
// branch->zero = NULL;
// break; }
}
/* Now get model specific calculations */
示例8: call_stsparse
//.........这里部分代码省略.........
jan = (int *) R_alloc(nnz, sizeof(int));
if (type == 0)
{for (j = 0; j < nnz; j++) jan[j] = INTEGER(Jan)[j];}
else {for (j = 0; j < nnz; j++) jan[j] = 0;}
/* 1-D, 2-D, 3-D problem: */
if (type == 2) /* 1=ncomp,2:dim(x), 3: cyclic(x)*/
for (j = 0; j<3 ; j++) dims[j] = INTEGER(NNZ)[j+1];
else if (type == 3) /* 1=ncomp,2-3:dim(x,y), 4-5: cyclic(x,y)*/
for (j = 0; j<5 ; j++) dims[j] = INTEGER(NNZ)[j+1];
else if (type == 4) /* 1=ncomp,2-4:dim(x,y,z), 5-7: cyclic(x,y,z)*/
for (j = 0; j<7 ; j++) dims[j] = INTEGER(NNZ)[j+1];
else if (type == 30) { /* same as type 3 (2-D) but with mapping */
for (j = 0; j<5 ; j++) dims[j] = INTEGER(NNZ)[j+1];
TotN = INTEGER(NNZ)[6];
indDIM = (int *) R_alloc(TotN, sizeof(int));
for (j = 0; j < TotN ; j++) indDIM[j] = INTEGER(NNZ)[j+7];
} else if (type == 40) { /* same as type 4 (3-D) but with mapping */
for (j = 0; j<7 ; j++) dims[j] = INTEGER(NNZ)[j+1];
TotN = INTEGER(NNZ)[8];
indDIM = (int *) R_alloc(TotN, sizeof(int));
for (j = 0; j < TotN ; j++) indDIM[j] = INTEGER(NNZ)[j+9];
}
igp = (int *) R_alloc(ngp+1, sizeof(int));
for (j = 0; j < ngp+1; j++) igp[j] = 0;
jgp = (int *) R_alloc(neq, sizeof(int));
for (j = 0; j < neq; j++) jgp[j] = 0;
len = LENGTH(atol);
Atol = (double *) R_alloc(len, sizeof(double));
for (j = 0; j < len; j++) Atol[j] = REAL(atol)[j];
len = LENGTH(rtol);
Rtol = (double *) R_alloc(len, sizeof(double));
for (j = 0; j < len; j++) Rtol[j] = REAL(rtol)[j];
Chtol = REAL(chtol)[0];
precis =(double *) R_alloc(maxit, sizeof(double));
for (j = 0; j < maxit; j++) precis[j] = 0;
PROTECT(yout = allocVector(REALSXP,ntot)) ; incr_N_Protect();
/* The initialisation routine */
initParms(initfunc, parms);
initForcs(initforc, forcs);
/* pointers to functions derivs and jac, passed to the FORTRAN subroutine */
if (isDll)
{
derivs = (C_deriv_func_type *) R_ExternalPtrAddrFn_(func);
} else { derivs = (C_deriv_func_type *) C_stsparse_derivs;
PROTECT(stsparse_deriv_func = func); incr_N_Protect();
PROTECT(stsparse_envir = rho);incr_N_Protect();
}
tin = REAL(time)[0];
if (method == 1) {
F77_CALL(dsparse) (derivs, &neq, &nnz, &nsp, &tin, svar, dsvar, beta, x,
alpha, ewt, rsp, ian, jan, igp, jgp, &ngp, R, C, IC, isp,
&maxit, &Chtol, Atol, Rtol, &Itol, &posit, pos, &ipos, &isSteady,
precis, &niter, dims, out, ipar, &type, indDIM);
} else {
F77_CALL(dsparsekit) (derivs, &neq, &nnz, &nsp, &tin, svar, dsvar, beta, x,
alpha, ewt, ian, jan, igp, jgp, &ngp, jlu, ju, iwork, iperm,
&maxit, &Chtol, Atol, Rtol, &Itol, &posit, pos, &ipos, &isSteady,
precis, &niter, dims, out, ipar, &type, &droptol, &permtol, &ilumethod,
&lfill, &lenplumx, plu, rwork, indDIM);
}
for (j = 0; j < ny; j++)
REAL(yout)[j] = svar[j];
if (isOut == 1)
{
derivs (&neq, &tin, svar, dsvar, out, ipar) ;
for (j = 0; j < nout; j++)
REAL(yout)[j + ny] = out[j];
}
PROTECT(RWORK = allocVector(REALSXP, niter));incr_N_Protect();
for (k = 0;k<niter;k++) REAL(RWORK)[k] = precis[k];
if (mflag == 1) Rprintf("mean residual derivative %g\n",precis[niter-1]);
setAttrib(yout, install("precis"), RWORK);
PROTECT(IWORK = allocVector(INTSXP, 4));incr_N_Protect();
INTEGER(IWORK)[0] = isSteady;
for (k = 0; k<3; k++) INTEGER(IWORK)[k+1] = dims[k];
setAttrib(yout, install("steady"), IWORK);
unprotect_all();
return(yout);
}
示例9: do_browser
/* browser(text = "", condition = NULL, expr = TRUE, skipCalls = 0L)
* ------- but also called from ./eval.c */
SEXP attribute_hidden do_browser(SEXP call, SEXP op, SEXP args, SEXP rho)
{
RCNTXT *saveToplevelContext;
RCNTXT *saveGlobalContext;
RCNTXT thiscontext, returncontext, *cptr;
int savestack, browselevel;
SEXP ap, topExp, argList;
/* argument matching */
PROTECT(ap = list4(R_NilValue, R_NilValue, R_NilValue, R_NilValue));
SET_TAG(ap, install("text"));
SET_TAG(CDR(ap), install("condition"));
SET_TAG(CDDR(ap), install("expr"));
SET_TAG(CDDDR(ap), install("skipCalls"));
argList = matchArgs(ap, args, call);
UNPROTECT(1);
PROTECT(argList);
/* substitute defaults */
if(CAR(argList) == R_MissingArg)
SETCAR(argList, mkString(""));
if(CADR(argList) == R_MissingArg)
SETCAR(CDR(argList), R_NilValue);
if(CADDR(argList) == R_MissingArg)
SETCAR(CDDR(argList), ScalarLogical(1));
if(CADDDR(argList) == R_MissingArg)
SETCAR(CDDDR(argList), ScalarInteger(0));
/* return if 'expr' is not TRUE */
if( !asLogical(CADDR(argList)) ) {
UNPROTECT(1);
return R_NilValue;
}
/* Save the evaluator state information */
/* so that it can be restored on exit. */
browselevel = countContexts(CTXT_BROWSER, 1);
savestack = R_PPStackTop;
PROTECT(topExp = R_CurrentExpr);
saveToplevelContext = R_ToplevelContext;
saveGlobalContext = R_GlobalContext;
if (!RDEBUG(rho)) {
int skipCalls = asInteger(CADDDR(argList));
cptr = R_GlobalContext;
while ( ( !(cptr->callflag & CTXT_FUNCTION) || skipCalls--)
&& cptr->callflag )
cptr = cptr->nextcontext;
Rprintf("Called from: ");
int tmp = asInteger(GetOption(install("deparse.max.lines"), R_BaseEnv));
if(tmp != NA_INTEGER && tmp > 0) R_BrowseLines = tmp;
if( cptr != R_ToplevelContext ) {
PrintValueRec(cptr->call, rho);
SET_RDEBUG(cptr->cloenv, 1);
} else
Rprintf("top level \n");
R_BrowseLines = 0;
}
R_ReturnedValue = R_NilValue;
/* Here we establish two contexts. The first */
/* of these provides a target for return */
/* statements which a user might type at the */
/* browser prompt. The (optional) second one */
/* acts as a target for error returns. */
begincontext(&returncontext, CTXT_BROWSER, call, rho,
R_BaseEnv, argList, R_NilValue);
if (!SETJMP(returncontext.cjmpbuf)) {
begincontext(&thiscontext, CTXT_RESTART, R_NilValue, rho,
R_BaseEnv, R_NilValue, R_NilValue);
if (SETJMP(thiscontext.cjmpbuf)) {
SET_RESTART_BIT_ON(thiscontext.callflag);
R_ReturnedValue = R_NilValue;
R_Visible = FALSE;
}
R_GlobalContext = &thiscontext;
R_InsertRestartHandlers(&thiscontext, TRUE);
R_ReplConsole(rho, savestack, browselevel+1);
endcontext(&thiscontext);
}
endcontext(&returncontext);
/* Reset the interpreter state. */
R_CurrentExpr = topExp;
UNPROTECT(1);
R_PPStackTop = savestack;
UNPROTECT(1);
R_CurrentExpr = topExp;
R_ToplevelContext = saveToplevelContext;
R_GlobalContext = saveGlobalContext;
return R_ReturnedValue;
}
示例10: print_acc
/**
* utility function to print out acceptance rates
*
* @param n number of iterations
* @param p the length of acc
* @param acc a vector that stores acceptance times or percentages
* @param pct indicating whether acc is the acceptance percentage or the unscaled acceptance times
*
*/
static R_INLINE void print_acc(int n, int p, double *acc, int pct){
double C = (pct) ? 100 : (100.0/n);
Rprintf(_("Acceptance rate: min(%4.2f%%), mean(%4.2f%%), max(%4.2f%%)\n"),
dmin(acc, p) * C, mean(acc, p) * C, dmax(acc, p) * C);
}
示例11: main
/**
* Main function for cwb-align-encode.
*
* @param argc Number of command-line arguments.
* @param argv Command-line arguments.
*/
int
main(int argc, char *argv[])
{
int argindex; /* index of first argument in argv[] */
char *align_name = NULL; /* name of the .align file */
FILE *af = NULL; /* alignment file handle */
int af_is_pipe; /* need to know whether to call fclose() or pclose() */
char alx_name[CL_MAX_LINE_LENGTH]; /* full pathname of .alx file */
char alg_name[CL_MAX_LINE_LENGTH]; /* full pathname of optional .alg file */
FILE *alx=NULL, *alg=NULL; /* file handles for .alx and optional .alg file */
char line[CL_MAX_LINE_LENGTH]; /* one line of input from <infile> */
char corpus1_name[CL_MAX_FILENAME_LENGTH];
char corpus2_name[CL_MAX_FILENAME_LENGTH];
char s1_name[CL_MAX_FILENAME_LENGTH];
char s2_name[CL_MAX_FILENAME_LENGTH];
Corpus *corpus1, *corpus2; /* corpus handles */
Attribute *w1, *w2; /* attribute handles for 'word' attributes; used to determine corpus size */
int size1, size2; /* size of source & target corpus */
Corpus *source_corpus; /* encode alignment in this corpus (depends on -R flag, important for -D option) */
char *source_corpus_name; /* just for error messages */
char *attribute_name; /* name of alignment attribute (depends on -R flag, must be lowercase) */
int f1,l1,f2,l2; /* alignment regions */
int current1, current2;
int mark, n_0_1, n_1_0;
int l;
progname = argv[0];
/* parse command line and read arguments */
argindex = alignencode_parse_args(argc, argv, 1);
align_name = argv[argindex];
/* open alignment file and parse header; .gz files are automatically decompressed */
af_is_pipe = 0;
l = strlen(align_name);
if ((l > 3) && (strncasecmp(align_name + l - 3, ".gz", 3) == 0)) {
char *pipe_cmd = (char *) cl_malloc(l+10);
sprintf(pipe_cmd, "gzip -cd %s", align_name); /* write .gz file through gzip pipe */
af = popen(pipe_cmd, "r");
if (af == NULL) {
perror(pipe_cmd);
Rprintf( "%s: can't read compressed file %s\n", progname, align_name);
rcqp_receive_error(1);
}
af_is_pipe = 1;
cl_free(pipe_cmd);
}
else {
af = fopen(align_name, "r");
if (af == NULL) {
perror(align_name);
Rprintf( "%s: can't read file %s\n", progname, align_name);
rcqp_receive_error(1);
}
}
/* read header = first line */
fgets(line, CL_MAX_LINE_LENGTH, af);
if (4 != sscanf(line, "%s %s %s %s", corpus1_name, s1_name, corpus2_name, s2_name)) {
Rprintf( "%s: %s not in .align format\n", progname, align_name);
Rprintf( "wrong header: %s", line);
rcqp_receive_error(1);
}
if (verbose) {
if (reverse)
Rprintf("Encoding alignment for [%s, %s] from file %s\n", corpus2_name, corpus1_name, align_name);
else
Rprintf("Encoding alignment for [%s, %s] from file %s\n", corpus1_name, corpus2_name, align_name);
}
/* open corpora and determine their sizes (for validity checks and compatibility mode) */
if (NULL == (corpus1 = cl_new_corpus(registry_dir, corpus1_name))) {
Rprintf( "%s: can't open corpus %s\n", progname, corpus1_name);
rcqp_receive_error(1);
}
if (NULL == (corpus2 = cl_new_corpus(registry_dir, corpus2_name))) {
Rprintf( "%s: can't open corpus %s\n", progname, corpus2_name);
rcqp_receive_error(1);
}
if (NULL == (w1 = cl_new_attribute(corpus1, "word", ATT_POS))) {
Rprintf( "%s: can't open p-attribute %s.word\n", progname, corpus1_name);
rcqp_receive_error(1);
}
if (NULL == (w2 = cl_new_attribute(corpus2, "word", ATT_POS))) {
Rprintf( "%s: can't open p-attribute %s.word\n", progname, corpus2_name);
rcqp_receive_error(1);
}
//.........这里部分代码省略.........
示例12: GPsptp_para_printRnu
// to print in the R interface for GP models, for temporal beta
void GPsptp_para_printRnu (int i, int iteration, int report, int p, int u, double accept,
double *phi, double *nu, double *sig2e, double *sig2eta, double *sig2beta,
double *sig2delta, double *sig20, double *rho, double *beta)
{
int j, k;
double phi1, nu1, sig2e1, sig2eta1, sig2beta1, sig2delta1, sig201, ii;
phi1 = *phi;
nu1 =*nu;
sig2e1 = *sig2e;
sig2eta1 = *sig2eta;
sig2beta1 = *sig2beta;
sig2delta1 = *sig2delta;
sig201 = *sig20;
double num = (iteration/report);
int intpart = (int)num;
for(j=0; j<report; j++){
if(i==(intpart*(j+1)-1)){
ii = (double) i;
Rprintf("---------------------------------------------------------------\n");
Rprintf(" Sampled: %i of %i, %3.2f%%.\n Batch Acceptance Rate (phi): %3.2f%%\n",
i+1, iteration, 100.0*(i+1)/iteration, 100.0*(accept/ii));
Rprintf(" Checking Parameters: \n");
Rprintf(" phi: %4.4f, nu: %4.4f, sig2eps: %4.4f, sig2eta: %4.4f,\n sig2beta: %4.4f, sig2delta: %4.4f, sig2op: %4.4f,\n",
phi1, nu1, sig2e1, sig2eta1, sig2beta1, sig2delta1, sig201);
for(k=0; k<u; k++){
Rprintf(" rho[%d]: %4.4f", k+1, rho[k]);
}
Rprintf("\n");
for(k=0; k<p; k++){
Rprintf(" beta[%d]: %4.4f", k+1, beta[k]);
}
Rprintf("\n---------------------------------------------------------------\n");
Rprintf(" ## Model used spatially and temporally varying dynamic parameters \n");
Rprintf(" ## Spatial and dynamic beta parameters are omitted in the display ");
Rprintf("\n---------------------------------------------------------------\n");
}
}
return;
}
示例13: alignencode_usage
/**
* Prints a message describing how to use the program to STDERR and then exits.
*/
void
alignencode_usage(void)
{
Rprintf( "\n");
Rprintf( "Usage: %s [options] <alignment_file>\n\n", progname);
Rprintf( "\n");
Rprintf( "Adds an alignment attribute to an existing CWB corpus\n");
Rprintf( "\n");
Rprintf( "Options:\n");
Rprintf( " -d <dir> write data file(s) to directory <dir>\n");
Rprintf( " -D write files to corpus data directory\n");
Rprintf( " -C compatibility mode (creates .alg file)\n");
/* Rprintf( " -R reverse alignment (target -> source)\n"); */
/* -R option disabled ... need to re-order alignment file for reverse alignment */
Rprintf( " -r <reg> use registry directory <reg>\n");
Rprintf( " -v verbose mode\n");
Rprintf( " -h this help page\n\n");
Rprintf( "Part of the IMS Open Corpus Workbench v" VERSION "\n\n");
rcqp_receive_error(1);
}
示例14: pp
/* print prefix */
static void pp(int pre) {
/* this is sort of silly, I know, but it saves at least some output
calls (and we can replace \t by spaces if desired) ... */
while (pre >= 8) { Rprintf("\t"); pre -= 8; }
while (pre-- > 0) Rprintf(" ");
}
示例15: alignencode_parse_args
/**
* Parses the program's commandline arguments.
*
* Usage:
*
* optindex = alignencode_parse_args(argc, argv, required_arguments);
*
* @param ac The program's argc
* @param av The program's argv
* @param min_args Minimum number of arguments to be parsed.
* @return The value of optind after parsing,
* ie the index of the first argument in argv[]
*/
int
alignencode_parse_args(int ac, char *av[], int min_args)
{
extern int optind; /* getopt() interface */
extern char *optarg; /* getopt() interface */
int c;
while ((c = getopt(ac, av, "hd:DCRr:v")) != EOF)
switch (c) {
/* -d: data directory */
case 'd':
if (data_dir == NULL)
data_dir = optarg;
else {
Rprintf( "%s: -d option used twice\n", progname);
rcqp_receive_error(2);
}
break;
/* -D: use data directory of source corpus */
case 'D':
data_dir_from_corpus = 1;
break;
/* -C: compatibility mode */
case 'C':
compatibility = 1;
break;
/* -R: reverse alignment */
case 'R':
reverse = 1;
break;
/* -r: registry directory */
case 'r':
if (registry_dir == NULL)
registry_dir = optarg;
else {
Rprintf( "%s: -r option used twice\n", progname);
rcqp_receive_error(2);
}
break;
/* -v: verbose */
case 'v':
verbose = 1;
break;
/* -h : help page = usage */
case 'h':
/* unknown option: print usage */
default:
alignencode_usage();
break;
}
if (ac - optind != min_args)
alignencode_usage(); /* no optional arguments in this case */
if ((data_dir == NULL) && (! data_dir_from_corpus)) {
Rprintf( "%s: either -d or -D must be specified\n", progname);
Rprintf( "Type \"%s -h\" for more information.\n", progname);
rcqp_receive_error(1);
}
if ((data_dir != NULL) && data_dir_from_corpus) {
Rprintf( "%s: -d and -D flags cannot be used at the same time\n", progname);
Rprintf( "Type \"%s -h\" for more information.\n", progname);
rcqp_receive_error(1);
}
return(optind); /* return index of first argument in argv[] */
}