#' Create a class for catenary
#'
#' Creates a basic catenary with endpoints
#'
#' @exportClass catenary
#' @name catenary-class
#' @rdname catenary-class
#' @slot c1 shape parameter
#' @slot c2 x-location parameter
#' @slot lambda y-location parameter
#' @slot endpoints left and right endpoint in data frame
#' @slot L length of catenary
#' @return an object of class \code{catenary}
#' @examples
#' getSlots("catenary")
methods::setClass(
Class="catenary",
representation(
c1 = "numeric",
c2 = "numeric",
lambda = "numeric",
endpoints = "data.frame",
L="numeric"
),
validity = function(object){
if(length(object@c1) >1 |
length(object@c2) > 1 |
length(object@lambda) > 1){
stop ("c1, c2, and lambda must all be scalars")
}
if(length(object@c1) == 0 | length(object@c2) == 0 |
length(object@lambda) == 0){
stop ("c1, c2, and lambda must be given")
}
return(TRUE)
}
)
#' Creates a catenary object
#'
#' First constructor that takes c1, c2, lambda, x0 and x1
#' Second constructor takes endpoints and either length or gives
#' natural or maximum catenary (one that just touches the ground)
#'
#' @param c1 shape parameter
#' @param c2 x-location parameter
#' @param lambda y-location parameter
#' @param x0 left point
#' @param x1 right point
#' @param endpoints 2 x 2 matrix or data frame with column x and y
#' and rows left and right
#' @param L length of catenary
#' @param type max or natural if length not given
#' @return an instance of \code{catenary} class
#' @export
#' @examples
#' cat1 <- catenary()
#' plot(cat1)
#' cat2 <- catenary(c1=1,c2=2,lambda=3,x0=0,x1=4)
#' plot(cat2)
#' x <- c(-1,1)
#' y <- c(2,2)
#' endpoints <- data.frame(x=x,y=y)
#' cat3 <- catenary(endpoints=endpoints,L=5)
#' plot(cat3)
#' cat4 <- catenary(endpoints=endpoints,type='natural')
#' plot(cat4)
#' cat5 <- catenary(endpoints=endpoints,type='max')
#' plot(cat5)
catenary <- function(c1=1,c2=0,lambda=0,x0=-1,x1=1,endpoints=NULL,L=NULL,type="natural"){
if(x1 <= x0){
stop("x0 must be to the left of x1")
}
if(!is.null(endpoints)){
# Use end points to calcalate para
if(is.null(L)){
# in this case no length so either natural or max
if(type=="natural"){
par <- fitNaturalCat(endpoints)
c1 <- par[1]
c2 <- par[2]
lambda <- par[3]
} else {
# Assume that wanted max
par <- fitMaxCat(endpoints)
c1 <- par[1]
c2 <- par[2]
lambda <- par[3]
}
} else {
# Given length
if(nrow(endpoints) != 2 | ncol(endpoints) != 2){
stop("Given endpoints must be a 2x2 data frame")
}
# Old method no longer used
# par <- fitCatEndPts(endpoints,L)
par <- fitCat(endpoints,L)
c1 <- par[1]
c2 <- par[2]
lambda <- par[3]
}
x0 <- endpoints[1,1]
x1 <- endpoints[2,1]
}
y0 <- f(x0,c1,c2,lambda)
y1 <- f(x1,c1,c2,lambda)
endpoints <- data.frame(x=c(x0,x1),y=c(y0,y1))
row.names(endpoints) <- c('left','right')
L <- getCatLength(x0=x0,x1=x1,c1=c1,c2=c2)
methods::new('catenary',c1=c1,c2=c2,lambda=lambda,endpoints=endpoints,L=L)
}
#' Set generic plot
#'
#' Overload plot
#'
#' @param x x-coordinate
#' @param y y-coordinate
#' @param ... extra
#' @export
#' @name plot
#' @docType methods
methods::setGeneric("plot", function(x, y, ...) standardGeneric("plot"))
#' @aliases plot,catenary-method
#' @name plot
#' @examples
#' tmp <- catenary(c1=1,c2=3,lambda=1,x0=0,x1=4)
#' plot(tmp)
methods::setMethod(f='plot',
signature='catenary',
definition = function(x,y,...){
xpts <- ypts <- NULL
tmp <- getPoints(x)
p <- ggplot2::ggplot(data=tmp,ggplot2::aes(x=xpts,y = ypts))
p <- p + ggplot2::geom_line()
p <- p + ggplot2::geom_point(ggplot2::aes(x=x,y=y),data=x@endpoints)
p <- p + ggplot2::labs(x="x",y="y")
return(p)
}
)
#' Method to get points for catenary
#'
#' Gives points for plotting
#'
#' @return data frame of points
#' @export
#' @keywords internal
#' @rdname getPoints
#' @name getPoints
#' @docType methods
methods::setGeneric('getPoints',
function(object){
standardGeneric('getPoints')
}
)
#' @aliases getPoints,catenary-method
#' @rdname getPoints
#' @name getPoints
methods::setMethod('getPoints',
signature = 'catenary',
definition = function(object){
xpts <- seq(object@endpoints[1,1],object@endpoints[2,1],l=100)
ypts <- f(xpts,object@c1,object@c2,object@lambda)
tmp <- data.frame(xpts,ypts)
return(tmp)
}
)
#' Method to get vertex for catenary
#'
#' Gives vertex point
#'
#' @param object a catenary object
#' @return coordinates of vertex
#' @export
#' @docType methods
#' @name vertex
methods::setGeneric('vertex',
function(object){
standardGeneric('vertex')
}
)
#' @aliases vertex,catenary-method
#' @rdname vertex
#' @name vertex
#' @examples
#' cat <- catenary(c1=1,c2=1,lambda=1)
#' vertex(cat)
methods::setMethod('vertex',
signature = 'catenary',
definition = function(object){
x <- object@c2
y <- object@c1 + object@lambda
return(c(x=x,y=y))
}
)
#' Method to get min and max of catenary
#'
#' Gives min or max
#'
#' @param object a catenary object
#' @return gives min or max values of catenary
#' @export
#' @docType methods
#' @name minmax
methods::setGeneric('minmax',
function(object){
standardGeneric('minmax')
}
)
#' @aliases minmax,catenary-method
#' @rdname minmax
#' @name minmax
#' @examples
#' cat <- catenary(c1=1,c2=1,lambda=1)
#' minmax(cat)
methods::setMethod('minmax',
signature = 'catenary',
definition = function(object){
if(object@c1 > 0){
miny <- c(x=object@c2,y=object@c1 + object@lambda)
maxy <- object@endpoints[which.max(object@endpoints$y),]
}
if(object@c1 < 0){
maxy <- c(x=object@c2,y=object@c1 + object@lambda)
miny <- object@endpoints[which.min(object@endpoints$y),]
}
tab <- rbind(miny,maxy)
row.names(tab) <- c("min","max")
return(tab)
}
)
#' Get length for catenary
#'
#' Returns the length of catenary
#'
#' @param x A \code{catenary} object
#' @return length
#' @export
#' @docType methods
#' @name L
#' @examples
#' tmp <- catenary(c1=1,c2=2,lambda=3,x0=0,x1=3)
#' L(tmp)
methods::setGeneric("L",function(x) {
standardGeneric("L")
})
#' @rdname L
#' @aliases L,catenary-method
#' @name L
methods::setMethod("L", "catenary", function(x){
slot(x,"L")
})
#' summary function
#'
#' gives pretty summary
#'
#' @param x catenary object
#' @param ... extra
#' @param na.rm boolean to remove NAs
#' @export
#' @docType methods
#' @name show
methods::setGeneric("show", function(object) {
standardGeneric("show")
})
#' @aliases show,catenary-method
#' @rdname show
#' @name show
methods::setMethod(f='show',
signature='catenary',
definition = function(object){
output <- list()
output$parameters <- data.frame(value = c(object@c1,object@c2,object@lambda))
rownames(output$parameters) <- c("c1",'c2','lambda')
output$endpoints <- object@endpoints
output$length <- L(object)
tmp <- data.frame(value=c(L(object),vertex(object)))
output$vertex <- vertex(object)
return(output)
}
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.