int main(int argc, char **argv)
{
char *progname = argv[0], *line, *newline();
int i, j, k, n_prob, got_opt();
double total_kinship();
vertex *top, *bot;
blankline = &whereblank;
line_no=0;
for (line=newline(); line && line != blankline; line = newline())
{
if (sscanf(line,"%d%d%d",&i,&j,&k) != 3)
{
error("\n %s(%d): cannot read triplet",progname,line_no);
}
if (i > 0) bot = find_vertex(i);
if (j > 0)
{
top = find_vertex(j);
if (!connected(bot,top)) make_edge(bot,top);
}
if (k > 0)
{
top = find_vertex(k);
if (!connected(bot,top)) make_edge(bot,top);
}
}
for ( ; line; line=newline())
{
while (line && line == blankline) line=newline();
for (no_probands(),n_prob=0 ; line && line != blankline; line=newline())
{
if (sscanf(line,"%d",&i) != 1)
{
error("\n %s(%d): cannot read integer",progname,line_no);
}
if (i > 0)
{
bot=find_vertex(i);
if (new_proband(bot)) n_prob +=1;
}
}
Rprintf("%9.3f",100000.0*total_kinship()/n_prob/(n_prob-1)*2.0);
Rprintf("\n\n");
R_FlushConsole();
}
R_ClearerrConsole();
return(0);
}
/* used by readline() and menu() */
static int ConsoleGetchar(void)
{
if (--ConsoleBufCnt < 0) {
ConsoleBuf[CONSOLE_BUFFER_SIZE] = '\0';
if (R_ReadConsole(ConsolePrompt, ConsoleBuf,
CONSOLE_BUFFER_SIZE, 0) == 0) {
R_ClearerrConsole();
return R_EOF;
}
ConsoleBufp = ConsoleBuf;
ConsoleBufCnt = (int) strlen((char *)ConsoleBuf);
ConsoleBufCnt--;
}
/* at this point we need to use unsigned char or similar */
return (int) *ConsoleBufp++;
}
void attribute_hidden Rstd_CleanUp(SA_TYPE saveact, int status, int runLast)
{
if(saveact == SA_DEFAULT) /* The normal case apart from R_Suicide */
saveact = SaveAction;
if(saveact == SA_SAVEASK) {
if(R_Interactive) {
unsigned char buf[1024];
qask:
R_ClearerrConsole();
R_FlushConsole();
int res = R_ReadConsole("Save workspace image? [y/n/c]: ",
buf, 128, 0);
if(res) {
switch (buf[0]) {
case 'y':
case 'Y':
saveact = SA_SAVE;
break;
case 'n':
case 'N':
saveact = SA_NOSAVE;
break;
case 'c':
case 'C':
jump_to_toplevel();
break;
default:
goto qask;
}
} else saveact = SA_NOSAVE; /* probably EOF */
} else
saveact = SaveAction;
}
switch (saveact) {
case SA_SAVE:
if(runLast) R_dot_Last();
if(R_DirtyImage) R_SaveGlobalEnv();
#ifdef HAVE_LIBREADLINE
# ifdef HAVE_READLINE_HISTORY_H
if(R_Interactive && UsingReadline) {
int err;
R_setupHistory(); /* re-read the history size and filename */
stifle_history(R_HistorySize);
err = write_history(R_HistoryFile);
if(err) warning(_("problem in saving the history file '%s'"),
R_HistoryFile);
}
# endif /* HAVE_READLINE_HISTORY_H */
#endif /* HAVE_LIBREADLINE */
break;
case SA_NOSAVE:
if(runLast) R_dot_Last();
break;
case SA_SUICIDE:
default:
break;
}
R_RunExitFinalizers();
CleanEd();
if(saveact != SA_SUICIDE) KillAllDevices();
R_CleanTempDir();
if(saveact != SA_SUICIDE && R_CollectWarnings)
PrintWarnings(); /* from device close and (if run) .Last */
if(ifp) fclose(ifp); /* input file from -f or --file= */
fpu_setup(FALSE);
exit(status);
}
static SEXP scanVector(SEXPTYPE type, int maxitems, int maxlines,
int flush, SEXP stripwhite, int blskip, LocalData *d)
{
SEXP ans, bns;
int blocksize, c, i, n, linesread, nprev,strip, bch;
char *buffer;
R_StringBuffer strBuf = {NULL, 0, MAXELTSIZE};
if (maxitems > 0) blocksize = maxitems;
else blocksize = SCAN_BLOCKSIZE;
R_AllocStringBuffer(0, &strBuf);
PROTECT(ans = allocVector(type, blocksize));
nprev = 0; n = 0; linesread = 0; bch = 1;
if (d->ttyflag) sprintf(ConsolePrompt, "1: ");
strip = asLogical(stripwhite);
for (;;) {
if(n % 10000 == 9999) R_CheckUserInterrupt();
if (bch == R_EOF) {
if (d->ttyflag) R_ClearerrConsole();
break;
}
else if (bch == '\n') {
linesread++;
if (linesread == maxlines)
break;
if (d->ttyflag) sprintf(ConsolePrompt, "%d: ", n + 1);
nprev = n;
}
if (n == blocksize) {
/* enlarge the vector*/
bns = ans;
if(blocksize > INT_MAX/2) error(_("too many items"));
blocksize = 2 * blocksize;
ans = allocVector(type, blocksize);
UNPROTECT(1);
PROTECT(ans);
copyVector(ans, bns);
}
buffer = fillBuffer(type, strip, &bch, d, &strBuf);
if (nprev == n && strlen(buffer)==0 &&
((blskip && bch =='\n') || bch == R_EOF)) {
if (d->ttyflag || bch == R_EOF)
break;
}
else {
extractItem(buffer, ans, n, d);
if (++n == maxitems) {
if (d->ttyflag && bch != '\n') { /* MBCS-safe */
while ((c = scanchar(FALSE, d)) != '\n')
;
}
break;
}
}
if (flush && (bch != '\n') && (bch != R_EOF)) { /* MBCS-safe */
while ((c = scanchar(FALSE, d)) != '\n' && (c != R_EOF));
bch = c;
}
}
if (!d->quiet) REprintf("Read %d item%s\n", n, (n == 1) ? "" : "s");
if (d->ttyflag) ConsolePrompt[0] = '\0';
if (n == 0) {
UNPROTECT(1);
R_FreeStringBuffer(&strBuf);
return allocVector(type,0);
}
if (n == maxitems) {
UNPROTECT(1);
R_FreeStringBuffer(&strBuf);
return ans;
}
bns = allocVector(type, n);
switch (type) {
case LGLSXP:
case INTSXP:
for (i = 0; i < n; i++)
INTEGER(bns)[i] = INTEGER(ans)[i];
break;
case REALSXP:
for (i = 0; i < n; i++)
REAL(bns)[i] = REAL(ans)[i];
break;
case CPLXSXP:
for (i = 0; i < n; i++)
COMPLEX(bns)[i] = COMPLEX(ans)[i];
break;
case STRSXP:
for (i = 0; i < n; i++)
SET_STRING_ELT(bns, i, STRING_ELT(ans, i));
break;
case RAWSXP:
for (i = 0; i < n; i++)
RAW(bns)[i] = RAW(ans)[i];
break;
default:
UNIMPLEMENTED_TYPEt("scanVector", type);
}
UNPROTECT(1);
R_FreeStringBuffer(&strBuf);
return bns;
}
