Skip to content

Commit

Permalink
Make package effectively header only, clean up build and silence warn…
Browse files Browse the repository at this point in the history
…ings in benchmark
  • Loading branch information
mlinderm committed Jun 17, 2015
1 parent cb17d8a commit 07ec98a
Show file tree
Hide file tree
Showing 5 changed files with 34 additions and 88 deletions.
50 changes: 2 additions & 48 deletions R/RclusterppLdpath.R
Original file line number Diff line number Diff line change
@@ -1,51 +1,5 @@
## Adapted from Rcpp
RclusterppLdFlags <- function(static=FALSE) { "" }

## Make sure system.file returns an absolute path
Rclusterpp.system.file <- function(...){
tools::file_path_as_absolute( base::system.file( ..., package = "Rclusterpp" ) )
}

## Identifies if the default linking on the platform should be static
## or dynamic. Currently only linux uses dynamic linking by default
## although it works fine on mac osx as well
staticLinking <- function() {
! grepl( "^linux", R.version$os )
}

## Use R's internal knowledge of path settings to find the lib/ directory
## plus optinally an arch-specific directory on system building multi-arch
RclusterppLdPath <- function() {
if (nzchar(.Platform$r_arch)) { ## eg amd64, ia64, mips
path <- Rclusterpp.system.file("lib",.Platform$r_arch)
} else {
path <- Rclusterpp.system.file("lib")
}
path
}

## Provide linker flags -- i.e. -L/path/to/libRclusterpp -- as well as an
## optional rpath call needed to tell the Linux dynamic linker about the
## location. This is not needed on OS X where we encode this as library
## built time (see src/Makevars) or Windows where we use a static library
## Updated Jan 2010: We now default to static linking but allow the use
## of rpath on Linux if static==FALSE has been chosen
## Note that this is probably being called from LdFlags()
RclusterppLdFlags <- function(static=staticLinking()) {
rclusterppdir <- RclusterppLdPath()
if (static) { # static is default on Windows and OS X
flags <- paste(rclusterppdir, "/libRclusterpp.a", sep="")
} else { # else for dynamic linking
flags <- paste("-L", rclusterppdir, " -lRclusterpp", sep="") # baseline setting
if ((.Platform$OS.type == "unix") && # on Linux, we can use rpath to encode path
(length(grep("^linux",R.version$os)))) {
flags <- paste(flags, " -Wl,-rpath,", rclusterppdir, sep="")
}
}
invisible(flags)
#invisible(paste(Rcpp::RcppLdFlags(static), flags, sep=" "))
}

