Mercurial > pub > dyncall > bindings
diff R/rdyncall/src/rutils_float.c @ 0:0cfcc391201f
initial from svn dyncall-1745
author | Daniel Adler |
---|---|
date | Thu, 19 Mar 2015 22:26:28 +0100 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/R/rdyncall/src/rutils_float.c Thu Mar 19 22:26:28 2015 +0100 @@ -0,0 +1,61 @@ +/** =========================================================================== + ** R-Package: rdyncall + ** File: src/rutils_float.c + ** Description: Utility functions for handling C float data types. + **/ + +#define USE_RINTERNALS +#include <Rdefines.h> +#include <Rinternals.h> +#include <R_ext/RS.h> + +/* Float utils */ + +SEXP r_as_floatraw(SEXP x) +{ + SEXP ans; + int i, n; + double *dp; + float *fp; + + dp = (double*) REAL(x); + + n = LENGTH(x); + if (n < 1) { + error("length of x should be >= 1"); + return R_NilValue; + } + + ans = PROTECT( Rf_allocVector(RAWSXP, sizeof(float)*n) ); + + fp = (float*) RAW(ans); + + for(i = 0 ; i < n ; ++i ) + fp[i] = (float) dp[i]; + + UNPROTECT(1); + return ans; +} + +SEXP r_floatraw2numeric(SEXP x) +{ + SEXP ans; + int i, n; + float *fp; + double *dp; + + fp = (float*) RAW(x); + + n = LENGTH(x) / sizeof(float); + ans = PROTECT( Rf_allocVector(REALSXP, n) ); + + dp = (double*) REAL(ans); + + for(i = 0 ; i < n ; ++i ) + dp[i] = (double) fp[i]; + + UNPROTECT(1); + return ans; + +} +