R interface to TwoBit code

Author: andrelmartins

Diff for: Makefile

@@ -1,7 +1,10 @@
-all: twoBitFreq test
+all: twoBitFreq test twobit.so
 
 twoBitFreq: main_freq.c twobit.c twobit.h
 	gcc -o twoBitFreq -Wall -g main_freq.c twobit.c 
 
 test: main.c twobit.c twobit.h
 	gcc -o test -Wall -g main.c twobit.c
+
+twobit.so: twobit_R.c twobit.h twobit.c
+	R CMD SHLIB twobit.c twobit_R.c

Diff for: twobit.R

@@ -0,0 +1,32 @@
+#
+# R twoBit Interface
+#
+
+twobit.curPath = getwd()
+
+# look for twobit.so
+if (file.access(paste(twobit.curPath, "/twobit.so", sep='')) < 0) {
+ # try hack
+ twobit.curPath = dirname(sys.frame(1)$ofile)
+ # test to see if it worked
+ stopifnot(file.access(paste(twobit.curPath, "/twobit.so", sep='')) >= 0)
+}
+
+twobit.load <- function(filename) {
+  dyn.load(paste(twobit.curPath, "/twobit.so", sep=''))
+  out <- .Call("rtwobit_load", filename)
+  return(out)
+}
+
+twobit.unload <- function(twobit) {
+  stopifnot(!is.null(twobit))
+  .Call("rtwobit_unload", twobit)
+  invisible(NULL)
+}
+
+twobit.sequence <- function(twobit, name, start, end) {
+  stopifnot(!is.null(twobit), !is.null(name), !is.null(start), !is.null(end))
+  stopifnot(end >= start)
+  out <- .Call("rtwobit_sequence", twobit, name, start, end)
+  return(out)
+}

Diff for: twobit.c

@@ -141,7 +141,7 @@ void free_index(struct twobit_index * index) {
   }
 }
 
-TwoBit * twobit_open(char * filename) {
+TwoBit * twobit_open(const char * filename) {
   int fd;
   struct stat sb;
   char * data;

Diff for: twobit.h

@@ -3,7 +3,7 @@
 
 typedef struct twobit_ TwoBit;
 
-TwoBit * twobit_open(char * filename);
+TwoBit * twobit_open(const char * filename);
 void twobit_close(TwoBit * ptr);
 
 int twobit_sequence_size(TwoBit * ptr, const char * name);

Diff for: twobit_R.c

@@ -0,0 +1,113 @@
+/* R interface for wiglib */
+#include "twobit.h"
+#include <R.h>
+#include <Rdefines.h>
+
+static void rtwobit_finalizer(SEXP ptr) {
+  if (!R_ExternalPtrAddr(ptr)) return;
+  twobit_close(R_ExternalPtrAddr(ptr));
+  R_ClearExternalPtr(ptr); /* not really necessary */
+}
+
+static SEXP rtwobit_names(TwoBit * twobit) {
+  char ** names = twobit_sequence_names(twobit);
+  SEXP result;
+  int count = 0, i;
+  char ** ptr;
+
+  for (ptr = names; *ptr != NULL; ++ptr)
+    ++count;
+
+  PROTECT(result = allocVector(STRSXP, count));
+
+  for (ptr = names, i = 0; *ptr != NULL; ++ptr, ++i) {
+    SET_STRING_ELT(result, i, mkChar(*ptr));
+    free(*ptr);
+  }
+  free(names);
+
+  UNPROTECT(1);
+
+  return result;
+}
+
+/* Load / Unload */
+SEXP rtwobit_load(SEXP filename) {
+  SEXP ans, ans_names, ptr;
+  TwoBit * twobit;
+
+
+  /* load twobit file */
+  PROTECT(filename = AS_CHARACTER(filename));
+
+  twobit = twobit_open(CHAR(STRING_ELT(filename, 0)));
+
+  /* create answer */
+  if (twobit == NULL) {
+    UNPROTECT(1);
+    return R_NilValue;
+  }
+
+  PROTECT(ans = allocVector(VECSXP, 1)); /* names */
+  PROTECT(ans_names = allocVector(STRSXP, 1));
+
+  /* make external pointer */
+  ptr = R_MakeExternalPtr(twobit, install("TWOBIT_struct"), R_NilValue);
+  PROTECT(ptr);
+  R_RegisterCFinalizerEx(ptr, rtwobit_finalizer, TRUE);
+  setAttrib(ans, install("handle_ptr"), ptr);
+
+  /* fill info */
+  SET_VECTOR_ELT(ans, 0, rtwobit_names(twobit));
+  SET_STRING_ELT(ans_names, 0, mkChar("names"));
+
+  setAttrib(ans, R_NamesSymbol, ans_names);
+  UNPROTECT(4);
+
+  return ans;
+}
+
+void rtwobit_unload(SEXP obj) {
+  SEXP ptr;
+
+  PROTECT(ptr = GET_ATTR(obj, install("handle_ptr")));
+  if (ptr == R_NilValue)
+    error("invalid twobit object");
+
+  rtwobit_finalizer(ptr);
+
+  UNPROTECT(1);
+}
+
+SEXP rtwobit_sequence(SEXP obj, SEXP name, SEXP start, SEXP end) {
+  SEXP ptr, res = R_NilValue;
+  TwoBit * twobit;
+
+  PROTECT(name = AS_CHARACTER(name));
+  PROTECT(start = AS_INTEGER(start));
+  PROTECT(end = AS_INTEGER(end));
+
+  PROTECT(ptr = GET_ATTR(obj, install("handle_ptr")));
+  if (ptr == R_NilValue)
+    error("invalid twobit object");
+
+  twobit = R_ExternalPtrAddr(ptr);
+  if (twobit == NULL) {
+    error("twobit object has been unloaded");
+  } else {
+    char * seq = twobit_sequence(twobit, CHAR(STRING_ELT(name, 0)),
+				 INTEGER(start)[0], INTEGER(end)[0]);
+    if (seq == NULL)
+      error("unknown sequence or invalid range");
+    else {
+      PROTECT(res = allocVector(STRSXP, 1));
+      SET_STRING_ELT(res, 0, mkChar(seq));
+      free(seq);
+      UNPROTECT(1);
+    }
+  }
+
+  UNPROTECT(4);
+
+  return res;
+}