Nothing
#' @title Convex hull decomposition
#' @aliases subarea
#' @description The function is used to calculate the coordinates and area of each convex hull from E environmental space to SR subniche.
#' @usage subarea(subnic)
#' @param subnic an object of class \code{subniche}.
#' @return A list containing the coordinates and area of each convex hulls
#' @examples
#' library(subniche)
#' data(doubs)
#' dudi1 <- dudi.pca(doubs$env, scale = TRUE, scan = FALSE, nf = 3)
#' nic1 <- niche(dudi1, doubs$fish, scann = FALSE)
#' # number of sites
#' N <- dim(nic1$ls)[1]
#' #Create a factor which defines the subsets
#' fact <- factor(c(rep(1,N/2),rep(2,N/2)))
#' # nic1 will be use as reference and fact will be use to define the subniches environment
#' subnic1 <- subniche(nic1, fact)
#' area_sub <- subarea(subnic1)
#' @references Karasiewicz S.,Doledec S.and Lefebvre S. (2017). Within outlying mean indexes: refining the OMI analysis for the realized niche decomposition. \emph{PeerJ} 5:e3364. \doi{10.7717/peerj.3364}.
#' @details The convex hulls measured are :
#' \enumerate{
#' \item E is the environmental space.
#' \item K the sub-environmental space.
#' \item NR the realized subniche.
#' \item SP the existing fundamental subniche.
#' \item SB the area of the biological constraint reducing SP.
#' \item SR the species realized subniche.}
#' See \doi{10.7717/peerj.3364} for more details on the subniche concept.
#' @rdname subarea
#' @export subarea
#' @import polyclip
#' @importFrom SIBER siberConvexhull
#' @importFrom polyclip polyclip
subarea <- function(subnic){
selecto <- function(x,n){
substring(x,nchar(x)-n+1)
}
res <- list()
res$E <- siberConvexhull(subnic$ls[,1], subnic$ls[,2])
names(res$E) <- c("TA" , "x", "y","samples")
res$K <- list()
lev <- levels(subnic$factor)
for(i in 1:length(lev)){
res$K[[i]] <- siberConvexhull(subnic$ls[which(subnic$factor==lev[i]),1], subnic$ls[which(subnic$factor==lev[i]),2])
names(res$K[[i]]) <- c("TA" , "x", "y","samples")
}
names(res$K) <- lev
appel <- as.list(subnic$call)
Y <- eval.parent(appel[[3]])
Y[Y!=0] <- 1
spnam <- colnames(Y)
res$NR <- list()
for (i in 1:length(spnam)){
occfact <- factor(Y[,i])
if (sum(Y[,i])>2){
res$NR[[i]] <- siberConvexhull(subnic$ls[which(occfact==1),1], subnic$ls[which(occfact==1),2])
names( res$NR[[i]]) <- c("TA","x","y","samples")
} else {
res$NR[[i]] <- list(TA=NULL,x=subnic$ls[which(occfact==1),1], y=subnic$ls[which(occfact==1),2], samples=rownames(subnic$ls[which(occfact==1),]))
}
}
names(res$NR) <- spnam
subsp <- subnic$sub
if(anyNA(subsp))
subsp <- subsp[-which(is.na(subsp[,1])==T),]
subsp <- rownames(subsp)
res$SR <- list()
for(i in 1:length(lev)){
y <- Y[subnic$factor==lev[i],]
ls <- subnic$ls[subnic$factor==lev[i],]
ch <- nchar(lev[i])
subnam <- c()
for (k in 1:length(subsp)){
if(isTRUE(selecto(subsp[k],ch)==lev[i])){
subi <- substr(subsp[k],1,nchar(subsp[k])-ch)
subnam <- c(subnam, subi)
} else { next }
}
res$SR[[i]] <- list()
for (j in 1:length(subnam)){
occfact <- factor(y[,subnam[j]])
if(sum(y[,subnam[j]])>2){
res$SR[[i]][[j]] <- siberConvexhull(ls[which(occfact==1),1], ls[which(occfact==1),2])
names(res$SR[[i]][[j]]) <- c("TA","x","y","samples")
} else {
res$SR[[i]][[j]] <- list(TA=NULL,x=subnic$ls[which(occfact==1),1], y=subnic$ls[which(occfact==1),2], samples=rownames(subnic$ls[which(occfact==1),]))
}
}
names(res$SR[[i]]) <- paste(subnam,lev[i], sep="")
}
names(res$SR) <- lev
res$SP <- list()
for(i in 1:length(lev)){
y <- Y[subnic$factor==lev[i],]
ls <- subnic$ls[subnic$factor==lev[i],]
ch <- nchar(lev[i])
subnam <- c()
for (k in 1:length(subsp)){
if(isTRUE(selecto(subsp[k],ch)==lev[i])){
subi <- substr(subsp[k],1,nchar(subsp[k])-ch)
subnam <- c(subnam, subi)
} else { next }
}
res$SP[[i]] <- list()
for (j in 1:length(subnam)){
if(sum(y[,subnam[j]])>2){
C <- polyclip(res$K[[i]],res$NR[subnam[j]])
res$SP[[i]][[j]] <-siberConvexhull(C[[1]]$x, C[[1]]$y)
names(res$SP[[i]][[j]]) <- c("TA","x","y","samples")
} else {
res$SP[[i]][[j]] <- res$SR[[i]][[j]]
}
}
names(res$SP[[i]]) <- paste(subnam, lev[i],sep="")
}
names(res$SP) <- lev
res$SB <- list()
for(i in 1:length(lev)){
res$SB[[i]] <- list()
ch <- nchar(lev[i])
subnam <- c()
for (k in 1:length(subsp)){
if(isTRUE(selecto(subsp[k],ch)==lev[i])){
subi <- substr(subsp[k],1,nchar(subsp[k])-ch)
subnam <- c(subnam, subi)
} else { next }
}
for (j in 1:length(subnam)){
sb <- res$SP[[i]][[j]][[1]]-res$SR[[i]][[j]][[1]]
if(isTRUE(sb<0)){
res$SB[[i]][[j]]<- 0
} else{
res$SB[[i]][[j]] <- sb
}
}
names(res$SB[[i]]) <- subnam
}
names(res$SB) <- lev
return(res)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.