Nothing
R/RcppExports.R
In recexcavAAR: 3D Reconstruction of Archaeological Excavations
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
#' Draws a circular point cloud (3D)
#'
#' @description
#' Draws a 2D circle on x- and y-plane around a center point in 3D space.
#'
#' @param centerx x axis value of circle center point
#' @param centery y axis value of circle center point
#' @param centerz z axis value of circle center point
#' @param radius circle radius
#' @param resolution amount of circle points (default = 30)
#'
#' @return
#' data.frame with the spatial coordinates of the resulting points
#'
#' @examples
#' draw_circle(
#' centerx = 4,
#' centery = 5,
#' centerz = 1,
#' radius = 3,
#' resolution = 20
#' )
#'
#' circ <- draw_circle(1,2,3,2)
#'
#' plot(circ$x, circ$y)
#'
#' @export
draw_circle <- function(centerx, centery, centerz, radius, resolution = 30L) {
.Call('recexcavAAR_draw_circle', PACKAGE = 'recexcavAAR', centerx, centery, centerz, radius, resolution)
}
#' Rotate a point cloud around a pivot point (3D)
#'
#' @description
#' Rotate a point cloud around a defined pivot point by defined angles. The default
#' rotation angle around each axis is zero and the default pivot point is the center
#' point of the point cloud (defined by mean())
#'
#' @param x vector of x axis values of rotation point cloud
#' @param y vector of y axis values of rotation point cloud
#' @param z vector of z axis values of rotation point cloud
#' @param degrx rotation angle around x axis in degree (default = 0)
#' @param degry rotation angle around y axis in degree (default = 0)
#' @param degrz rotation angle around z axis in degree (default = 0)
#' @param pivotx x axis value of pivot point (default = mean(x))
#' @param pivoty y axis value of pivot point (default = mean(y))
#' @param pivotz z axis value of pivot point (default = mean(z))
#'
#' @return
#' data.frame with the spatial coordinates of the resulting points
#'
#' @examples
#' circ <- draw_circle(0,0,0,5)
#'
#' #library(rgl)
#' #plot3d(
#' # circ,
#' # xlim = c(-6,6),
#' # ylim = c(-6,6),
#' # zlim = c(-6,6)
#' #)
#'
#' rotcirc <- rotate(circ$x, circ$y, circ$z, degrx = 45)
#'
#' #plot3d(
#' # rotcirc,
#' # xlim = c(-6,6),
#' # ylim = c(-6,6),
#' # zlim = c(-6,6)
#' #)
#'
#' @export
rotate <- function(x, y, z, degrx = 0.0, degry = 0.0, degrz = 0.0, pivotx = NA_real_, pivoty = NA_real_, pivotz = NA_real_) {
.Call('recexcavAAR_rotate', PACKAGE = 'recexcavAAR', x, y, z, degrx, degry, degrz, pivotx, pivoty, pivotz)
}
#' Draws a spherical point cloud (3D)
#'
#' @description
#' Draws a sphere around a center point in 3D space.
#'
#' @param centerx x axis value of sphere center point
#' @param centery y axis value of sphere center point
#' @param centerz z axis value of sphere center point
#' @param radius sphere radius
#' @param phires phi resolution (default = 10)
#' @param thetares theta resolution (default = 10)
#'
#' @return
#' data.frame with the spatial coordinates of the resulting points
#'
#' @examples
#' sphere <- draw_sphere(
#' centerx = 4,
#' centery = 5,
#' centerz = 1,
#' radius = 3,
#' phires = 20,
#' thetares = 20
#' )
#'
#' #library(rgl)
#' #plot3d(sphere)
#'
#' @export
draw_sphere <- function(centerx, centery, centerz, radius, phires = 10L, thetares = 10L) {
.Call('recexcavAAR_draw_sphere', PACKAGE = 'recexcavAAR', centerx, centery, centerz, radius, phires, thetares)
}
#' Scales a point cloud (3D)
#'
#' @description
#' Scales a 3D point cloud on every axis.
#'
#' @param x vector of x axis values of scale point cloud
#' @param y vector of y axis values of scale point cloud
#' @param z vector of z axis values of scale point cloud
#' @param scalex scaling factor on x axis (default = 1)
#' @param scaley scaling factor on y axis (default = 1)
#' @param scalez scaling factor on z axis (default = 1)
#'
#' @return
#' data.frame with the spatial coordinates of the resulting points
#'
#' @examples
#' s <- draw_sphere(1,1,1,3)
#'
#' #library(rgl)
#' #plot3d(s)
#'
#' s2 <- rescale(s$x, s$y, s$z, scalex = 4, scalez = 5)
#'
#' #library(rgl)
#' #plot3d(s2)
#'
#' @export
rescale <- function(x, y, z, scalex = 1, scaley = 1, scalez = 1) {
.Call('recexcavAAR_rescale', PACKAGE = 'recexcavAAR', x, y, z, scalex, scaley, scalez)
}
#' Fills hexahedrons with a regular point raster (3D)
#'
#' @description
#' A hexahedron is a three dimensional shape that is defined by 6 faces and 8 corner points.
#' \code{fillhexa} allows to fill such a shape with a regular point raster.
#'
#' @details
#' See \url{https://stackoverflow.com/questions/36115215/filling-a-3d-body-with-a-systematic-point-raster}
#' for a description of the function and how it was developed.
#'
#' @param hex dataframe with three columns and eight rows to define a hexahedron by its corner
#' point coordinates x, y and z
#' @param res numeric value > 0 and <= 1 for the resolution of the point raster
#'
#' @return data.frame with the spatial coordinates of the resulting points of the grid
#'
#' @examples
#' hexatestdf <- data.frame(
#' x = c(0,1,0,4,5,5,5,5),
#' y = c(1,1,4,4,1,1,4,4),
#' z = c(4,8,4,9,4,8,4,6)
#' )
#'
#' cx = fillhexa(hexatestdf, 0.1)
#'
#' #library(rgl)
#' #plot3d(
#' # cx[,1], cx[,2], cx[,3],
#' # type = "p",
#' # xlab = "x", ylab = "y", zlab = "z"
#' #)
#'
#' @export
fillhexa <- function(hex, res) {
.Call('recexcavAAR_fillhexa', PACKAGE = 'recexcavAAR', hex, res)
}
#' Check if a point is within a polygon (2D)
#'
#' @description
#' \code{pnp} is able to determine if a point is within a polygon in 2D space.
#' The polygon is described by its corner points. The points must be in a correct
#' drawing order.
#'
#' Based on this solution:
#' Copyright (c) 1970-2003, Wm. Randolph Franklin
#' \url{http://wrf.ecse.rpi.edu/pmwiki/pmwiki.php/Main/Software#toc24}
#'
#' @details
#' For discussion see: \url{http://stackoverflow.com/questions/217578/how-can-i-determine-whether-a-2d-point-is-within-a-polygon/2922778#2922778}
#'
#' @param vertx vector of x axis values of polygon corner points
#' @param verty vector of y axis values of polygon corner points
#' @param testx x axis value of point of interest
#' @param testy y axis value of point of interest
#'
#' @return boolean value - TRUE, if the point is within the polygon. Otherwise FALSE.
#'
#' @family pnpfuncs
#'
#' @examples
#' df <- data.frame(
#' x = c(1,1,2,2),
#' y = c(1,2,1,2)
#' )
#'
#' pnp(df$x, df$y, 1.5, 1.5)
#' pnp(df$x, df$y, 2.5, 2.5)
#'
#' # caution: false-negatives in edge-cases:
#' pnp(df$x, df$y, 2, 1.5)
#'
#' @export
pnp <- function(vertx, verty, testx, testy) {
.Call('recexcavAAR_pnp', PACKAGE = 'recexcavAAR', vertx, verty, testx, testy)
}
#' Check if multiple points are within a polygon (2D)
#'
#' @description
#' \code{pnpmulti} works as \code{\link{pnp}} but for multiple points.
#'
#' @param vertx vector of x axis values of polygon corner points
#' @param verty vector of y axis values of polygon corner points
#' @param testx vector of x axis values of points of interest
#' @param testy vector of y axis values of points of interest
#'
#' @return vector with boolean values - TRUE, if the respective point is within the polygon.
#' Otherwise FALSE.
#'
#' @examples
#' polydf <- data.frame(
#' x = c(1,1,2,2),
#' y = c(1,2,1,2)
#' )
#'
#' testdf <- data.frame(
#' x = c(1.5, 2.5),
#' y = c(1.5, 2.5)
#' )
#'
#' pnpmulti(polydf$x, polydf$y, testdf$x, testdf$y)
#'
#' @family pnpfuncs
#'
#' @export
pnpmulti <- function(vertx, verty, testx, testy) {
.Call('recexcavAAR_pnpmulti', PACKAGE = 'recexcavAAR', vertx, verty, testx, testy)
}
#' Multiple point position decision in relation to a set of stacked surfaces (3D)
#'
#' \code{posdec} has the purpose to make a decision about the position of individual points in relation
#' to a set of stacked surfaces in 3D space. The decision is made by comparing the mean z axis value of
#' the four horizontally closest points of a surface to the z axis value of the point in question.
#'
#' @param crdf data.frame with the spatial coordinates of the points of interest. Must contain three
#' columns with the x axis values, y axis values and z axis values of the points in the order x, y, z
#' @param maplist list of data.frames which contain the points that make up the surfaces. The individual
#' data.frames must have the same structure as \code{crdf}
#'
#' @return data.frame with the spatial coordinates of the points of interest and the respective position
#' information
#'
#' @family posdecfuncs
#'
#' @examples
#' df1 <- data.frame(
#' x = rnorm(50),
#' y = rnorm(50),
#' z = rnorm(50) - 5
#' )
#'
#' df2 <- data.frame(
#' x = rnorm(50),
#' y = rnorm(50),
#' z = rnorm(50) + 5
#')
#'
#' lpoints <- list(df1, df2)
#'
#' maps <- kriglist(lpoints, lags = 3, model = "spherical")
#'
#' finds <- data.frame(
#' x = c(0, 1, 0.5, 0.7),
#' y = c(0.5, 0, 1, 0.7),
#' z = c(-10, 10, 0, 2)
#' )
#'
#' posdec(finds, maps)
#'
#' @export
posdec <- function(crdf, maplist) {
.Call('recexcavAAR_posdec', PACKAGE = 'recexcavAAR', crdf, maplist)
}
#' Multiple point position decision in relation to a set of stacked surfaces (3D)
#' for multiple data.frames in a list
#'
#' \code{posdeclist} works as \code{\link{posdec}} but not just for a single data.frame
#' with individual points but for a list of data.frames
#'
#' @param crdflist list of data.frames with the spatial coordinates of the points of
#' interest (for details see \code{\link{posdec}})
#' @param maplist list of data.frames which contain the points that make up the surfaces
#'
#' @return list of data.frames with the spatial coordinates of the points of interest
#' and the respective position information
#'
#' @family posdecfuncs
#'
#' @examples
#' df1 <- data.frame(
#' x = rnorm(50),
#' y = rnorm(50),
#' z = rnorm(50) - 5
#' )
#'
#' df2 <- data.frame(
#' x = rnorm(50),
#' y = rnorm(50),
#' z = rnorm(50) + 5
#')
#'
#' lpoints <- list(df1, df2)
#'
#' maps <- kriglist(lpoints, lags = 3, model = "spherical")
#'
#' hexadf1 <- data.frame(
#' x = c(0, 1, 0, 4, 5, 5, 5, 5),
#' y = c(1, 1, 4, 4, 1, 1, 4, 4),
#' z = c(1, 5, 1, 6, 1, 5, 1, 3)
#' )
#'
#' hexadf2 <- data.frame(
#' x = c(0, 1, 0, 4, 5, 5, 5, 5),
#' y = c(1, 1, 4, 4, 1, 1, 4, 4),
#' z = c(-1, -5, -1, -6, -1, -5, -1, -3)
#' )
#'
#' cx1 <- fillhexa(hexadf1, 0.1)
#' cx2 <- fillhexa(hexadf2, 0.1)
#'
#' cubelist <- list(cx1, cx2)
#'
#' posdeclist(cubelist, maps)
#'
#' @export
posdeclist <- function(crdflist, maplist) {
.Call('recexcavAAR_posdeclist', PACKAGE = 'recexcavAAR', crdflist, maplist)
}
#' Transformation of numeric matrices from wide to long format
#'
#' \code{spatiallong} transforms a set of two independent variables in vectors and a
#' dependent variable in a wide matrix to a long matrix that combines the information.
#' The result is exported as a data.frame.
#'
#' @param x vector of first independent variable. e.g. vector with x axis spatial points
#' @param y vector of second independent variable. e.g. vector with y axis spatial points
#' @param z matrix of dependent variable. e.g. matrix with z axis spatial points
#'
#' @return data.frame with three columns x, y and z
#'
#' @family transfuncs
#'
#' @examples
#' x <- c(1, 1, 1, 2, 2, 2, 3, 3, 4)
#' y <- c(1, 2, 3, 1, 2, 3, 1, 2, 3)
#' z <- c(3, 4, 2, 3, NA, 5, 6, 3, 1)
#'
#' sw <- spatialwide(x, y, z, digits = 3)
#'
#' spatiallong(sw$x, sw$y, sw$z)
#'
#' @export
spatiallong <- function(x, y, z) {
.Call('recexcavAAR_spatiallong', PACKAGE = 'recexcavAAR', x, y, z)
}
#' Transformation of numeric matrices from long to wide format
#'
#' Transforms a set of two independent and one dependent variables in vectors from a long
#' to a wide format and exports this result as a list
#'
#' @param x vector of first independent variable. e.g. vector with x-axis spatial points
#' @param y vector of second independent variable. e.g. vector with y-axis spatial points
#' @param z vector of dependent variable. e.g. vector with z-axis spatial points
#' @param digits integer indicating the number of decimal places to be used for rounding
#' the dependent variables \code{x} and \code{y}.
#'
#' @return List with three elements:
#'
#' $x: vector with ascendingly sorted, unique values of the first independent variable \code{x}
#'
#' $y: vector with ascendingly sorted, unique values of the second independent variable \code{y}
#'
#' $z: matrix with the values of z for the defined combinations of \code{x} (columns) and
#' \code{y} (rows)
#'
#' @family transfuncs
#'
#' @examples
#' x <- c(1, 1, 1, 2, 2, 2, 3, 3, 4)
#' y <- c(1, 2, 3, 1, 2, 3, 1, 2, 3)
#' z <- c(3, 4, 2, 3, NA, 5, 6, 3, 1)
#'
#' spatialwide(x, y, z, digits = 3)
#'
#' @export
spatialwide <- function(x, y, z, digits) {
.Call('recexcavAAR_spatialwide', PACKAGE = 'recexcavAAR', x, y, z, digits)
}
#' Center determination for hexahedrons
#'
#' A hexahedron is a three dimensional shape that is defined by 6 faces and 8 corner points.
#' \code{spitcenter} determines a center point for an input hexahedron by calculating the mean
#' of the maximal extent on all three axis.
#'
#' @param hex dataframe with three columns and eight rows to define a hexahedron by its corner
#' point coordinates x, y and z
#'
#' @return vector with the spatial coordinates of the center point of the input hexahedron
#'
#' @family centerdetfuncs
#'
#' @examples
#' hexatestdf <- data.frame(
#' x = c(0,1,0,4,5,5,5,5),
#' y = c(1,1,4,4,1,1,4,4),
#' z = c(4,8,4,9,4,8,4,6)
#' )
#'
#' center <- spitcenter(hexatestdf)
#'
#' #library(rgl)
#' #plot3d(
#' # hexatestdf$x, hexatestdf$y, hexatestdf$z,
#' # type = "p",
#' # xlab = "x", ylab = "y", zlab = "z"
#' #)
#' #plot3d(
#' # center[1], center[2], center[3],
#' # type = "p",
#' # col = "red",
#' # add = TRUE
#' #)
#'
#' @export
spitcenter <- function(hex) {
.Call('recexcavAAR_spitcenter', PACKAGE = 'recexcavAAR', hex)
}
#' Center determination for rectangles whose tops and bottoms are defined by irregular surfaces (3D)
#'
#' \code{spitcenternat} first of all calculates the horizontal center of an input rectangle.
#' Then it determines the vertical positions of the center points in relation to a surface stack.
#'
#' @param hex data.frame with the 2D corners of the rectangle defined by four points
#' @param maplist list of data.frames which contain the points that make up the surfaces
#'
#' @return data.frame with the spatial coordinates of the center points
#'
#' @family centerdetfuncs
#'
#' @examples
#' df1 <- data.frame(
#' x = c(rep(0, 6), seq(0.2, 2.8, 0.2), seq(0.2, 2.8, 0.2), rep(3,6)),
#' y = c(seq(0, 1, 0.2), rep(0, 14), rep(1, 14), seq(0, 1, 0.2)),
#' z = c(0.9+0.05*rnorm(6), 0.9+0.05*rnorm(14), 1.3+0.05*rnorm(14), 1.2+0.05*rnorm(6))
#' )
#'
#' df2 <- data.frame(
#' x = c(rep(0, 6), seq(0.2, 2.8, 0.2), seq(0.2, 2.8, 0.2), rep(3,6)),
#' y = c(seq(0, 1, 0.2), rep(0, 14), rep(1, 14), seq(0, 1, 0.2)),
#' z = c(0.6+0.05*rnorm(6), 0.6+0.05*rnorm(14), 1.0+0.05*rnorm(14), 0.9+0.05*rnorm(6))
#' )
#'
#' df3 <- data.frame(
#' x = c(rep(0, 6), seq(0.2, 2.8, 0.2), seq(0.2, 2.8, 0.2), rep(3,6)),
#' y = c(seq(0, 1, 0.2), rep(0, 14), rep(1, 14), seq(0, 1, 0.2)),
#' z = c(0.3+0.05*rnorm(6), 0.3+0.05*rnorm(14), 0.7+0.05*rnorm(14), 0.6+0.05*rnorm(6))
#' )
#'
#' lpoints <- list(df1, df2, df3)
#'
#' maps <- kriglist(lpoints, lags = 3, model = "spherical")
#'
#' hexatestdf <- data.frame(
#' x = c(1, 1, 1, 1, 2, 2, 2, 2),
#' y = c(0, 1, 0, 1, 0, 1, 0, 1)
#' )
#'
#' spitcenternat(hexatestdf, maps)
#'
#' @export
spitcenternat <- function(hex, maplist) {
.Call('recexcavAAR_spitcenternat', PACKAGE = 'recexcavAAR', hex, maplist)
}
#' Center determination for rectangles whose tops and bottoms are defined by irregular
#' surfaces (3D) for multiple data.frames in a list
#'
#' \code{spitcenternatlist} works as \code{\link{spitcenternat}} but not just for a
#' single data.frame but for a list of data.frames
#'
#' @param hexlist list of data.frames with the 2D corners of the rectangles
#' @param maplist list of data.frames which contain the points that make up the surfaces
#'
#' @return list of data.frames with the spatial coordinates of the center points
#'
#' @family centerdetfuncs
#'
#' @examples
#' df1 <- data.frame(
#' x = c(rep(0, 6), seq(0.2, 2.8, 0.2), seq(0.2, 2.8, 0.2), rep(3,6)),
#' y = c(seq(0, 1, 0.2), rep(0, 14), rep(1, 14), seq(0, 1, 0.2)),
#' z = c(0.9+0.05*rnorm(6), 0.9+0.05*rnorm(14), 1.3+0.05*rnorm(14), 1.2+0.05*rnorm(6))
#' )
#'
#' df2 <- data.frame(
#' x = c(rep(0, 6), seq(0.2, 2.8, 0.2), seq(0.2, 2.8, 0.2), rep(3,6)),
#' y = c(seq(0, 1, 0.2), rep(0, 14), rep(1, 14), seq(0, 1, 0.2)),
#' z = c(0.6+0.05*rnorm(6), 0.6+0.05*rnorm(14), 1.0+0.05*rnorm(14), 0.9+0.05*rnorm(6))
#' )
#'
#' df3 <- data.frame(
#' x = c(rep(0, 6), seq(0.2, 2.8, 0.2), seq(0.2, 2.8, 0.2), rep(3,6)),
#' y = c(seq(0, 1, 0.2), rep(0, 14), rep(1, 14), seq(0, 1, 0.2)),
#' z = c(0.3+0.05*rnorm(6), 0.3+0.05*rnorm(14), 0.7+0.05*rnorm(14), 0.6+0.05*rnorm(6))
#' )
#'
#' lpoints <- list(df1, df2, df3)
#'
#' maps <- kriglist(lpoints, lags = 3, model = "spherical")
#'
#' hexatestdf1 <- data.frame(
#' x = c(1, 1, 1, 1, 2, 2, 2, 2),
#' y = c(0, 1, 0, 1, 0, 1, 0, 1)
#' )
#'
#' hexatestdf2 <- data.frame(
#' x = c(0, 0, 0, 0, 1, 1, 1, 1),
#' y = c(0, 1, 0, 1, 0, 1, 0, 1)
#' )
#'
#' hexs <- list(hexatestdf1, hexatestdf2)
#'
#' spitcenternatlist(hexs, maps)
#'
#' @export
spitcenternatlist <- function(hexlist, maplist) {
.Call('recexcavAAR_spitcenternatlist', PACKAGE = 'recexcavAAR', hexlist, maplist)
}
Try the recexcavAAR package in your browser
Any scripts or data that you put into this service are public.
recexcavAAR documentation built on May 1, 2019, 6:48 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
#' Draws a circular point cloud (3D)
#'
#' @description
#' Draws a 2D circle on x- and y-plane around a center point in 3D space.
#'
#' @param centerx x axis value of circle center point
#' @param centery y axis value of circle center point
#' @param centerz z axis value of circle center point
#' @param radius circle radius
#' @param resolution amount of circle points (default = 30)
#'
#' @return
#' data.frame with the spatial coordinates of the resulting points
#'
#' @examples
#' draw_circle(
#' centerx = 4,
#' centery = 5,
#' centerz = 1,
#' radius = 3,
#' resolution = 20
#' )
#'
#' circ <- draw_circle(1,2,3,2)
#'
#' plot(circ$x, circ$y)
#'
#' @export
draw_circle <- function(centerx, centery, centerz, radius, resolution = 30L) {
.Call('recexcavAAR_draw_circle', PACKAGE = 'recexcavAAR', centerx, centery, centerz, radius, resolution)
}
#' Rotate a point cloud around a pivot point (3D)
#'
#' @description
#' Rotate a point cloud around a defined pivot point by defined angles. The default
#' rotation angle around each axis is zero and the default pivot point is the center
#' point of the point cloud (defined by mean())
#'
#' @param x vector of x axis values of rotation point cloud
#' @param y vector of y axis values of rotation point cloud
#' @param z vector of z axis values of rotation point cloud
#' @param degrx rotation angle around x axis in degree (default = 0)
#' @param degry rotation angle around y axis in degree (default = 0)
#' @param degrz rotation angle around z axis in degree (default = 0)
#' @param pivotx x axis value of pivot point (default = mean(x))
#' @param pivoty y axis value of pivot point (default = mean(y))
#' @param pivotz z axis value of pivot point (default = mean(z))
#'
#' @return
#' data.frame with the spatial coordinates of the resulting points
#'
#' @examples
#' circ <- draw_circle(0,0,0,5)
#'
#' #library(rgl)
#' #plot3d(
#' # circ,
#' # xlim = c(-6,6),
#' # ylim = c(-6,6),
#' # zlim = c(-6,6)
#' #)
#'
#' rotcirc <- rotate(circ$x, circ$y, circ$z, degrx = 45)
#'
#' #plot3d(
#' # rotcirc,
#' # xlim = c(-6,6),
#' # ylim = c(-6,6),
#' # zlim = c(-6,6)
#' #)
#'
#' @export
rotate <- function(x, y, z, degrx = 0.0, degry = 0.0, degrz = 0.0, pivotx = NA_real_, pivoty = NA_real_, pivotz = NA_real_) {
.Call('recexcavAAR_rotate', PACKAGE = 'recexcavAAR', x, y, z, degrx, degry, degrz, pivotx, pivoty, pivotz)
}
#' Draws a spherical point cloud (3D)
#'
#' @description
#' Draws a sphere around a center point in 3D space.
#'
#' @param centerx x axis value of sphere center point
#' @param centery y axis value of sphere center point
#' @param centerz z axis value of sphere center point
#' @param radius sphere radius
#' @param phires phi resolution (default = 10)
#' @param thetares theta resolution (default = 10)
#'
#' @return
#' data.frame with the spatial coordinates of the resulting points
#'
#' @examples
#' sphere <- draw_sphere(
#' centerx = 4,
#' centery = 5,
#' centerz = 1,
#' radius = 3,
#' phires = 20,
#' thetares = 20
#' )
#'
#' #library(rgl)
#' #plot3d(sphere)
#'
#' @export
draw_sphere <- function(centerx, centery, centerz, radius, phires = 10L, thetares = 10L) {
.Call('recexcavAAR_draw_sphere', PACKAGE = 'recexcavAAR', centerx, centery, centerz, radius, phires, thetares)
}
#' Scales a point cloud (3D)
#'
#' @description
#' Scales a 3D point cloud on every axis.
#'
#' @param x vector of x axis values of scale point cloud
#' @param y vector of y axis values of scale point cloud
#' @param z vector of z axis values of scale point cloud
#' @param scalex scaling factor on x axis (default = 1)
#' @param scaley scaling factor on y axis (default = 1)
#' @param scalez scaling factor on z axis (default = 1)
#'
#' @return
#' data.frame with the spatial coordinates of the resulting points
#'
#' @examples
#' s <- draw_sphere(1,1,1,3)
#'
#' #library(rgl)
#' #plot3d(s)
#'
#' s2 <- rescale(s$x, s$y, s$z, scalex = 4, scalez = 5)
#'
#' #library(rgl)
#' #plot3d(s2)
#'
#' @export
rescale <- function(x, y, z, scalex = 1, scaley = 1, scalez = 1) {
.Call('recexcavAAR_rescale', PACKAGE = 'recexcavAAR', x, y, z, scalex, scaley, scalez)
}
#' Fills hexahedrons with a regular point raster (3D)
#'
#' @description
#' A hexahedron is a three dimensional shape that is defined by 6 faces and 8 corner points.
#' \code{fillhexa} allows to fill such a shape with a regular point raster.
#'
#' @details
#' See \url{https://stackoverflow.com/questions/36115215/filling-a-3d-body-with-a-systematic-point-raster}
#' for a description of the function and how it was developed.
#'
#' @param hex dataframe with three columns and eight rows to define a hexahedron by its corner
#' point coordinates x, y and z
#' @param res numeric value > 0 and <= 1 for the resolution of the point raster
#'
#' @return data.frame with the spatial coordinates of the resulting points of the grid
#'
#' @examples
#' hexatestdf <- data.frame(
#' x = c(0,1,0,4,5,5,5,5),
#' y = c(1,1,4,4,1,1,4,4),
#' z = c(4,8,4,9,4,8,4,6)
#' )
#'
#' cx = fillhexa(hexatestdf, 0.1)
#'
#' #library(rgl)
#' #plot3d(
#' # cx[,1], cx[,2], cx[,3],
#' # type = "p",
#' # xlab = "x", ylab = "y", zlab = "z"
#' #)
#'
#' @export
fillhexa <- function(hex, res) {
.Call('recexcavAAR_fillhexa', PACKAGE = 'recexcavAAR', hex, res)
}
#' Check if a point is within a polygon (2D)
#'
#' @description
#' \code{pnp} is able to determine if a point is within a polygon in 2D space.
#' The polygon is described by its corner points. The points must be in a correct
#' drawing order.
#'
#' Based on this solution:
#' Copyright (c) 1970-2003, Wm. Randolph Franklin
#' \url{http://wrf.ecse.rpi.edu/pmwiki/pmwiki.php/Main/Software#toc24}
#'
#' @details
#' For discussion see: \url{http://stackoverflow.com/questions/217578/how-can-i-determine-whether-a-2d-point-is-within-a-polygon/2922778#2922778}
#'
#' @param vertx vector of x axis values of polygon corner points
#' @param verty vector of y axis values of polygon corner points
#' @param testx x axis value of point of interest
#' @param testy y axis value of point of interest
#'
#' @return boolean value - TRUE, if the point is within the polygon. Otherwise FALSE.
#'
#' @family pnpfuncs
#'
#' @examples
#' df <- data.frame(
#' x = c(1,1,2,2),
#' y = c(1,2,1,2)
#' )
#'
#' pnp(df$x, df$y, 1.5, 1.5)
#' pnp(df$x, df$y, 2.5, 2.5)
#'
#' # caution: false-negatives in edge-cases:
#' pnp(df$x, df$y, 2, 1.5)
#'
#' @export
pnp <- function(vertx, verty, testx, testy) {
.Call('recexcavAAR_pnp', PACKAGE = 'recexcavAAR', vertx, verty, testx, testy)
}
#' Check if multiple points are within a polygon (2D)
#'
#' @description
#' \code{pnpmulti} works as \code{\link{pnp}} but for multiple points.
#'
#' @param vertx vector of x axis values of polygon corner points
#' @param verty vector of y axis values of polygon corner points
#' @param testx vector of x axis values of points of interest
#' @param testy vector of y axis values of points of interest
#'
#' @return vector with boolean values - TRUE, if the respective point is within the polygon.
#' Otherwise FALSE.
#'
#' @examples
#' polydf <- data.frame(
#' x = c(1,1,2,2),
#' y = c(1,2,1,2)
#' )
#'
#' testdf <- data.frame(
#' x = c(1.5, 2.5),
#' y = c(1.5, 2.5)
#' )
#'
#' pnpmulti(polydf$x, polydf$y, testdf$x, testdf$y)
#'
#' @family pnpfuncs
#'
#' @export
pnpmulti <- function(vertx, verty, testx, testy) {
.Call('recexcavAAR_pnpmulti', PACKAGE = 'recexcavAAR', vertx, verty, testx, testy)
}
#' Multiple point position decision in relation to a set of stacked surfaces (3D)
#'
#' \code{posdec} has the purpose to make a decision about the position of individual points in relation
#' to a set of stacked surfaces in 3D space. The decision is made by comparing the mean z axis value of
#' the four horizontally closest points of a surface to the z axis value of the point in question.
#'
#' @param crdf data.frame with the spatial coordinates of the points of interest. Must contain three
#' columns with the x axis values, y axis values and z axis values of the points in the order x, y, z
#' @param maplist list of data.frames which contain the points that make up the surfaces. The individual
#' data.frames must have the same structure as \code{crdf}
#'
#' @return data.frame with the spatial coordinates of the points of interest and the respective position
#' information
#'
#' @family posdecfuncs
#'
#' @examples
#' df1 <- data.frame(
#' x = rnorm(50),
#' y = rnorm(50),
#' z = rnorm(50) - 5
#' )
#'
#' df2 <- data.frame(
#' x = rnorm(50),
#' y = rnorm(50),
#' z = rnorm(50) + 5
#')
#'
#' lpoints <- list(df1, df2)
#'
#' maps <- kriglist(lpoints, lags = 3, model = "spherical")
#'
#' finds <- data.frame(
#' x = c(0, 1, 0.5, 0.7),
#' y = c(0.5, 0, 1, 0.7),
#' z = c(-10, 10, 0, 2)
#' )
#'
#' posdec(finds, maps)
#'
#' @export
posdec <- function(crdf, maplist) {
.Call('recexcavAAR_posdec', PACKAGE = 'recexcavAAR', crdf, maplist)
}
#' Multiple point position decision in relation to a set of stacked surfaces (3D)
#' for multiple data.frames in a list
#'
#' \code{posdeclist} works as \code{\link{posdec}} but not just for a single data.frame
#' with individual points but for a list of data.frames
#'
#' @param crdflist list of data.frames with the spatial coordinates of the points of
#' interest (for details see \code{\link{posdec}})
#' @param maplist list of data.frames which contain the points that make up the surfaces
#'
#' @return list of data.frames with the spatial coordinates of the points of interest
#' and the respective position information
#'
#' @family posdecfuncs
#'
#' @examples
#' df1 <- data.frame(
#' x = rnorm(50),
#' y = rnorm(50),
#' z = rnorm(50) - 5
#' )
#'
#' df2 <- data.frame(
#' x = rnorm(50),
#' y = rnorm(50),
#' z = rnorm(50) + 5
#')
#'
#' lpoints <- list(df1, df2)
#'
#' maps <- kriglist(lpoints, lags = 3, model = "spherical")
#'
#' hexadf1 <- data.frame(
#' x = c(0, 1, 0, 4, 5, 5, 5, 5),
#' y = c(1, 1, 4, 4, 1, 1, 4, 4),
#' z = c(1, 5, 1, 6, 1, 5, 1, 3)
#' )
#'
#' hexadf2 <- data.frame(
#' x = c(0, 1, 0, 4, 5, 5, 5, 5),
#' y = c(1, 1, 4, 4, 1, 1, 4, 4),
#' z = c(-1, -5, -1, -6, -1, -5, -1, -3)
#' )
#'
#' cx1 <- fillhexa(hexadf1, 0.1)
#' cx2 <- fillhexa(hexadf2, 0.1)
#'
#' cubelist <- list(cx1, cx2)
#'
#' posdeclist(cubelist, maps)
#'
#' @export
posdeclist <- function(crdflist, maplist) {
.Call('recexcavAAR_posdeclist', PACKAGE = 'recexcavAAR', crdflist, maplist)
}
#' Transformation of numeric matrices from wide to long format
#'
#' \code{spatiallong} transforms a set of two independent variables in vectors and a
#' dependent variable in a wide matrix to a long matrix that combines the information.
#' The result is exported as a data.frame.
#'
#' @param x vector of first independent variable. e.g. vector with x axis spatial points
#' @param y vector of second independent variable. e.g. vector with y axis spatial points
#' @param z matrix of dependent variable. e.g. matrix with z axis spatial points
#'
#' @return data.frame with three columns x, y and z
#'
#' @family transfuncs
#'
#' @examples
#' x <- c(1, 1, 1, 2, 2, 2, 3, 3, 4)
#' y <- c(1, 2, 3, 1, 2, 3, 1, 2, 3)
#' z <- c(3, 4, 2, 3, NA, 5, 6, 3, 1)
#'
#' sw <- spatialwide(x, y, z, digits = 3)
#'
#' spatiallong(sw$x, sw$y, sw$z)
#'
#' @export
spatiallong <- function(x, y, z) {
.Call('recexcavAAR_spatiallong', PACKAGE = 'recexcavAAR', x, y, z)
}
#' Transformation of numeric matrices from long to wide format
#'
#' Transforms a set of two independent and one dependent variables in vectors from a long
#' to a wide format and exports this result as a list
#'
#' @param x vector of first independent variable. e.g. vector with x-axis spatial points
#' @param y vector of second independent variable. e.g. vector with y-axis spatial points
#' @param z vector of dependent variable. e.g. vector with z-axis spatial points
#' @param digits integer indicating the number of decimal places to be used for rounding
#' the dependent variables \code{x} and \code{y}.
#'
#' @return List with three elements:
#'
#' $x: vector with ascendingly sorted, unique values of the first independent variable \code{x}
#'
#' $y: vector with ascendingly sorted, unique values of the second independent variable \code{y}
#'
#' $z: matrix with the values of z for the defined combinations of \code{x} (columns) and
#' \code{y} (rows)
#'
#' @family transfuncs
#'
#' @examples
#' x <- c(1, 1, 1, 2, 2, 2, 3, 3, 4)
#' y <- c(1, 2, 3, 1, 2, 3, 1, 2, 3)
#' z <- c(3, 4, 2, 3, NA, 5, 6, 3, 1)
#'
#' spatialwide(x, y, z, digits = 3)
#'
#' @export
spatialwide <- function(x, y, z, digits) {
.Call('recexcavAAR_spatialwide', PACKAGE = 'recexcavAAR', x, y, z, digits)
}
#' Center determination for hexahedrons
#'
#' A hexahedron is a three dimensional shape that is defined by 6 faces and 8 corner points.
#' \code{spitcenter} determines a center point for an input hexahedron by calculating the mean
#' of the maximal extent on all three axis.
#'
#' @param hex dataframe with three columns and eight rows to define a hexahedron by its corner
#' point coordinates x, y and z
#'
#' @return vector with the spatial coordinates of the center point of the input hexahedron
#'
#' @family centerdetfuncs
#'
#' @examples
#' hexatestdf <- data.frame(
#' x = c(0,1,0,4,5,5,5,5),
#' y = c(1,1,4,4,1,1,4,4),
#' z = c(4,8,4,9,4,8,4,6)
#' )
#'
#' center <- spitcenter(hexatestdf)
#'
#' #library(rgl)
#' #plot3d(
#' # hexatestdf$x, hexatestdf$y, hexatestdf$z,
#' # type = "p",
#' # xlab = "x", ylab = "y", zlab = "z"
#' #)
#' #plot3d(
#' # center[1], center[2], center[3],
#' # type = "p",
#' # col = "red",
#' # add = TRUE
#' #)
#'
#' @export
spitcenter <- function(hex) {
.Call('recexcavAAR_spitcenter', PACKAGE = 'recexcavAAR', hex)
}
#' Center determination for rectangles whose tops and bottoms are defined by irregular surfaces (3D)
#'
#' \code{spitcenternat} first of all calculates the horizontal center of an input rectangle.
#' Then it determines the vertical positions of the center points in relation to a surface stack.
#'
#' @param hex data.frame with the 2D corners of the rectangle defined by four points
#' @param maplist list of data.frames which contain the points that make up the surfaces
#'
#' @return data.frame with the spatial coordinates of the center points
#'
#' @family centerdetfuncs
#'
#' @examples
#' df1 <- data.frame(
#' x = c(rep(0, 6), seq(0.2, 2.8, 0.2), seq(0.2, 2.8, 0.2), rep(3,6)),
#' y = c(seq(0, 1, 0.2), rep(0, 14), rep(1, 14), seq(0, 1, 0.2)),
#' z = c(0.9+0.05*rnorm(6), 0.9+0.05*rnorm(14), 1.3+0.05*rnorm(14), 1.2+0.05*rnorm(6))
#' )
#'
#' df2 <- data.frame(
#' x = c(rep(0, 6), seq(0.2, 2.8, 0.2), seq(0.2, 2.8, 0.2), rep(3,6)),
#' y = c(seq(0, 1, 0.2), rep(0, 14), rep(1, 14), seq(0, 1, 0.2)),
#' z = c(0.6+0.05*rnorm(6), 0.6+0.05*rnorm(14), 1.0+0.05*rnorm(14), 0.9+0.05*rnorm(6))
#' )
#'
#' df3 <- data.frame(
#' x = c(rep(0, 6), seq(0.2, 2.8, 0.2), seq(0.2, 2.8, 0.2), rep(3,6)),
#' y = c(seq(0, 1, 0.2), rep(0, 14), rep(1, 14), seq(0, 1, 0.2)),
#' z = c(0.3+0.05*rnorm(6), 0.3+0.05*rnorm(14), 0.7+0.05*rnorm(14), 0.6+0.05*rnorm(6))
#' )
#'
#' lpoints <- list(df1, df2, df3)
#'
#' maps <- kriglist(lpoints, lags = 3, model = "spherical")
#'
#' hexatestdf <- data.frame(
#' x = c(1, 1, 1, 1, 2, 2, 2, 2),
#' y = c(0, 1, 0, 1, 0, 1, 0, 1)
#' )
#'
#' spitcenternat(hexatestdf, maps)
#'
#' @export
spitcenternat <- function(hex, maplist) {
.Call('recexcavAAR_spitcenternat', PACKAGE = 'recexcavAAR', hex, maplist)
}
#' Center determination for rectangles whose tops and bottoms are defined by irregular
#' surfaces (3D) for multiple data.frames in a list
#'
#' \code{spitcenternatlist} works as \code{\link{spitcenternat}} but not just for a
#' single data.frame but for a list of data.frames
#'
#' @param hexlist list of data.frames with the 2D corners of the rectangles
#' @param maplist list of data.frames which contain the points that make up the surfaces
#'
#' @return list of data.frames with the spatial coordinates of the center points
#'
#' @family centerdetfuncs
#'
#' @examples
#' df1 <- data.frame(
#' x = c(rep(0, 6), seq(0.2, 2.8, 0.2), seq(0.2, 2.8, 0.2), rep(3,6)),
#' y = c(seq(0, 1, 0.2), rep(0, 14), rep(1, 14), seq(0, 1, 0.2)),
#' z = c(0.9+0.05*rnorm(6), 0.9+0.05*rnorm(14), 1.3+0.05*rnorm(14), 1.2+0.05*rnorm(6))
#' )
#'
#' df2 <- data.frame(
#' x = c(rep(0, 6), seq(0.2, 2.8, 0.2), seq(0.2, 2.8, 0.2), rep(3,6)),
#' y = c(seq(0, 1, 0.2), rep(0, 14), rep(1, 14), seq(0, 1, 0.2)),
#' z = c(0.6+0.05*rnorm(6), 0.6+0.05*rnorm(14), 1.0+0.05*rnorm(14), 0.9+0.05*rnorm(6))
#' )
#'
#' df3 <- data.frame(
#' x = c(rep(0, 6), seq(0.2, 2.8, 0.2), seq(0.2, 2.8, 0.2), rep(3,6)),
#' y = c(seq(0, 1, 0.2), rep(0, 14), rep(1, 14), seq(0, 1, 0.2)),
#' z = c(0.3+0.05*rnorm(6), 0.3+0.05*rnorm(14), 0.7+0.05*rnorm(14), 0.6+0.05*rnorm(6))
#' )
#'
#' lpoints <- list(df1, df2, df3)
#'
#' maps <- kriglist(lpoints, lags = 3, model = "spherical")
#'
#' hexatestdf1 <- data.frame(
#' x = c(1, 1, 1, 1, 2, 2, 2, 2),
#' y = c(0, 1, 0, 1, 0, 1, 0, 1)
#' )
#'
#' hexatestdf2 <- data.frame(
#' x = c(0, 0, 0, 0, 1, 1, 1, 1),
#' y = c(0, 1, 0, 1, 0, 1, 0, 1)
#' )
#'
#' hexs <- list(hexatestdf1, hexatestdf2)
#'
#' spitcenternatlist(hexs, maps)
#'
#' @export
spitcenternatlist <- function(hexlist, maplist) {
.Call('recexcavAAR_spitcenternatlist', PACKAGE = 'recexcavAAR', hexlist, maplist)
}
Try the recexcavAAR package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.