R/s4xtms.R

In ipeglim: Imprecise Inferential Framework on Statistical Reasoning

#' @title 
#' Construction of Convex Hull from Given Inequalities
#' 
#' @description
#' Using a set of linear inequality constraints
#' 
#' @param x a list
#' 
#' @export
s4xtms.eqns <- function(x, ...){

	lhs <- x$lhs
	rhs <- x$rhs
	
	# ncol(lhs) must be >=2
	
	lc.pairs <- combn(nrow(lhs), ncol(lhs))
	roots <- lapply(seq_len(ncol(lc.pairs)), function(i, ...){
		sel <- as.vector(lc.pairs[,i])
		A <- lhs[sel,]
		b <- rhs[sel]
		sol <- tryCatch(solve(A,b), error=function(e) return(NA))})
	roots <- do.call(cbind, roots)
	chk <- (lhs %*% roots) >= rhs
	vid <- which(apply(chk, 2, all))
	
	xtms <- t(roots[,vid])
	xtms <- xtms[!duplicated(xtms),]
	xtms <- as.matrix(xtms)

	if (ncol(xtms)==2) {
		xtms <- xtms[chull(xtms),]
	} 
	
	if (ncol(xtms)>=3) {
		xtms <- xtms[unique(geometry::convhulln(xtms)),]
	}
    
	return(xtms)
}

#' @title
#' Convex hull (circle)
#'
#' @description
#' Convex hull (circle)
#' 
#' @param x a list
#' 
#' @export
s4xtms.circle <- function(x, ...){
		
	x0 <- x$x
	y0 <- x$y
	r <- x$r
	len <- x$len
	z0 <- x$z

#	if (m0shape=="circle2d"){ 
	if (is.null(z0)) {
		by <- seq(from=-pi, to=pi, length.out=len)
		x <- r*cos(by) + x0
		y <- r*sin(by) + y0
		xtms <- cbind(x,y)
		xtms <- xtms[-nrow(xtms),] # the last point is equal to the first point always
		xtms <- xtms[!duplicated(xtms),]
	}

#	if (m0shape=="sphere3d") {
	if (!is.null(z0)) {
		by <- seq(from=-pi, to=pi, length.out=len)
		x <- c(rep(1,len) %*% t(cos(by)))*r + x0
		y <- c(cos(by)%*%t(sin(by)))*r + y0
		z <- c(sin(by)%*%t(sin(by)))*r + z0
		xtms <- cbind(x,y,z)
#		xtms <- xtms[-nrow(xtms),]
		xtms <- xtms[!duplicated(xtms),]
	}
	
	return(xtms)
}