C++ R_ProcessEvents函数代码示例

/* assemble call as string in C code */
void menu_ttest2()
{
    char cmd[256];

    done = 0;
    create_dialog();
    setaction(bCancel, cancel2);
    show(win);
    for(;;) {
        R_WaitEvent();
        R_ProcessEvents();
        if(done > 0) break;
    }
    if(done == 1) {
        sprintf(cmd, "t.test(x=%s, y=%s, alternative=\"%s\",\n      paired=%s, var.equal=%s, conf.level=%s)\n", v[0], v[1],
                alts[getlistitem(alt)],
                ischecked(paired) ? "TRUE" : "FALSE",
                ischecked(varequal) ? "TRUE" : "FALSE",
                GA_gettext(lvl));
        Rconsolecmd(cmd);
    }
    hide(win);
    delobj(bApply);
    delobj(win);
}

 /* Fill a text buffer with user typed console input. */
int
R_ReadConsole(const char *prompt, unsigned char *buf, int len,
	      int addtohistory)
{
    R_ProcessEvents();
    return TrueReadConsole(prompt, (char *) buf, len, addtohistory);
}

int
rpipeGetc(rpipe * r)
{
    DWORD a, b;
    char  c;

    if (!r)
	return NOLAUNCH;
    while (PeekNamedPipe(r->read, NULL, 0, NULL, &a, NULL)) {
	if (!a && !r->active) {
	    /* I got a case in which process terminated after Peek.. */
	    PeekNamedPipe(r->read, NULL, 0, NULL, &a, NULL);
	    if (!a) return NOLAUNCH;/* end of pipe */
	}
	if (a) {
	    if (ReadFile(r->read, &c, 1, &b, NULL) == TRUE)
		return c;
	    else
		return NOLAUNCH;/* error but...treated as eof */
	}
	/* we want to look for user break here */
	while (peekevent()) doevent();
	if (UserBreak) {
	    rpipeTerminate(r);
	    break;
	}
	R_ProcessEvents();
	Sleep(100);
    }
    return NOLAUNCH;		/* again.. */
}

static void eventloop(editor c)
{
    while (fix_editor_up) {
	/* avoid consuming 100% CPU time here */
	Sleep(10);
	R_ProcessEvents();
    }
}

void editorcleanall(void)
{
    int i;
    for (i = neditors-1;  i >= 0; --i) {
	if (editorchecksave(REditors[i])) {
	    R_ProcessEvents();  // see R_CleanUp
	    jump_to_toplevel();
	}
	del(REditors[i]);
    }
}

void topmodel(double *parameters,
              double *topidx,
              double *delay,
              double *rain,
              double *ET0,
              double *Qobs,
              int *nidxclass,
              int *ntimestep,
              int *iterations,
              int *nch,
              int *whattoreturn,
              double *perfNS,
              double *result)
{
    int i,j;

    topmodel_topidx_calc(topidx, *nidxclass);
    topmodel_memory_allocation(*nch, *ntimestep, *nidxclass);

    if(*iterations > 1) Rprintf("Iteration:         ");
#ifdef win32
    R_flushConsole();
    R_ProcessEvents();
#endif

    for(i=0; i<*iterations; i++) {
        R_CheckUserInterrupt();
        if(*iterations > 1) Rprintf ("\b\b\b\b\b\b\b\b%8i",i+1);

        topmodel_init(parameters, delay, *nch, i, *nidxclass, *ntimestep);

        /* run the model for each time step */
        for(j=0; j<*ntimestep; j++)
            topmodel_run(rain,ET0,*nidxclass,j,*ntimestep);

        /* TODO: separate routing */

        /* return simulations? */
        if(whattoreturn[0] > 0) {
            topmodel_output(result, *ntimestep, *iterations, whattoreturn[0], *nidxclass, i);
        }

        /* return NS? */
        if(whattoreturn[1]) {
            perfNS[i] = NS(misc.Qt, Qobs, *ntimestep);
        }
    }

    if(*iterations > 1) Rprintf("\n");
    topmodel_memory_free(*nch, *ntimestep, *nidxclass);
    return;
}

