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;
+
+}
+