# R/parametric.R In geozoo: Zoo of Geometric Objects

#### Documented in boy.surfaceconic.spiralconic.spiral.nautiluscross.capdini.surfaceellipsoidenneper.surfaceklein.fig.eightroman.surface

##Parametric Eqn's

#' Boy Surface
#'
#' A function to produce a Boy Surface.
#'
#' @param n number of points
#' @references \url{http://schloerke.github.io/geozoo/mobius/other/}
#' @author Barret Schloerke
#' @examples
#' ## Generates a Boy Surface
#' boy.surface(n = 1000)
#'
#' @keywords dynamic
#' @export
boy.surface <- function(n = 10000) {
vert <- matrix(
do.call(
"rbind",
as.list(
replicate(n, boy_surface_row())
)
),
ncol = 3, byrow = TRUE
)
wires <- NULL

structure(
list(points = vert, edges = wires),
class = c("geozooNoScale", "geozoo")
)
}

#' @keywords internal
boy_surface_row <- function( ){
u <- runif( 1, min = 0, max = pi)
v <- runif( 1, min = 0, max = pi)
a <- cos( v) * sin( u)
b <- sin( v) * sin( u)
c <- cos( u)
x <- 1 / 2 * (
( 2 * a ^ 2 - b ^ 2 - c ^ 2) +
2 * b * c * ( b ^ 2 - c ^ 2) +
c * a * ( a ^ 2 - c ^ 2) +
a * b * ( b ^ 2 - a ^ 2)
)
y <- sqrt(3) / 2 * (
( b ^ 2 - c ^ 2) +
c * a * ( c ^ 2 - a ^ 2) +
a * b * ( b ^ 2 - a ^ 2)
)
z <- ( a + b + c) * (
( a + b + c) ^ 3 +
4 * ( b - a) * ( c - b) * ( a - c)
)
z <- z / 8
return( cbind( x, y, z))
}

#' Conic Spiral
#'
#' A function to produce a conic spiral
#'
#' @param n number of points
#' @param a final radius of cone
#' @param b height of object
#' @param w number of spirals
#' @return
#'  \item{points }{location of points}
#'  \item{edges }{edges of the object (null)}
#' @references \url{http://schloerke.github.io/geozoo/mobius/other/}
#' @author Barret Schloerke
#' @examples
#' ## Generates a Conic Spiral
#' conic.spiral(n = 1000)
#'
#' @keywords dynamic
#' @export
conic.spiral <- function(n = 10000, a = .2, b = 1, c = .1, w = 2) {
vert <- matrix(
do.call(
"rbind",
as.list(
replicate(n, conic_spiral_row(a, b, c, w))
)
),
ncol = 3, byrow = TRUE
)
wires <- NULL

structure(
list(points = vert, edges = wires),
class = c("geozooNoScale", "geozoo")
)
}

#' @keywords internal
conic_spiral_row <- function(a, b, c, w) {
u <- runif( 1, min = 0, max = 2 * pi)
v <- runif( 1, min = 0, max = 2 * pi)

x <- a * ( 1 - v / ( 2 * pi)) * cos( w * v) * ( 1 + cos( u)) +
c * cos( w * v)
y <- a * ( 1 - v / ( 2 * pi)) * sin( w * v) * ( 1 + cos( u)) +
c * sin( w * v)
z <- ( b * v + a * ( 1 - v / ( 2 * pi)) * sin( u)) / ( 2 * pi)
return( cbind( x, y, z))
}

#' Conic Spiral (Nautilus Shape)
#'
#' A function to produce a Conic Spiral in a nautilus shape
#'
#' @param n number of points
#' @param a final radius of cone
#' @param b height of object
#' @param w number of spirals
#' @return
#'  \item{points }{location of points}
#'  \item{edges }{edges of the object (null)}
#' @references \url{http://schloerke.github.io/geozoo/mobius/other/}
#' @author Barret Schloerke
#' @examples
#' ## Generates a Nautilus Conic Spiral
#' conic.spiral.nautilus( n = 1000 )
#'
#' @keywords dynamic
#' @export
conic.spiral.nautilus <- function(n = 10000, a = .2, b = .1, c = 0, w = 2) {
vert <- matrix(
do.call(
"rbind",
as.list(
replicate(n, conic_spiral_row(a, b, c, w))
)
),
ncol = 3, byrow = TRUE
)
wires <- NULL

structure(
list(points = vert, edges = wires),
class = c("geozooNoScale", "geozoo")
)
}

