From b555b36b5c14f7a4342b10bcea8374bfe5e0fac8 Mon Sep 17 00:00:00 2001
From: Justin Bedo <cu@cua0.org>
Date: Tue, 7 Feb 2023 16:09:06 +1100
Subject: add R bindings

---
 R/DESCRIPTION   |  4 ++++
 R/NAMESPACE     |  2 ++
 R/R/pca.R       | 18 ++++++++++++++++++
 R/default.nix   |  8 ++++++++
 R/src/Makevars  |  1 +
 R/src/wrapper.c | 27 +++++++++++++++++++++++++++
 flake.nix       |  5 ++++-
 7 files changed, 64 insertions(+), 1 deletion(-)
 create mode 100644 R/DESCRIPTION
 create mode 100644 R/NAMESPACE
 create mode 100644 R/R/pca.R
 create mode 100644 R/default.nix
 create mode 100644 R/src/Makevars
 create mode 100644 R/src/wrapper.c

diff --git a/R/DESCRIPTION b/R/DESCRIPTION
new file mode 100644
index 0000000..ab8a35c
--- /dev/null
+++ b/R/DESCRIPTION
@@ -0,0 +1,4 @@
+Package: codapca
+Type: Package
+Title: CODA-PCA
+Version: 0.1
diff --git a/R/NAMESPACE b/R/NAMESPACE
new file mode 100644
index 0000000..35f6f6a
--- /dev/null
+++ b/R/NAMESPACE
@@ -0,0 +1,2 @@
+export("pca")
+useDynLib(codapca)
diff --git a/R/R/pca.R b/R/R/pca.R
new file mode 100644
index 0000000..85782e4
--- /dev/null
+++ b/R/R/pca.R
@@ -0,0 +1,18 @@
+pca <- function(x, k=1,q=0.5){
+  n <- nrow(x)
+  d <- ncol(x)
+  B <- matrix(0, n, k)
+  U <- matrix(0, d, k)
+  l <- 0
+
+  res <- .C("pca_wrapper",
+    n=as.integer(n),
+    d=as.integer(d),
+    q=as.numeric(q),
+    k=as.integer(k),
+    X=as.numeric(t(x)),
+    B=as.numeric(B),
+    U=as.numeric(U),
+    l=l)
+  list(B=matrix(res$B,n,k,T),U=matrix(res$U,d,k,T), Y=matrix(res$X,n,d,T), l=res$l)
+}
diff --git a/R/default.nix b/R/default.nix
new file mode 100644
index 0000000..16d07a4
--- /dev/null
+++ b/R/default.nix
@@ -0,0 +1,8 @@
+{ R, buildRPackage, coda-pca }:
+
+buildRPackage {
+  name = "coda-pca";
+  src = ./.;
+  nativeBuildInputs = [ R ];
+  buildInputs = [ coda-pca ];
+}
diff --git a/R/src/Makevars b/R/src/Makevars
new file mode 100644
index 0000000..ca122c3
--- /dev/null
+++ b/R/src/Makevars
@@ -0,0 +1 @@
+PKG_LIBS = -lcodapca
diff --git a/R/src/wrapper.c b/R/src/wrapper.c
new file mode 100644
index 0000000..dd7bce1
--- /dev/null
+++ b/R/src/wrapper.c
@@ -0,0 +1,27 @@
+#include "pca.h"
+
+void
+pca_wrapper(int *n, int *d, double *q, int *k, double *X, double *B, double *U, double *l) {
+
+  struct futhark_context_config *cfg = futhark_context_config_new();
+  struct futhark_context *ctx = futhark_context_new(cfg);
+
+  struct futhark_f64_2d *Xf = futhark_new_f64_2d(ctx, X, *n, *d);
+  struct futhark_f64_2d *Yf;
+  struct futhark_f64_2d *Bf;
+  struct futhark_f64_2d *Uf;
+
+  futhark_entry_pcaWithQuantile(ctx, &Bf, &Uf, &Yf, l, *q, *k, Xf);
+  futhark_context_sync(ctx);
+  futhark_values_f64_2d(ctx, Bf, B);
+  futhark_values_f64_2d(ctx, Uf, U);
+  futhark_values_f64_2d(ctx, Yf, X);
+
+  futhark_free_f64_2d(ctx, Xf);
+  futhark_free_f64_2d(ctx, Bf);
+  futhark_free_f64_2d(ctx, Uf);
+  futhark_free_f64_2d(ctx, Yf);
+  futhark_context_free(ctx);
+  futhark_context_config_free(cfg);
+
+}
diff --git a/flake.nix b/flake.nix
index 38e252b..bd1f1ca 100644
--- a/flake.nix
+++ b/flake.nix
@@ -10,7 +10,10 @@
     flake-utils.lib.eachDefaultSystem (system: let
       pkgs = import nixpkgs {inherit system;};
     in rec {
-      packages = {lib = pkgs.callPackage ./. {};};
+      packages = rec {
+        lib = pkgs.callPackage ./. {};
+        R = pkgs.callPackage ./R { inherit (pkgs) R; inherit (pkgs.rPackages) buildRPackage; coda-pca = lib; };
+      };
       defaultPackage = packages.lib;
     });
 }
-- 
cgit v1.2.3