changed svm and gaussian samplers to hyperelliptical with dave harris…

…' help. restructured underlying classes and parameter storage. redid thresholding algorithm to unify volume and probability quantiles. removed normalized output. improved printing and plotting code.

DESCRIPTION

@@ -1,9 +1,9 @@
 Package: hypervolume
 Type: Package
 Title: High Dimensional Geometry and Set Operations Using Kernel Density Estimation, Support Vector Machines, and Convex Polytopes
-Version: 2.0.4
+Version: 2.0.5
 Date: 2017-05-18
-Author: Benjamin Blonder
+Author: Benjamin Blonder, with contributions from David J. Harris
 Maintainer: Benjamin Blonder <bblonder@gmail.com>
 Description: Estimates the shape and volume of high-dimensional datasets and performs set operations: intersection / overlap, union, unique components, inclusion test, and hole detection. Uses stochastic geometry approach to high-dimensional kernel density estimation, support vector machine delineation, and convex polytope generation. Applications include modeling trait and niche hypervolumes and species distribution modeling.
 License: GPL-3

NAMESPACE

@@ -3,13 +3,14 @@ useDynLib(hypervolume)
 export( 
   #sample_model_metropolis,
   #sample_model_rejection,
+  #sample_model_ellipsoid,
 
   #kdtree_build,
   #evalfrectangular,
   #evalfspherical,
 
   estimate_bandwidth, 
-  estimate_threshold_gaussian,
+  #estimate_threshold_gaussian,
   expectation_ball, 
   expectation_box, 
   expectation_convex,
@@ -30,7 +31,7 @@ export(
   hypervolume_overlap_statistics,
   hypervolume_project,
   hypervolume_prune, 
-  hypervolume_quantile_threshold,
+  hypervolume_threshold,
   hypervolume_redundancy,
   hypervolume_save_animated_gif,
   hypervolume_segment, 
@@ -88,8 +89,8 @@ importFrom("hexbin","hexbin")
 importFrom("raster","raster", "getValues","values")
 
 importFrom("grDevices", "col2rgb", "rainbow", "rgb", "hsv", "rgb2hsv")
-importFrom("graphics", ".filled.contour", "axis", "box", "contour","par", "plot", "points", "text")
-importFrom("stats", "cor", "cutree", "dist", "na.omit", "pgamma","rnorm", "runif", "sd", "median", "quantile")
+importFrom("graphics", ".filled.contour", "axis", "box", "contour","par", "plot", "points", "text","lines")
+importFrom("stats", "cor", "cutree", "dist", "na.omit", "pgamma","rnorm", "runif", "sd", "median", "quantile","rbinom")
 importFrom("utils", "data", "head")
 importFrom("maps", "map")
 importFrom("graphics", "abline", "legend", "mtext")

R/AllClassDefinitions.R

@@ -5,21 +5,12 @@ setClass("Hypervolume", slots=c(
     Dimensionality="numeric",
     Volume="numeric",
     PointDensity="numeric",
-    Parameters="numeric",
+    Parameters="list",
 
     RandomUniformPointsThresholded="matrix",
     ProbabilityDensityAtRandomUniformPoints="numeric"
     ))
 
-setClass("HypervolumeOld",
-         slots=list(
-              Bandwidth="numeric",
-              RepsPerPoint="numeric",
-              DisjunctFactor="numeric",
-              QuantileThresholdDesired="numeric",
-              QuantileThresholdObtained="numeric"),
-         contains="Hypervolume")
-
 setClass("HypervolumeList", slots=c(
     HVList="list"
   ))
@@ -35,7 +26,15 @@ summary.Hypervolume <- function(object, ...)
   cat(sprintf("Volume: %f\n",object@Volume))
   cat(sprintf("Random point density: %f\n",object@PointDensity))
   cat(sprintf("Number of random points: %d\n",nrow(object@RandomUniformPointsThresholded)))
-  cat(sprintf("Parameters:\n\t%s\n",paste("",paste(names(object@Parameters), format(object@Parameters,digits=3), sep=": "),collapse='\n\t')))
+  cat(sprintf("Random point values:\n\tmin: %.3f\n\tmean: %.3f\n\tmedian: %.3f\n\tmax:%.3f\n",
+                min(object@ProbabilityDensityAtRandomUniformPoints),
+                mean(object@ProbabilityDensityAtRandomUniformPoints),
+                median(object@ProbabilityDensityAtRandomUniformPoints),
+                max(object@ProbabilityDensityAtRandomUniformPoints)))
+  cat(sprintf("Parameters:\n"))
+  lapply(1:length(object@Parameters), function(x) {
+    cat(sprintf("\t%s: %s\n",names(object@Parameters)[x], paste(format(object@Parameters[[x]]),collapse=" ")))
+  })    
 }
 
 summary.HypervolumeList <- function(object, ...)

R/hypervolume_box.R

@@ -1,8 +1,10 @@
 hypervolume_box <- function(data, name=NULL, verbose=TRUE, samples.per.point=ceiling((10^(1+ncol(data)))/nrow(data)), kde.bandwidth=estimate_bandwidth(data), tree.chunksize=1e4)
 {
-
-
   data <- as.matrix(data)
+  if (is.null(dimnames(data)[[2]]))
+  {
+    dimnames(data)[[2]] <- paste("X",1:ncol(data))
+  }
 
   dim = ncol(data)
   np = nrow(data)
@@ -22,7 +24,7 @@ hypervolume_box <- function(data, name=NULL, verbose=TRUE, samples.per.point=cei
     stop('Bandwidth must be non-zero.')
   }
 
-  names(kde.bandwidth) <- paste("kde.bandwidth",dimnames(data)[[2]],sep=".")
+  names(kde.bandwidth) <- dimnames(data)[[2]]
 
   # double the bandwidth as for other functions it is interpreted as a box half-width
   # but in this function is interpreted as a box full-width.
@@ -111,9 +113,9 @@ hypervolume_box <- function(data, name=NULL, verbose=TRUE, samples.per.point=cei
   hv_box@Dimensionality = dim
   hv_box@Volume = vc$final_volume
   hv_box@PointDensity = point_density_final
-  hv_box@Parameters = c(kde.bandwidth, samples.per.point=samples.per.point)
+  hv_box@Parameters = list(kde.bandwidth=kde.bandwidth, samples.per.point=samples.per.point)
   hv_box@RandomUniformPointsThresholded = as.matrix(points_uniform_final);  
-  hv_box@ProbabilityDensityAtRandomUniformPoints = normalize_probability(density_uniform_final, point_density_final)
+  hv_box@ProbabilityDensityAtRandomUniformPoints = density_uniform_final
 
   return(hv_box)  
 

R/hypervolume_expectation.R

@@ -83,8 +83,8 @@ expectation_box <- function(input, point.density=NULL, num.points=NULL, use.rand
                 Dimensionality=ncol(data), 
                 Volume=volume,
                 PointDensity=point.density, 
-                Parameters= NaN,
-                ProbabilityDensityAtRandomUniformPoints = normalize_probability(rep(1, npoints),point.density)
+                Parameters= list(),
+                ProbabilityDensityAtRandomUniformPoints = rep(1, npoints)
   )  
 
   return(hv_box)
@@ -148,8 +148,8 @@ expectation_ball <- function(input, point.density=NULL, num.points=NULL, use.ran
                  Dimensionality=ncol(data), 
                  Volume=volume,
                  PointDensity=point.density, 
-                 Parameters= NaN, 
-                 ProbabilityDensityAtRandomUniformPoints = normalize_probability(rep(1, npoints),point.density)
+                 Parameters= list(), 
+                 ProbabilityDensityAtRandomUniformPoints = rep(1, npoints)
   )  
 
   return(hv_ball)
@@ -420,7 +420,7 @@ expectation_convex <- function(input, point.density=NULL, num.points=NULL, num.p
                    PointDensity=point.density,
                    Volume= volume_convexhull,
                    Dimensionality=ncol(samples),
-                   ProbabilityDensityAtRandomUniformPoints=normalize_probability(rep(1, nrow(samples)),point.density),
+                   ProbabilityDensityAtRandomUniformPoints=rep(1, nrow(samples)),
                    Name=sprintf("Convex expectation for %s", ifelse(class(input)=="Hypervolume", input@Name, deparse(substitute(data))[1])),
                    Method="Adaptive hit and run convex expectation")	
 
@@ -495,8 +495,8 @@ expectation_convex <- function(input, point.density=NULL, num.points=NULL, num.p
                     Dimensionality=ncol(inpoints), 
                     Volume=hull_volume,
                     PointDensity = point.density,
-                    Parameters= NaN,
-                    ProbabilityDensityAtRandomUniformPoints = normalize_probability(rep(1, nrow(inpoints)),point.density)
+                    Parameters= list(),
+                    ProbabilityDensityAtRandomUniformPoints = rep(1, nrow(inpoints))
     )
 
     return(hv_chull)