Thanks again, Dirk.
full example (sorry for the verbose post):
library(inline)
library(Rcpp)
inc <- '
#include <iostream>
#include <armadillo>
#include <cppbugs/cppbugs.hpp>
using namespace arma;
using namespace cppbugs;
class TestModel: public MCModel {
public:
const mat& y; // given
const mat& X; // given
Normal<vec> b;
Uniform<double> tau_y;
Deterministic<mat> y_hat;
Normal<mat> likelihood;
Deterministic<double> rsq;
TestModel(const mat& y_,const mat& X_): y(y_), X(X_),
b(randn<vec>(X_.n_cols)),
tau_y(1),
y_hat(X*b.value),
likelihood(y_,true),
rsq(0)
{
add(b);
add(tau_y);
add(y_hat);
add(likelihood);
add(rsq);
}
void update() {
y_hat.value = X*b.value;
rsq.value = as_scalar(1 - var(y - y_hat.value) / var(y));
}
double logp() const {
return b.logp(0.0, 0.0001) + tau_y.logp(0,100) +
likelihood.logp(y_hat.value,tau_y.value);
}
};
'
src <- '
mat X(REAL(XR),100,2);
mat y(REAL(yr),100,1);
TestModel m(y,X);
int iterations = 1e5;
m.sample(iterations, 1e4, 10);
return Rcpp::List::create(Rcpp::Named("b", m.b.mean()),
Rcpp::Named("ar", m.acceptance_ratio()));
'
fun <- cxxfunction(signature(XR="numeric", yr="numeric"), body=src,
include=inc, plugin="Rcpp")
NR <- 100
NC <- 2
x <- matrix(rnorm(NR*NC),NR,NC)
y <- rnorm(NR)
print(system.time(ans <- fun(x,y)))
print(ans)
actual run:
> source("test.inline.bugs.R")
user system elapsed
0.420 0.020 0.435
$b
[1] -0.01127731 -0.11217234
$ar
[1] 0.29405
2010/10/5 Dirk Eddelbuettel <e...@debian.org>:
>
> On 5 October 2010 at 13:21, Whit Armstrong wrote:
> | aha, thanks for correcting me. on the inline/Rcpp division of labor.
> |
> | So, what you are suggesting should have been obvious to me.
> |
> | I pass the class def in the include statement of the inline function?
> | Is that it?
> |
> | I'll ping back after I try this.
> |
> | If this really works, then I think WinBUGS can finally die.
>
> It works over here, chances are you may get lucky too.
>
> Here, I took a simple templated class square from one of the unit tests and
> wrapped it in (fairly verbose) example:
>
>
> e...@max:~$ cat /tmp/whit.r
> #!/usr/bin/r -ti
>
> suppressMessages(library(inline))
> suppressMessages(library(Rcpp))
>
> inc <- 'template <typename T>
> class square : public std::unary_function<T,T> {
> public:
> T operator()( T t) const { return t*t ;}
> };
> '
>
> src <- '
> double x = Rcpp::as<double>(xs);
> int i = Rcpp::as<int>(is);
> square<double> sqdbl;
> square<int> sqint;
> return Rcpp::List::create(Rcpp::Named("x", sqdbl(x)),
> Rcpp::Named("i", sqint(i)));
> '
> fun <- cxxfunction(signature(xs="numeric", is="integer"), body=src,
> include=inc, plugin="Rcpp")
>
> print(fun(2.0, 3L))
> e...@max:~$ chmod 0755 /tmp/whit.r
> e...@max:~$ /tmp/whit.r
> $x
> [1] 4
>
> $i
> [1] 9
>
> e...@max:~$
>
>
> All good? Send my condolences to the family of WinBUGS.
>
> Dirk
>
>
>
>
> | -Whit
> |
> |
> | 2010/10/5 Dirk Eddelbuettel <e...@debian.org>:
> | >
> | > Hi Whit,
> | >
> | > On 5 October 2010 at 12:25, Whit Armstrong wrote:
> | > | I just reviewed the Rcpp documentation.
> | >
> | > Great. Now tell us how to make it sticky so that we get you to contribute
> :)
> | >
> | > | I see plenty of cfunction/cxxfunction examples, but I'm curious
> | > | whether one can provide a class definition inline in an R script and
> | > | then initialize an instance of the class and call a method on the
> | > | class. all inline in R.
> | > |
> | > | Is this feature something you all would consider adding to Rcpp?
> | >
> | > a) A change would be an inline feature, not an Rcpp feature.
> | >
> | > b) But we already do :) support this, and even use it in numerous cases in
> | > the unit tests; this uses the include= argument to cxxfunction et
> al.
> | >
> | > So you can supply your templated logic in an R string to include= and then
> | > use the code in an R string to to src= and pass it all through
> cxxfunction()
> | > for a quick test.
> | >
> | > See e.g. runit.macros.R or or runit.Module.R. I think we also have blog
> | > posts and / or vignette examples that use it.
> | >
> | > Hth, Dirk
> | >
> | > --
> | > Dirk Eddelbuettel | e...@debian.org | http://dirk.eddelbuettel.com
> | >
>
> --
> Dirk Eddelbuettel | e...@debian.org | http://dirk.eddelbuettel.com
>
_______________________________________________
Rcpp-devel mailing list
Rcpp-devel@lists.r-forge.r-project.org
https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-devel
