#!/usr/bin/env r
#
# Copyright (C) 2009 - 2016  Dirk Eddelbuettel and Romain Francois
#
# This file is part of Rcpp.
#
# Rcpp is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# Rcpp is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.

suppressMessages(library(Rcpp))
suppressMessages(library(RcppGSL))
suppressMessages(library(inline))

firstExample <- function() {
    ## a really simple C program calling three functions from the GSL
    gslrng <- '
    gsl_rng *r;
    gsl_rng_env_setup();
    double v;

    r = gsl_rng_alloc (gsl_rng_default);

    printf("  generator type: %s\\n", gsl_rng_name (r));
    printf("  seed = %lu\\n", gsl_rng_default_seed);
    v = gsl_rng_get (r);
    printf("  first value = %.0f\\n", v);

    gsl_rng_free(r);
    return R_NilValue;
    '

    ## turn into a function that R can call
    ## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
    funx <- cxxfunction(signature(), gslrng,
                        includes="#include <gsl/gsl_rng.h>",
                        plugin="RcppGSL")

    cat("Calling first example\n")
    funx()
    invisible(NULL)
}

secondExample <- function() {

    ## now use Rcpp to pass down a parameter for the seed
    gslrng <- '
    int seed = Rcpp::as<int>(par) ;

    gsl_rng *r;
    gsl_rng_env_setup();
    double v;

    r = gsl_rng_alloc (gsl_rng_default);

    gsl_rng_set (r, (unsigned long) seed);
    v = gsl_rng_get (r);

    #ifndef BeSilent
    printf("  generator type: %s\\n", gsl_rng_name (r));
    printf("  seed = %d\\n", seed);
    printf("  first value = %.0f\\n", v);
    #endif

    gsl_rng_free(r);
    return Rcpp::wrap(v) ;
    '

    ## turn into a function that R can call
    ## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
    ## use additional define for compile to suppress output
    funx <- cxxfunction(signature(par="numeric"), gslrng,
                        includes="#include <gsl/gsl_rng.h>",
                        plugin="RcppGSL")
    cat("\n\nCalling second example without -DBeSilent set\n")
    print(funx(0))


    ## now override settings to add -D flag
    settings <- getPlugin("RcppGSL")
    settings$env$PKG_CPPFLAGS <- paste(settings$PKG_CPPFLAGS, "-DBeSilent")
    
    funx <- cxxfunction(signature(par="numeric"), gslrng,
                        includes="#include <gsl/gsl_rng.h>",
                        settings=settings)
    cat("\n\nCalling second example with -DBeSilent set\n")
    print(funx(0))

    invisible(NULL)
}

thirdExample <- function() {

    ## now use Rcpp to pass down a parameter for the seed, and a vector size
    gslrng <- '
    int seed = Rcpp::as<int>(s) ;
    int len = Rcpp::as<int>(n);

    gsl_rng *r;
    gsl_rng_env_setup();
    std::vector<double> v(len);

    r = gsl_rng_alloc (gsl_rng_default);

    gsl_rng_set (r, (unsigned long) seed);
    for (int i=0; i<len; i++) {
       v[i] = gsl_rng_get (r);
    }
    gsl_rng_free(r);

    return Rcpp::wrap(v) ;
    '

    ## turn into a function that R can call
    ## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
    ## use additional define for compile to suppress output
    funx <- cxxfunction(signature(s="numeric", n="numeric"),
                        gslrng,
                        includes="#include <gsl/gsl_rng.h>",
                        plugin="RcppGSL")
    cat("\n\nCalling third example with seed and length\n")
    print(funx(0, 5))

    invisible(NULL)
}

fourthExample <- function() {

    ## now use Rcpp to pass down a parameter for the seed, and a vector size
    gslrng <- '
    int seed = Rcpp::as<int>(s);
    int len = Rcpp::as<int>(n);

    gsl_rng *r;
    gsl_rng_env_setup();
    std::vector<double> v(len);

    r = gsl_rng_alloc (gsl_rng_default);

    gsl_rng_set (r, (unsigned long) seed);
    for (int i=0; i<len; i++) {
       v[i] = gsl_rng_get (r);
    }
    gsl_rng_free(r);

    return wrap(v);
    '

    ## turn into a function that R can call
    ## compileargs redundant on Debian/Ubuntu as gsl headers are found anyway
    ## use additional define for compile to suppress output
    funx <- cxxfunction(signature(s="numeric", n="numeric"),
                        gslrng,
                        includes=c("#include <gsl/gsl_rng.h>",
                                   "using namespace Rcpp;",
                                   "using namespace std;"),
                        plugin="RcppGSL")
    cat("\n\nCalling fourth example with seed, length and namespaces\n")
    print(funx(0, 5))

    invisible(NULL)
}

firstExample()
secondExample()
thirdExample()
fourthExample()