#' Cross Cap
#'
#' A function to generate a cross cap
#'
#' @param n number of points
#' @return
#'  \item{points }{location of points}
#'  \item{edges }{edges of the object (null)}
#' @references \url{http://schloerke.github.io/geozoo/mobius/other/}
#' @author Barret Schloerke
#' @examples
#' ## Generates a Cross Cap
#' cross.cap( n = 1000 )
#'
#' @keywords dynamic
#' @export
cross.cap <- function(n = 10000) {
vert <- matrix(
do.call(
"rbind",
as.list(
replicate(n, cross_cap_row())
)
),
ncol = 3, byrow = TRUE
)
wires <- NULL

structure(
list(points = vert, edges = wires),
class = c("geozooNoScale", "geozoo")
)
}

#' @keywords internal
cross_cap_row <- function( ) {
u <- runif( 1, min = 0, max = pi)
v <- runif( 1, min = 0, max = pi)
x <- cos( u) * sin( 2 * v)
y <- sin( u) * sin( 2 * v)
z <- cos( v) * cos( v) - cos( u) * cos( u) * sin( v) * sin( v)
return( cbind( x, y, z))
}

#' Dini Surface
#'
#' A function to generate a dini surface.
#'
#' @param n number of points
#' @param a outer radius of object
#' @param b space between loops
#' @return
#'  \item{points }{location of points}
#'  \item{edges }{edges of the object (null)}
#' @references \url{http://schloerke.github.io/geozoo/mobius/other/}
#' @author Barret Schloerke
#' @examples
#' ## Generates a Dini Surface
#' dini.surface(n = 1000, a = 1, b = 1)
#'
#' @keywords dynamic
#' @export
dini.surface <- function(n = 10000, a = 1, b = 1) {
vert <- matrix(
do.call(
"rbind",
as.list(
replicate(n, dini_surface_row( a, b))
)
),
ncol = 3, byrow = TRUE
)
wires <- NULL

structure(
list( points = vert, edges = wires),
class = c("geozooNoScale", "geozoo")
)
}

#' @keywords internal
dini_surface_row <- function(a = 1, b = 1) {
u <- runif( 1, min = 0, max = 4 * pi)
v <- runif( 1, min = 0.0000000001, max = 2)
x <- a * cos( u) * sin( v)
y <- a * sin( u) * sin( v)
z <- a * ( cos(v) + log(tan(v / 2))) + (b * u)
return( cbind( x, y, z))
}

#' Ellipsoid
#'
#' A function to generate an ellipsoid
#'
#' @param n number of points
#' @param a radius in x direction
#' @param b radius in y direction
#' @param c radius in z direction
#' @return
#'  \item{points }{location of points}
#'  \item{edges }{edges of the object (null)}
#' @references \url{http://schloerke.github.io/geozoo/mobius/other/}
#' @author Barret Schloerke
#' @examples
#' ## Generates an ellipsoid
#' ellipsoid(n = 1000, a = 1, b = 1, c = 3)
#'
#' @keywords dynamic
#' @export
ellipsoid <- function(n = 10000, a = 1, b = 1, c = 3) {
vert <- matrix(
do.call(
"rbind",
as.list(
replicate(n, ellipsoid_row(a, b, c))
)
),
ncol = 3, byrow = TRUE
)
wires <- NULL

structure(
list(points = vert, edges = wires),
class = c("geozooNoScale", "geozoo")
)
}

#' @keywords internal
ellipsoid_row <- function(a, b, c) {
u <- runif( 1, min = 0, max = 2 * pi)
v <- runif( 1, min = 0, max = 2 * pi)
x <- a * cos( u) * sin( v)
y <- b * sin( u) * sin( v)
z <- c * cos( v)
return( cbind( x, y, z))
}