## LdFlags defaults to static linking on the non-Linux platforms Windows and OS X
LdFlags <- function(static=staticLinking()) {
LdFlags <- function(static=FALSE) {
cat(RclusterppLdFlags(static=static))
}
1 change: 0 additions & 1 deletion R/inline.R
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
inlineCxxPlugin <-
Rcpp:::Rcpp.plugin.maker(
include.before = "#include <Rclusterpp.h>",
libs = Rclusterpp::RclusterppLdFlags(FALSE),
package = "Rclusterpp",
LinkingTo = c("Rclusterpp", "RcppEigen", "Rcpp"),
Makevars = NULL,
Expand Down
4 changes: 2 additions & 2 deletions inst/examples/benchmark.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,8 +11,8 @@ for (r in ROWS) {
data <- matrix(rnorm(r * COLUMNS), nrow=r)
result <- benchmark(
Rclusterpp = Rclusterpp.hclust(data, method="ward"),
hclust = stats::hclust((dist(data, method="euclidean")^2)/2.0, method="ward"),
fastcluster = fastcluster::hclust((dist(data, method="euclidean")^2)/2.0, method="ward"),
hclust = stats::hclust((dist(data, method="euclidean")^2)/2.0, method="ward.D"),
fastcluster = fastcluster::hclust((dist(data, method="euclidean")^2)/2.0, method="ward.D"),
replications = 5,
columns=c("test", "elapsed", "user.self", "sys.self"),
order="elapsed"
Expand Down
31 changes: 30 additions & 1 deletion inst/include/Rclusterpp/hclust.h
Original file line number Diff line number Diff line change
Expand Up @@ -98,13 +98,42 @@ namespace Rclusterpp {
} // end of Rclusterpp namespace

namespace Rcpp {
template <> SEXP wrap( const Rclusterpp::Hclust& hclust );
//template <> SEXP wrap( const Rclusterpp::Hclust& hclust );

template <typename T> SEXP wrap( const Rclusterpp::ClusterVector<T>& clusters ) {
Rclusterpp::Hclust hclust(clusters.initial_clusters());
Rclusterpp::populate_Rhclust(clusters, hclust);
return Rcpp::wrap(hclust);
}

template <> Eigen::RowMajorNumericMatrix as(SEXP x) {
return Eigen::RowMajorNumericMatrix(as<Eigen::MapNumericMatrix>(x));
}

template <> Rclusterpp::LinkageKinds as(SEXP x){
switch (as<int>(x)) {
default: throw not_compatible("Linkage method invalid or not yet supported");
case 1: return Rclusterpp::WARD;
case 2: return Rclusterpp::AVERAGE;
case 3: return Rclusterpp::SINGLE;
case 4: return Rclusterpp::COMPLETE;
}
}

template <> Rclusterpp::DistanceKinds as(SEXP x){
switch (as<int>(x)) {
default: throw not_compatible("Distance method invalid or not yet supported");
case 1: return Rclusterpp::EUCLIDEAN;
case 2: return Rclusterpp::MANHATTAN;
case 3: return Rclusterpp::MAXIMUM;
case 4: return Rclusterpp::MINKOWSKI;
}
}

template <> SEXP wrap( const Rclusterpp::Hclust& hclust ) {
return List::create( _["merge"] = hclust.merge, _["height"] = hclust.height, _["order"] = hclust.order );
}

} // Rcpp namespace

#endif
36 changes: 0 additions & 36 deletions src/hclust.cpp
Original file line number Diff line number Diff line change
@@ -1,6 +1,3 @@
#include <algorithm>
#include <functional>
#include <stack>
#include <stdexcept>

#ifdef _OPENMP
Expand All @@ -9,37 +6,6 @@

#include <Rclusterpp.h>

namespace Rcpp {

template <> Eigen::RowMajorNumericMatrix as(SEXP x) {
return Eigen::RowMajorNumericMatrix(as<Eigen::MapNumericMatrix>(x));
}

template <> Rclusterpp::LinkageKinds as(SEXP x){
switch (as<int>(x)) {
default: throw not_compatible("Linkage method invalid or not yet supported");
case 1: return Rclusterpp::WARD;
case 2: return Rclusterpp::AVERAGE;
case 3: return Rclusterpp::SINGLE;
case 4: return Rclusterpp::COMPLETE;
}
}

template <> Rclusterpp::DistanceKinds as(SEXP x){
switch (as<int>(x)) {
default: throw not_compatible("Distance method invalid or not yet supported");
case 1: return Rclusterpp::EUCLIDEAN;
case 2: return Rclusterpp::MANHATTAN;
case 3: return Rclusterpp::MAXIMUM;
case 4: return Rclusterpp::MINKOWSKI;
}
}

template <> SEXP wrap( const Rclusterpp::Hclust& hclust ) {
return List::create( _["merge"] = hclust.merge, _["height"] = hclust.height, _["order"] = hclust.order );
}

} // Rcpp

RcppExport SEXP linkage_kinds() {
BEGIN_RCPP
Expand Down Expand Up @@ -156,8 +122,6 @@ namespace {
if (TYPEOF(data) != RTYPE)
throw std::invalid_argument("Wrong R type for mapped vector");

//typedef ::Rcpp::traits::storage_type<RTYPE>::type STORAGE;
//double *d_start = ::Rcpp::internal::r_vector_start<RTYPE,STORAGE>(data);
double *d_start = REAL(data);

for (ssize_t c=0; c<N-1; c++) {
Expand Down

0 comments on commit 07ec98a

Please sign in to comment.