/*
* Starts the R interpreter.
*/
VALUE rr_init(VALUE self){
init_R(0,NULL);
// Initialize the list of protected objects
R_References = R_NilValue;
SET_SYMVALUE(install("R.References"), R_References);
return self;
}
/*
* Starts the R interpreter.
*/
VALUE rr_init(VALUE self, VALUE r_argv){
char **argv;
int i, argc = 1;
VALUE arg;
switch (TYPE(r_argv)) {
case T_ARRAY:
argv = (char **)calloc(RARRAY_LEN(r_argv) + 1, sizeof(char *));
if (argv == NULL) rb_raise(rb_eTypeError, "rr_init could not allocate memory");
for (i = 0; i < RARRAY_LEN(r_argv); i++) {
arg = rb_ary_entry(r_argv, i);
if (TYPE(arg) == T_STRING) {
argv[i+1] = (char *)malloc((RSTRING_LEN(arg) + 1) * sizeof(char));
strcpy(argv[i+1], StringValueCStr(arg));
}
else rb_raise(rb_eTypeError, "rr_init array input must contain only strings");
}
argc += RARRAY_LEN(r_argv);
break;
default:
rb_raise(rb_eTypeError, "rr_init must receive an array of strings or NULL");
break;
}
argv[0] = (char *)malloc((strlen("rsruby") + 1) * sizeof(char));
if (argv[0] == NULL) rb_raise(rb_eTypeError, "rr_init could not allocate memory");
strcpy(argv[0], "rsruby");
init_R(argc, argv);
// Initialize the list of protected objects
R_References = R_NilValue;
SET_SYMVALUE(install("R.References"), R_References);
for (i = 0; i < argc; i++)
free(argv[i]);
free(argv);
return self;
}
int
eval_R_command(const char *funcName, int argc, char *argv[])
{
SEXP e;
SEXP arg;
int i;
int errorOccurred;
init_R(argc, argv);
PROTECT(arg = allocVector(INTSXP, 10));
for(i = 0; i < LENGTH(arg); i++) INTEGER(arg)[i] = i + 1;
PROTECT(e = lang2(install(funcName), arg));
/* Evaluate the call to the R function.
Ignore the return value.
*/
R_tryEval(e, R_GlobalEnv, &errorOccurred);
Rf_endEmbeddedR(0);
UNPROTECT(2);
return(0);
}
int main (int argc,char *argv[])
{/* Main */
double *f=NULL;
int i;
char *pp=NULL;
FILE *fout=NULL;
SEXP e, e1, rv, rs;
init_R(argc, argv);
/* Calling R and asking it to call compiled C routines! */
{
int deuce=-999;
DllInfo *info;
R_CallMethodDef callMethods[] = {
{"callback", (DL_FUNC) &callback, 1},
{NULL, NULL, 0}
};
info = R_getEmbeddingDllInfo();
R_registerRoutines(info, NULL, callMethods, NULL, NULL);
/* .Call is the R function used to call compiled
code that uses internal R objects */
PROTECT(e1=lang3( install(".Call"),
mkString("callback"),ScalarInteger(100)));
/* evaluate the R command in the global environment*/
PROTECT(e=eval(e1,R_GlobalEnv));
/* show the value */
printf("Answer returned by R:"); Rf_PrintValue(e);
/* store the value in a local variable */
deuce = INTEGER(e)[0];
printf("Got %d back from result SEXP\n\n", deuce);
UNPROTECT(2); /* allow for R's garbage collection */
}
/* Calling R and asking it to do computation on a C array */
f = (double *)malloc(sizeof(double)*256);
for (i=0; i<256;++i) f[i]=(double)rand()/(double)RAND_MAX+i/64;
/*Now copy array into R structs */
PROTECT(rv=allocVector(REALSXP, 256));
defineVar(install("f"), rv, R_GlobalEnv); /* put rv in R's environment and
name it "f" */
for (i=0; i<256;++i) REAL(rv)[i] = f[i]; /* fill rv with values */
/* plot that array with R's: plot(f) */
PROTECT(e = lang1(install("x11")));
eval(e, R_GlobalEnv);
UNPROTECT(1);
PROTECT(e=lang2(install("plot"),install("f")));
eval(e, R_GlobalEnv);
UNPROTECT(1);
/* calculate the log of the values with log(f) */
PROTECT(e1=lang2(install("log"),install("f")));
PROTECT(e=eval(e1,R_GlobalEnv));
for (i=0; i<256;++i) {
if (i<5 || i>250) {
printf("%d: log(%f)=%f\n", i, f[i], REAL(e)[i]);
} else if (!(i%20)) {
printf("...");
}
}
UNPROTECT(2);
/* Now run some R script with source(".../ExamineXmat.R") */
if (!(pp = Add_plausible_path("ExamineXmat.R"))) {
fprintf(stderr,"Failed to find ExamineXmat.R\n");
exit(1);
}
PROTECT(rs=mkString(pp));
defineVar(install("sss"), rs, R_GlobalEnv);
fprintf(stderr,"checking on script name: %s\n", STRING_VALUE(rs));
PROTECT(e=lang2(install("source"),install("sss")));
eval(e, R_GlobalEnv);
UNPROTECT(2);
fprintf(stderr,"Hit enter to proceed\n");
free(pp); pp=NULL;
/* Here is should test calling R functions from some functions
that we create. I will need to sort out how packges are formed
for R and how R can find them on any machine etc. Nuts and bolts...
A simple exercise here would be to learn how to construct our R library
and call its functions from here ... */
free(f); f = NULL; free(pp); pp=NULL;
getchar();
}
static int init_r(void)
{
init_R();
return 1;
}
void doBadThings(logread_args* args) {
sortLinkedList_Names(peopleHead);
int32_t currRoom;
uint32_t isFirst = 1;
if (args->currentState) {
if (args->inHTML) {
whyIsTheHTMLFormatDifferent_S(args);
return;
}
Node* temp = peopleHead;
while (temp) {
person* tempP = (person *) (temp->data);
if (tempP->isEmployee && tempP->inBuilding) {
if (!isFirst)
printf(",");
isFirst = 0;
printf("%s", tempP->name);
}
temp = temp->next;
}
isFirst = 1;
temp = peopleHead;
printf("\n");
while (temp) {
person* tempP = (person *) (temp->data);
if (!tempP->isEmployee && tempP->inBuilding) {
if (!isFirst)
printf(",");
isFirst = 0;
printf("%s", tempP->name);
}
temp = temp->next;
}
printf("\n");
for (currRoom = 0; currRoom <= highestRoomNum; currRoom++) {
isFirst = 1;
Node* temp = peopleHead;
while (temp) {
person* tempP = (person *) (temp->data);
if (tempP->roomID == currRoom && tempP->inBuilding) {
if (isFirst)
printf("%d: ", currRoom);
if (!isFirst)
printf(",");
isFirst = 0;
printf("%s", tempP->name);
}
temp = temp->next;
}
if (!isFirst)
printf("\n");
}
} else if (args->listAllRooms_R) {
person* blahzz;
if (args->employeeName != NULL) {
blahzz = ht_get(allMahHashes_employees, args->employeeName);
} else {
blahzz = ht_get(allMahHashes_guests, args->guestName);
}
Node* temp = blahzz == NULL ? NULL : blahzz->rooms;
if (temp)
reverse(&temp);
uint32_t isFirst = 1;
if (args->inHTML)
printHeader();
while (temp) {
int32_t* num = (int32_t*) (temp->data);
if (args->inHTML) {
if (isFirst)
init_R();
print_R_element(num);
} else {
if (!isFirst)
printf(",");
printf("%d", *num);
}
isFirst = 0;
temp = temp->next;
}
if (args->inHTML)
printFooter();
} else if (args->totalTime) {
if (args->inHTML)
invalid_check(args);
person* blahzz;
if (args->employeeName != NULL) {
blahzz = ht_get(allMahHashes_employees, args->employeeName);
} else {
blahzz = ht_get(allMahHashes_guests, args->guestName);
}
int32_t timespent;
if (blahzz != NULL && blahzz->leaveTime == -1) {
timespent = lastTime - blahzz->enterTime;
} else {
timespent = blahzz->leaveTime - blahzz->enterTime;
}
if (blahzz != NULL)
printf("%d", timespent);
} else if (args->listEmployeesWithTime
&& args->bounds->upper > args->bounds->lower) {
Node* temp = peopleHead;
if (args->inHTML) {
printHeader();
printf("<tr>\n<th>Employees</th>\n</tr>\n");
}
while (temp) {
person* tempP = (person *) (temp->data);
if (tempP->isEmployee
&& (tempP->enterTime <= args->bounds->upper
&& (tempP->leaveTime >= args->bounds->lower
|| tempP->leaveTime == -1))) {
if (!isFirst && !args->inHTML) {
printf(",");
}
isFirst = 0;
if (!args->inHTML) {
printf("%s", tempP->name);
} else {
print_AB_element(tempP->name);
}
}
temp = temp->next;
}
if (args->inHTML)
printFooter();
} else if (args->listEmployeesWithoutTime
&& args->bounds->upper > args->bounds->lower
&& args->bounds->upper1 > args->bounds->lower1) {
Node* temp = peopleHead;
if (args->inHTML) {
printHeader();
printf("<tr>\n<th>Employees</th>\n</tr>\n");
}
while (temp) {
person* tempP = (person *) (temp->data);
if (tempP->isEmployee
&& (tempP->enterTime <= args->bounds->upper
&& (tempP->leaveTime >= args->bounds->lower
|| tempP->leaveTime == -1))
&& ((tempP->enterTime > args->bounds->upper1
&& tempP->leaveTime > args->bounds->upper1)
|| (tempP->leaveTime < args->bounds->lower1
&& tempP->enterTime < args->bounds->lower1))) {
if (!isFirst && !args->inHTML) {
printf(",");
}
isFirst = 0;
if (!args->inHTML) {
printf("%s", tempP->name);
} else {
print_AB_element(tempP->name);
}
}
temp = temp->next;
}
if (args->inHTML)
printFooter();
} else if (args->printSpecificRooms_I) {
Node * temp = args->peoples_I;
Node * roomList = NULL;
Node * oldList = NULL;
while (temp) {
person * tempPerson = (person *) temp->data;
person* currPerson =
tempPerson->isEmployee ?
ht_get(allMahHashes_employees, tempPerson->name) :
ht_get(allMahHashes_guests, tempPerson->name);
if (currPerson) {
if (isFirst) {
roomList = currPerson->rooms;
sortLinkedList_Nums(roomList);
} else {
oldList = roomList;
roomList = NULL;
while (oldList && currPerson->rooms) {
int32_t * tempAA = oldList->data;
int32_t * tempBB = currPerson->rooms->data;
if (*tempAA == *tempBB) {
int32_t * tempNum = calloc(1, sizeof(int32_t));
*tempNum = *tempAA;
stack_push(&roomList, tempNum);
oldList = oldList->next;
currPerson->rooms = currPerson->rooms->next;
} else if (*tempAA < *tempBB) {
oldList = oldList->next;
} else {
currPerson->rooms = currPerson->rooms->next;
}
}
}
}
temp = temp->next;
}
isFirst = 1;
if (args->inHTML) {
printHeader();
printf("<tr>\n<th>Rooms</th>\n</tr>\n");
}
while (roomList) {
if (!isFirst && !args->inHTML)
printf(",");
int32_t * tempNum = roomList->data;
if (!args->inHTML) {
printf("%d", *tempNum);
} else {
print_I_element(tempNum);
}
isFirst = 0;
roomList = roomList->next;
}
if (args->inHTML)
printFooter();
}
fflush(stdout);
}