|
0
|
1 /** ===========================================================================
|
|
|
2 ** R-Package: rdyncall
|
|
|
3 ** File: src/rutils_float.c
|
|
|
4 ** Description: Utility functions for handling C float data types.
|
|
|
5 **/
|
|
|
6
|
|
|
7 #define USE_RINTERNALS
|
|
|
8 #include <Rdefines.h>
|
|
|
9 #include <Rinternals.h>
|
|
|
10 #include <R_ext/RS.h>
|
|
|
11
|
|
|
12 /* Float utils */
|
|
|
13
|
|
|
14 SEXP r_as_floatraw(SEXP x)
|
|
|
15 {
|
|
|
16 SEXP ans;
|
|
|
17 int i, n;
|
|
|
18 double *dp;
|
|
|
19 float *fp;
|
|
|
20
|
|
|
21 dp = (double*) REAL(x);
|
|
|
22
|
|
|
23 n = LENGTH(x);
|
|
|
24 if (n < 1) {
|
|
|
25 error("length of x should be >= 1");
|
|
|
26 return R_NilValue;
|
|
|
27 }
|
|
|
28
|
|
|
29 ans = PROTECT( Rf_allocVector(RAWSXP, sizeof(float)*n) );
|
|
|
30
|
|
|
31 fp = (float*) RAW(ans);
|
|
|
32
|
|
|
33 for(i = 0 ; i < n ; ++i )
|
|
|
34 fp[i] = (float) dp[i];
|
|
|
35
|
|
|
36 UNPROTECT(1);
|
|
|
37 return ans;
|
|
|
38 }
|
|
|
39
|
|
|
40 SEXP r_floatraw2numeric(SEXP x)
|
|
|
41 {
|
|
|
42 SEXP ans;
|
|
|
43 int i, n;
|
|
|
44 float *fp;
|
|
|
45 double *dp;
|
|
|
46
|
|
|
47 fp = (float*) RAW(x);
|
|
|
48
|
|
|
49 n = LENGTH(x) / sizeof(float);
|
|
|
50 ans = PROTECT( Rf_allocVector(REALSXP, n) );
|
|
|
51
|
|
|
52 dp = (double*) REAL(ans);
|
|
|
53
|
|
|
54 for(i = 0 ; i < n ; ++i )
|
|
|
55 dp[i] = (double) fp[i];
|
|
|
56
|
|
|
57 UNPROTECT(1);
|
|
|
58 return ans;
|
|
|
59
|
|
|
60 }
|
|
|
61
|