#' Enneper's Surface
#'
#' A function to generate Enneper's surface
#'
#' @param n number of points
#' @param a angle, radians, minimum and maximum.  -a < angle < a
#' @return
#'  \item{points }{location of points}
#'  \item{edges }{edges of the object (null)}
#' @references \url{http://schloerke.github.io/geozoo/mobius/other/}
#' @author Barret Schloerke
#' @examples
#' ## Generates an Enneper Surface
#' enneper.surface(n = 1000, a = 4)
#'
#' @keywords dynamic
#' @export
enneper.surface <- function(n = 10000, a = 4) {
vert <- matrix(
do.call(
"rbind",
as.list(
replicate(n, enneper_surface_row(a))
)
),
ncol = 3, byrow = TRUE
)
wires <- NULL

structure(
list( points = vert, edges = wires),
class = c("geozooNoScale", "geozoo")
)
}

#' @keywords internal
enneper_surface_row <- function( a = 4) {
u <- runif( 1, min = - a, max = a)
v <- runif( 1, min = - a, max = a)
x <- u - u ^ 3 / 3 + u * v ^ 2
y <- v - v ^ 3 / 3 + v * u ^ 2
z <- u ^ 2 - v ^ 2
return( cbind( x, y, z))
}

#' Figure Eight Klein Bottle
#'
#' A function to generate a figure eight Klein bottle
#'
#' @param n number of points
#' @return
#'  \item{points }{location of points}
#'  \item{edges }{edges of the object (null)}
#' @references \url{http://schloerke.github.io/geozoo/mobius/other/}
#' @author Barret Schloerke
#' @examples
#' ## Generates a figure eight Klein bottle.
#' klein.fig.eight(n = 1000, a = 3, b = 1)
#'
#' @keywords dynamic
#' @export
klein.fig.eight <- function(n = 10000, a = 3, b = 1) {
vert <- matrix(
do.call(
"rbind",
as.list(
replicate(n, klein_fig_eight_row(a, b))
)
),
ncol = 4,
byrow = TRUE
)
wires <- NULL

structure(
list( points = vert, edges = wires),
class = c("geozooNoScale", "geozoo")
)
}

#' @keywords internal
klein_fig_eight_row <- function( a = 3, b = 1) {
u <- runif( 1, min = - pi, max = pi)
v <- runif( 1, min = - pi, max = pi)
x <- ( b * cos( v) + a) * cos( u)
y <- ( b * cos( v) + a) * sin( u)
z <- b * sin( v) * cos( u / 2)
w <- b * sin( v) * sin( u / 2)
return( cbind( x, y, z, w))
}

#' Roman Surface
#'
#' A function to generate a Roman surface, also known as a Steiner surface
#'
#' @param n number of points
#' @param a maximum radius of object
#' @return
#'  \item{points }{location of points}
#'  \item{edges }{edges of the object (null)}
#' @references \url{http://schloerke.github.io/geozoo/mobius/other/}
#' @author Barret Schloerke
#' @examples
#' ## Generates a Roman surface.
#' roman.surface(n = 1000, a = 1)
#'
#' @keywords dynamic
#' @export
roman.surface <- function(n = 10000, a = 1) {
vert <- matrix(
do.call(
"rbind",
as.list(
replicate(n, roman_surface_row(a))
)
),
ncol = 3, byrow = TRUE
)
wires <- NULL

structure(
list(points = vert, edges = wires),
class = c("geozooNoScale", "geozoo")
)
}

#' @keywords internal
roman_surface_row <- function(a = 1) {
u <- runif( 1, min = 0, max = pi)
v <- runif( 1, min = 0, max = pi)
x <- a ^ 2 * cos( v) * cos( v) * sin( 2 * u) / 2
y <- a ^ 2 * sin( u) * sin( 2 * v) / 2
z <- a ^ 2 * cos( u) * sin( 2 * v) / 2
return( cbind( x, y, z))
}


## Try the geozoo package in your browser

Any scripts or data that you put into this service are public.

geozoo documentation built on May 29, 2017, 5:58 p.m.