diff --git a/NAMESPACE b/NAMESPACE index 4996691..eeb7aa3 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/deform-package.R b/R/deform-package.R index 126bf61..2efcaff 100644 --- a/R/deform-package.R +++ b/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 diff --git a/R/seismicity.R b/R/seismicity.R new file mode 100644 index 0000000..4d93781 --- /dev/null +++ b/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 +} \ No newline at end of file diff --git a/man/deform.Rd b/man/deform.Rd index c0b6e6a..0630dd5 100644 --- a/man/deform.Rd +++ b/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 diff --git a/man/deform_hull.Rd b/man/deform_hull.Rd new file mode 100644 index 0000000..09d6027 --- /dev/null +++ b/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 +} + diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 0e89e4e..a0ca879 100644 --- a/src/RcppExports.cpp +++ b/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 }