deform_hull function

NAMESPACE

@@ -6,6 +6,7 @@ export(D_project)
 export(Tilt)
 export(Uniaxial_extension)
 export(agency.root)
+export(deform_hull)
 export(degreelen)
 export(dynamic)
 export(ellipsoid)

R/deform-package.R

@@ -1,5 +1,4 @@
-#' The \code{deform} package:
-#' crustal deformation tools in R.
+#' The \code{deform} package: crustal deformation tools in R
 #' 
 #' @name deform
 #' @docType package

R/seismicity.R

@@ -0,0 +1,42 @@
+#' Deform a convex hull
+#' @description
+#' Deform the coordinates of a convex hull
+#' @details
+#' This effectively applies a 2D plane-strain tensor to the coordinates where the 
+#' diagonal components equal \code{out.by} and the off diagonal components equal \code{shear.by}.
+#' @export
+#' @param hull.coords a matrix or data.frame with x and y coordinates of the convex hull
+#' @param out.by numeric; the factor to expand the area of the hull by
+#' @param shear.by numeric; the factor to shear the area of the hull by
+#' @param plot logical; should the results be plotted?
+#' @author A.J. Barbour
+#' @examples
+#' set.seed(1234)
+#' X <- matrix(stats::rnorm(2000), ncol = 2)
+#' hull.inds <- chull(X)
+#' hull.inds <- c(hull.inds, hull.inds[1])
+#' hull <- X[hull.inds, ]
+#' 
+#' deform_hull(hull, plot=TRUE)
+#' deform_hull(hull, out.by=2, plot=TRUE)
+#'
+deform_hull <- function(hull.coords, out.by=1, shear.by=0, plot=FALSE){
+  M <- as.matrix(hull.coords)
+  stopifnot(ncol(M)>=2)
+  cn <- names(hull.coords)
+  cms <- colMeans(M)
+  M.dem <- sweep(M, 2, cms)
+  Affine <- matrix(c(out.by, shear.by, shear.by, out.by), ncol=2)
+  Trans <- matrix(cms, ncol=2, nrow=nrow(hull.coords), byrow=TRUE)
+  M.sc <- M.dem %*% Affine + Trans
+  if (plot){
+    plot(M.sc, col=NA)
+    segments(Trans[,1], Trans[,2], M.sc[,1], M.sc[,2], col='grey', lty=2)
+    points(cms[1], cms[2], pch="+", font=2, cex=1.5)
+    lines(M, type='b', pch=16, cex=0.5)
+    lines(M.sc, type='b', pch=16, col='red')
+  }
+  M.sc <- data.frame(M.sc)
+  names(M.sc) <- cn
+  M.sc
+}

man/deform.Rd

@@ -4,11 +4,9 @@
 \name{deform}
 \alias{deform}
 \alias{deform-package}
-\title{The \code{deform} package:
-crustal deformation tools in R.}
+\title{The \code{deform} package: crustal deformation tools in R}
 \description{
-The \code{deform} package:
-crustal deformation tools in R.
+The \code{deform} package: crustal deformation tools in R
 }
 \seealso{
 \code{\link{segall85}} for deformation associated with fluid extraction

man/deform_hull.Rd

@@ -0,0 +1,38 @@
+% Generated by roxygen2 (4.1.0): do not edit by hand
+% Please edit documentation in R/seismicity.R
+\name{deform_hull}
+\alias{deform_hull}
+\title{Deform a convex hull}
+\usage{
+deform_hull(hull.coords, out.by = 1, shear.by = 0, plot = FALSE)
+}
+\arguments{
+\item{hull.coords}{a matrix or data.frame with x and y coordinates of the convex hull}
+
+\item{out.by}{numeric; the factor to expand the area of the hull by}
+
+\item{shear.by}{numeric; the factor to shear the area of the hull by}
+
+\item{plot}{logical; should the results be plotted?}
+}
+\description{
+Deform the coordinates of a convex hull
+}
+\details{
+This effectively applies a 2D plane-strain tensor to the coordinates where the
+diagonal components equal \code{out.by} and the off diagonal components equal \code{shear.by}.
+}
+\examples{
+set.seed(1234)
+X <- matrix(stats::rnorm(2000), ncol = 2)
+hull.inds <- chull(X)
+hull.inds <- c(hull.inds, hull.inds[1])
+hull <- X[hull.inds, ]
+
+deform_hull(hull, plot=TRUE)
+deform_hull(hull, out.by=2, plot=TRUE)
+}
+\author{
+A.J. Barbour
+}
+

src/RcppExports.cpp

@@ -9,13 +9,9 @@ using namespace Rcpp;
 List rcpp_hello_world();
 RcppExport SEXP deform_rcpp_hello_world() {
 BEGIN_RCPP
-    SEXP __sexp_result;
-    {
-        Rcpp::RNGScope __rngScope;
-        List __result = rcpp_hello_world();
-        PROTECT(__sexp_result = Rcpp::wrap(__result));
-    }
-    UNPROTECT(1);
-    return __sexp_result;
+    Rcpp::RObject __result;
+    Rcpp::RNGScope __rngScope;
+    __result = Rcpp::wrap(rcpp_hello_world());
+    return __result;
 END_RCPP
 }