void processEvents()
{
#ifdef __APPLE__
   R_ProcessEvents();
#else
   // check for activity on standard input handlers (but ignore stdin).
   // return immediately if there is no input currently available
   fd_set* what = R_checkActivity(0,1);

   // run handlers on the input (or run the polled event handler if there
   // is no input currently available)
   R_runHandlers(R_InputHandlers, what);
#endif
}

/*********************
 void WtCDSample

 Using the parameters contained in the array theta, obtain the
 network statistics for a sample of size samplesize.  burnin is the
 initial number of Markov chain steps before sampling anything
 and interval is the number of MC steps between successive 
 networks in the sample.  Put all the sampled statistics into
 the networkstatistics array. 
*********************/
WtMCMCStatus WtCDSample(WtMHproposal *MHp,
			  double *theta, double *networkstatistics, 
			int samplesize, int *CDparams, Vertex *undotail, Vertex *undohead, double *undoweight, int fVerbose,
			  WtNetwork *nwp, WtModel *m, double *extraworkspace){
  /*********************
  networkstatistics are modified in groups of m->n_stats, and they
  reflect the CHANGE in the values of the statistics from the
  original (observed) network.  Thus, when we begin, the initial 
  values of the first group of m->n_stats networkstatistics should 
  all be zero
  *********************/
/*for (j=0; j < m->n_stats; j++) */
/*  networkstatistics[j] = 0.0; */
/* Rprintf("\n"); */
/* for (j=0; j < m->n_stats; j++){ */
/*   Rprintf("j %d %f\n",j,networkstatistics[j]); */
/* } */
/* Rprintf("\n"); */

  int staken=0;
  
  /* Now sample networks */
  unsigned int i=0, sattempted=0;
  while(i<samplesize){
    
    if(WtCDStep(MHp, theta, networkstatistics, CDparams, &staken, undotail, undohead, undoweight,
		fVerbose, nwp, m, extraworkspace)!=WtMCMC_OK)
      return WtMCMC_MH_FAILED;
    
#ifdef Win32
    if( ((100*i) % samplesize)==0 && samplesize > 500){
      R_FlushConsole();
      R_ProcessEvents();
    }
#endif
      networkstatistics += m->n_stats;
      i++;

    sattempted++;
  }

  if (fVerbose){
    Rprintf("Sampler accepted %7.3f%% of %d proposed steps.\n",
	    staken*100.0/(1.0*sattempted*CDparams[0]), sattempted*CDparams[0]); 
  }
  
  return WtMCMC_OK;
}

time_t interact(time_t itime)
{
#ifdef RPRINT
  time_t ntime = time(NULL);

  if(ntime - itime > 1) {
    R_FlushConsole();
    R_CheckUserInterrupt();
#if  (defined(HAVE_AQUA) || defined(Win32) || defined(Win64))
    R_ProcessEvents();
#endif
    itime = ntime;
  }
#endif
  return itime;
}

void rcall_process_events()
{
    if (!R_is_ready) return;

    R_is_ready = 0;

    // FIXME: a dirty fix to prevent segfault right after a sigint
    R_interrupts_pending = 0;

#ifdef __APPLE__
    R_ProcessEvents();
#endif

    fd_set* what = R_checkActivity(0,1);
    if (what != NULL) R_runHandlers(R_InputHandlers, what);

    R_is_ready = 1;
}

SEXP do_syssleep(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    DWORD mtime;
    int ntime;
    double time;

    checkArity(op, args);
    time = asReal(CAR(args));
    if (ISNAN(time) || time < 0)
	errorcall(call, _("invalid '%s' value"), "time");
    ntime = 1000*(time) + 0.5;
    while (ntime > 0) {
	mtime = min(500, ntime);
	ntime -= mtime;
	Sleep(mtime);
	R_ProcessEvents();
    }
    return R_NilValue;
}

