source: trunk/lang/R/Rappture/src/RpLibraryRInterface.cc @ 2709

Last change on this file since 2709 was 2709, checked in by dkearney, 11 years ago

adding R bindings with app-fermi example.
File size: 16.5 KB
Line 
1/*
2 * ----------------------------------------------------------------------
3 *  INTERFACE: R Rappture Library Source
4 *
5 * ======================================================================
6 *  AUTHOR:  Derrick Kearney, Purdue University
7 *  Copyright (c) 2005-2011  Purdue Research Foundation
8 *
9 *  See the file "license.terms" for information on usage and
10 *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 * ======================================================================
12 */
13
14#include "RpLibrary.h"
15#include "RpBindingsDict.h"
16
17#include "RpLibraryRInterface.h"
18
19#ifdef __cplusplus
20extern "C" {
21#endif
22
23static void
24rp_lib_finalizer(SEXP ptr)
25{
26    RpLibrary* lib = NULL;
27    if (!R_ExternalPtrAddr(ptr)) {
28        return;
29    }
30    lib = (RpLibrary *) R_ExternalPtrAddr(ptr);
31    if (lib != NULL) {
32        delete lib;
33        lib = NULL;
34    }
35    R_ClearExternalPtr(ptr);
36
37}
38
39
40
41/**********************************************************************/
42// FUNCTION: rp_lib(const char* filePath, int handle)
43/// Open the file at 'filePath' and return Rappture Library Object.
44/**
45 */
46
47SEXP
48RPRLib(SEXP fname)
49{
50    RpLibrary* lib = NULL;
51    int handle = -1;
52    SEXP ans, ptr;
53
54    ans = allocVector(INTSXP,1);
55    PROTECT(ans);
56    INTEGER(ans)[0] = -1;
57
58    if (!isString(fname) || length(fname) != 1) {
59        error("fname is not a single string");
60        UNPROTECT(1);
61        return ans;
62    }
63
64    // create a RapptureIO object and store in dictionary
65    lib = new RpLibrary(CHAR(STRING_ELT(fname, 0)));
66    if (lib == NULL) {
67        error("could not allocate new RpLibrary object");
68        UNPROTECT(1);
69        return ans;
70    }
71
72    ptr = R_MakeExternalPtr((void *)lib,install("RapptureLib"),R_NilValue);
73    PROTECT(ptr);
74    R_RegisterCFinalizerEx(ptr, rp_lib_finalizer, TRUE);
75
76    handle = storeObject_Void((void*)lib);
77
78    INTEGER(ans)[0] = handle;
79    UNPROTECT(2);
80
81    return(ans);
82}
83
84/**********************************************************************/
85// FUNCTION: RPRLibGetString()
86/// Get data located at 'path' and return it as a string value.
87/**
88 */
89SEXP
90RPRLibGetString(
91    SEXP handle,            // integer handle of library
92    SEXP path)              // null terminated path
93{
94    RpLibrary* lib = NULL;
95    SEXP ans;
96    int handleVal = -1;
97    std::string data;
98
99    ans = allocVector(STRSXP,1);
100    PROTECT(ans);
101
102    SET_STRING_ELT(ans,0,mkChar(""));
103
104    if (!isInteger(handle) || length(handle) != 1) {
105        error("handle is not an integer");
106        UNPROTECT(1);
107        return ans;
108    }
109
110    if (!isString(path) || length(path) != 1) {
111        error("path is not a string");
112        UNPROTECT(1);
113        return ans;
114    }
115
116    handleVal = asInteger(handle);
117
118    if (handleVal == 0) {
119        error("invalid handle");
120        UNPROTECT(1);
121        return ans;
122    }
123
124    lib = (RpLibrary*) getObject_Void(handleVal);
125
126    if (lib == NULL) {
127        error("invalid Rappture Library Object");
128        UNPROTECT(1);
129        return ans;
130    }
131
132    data = lib->getString(CHAR(STRING_ELT(path, 0)));
133
134    SET_STRING_ELT(ans, 0, mkChar(data.c_str()));
135
136    UNPROTECT(1);
137
138    return ans;
139}
140
141
142/**********************************************************************/
143// FUNCTION: RPRLibGetDouble()
144/// Get data located at 'path' and return it as a double precision value.
145/**
146 */
147SEXP
148RPRLibGetDouble(
149    SEXP handle,            // integer handle of library
150    SEXP path)              // null terminated path
151{
152    RpLibrary* lib = NULL;
153    SEXP ans;
154    int handleVal = -1;
155    double data;
156
157    ans = allocVector(REALSXP,1);
158    PROTECT(ans);
159
160    REAL(ans)[0] = 0.0;
161
162    if (!isInteger(handle) || length(handle) != 1) {
163        error("handle is not a single integer");
164        UNPROTECT(1);
165        return ans;
166    }
167
168    if (!isString(path) || length(path) != 1) {
169        error("path is not a string");
170        UNPROTECT(1);
171        return ans;
172    }
173
174    handleVal = asInteger(handle);
175
176    if (handleVal == 0) {
177        error("invalid handle");
178        UNPROTECT(1);
179        return ans;
180    }
181
182    lib = (RpLibrary*) getObject_Void(handleVal);
183
184    if (lib == NULL) {
185        error("invalid Rappture Library Object");
186        UNPROTECT(1);
187        return ans;
188    }
189
190    data = lib->getDouble(CHAR(STRING_ELT(path, 0)));
191
192    REAL(ans)[0] = data;
193
194    UNPROTECT(1);
195
196    return ans;
197}
198
199
200/**********************************************************************/
201// FUNCTION: RPRLibInteger()
202/// Get data located at 'path' and return it as an integer value.
203/**
204 */
205SEXP
206RPRLibGetInteger(
207    SEXP handle,            // integer handle of library
208    SEXP path)              // null terminated path
209{
210    RpLibrary* lib = NULL;
211    SEXP ans;
212    int handleVal = -1;
213    int data;
214
215    ans = allocVector(INTSXP,1);
216    PROTECT(ans);
217
218    INTEGER(ans)[0] = 0;
219
220    if (!isInteger(handle) || length(handle) != 1) {
221        error("handle is not a single integer");
222        UNPROTECT(1);
223        return ans;
224    }
225
226    if (!isString(path) || length(path) != 1) {
227        error("path is not a string");
228        UNPROTECT(1);
229        return ans;
230    }
231
232    handleVal = asInteger(handle);
233
234    if (handleVal == 0) {
235        error("invalid handle");
236        UNPROTECT(1);
237        return ans;
238    }
239
240    lib = (RpLibrary*) getObject_Void(handleVal);
241
242    if (lib == NULL) {
243        error("invalid Rappture Library Object");
244        UNPROTECT(1);
245        return ans;
246    }
247
248    data = lib->getInt(CHAR(STRING_ELT(path, 0)));
249
250    INTEGER(ans)[0] = data;
251
252    UNPROTECT(1);
253
254    return ans;
255}
256
257
258/**********************************************************************/
259// FUNCTION: RPRLibGetBoolean()
260/// Get data located at 'path' and return it as an integer value.
261/**
262 */
263SEXP
264RPRLibGetBoolean(
265    SEXP handle,            // integer handle of library
266    SEXP path)              // null terminated path
267{
268    RpLibrary* lib = NULL;
269    SEXP ans;
270    int handleVal = -1;
271    bool data;
272
273    ans = allocVector(LGLSXP,1);
274    PROTECT(ans);
275
276    LOGICAL(ans)[0] = false;
277
278    if (!isInteger(handle) || length(handle) != 1) {
279        error("handle is not a single integer");
280        UNPROTECT(1);
281        return ans;
282    }
283
284    if (!isString(path) || length(path) != 1) {
285        error("path is not a string");
286        UNPROTECT(1);
287        return ans;
288    }
289
290    handleVal = asInteger(handle);
291
292    if (handleVal == 0) {
293        error("invalid handle");
294        UNPROTECT(1);
295        return ans;
296    }
297
298    lib = (RpLibrary*) getObject_Void(handleVal);
299
300    if (lib == NULL) {
301        error("invalid Rappture Library Object");
302        UNPROTECT(1);
303        return ans;
304    }
305
306    data = lib->getBool(CHAR(STRING_ELT(path, 0)));
307
308    LOGICAL(ans)[0] = data;
309
310    UNPROTECT(1);
311
312    return ans;
313}
314
315
316/**********************************************************************/
317// FUNCTION: RPRLibGetFile()
318/// Get data located at 'path' and write it to the file 'fileName'.
319/**
320 * Returns if any bytes were written to the file
321 */
322SEXP
323RPRLibGetFile (
324    SEXP handle,            // integer handle of library
325    SEXP path,              // null terminated path
326    SEXP fileName)          // name of file to write data to
327{
328    RpLibrary* lib = NULL;
329    SEXP ans;
330    int handleVal = -1;
331    int nbytes = 0;
332
333    ans = allocVector(INTSXP,1);
334    PROTECT(ans);
335
336    INTEGER(ans)[0] = -1;
337
338    if (!isInteger(handle) || length(handle) != 1) {
339        error("handle is not a single integer");
340        UNPROTECT(1);
341        return ans;
342    }
343
344    if (!isString(path) || length(path) != 1) {
345        error("path is not a string");
346        UNPROTECT(1);
347        return ans;
348    }
349
350    if (!isString(fileName) || length(fileName) != 1) {
351        error("fileName is not a string");
352        UNPROTECT(1);
353        return ans;
354    }
355
356    handleVal = asInteger(handle);
357
358    if (handleVal == 0) {
359        error("invalid handle");
360        UNPROTECT(1);
361        return ans;
362    }
363
364    lib = (RpLibrary*) getObject_Void(handleVal);
365
366    if (lib == NULL) {
367        error("invalid Rappture Library Object");
368        UNPROTECT(1);
369        return ans;
370    }
371
372    nbytes = lib->getFile(  CHAR(STRING_ELT(path, 0)),
373                            CHAR(STRING_ELT(fileName, 0)));
374
375    INTEGER(ans)[0] = nbytes;
376
377    UNPROTECT(1);
378
379    return ans;
380}
381
382
383
384/**********************************************************************/
385// FUNCTION: RPRLibPutString()
386/// Put string into Rappture Library Object at location 'path'.
387/**
388 */
389SEXP
390RPRLibPutString(
391    SEXP handle,
392    SEXP path,
393    SEXP value,
394    SEXP append)
395{
396    RpLibrary* lib = NULL;
397    SEXP ans;
398    int handleVal = -1;
399    int nbytes = 0;
400    unsigned int appendVal;
401
402    ans = allocVector(INTSXP,1);
403    PROTECT(ans);
404
405    INTEGER(ans)[0] = -1;
406
407    if (!isInteger(handle) || length(handle) != 1) {
408        error("handle is not an integer");
409        UNPROTECT(1);
410        return ans;
411    }
412
413    if (!isString(path) || length(path) != 1) {
414        error("path is not a string");
415        UNPROTECT(1);
416        return ans;
417    }
418
419    if (!isString(value) || length(value) != 1) {
420        error("value is not a string");
421        UNPROTECT(1);
422        return ans;
423    }
424
425    if (!isLogical(append) || length(append) != 1) {
426        error("append is not a logical");
427        UNPROTECT(1);
428        return ans;
429    }
430
431    handleVal = asInteger(handle);
432
433    if (handleVal == 0) {
434        error("invalid handle");
435        UNPROTECT(1);
436        return ans;
437    }
438
439    lib = (RpLibrary*) getObject_Void(handleVal);
440
441    if (lib == NULL) {
442        error("invalid Rappture Library Object");
443        UNPROTECT(1);
444        return ans;
445    }
446
447    appendVal = asLogical(append);
448    if (appendVal == 1) {
449        appendVal = RPLIB_APPEND;
450    } else if (appendVal == 0) {
451        appendVal = RPLIB_OVERWRITE;
452    } else {
453        // NA_LOGICAL was returned?
454        error("invalid append value");
455        UNPROTECT(1);
456        return ans;
457    }
458
459    lib->put(CHAR(STRING_ELT(path, 0)),
460             CHAR(STRING_ELT(value, 0)),
461             "",
462             appendVal,
463             RPLIB_TRANSLATE);
464
465
466    INTEGER(ans)[0] = 1;
467
468    UNPROTECT(1);
469
470    return ans;
471}
472
473
474/**********************************************************************/
475// FUNCTION: RPRLibPutData()
476/// Put string into Rappture Library Object at location 'path'.
477/**
478 */
479/*
480SEXP
481RPRLibPutData(
482    SEXP handle,
483    SEXP path,
484    SEXP bytes,
485    SEXP nbytes,
486    SEXP append)
487{
488    RpLibrary* lib = NULL;
489    SEXP ans;
490    int handleVal = -1;
491    int nbytes = 0;
492    unsigned int appendVal;
493
494    ans = allocVector(INTSXP,1);
495    PROTECT(ans);
496
497    INTEGER(ans)[0] = -1;
498
499    if (!isInteger(handle) || length(handle) != 1) {
500        error("handle is not an integer");
501        UNPROTECT(1);
502        return ans;
503    }
504
505    if (!isString(path) || length(path) != 1) {
506        error("path is not a string");
507        UNPROTECT(1);
508        return ans;
509    }
510
511    if (!isString(bytes) || length(bytes) != 1) {
512        error("bytes is not a string");
513        UNPROTECT(1);
514        return ans;
515    }
516
517    if (!isInteger(nbytes) || length(nbytes) != 1) {
518        error("nbytes is not an integer");
519        UNPROTECT(1);
520        return ans;
521    }
522
523    if (!isLogical(append) || length(append) != 1) {
524        error("append is not a logical");
525        UNPROTECT(1);
526        return ans;
527    }
528
529    handleVal = asInteger(handle);
530
531    if (handleVal == 0) {
532        error("invalid handle");
533        UNPROTECT(1);
534        return ans;
535    }
536
537    lib = (RpLibrary*) getObject_Void(handleVal);
538
539    if (lib == NULL) {
540        error("invalid Rappture Library Object");
541        UNPROTECT(1);
542        return ans;
543    }
544
545    if (asLogical(append)) {
546        appendVal = RPLIB_APPEND;
547    } else {
548        appendVal = RPLIB_OVERWRITE;
549    }
550
551    lib->putData(CHAR(STRING_ELT(path, 0)),
552                 CHAR(STRING_ELT(value, 0)),
553                 INTEGER(nbytes),
554                 appendVal);
555
556    INTEGER(ans)[0] = 1;
557
558    UNPROTECT(1);
559
560    return ans;
561}
562*/
563
564/**********************************************************************/
565// FUNCTION: RPRLibPutDouble()
566/// Put double value into Rappture Library Object at location 'path'.
567/**
568 */
569SEXP
570RPRLibPutDouble(
571    SEXP handle,
572    SEXP path,
573    SEXP value,
574    SEXP append)
575{
576    RpLibrary* lib = NULL;
577    SEXP ans;
578    int handleVal = -1;
579    int nbytes = 0;
580    unsigned int appendVal;
581
582    ans = allocVector(INTSXP,1);
583    PROTECT(ans);
584
585    INTEGER(ans)[0] = -1;
586
587    if (!isInteger(handle) || length(handle) != 1) {
588        error("handle is not an integer");
589        UNPROTECT(1);
590        return ans;
591    }
592
593    if (!isString(path) || length(path) != 1) {
594        error("path is not a string");
595        UNPROTECT(1);
596        return ans;
597    }
598
599    if (!isReal(value) || length(value) != 1) {
600        error("value is not a real");
601        UNPROTECT(1);
602        return ans;
603    }
604
605    if (!isLogical(append) || length(append) != 1) {
606        error("append is not a logical");
607        UNPROTECT(1);
608        return ans;
609    }
610
611    handleVal = asInteger(handle);
612
613    if (handleVal == 0) {
614        error("invalid handle");
615        UNPROTECT(1);
616        return ans;
617    }
618
619    lib = (RpLibrary*) getObject_Void(handleVal);
620
621    if (lib == NULL) {
622        error("invalid Rappture Library Object");
623        UNPROTECT(1);
624        return ans;
625    }
626
627    appendVal = asLogical(append);
628    if (appendVal == 1) {
629        appendVal = RPLIB_APPEND;
630    } else if (appendVal == 0) {
631        appendVal = RPLIB_OVERWRITE;
632    } else {
633        // NA_LOGICAL was returned?
634        error("invalid append value");
635        UNPROTECT(1);
636        return ans;
637    }
638
639    lib->put(CHAR(STRING_ELT(path, 0)),
640             asReal(value),
641             "",
642             appendVal);
643
644    INTEGER(ans)[0] = 1;
645
646    UNPROTECT(1);
647
648    return ans;
649}
650
651
652/**********************************************************************/
653// FUNCTION: RPRLibPutFile()
654/// Put double value into Rappture Library Object at location 'path'.
655/**
656 */
657SEXP
658RPRLibPutFile(
659    SEXP handle,
660    SEXP path,
661    SEXP fname,
662    SEXP compress,
663    SEXP append)
664{
665    RpLibrary* lib = NULL;
666    SEXP ans;
667    int handleVal = -1;
668    unsigned int appendVal;
669    unsigned int compressVal;
670
671    ans = allocVector(INTSXP,1);
672    PROTECT(ans);
673
674    INTEGER(ans)[0] = -1;
675
676    if (!isInteger(handle) || length(handle) != 1) {
677        error("handle is not an integer");
678        UNPROTECT(1);
679        return ans;
680    }
681
682    if (!isString(path) || length(path) != 1) {
683        error("path is not a string");
684        UNPROTECT(1);
685        return ans;
686    }
687
688    if (!isString(fname) || length(fname) != 1) {
689        error("fileName is not a string");
690        UNPROTECT(1);
691        return ans;
692    }
693
694    if (!isLogical(compress) || length(compress) != 1) {
695        error("compress is not a logical");
696        UNPROTECT(1);
697        return ans;
698    }
699
700    if (!isLogical(append) || length(append) != 1) {
701        error("append is not a logical");
702        UNPROTECT(1);
703        return ans;
704    }
705
706    handleVal = asInteger(handle);
707
708    if (handleVal == 0) {
709        error("invalid handle");
710        UNPROTECT(1);
711        return ans;
712    }
713
714    lib = (RpLibrary*) getObject_Void(handleVal);
715
716    if (lib == NULL) {
717        error("invalid Rappture Library Object");
718        UNPROTECT(1);
719        return ans;
720    }
721
722    compressVal = asLogical(compress);
723    if (compressVal == 1) {
724        compressVal = RPLIB_COMPRESS;
725    } else {
726        compressVal = RPLIB_NO_COMPRESS;
727    }
728
729    appendVal = asLogical(append);
730    if (appendVal == 1) {
731        appendVal = RPLIB_APPEND;
732    } else {
733        appendVal = RPLIB_OVERWRITE;
734    }
735
736    lib->putFile(CHAR(STRING_ELT(path, 0)),
737                 CHAR(STRING_ELT(fname,0)),
738                 compressVal,
739                 appendVal);
740
741    INTEGER(ans)[0] = 1;
742
743    UNPROTECT(1);
744
745    return ans;
746}
747
748/**********************************************************************/
749// FUNCTION: rp_result()
750/// Write xml text to a run.xml file and signal the program has completed
751/**
752 */
753SEXP
754RPRLibResult(
755    SEXP handle)
756{
757    RpLibrary* lib = NULL;
758    SEXP ans;
759    int handleVal = -1;
760
761    ans = allocVector(INTSXP,1);
762    PROTECT(ans);
763
764    INTEGER(ans)[0] = -1;
765
766    if (!isInteger(handle) || length(handle) != 1) {
767        error("handle is not an integer");
768        UNPROTECT(1);
769        return ans;
770    }
771
772    handleVal = asInteger(handle);
773
774    if (handleVal == 0) {
775        error("invalid handle");
776        UNPROTECT(1);
777        return ans;
778    }
779
780    lib = (RpLibrary*) getObject_Void(handleVal);
781
782    if (lib == NULL) {
783        error("invalid Rappture Library Object");
784        UNPROTECT(1);
785        return ans;
786    }
787
788    lib->put("tool.version.rappture.language", "R");
789    lib->result();
790
791    INTEGER(ans)[0] = 1;
792
793    UNPROTECT(1);
794
795    return ans;
796}
797
798#ifdef __cplusplus
799}
800#endif // ifdef __cplusplus
801
Note: See TracBrowser for help on using the repository browser.