Nothing
###############################################################################
#
# IPSEAR.R
#
# Individual Phylogenetic Species Evennes -Area Relationship
#
# $Version: 0.1 $ $Date: 2013/02/17 23:48:03 $
#
# function to compute Indivdual Phylogenetic Species Evennes Area Relationships (i.e., acumulation of PSE curves
# around individual species) in a community.
#
# Value: an object of class fv , bassicaly a data.frame with the following
# elemnts:
# r: vector of radii at which IPSEAR(r) has been estimated
# ipsv: vector with the IPSEAR(r) values
# ###npoints: number of focal points employed to estimate isar(r) at each
# radius r
#
# Arguments:
# mippp: Multivariate point pattern (ppp of spatstat)
# mippp.sp: Focal (unmarked) point pattern (ppp of spatstat) or character
# string indicating one of the marks in the multivariate mippp
# mimark: character string indicating one of the marks in the
# multivariate mippp
# namesark: name of the column with species names in the data.frame of
# marks (only for multimarked ppp's)
# tree: A phylogenetic tree in "phylo" format (ape) or phylogenetic covariance matrix
# r: vector with the sequence of radii (>0) at which estimate
# ISAR(r)
# buffer: a number indicating the width around the window of the focal
# point pattern that will be excluded from the computations of
# ISAR(r) to control de edge effect, or the string "adapt",
# indicating that an adaptive border (of width ri) will be
# excluded for the computation of each ISAR(ri)
# bfw: an owin object indicating a subset of the focal point pattern
# that will be employed to compute ISAR(r)
#
# Details:
# btw can be employed to select different habitats and compute ISAR((R) i
# each habitat
ipsear<- function(mippp, mippp.sp=NULL, mimark=NULL, namesmark=NULL, tree=NULL,
r=NULL, buffer=0, bfw=NULL, correct.phylo="mean") {
# Check mippp
#If species marks are within a data.frame of marks, get this column and
# discard the rest
if(!is.null(namesmark)) mippp$marks <- factor((mippp$marks[namesmark][[1]])) # OJO: que representa el [[1]] del final: es para coger los valores. si no se pone da problemas !!!!!!!!!!!!!!!!!!!!!!!!!!!
# Check tree
# this is for checktree
idar <-"ipsear"
if(is.null(tree)) stop("you should provide a phylogenetic tree to compute ipscar")
#if(class(tree)=="phylo") tree<- vcv.phylo(tree, corr = TRUE) #!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CAMBIADO 04/12/2019 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
if(inherits(tree, what="phylo")) tree<- vcv.phylo(tree, corr = TRUE)
if(!is.matrix(tree)) stop("you should provide a phylogenetic tree or a phylogenetic covariance matrix to compute ipscar")
tree <- checktree(tree=tree, mippp=mippp, idar=idar, correct.phylo=correct.phylo)
# Check mippp.sp
#If mippp.sp has not been provided as a ppp, build it from the multivariate
# mippp and the provided mark
if(!is.null(mippp.sp) & !is.ppp(mippp.sp)) {
mippp.sp <- NULL
mimark <- mippp.sp
}
if(!is.null(mimark)) if(mimark%in%levels(mippp$marks)==FALSE){
stop(paste(mimark, " can't be recognized as a mark\n\n
have you indicated in which column of thedataframe are the species
marks? (argument 'namesmark'\n\n"))
}
if (is.null(mippp.sp)) mippp.sp<- mippp[mippp$marks==mimark]
#If indicated, correct edge effect with a fixed buffer of size "buffer"
# or with the window "bfw"
if(buffer!="adapt"){
if(is.null(bfw)) bfw<- erosion( mippp$window, buffer)
mippp.sp <- mippp.sp[inside.owin(mippp.sp, w=bfw)]
npoints <- rep(mippp.sp$n, length(r))
names(npoints) <- r
}
#Tabulate the number of individuals of each species (i.e. types) around each
# individual of the focal species within circles of each of the r radii
cosamt <- mitable(mippp.sp, mippp, r)
# Check that there are enough differnt individuasl to compute psv (and avoid error!). Frequent problem for short r's
cosamt.ok<- sapply(cosamt, function(y) any(apply(y,1,function(x) sum(x>0))>1)) #!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 17/02/2015
#If indicated correct edge effect with an adaptive buffer
if(buffer=="adapt"){
bdp <- bdist.points(mippp.sp)
for (i in 1:length(r)) cosamt[[i]]<-cosamt[[i]][bdp>=r[i],]
npoints <- sapply(cosamt, function(x) dim(x)[1])
}
#Compute IPSVAR(r) for each radius r
# preset result to NA
ipsear<- rep(NA, length(r))
# first for each individual (for those individuals which have enough neighbors)
#ipsear <- lapply(cosamt, function(x) pse(x, tree=tree)$PSE)
ipsear[cosamt.ok] <- lapply(cosamt[cosamt.ok], function(x) pse(x, tree = tree)$PSE)
# then average ipsv for each radius
ipsear <- sapply(ipsear, mean, na.rm=T) # TODO: optional na.rm. At short distances lot of NA's and maybe unreliable means
# return results
result <- data.frame(r=r, ipsear=ipsear)
result <- fv(result, argu="r", ylab=substitute(IPSEAR(r), NULL),
valu="ipsear", fmla=ipsear ~ r,
alim=c(min(r),max(r)),
labl=c("r", "%s(r)"),
desc=c("radius of circle",
"%s"),
fname="IPSEAR")
#class(result)<-c("isar", class(result))
return(result)
}
###############################################################################
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.