SEXP menu_ttest3()
{
    char cmd[256];
    SEXP cmdSexp, cmdexpr, ans = R_NilValue;
    int i;
    ParseStatus status;

    done = 0;
    create_dialog();
    setaction(bCancel, cancel2);
    show(win);
    for(;;) {
        R_WaitEvent();
        R_ProcessEvents();
        if(done > 0) break;
    }
    if(done == 1) {
        sprintf(cmd, "t.test(x=%s, y=%s, alternative=\"%s\",\n      paired=%s, var.equal=%s, conf.level=%s)\n", v[0], v[1],
                alts[getlistitem(alt)],
                ischecked(paired) ? "TRUE" : "FALSE",
                ischecked(varequal) ? "TRUE" : "FALSE",
                GA_gettext(lvl));
    }
    hide(win);
    delobj(bApply);
    delobj(win);
    if(done == 1) {
        PROTECT(cmdSexp = allocVector(STRSXP, 1));
        SET_STRING_ELT(cmdSexp, 0, mkChar(cmd));
        cmdexpr = PROTECT(R_ParseVector(cmdSexp, -1, &status, R_NilValue));
        if (status != PARSE_OK) {
            UNPROTECT(2);
            error("invalid call %s", cmd);
        }
        /* Loop is needed here as EXPSEXP will be of length > 1 */
        for(i = 0; i < length(cmdexpr); i++)
            ans = eval(VECTOR_ELT(cmdexpr, i), R_GlobalEnv);
        UNPROTECT(2);
    }
    return ans;
}

/* just retrieve values from the dialog box and assemble call in
   interpreted code
*/
void menu_ttest(char **vars, int ints[], double level[])
{
    done = 0;
    create_dialog();
    setaction(bCancel, cancel);
    show(win);
    for(;;) {
    	R_WaitEvent();
	R_ProcessEvents();
	if(done > 0) break;
    }
    vars[0] = v[0]; vars[1] = v[1];
    ints[0] =  getlistitem(alt);
    ints[1] =  ischecked(paired);
    ints[2] =  ischecked(varequal);
    ints[3] = done;
    level[0] = R_atof(GA_gettext(lvl));
    hide(win);
    delobj(bApply);
    delobj(win);
}

/*********************
 void WtMCMCSample

 Using the parameters contained in the array theta, obtain the
 network statistics for a sample of size samplesize.  burnin is the
 initial number of Markov chain steps before sampling anything
 and interval is the number of MC steps between successive 
 networks in the sample.  Put all the sampled statistics into
 the networkstatistics array. 
*********************/
WtMCMCStatus WtCDSample(WtMHproposal *MHp,
			  double *theta, double *networkstatistics, 
			int samplesize, int nsteps, Vertex *undotail, Vertex *undohead, double *undoweight, int fVerbose,
			  WtNetwork *nwp, WtModel *m) {
  int i, j;
    
  /*********************
  networkstatistics are modified in groups of m->n_stats, and they
  reflect the CHANGE in the values of the statistics from the
  original (observed) network.  Thus, when we begin, the initial 
  values of the first group of m->n_stats networkstatistics should 
  all be zero
  *********************/
/*for (j=0; j < m->n_stats; j++) */
/*  networkstatistics[j] = 0.0; */
/* Rprintf("\n"); */
/* for (j=0; j < m->n_stats; j++){ */
/*   Rprintf("j %d %f\n",j,networkstatistics[j]); */
/* } */
/* Rprintf("\n"); */

  /* Now sample networks */
  for (i=0; i < samplesize; i++){
    
    if(WtCDStep(MHp, theta, networkstatistics, nsteps, undotail, undohead, undoweight,
		fVerbose, nwp, m)!=WtMCMC_OK)
      return WtMCMC_MH_FAILED;
    
#ifdef Win32
    if( ((100*i) % samplesize)==0 && samplesize > 500){
      R_FlushConsole();
      R_ProcessEvents();
    }
#endif
    networkstatistics += m->n_stats;
  }
  return WtMCMC_OK;
}

void
EmbeddedR_ProcessEvents()
{
  if (! RINTERF_HASARGSSET()) {
    printf("R should not process events before being initialized.");
    return;
  }
  if (RINTERF_ISBUSY()) {
    printf("Concurrent access to R is not allowed.");
    return;
  }
  // setlock
  RStatus = RStatus | RINTERF_ISBUSY();
#if defined(HAVE_AQUA) || (defined(Win32) || defined(Win64))
  /* Can the call to R_ProcessEvents somehow fail ? */
  R_ProcessEvents();
#endif
#if ! (defined(Win32) || defined(Win64))
  R_runHandlers(R_InputHandlers, R_checkActivity(0, 1));
#endif
  // freelock
  RStatus = RStatus ^ RINTERF_ISBUSY();
}