R/deprecated.R

Defines functions rescaleTree speciationalTree exponentialchangeTree linearchangeTree tworateTree ouTree kappaTree lambdaTree deltaTree getAncStates node.leaves rate.estimate ic.sigma tip.disparity birthdeath.tree BDsim name.check prune.random.taxa prune.extinct.taxa runMedusa .namespace .defunctify .deprecate

Documented in BDsim birthdeath.tree deltaTree exponentialchangeTree getAncStates ic.sigma kappaTree lambdaTree linearchangeTree name.check node.leaves ouTree prune.extinct.taxa prune.random.taxa rate.estimate rescaleTree runMedusa speciationalTree tip.disparity tworateTree

.deprecate=function(prev, curr, ...){
	warning(paste(sQuote(prev), "is being deprecated: use", paste(sQuote(curr), "instead", collapse=" or "), sep=" "), ...)
}

.defunctify=function(prev, curr, ...){
	warning(paste(sQuote(prev), "is no longer available: use", paste(sQuote(curr), "instead", collapse=" or "), sep=" "), ...)
}


.namespace=function(package){
    x=loadedNamespaces()
    package%in%x
}

runMedusa=function(phy, richness, estimateExtinction = TRUE, modelLimit = 20, cutAtStem=TRUE, startR=0.05, startE=0.5, ...){
	.deprecate("runMedusa", "medusa")
    message("Refer to documentation (?medusa) for information on summarizing output")
	medusa(phy, richness=richness, model=ifelse(estimateExtinction, "bd", "yule"), cut=ifelse(cutAtStem, "stem", "node"), partitions=modelLimit, init=c(r=startR, epsilon=startE), ...)
}

prune.extinct.taxa=function(phy, tol= .Machine$double.eps^0.5){
    .deprecate("prune.extinct.taxa", "drop.extinct")
	drop.extinct(phy, tol)
}

prune.random.taxa=function(phy, n){
    .deprecate("prune.random.taxa", "drop.random")
	drop.random(phy, n)
}

name.check=function(phy, data){
    if(is.null(names(data))) stop("'data' must be given as a vector or matrix with names")
	.deprecate("name.check", "geiger:::.treedata")
	.treedata(phy, data)
}

BDsim=function(nStart, b, d, times){
	.deprecate("BDsim", "sim.bd")
	sim.bd(b=b, d=d, n0=nStart, times=times)
}


birthdeath.tree=function(b, d, time.stop=0, taxa.stop=0, seed=0, print.seed=FALSE, return.all.extinct=TRUE){
	.deprecate("birthdeath.tree", "sim.bdtree")
	crit=.check.stoppingcrit(time.stop, taxa.stop)
	sim.bdtree(b=b, d=d, stop=crit, n=taxa.stop, t=time.stop, seed=seed, extinct=return.all.extinct) 
}

tip.disparity=function(phy, data, disp=c("avg.sq", "avg.manhattan", 
"num.states")){
	.deprecate("tip.disparity", "disparity")
	disparity(phy=phy, data=data, index=disp)
}

ic.sigma=function(phy, data){
	.deprecate("ic.sigma", "ratematrix")
	ratematrix(phy=phy, dat=data)
}

rate.estimate=function(time=0, n=0, phy=NULL, epsilon = 0, missing = 0, crown=TRUE, kendall.moran=FALSE){
	.deprecate("rate.estimate", c("bd.ms", "bd.km"))
	if(kendall.moran){
		bd.km(phy=phy, time=time, n=n, missing=missing, crown=crown)
	} else {
		bd.ms(phy=phy, time=time, n=n, missing=missing, crown=crown, epsilon=epsilon)
	}
}

node.leaves=function(phy, node){
	.deprecate("node.leaves", "tips")
	tips(phy, node)

}

getAncStates=function(x, phy){
    .defunctify("getAncStates", "phytools:::fastAnc", immediate.=TRUE)
    stop()
#    if(.namespace("phytools")) {
#        td=treedata(phy, x, sort=TRUE)
#       if(ncol(td$data)>1) res=apply(td$data, 2, function(y) fastAnc(td$phy, y)) else res=fastAnc(td$phy, td$data[,1])
#            attr(res, "phylo")=td$phy
#           return(res)
#    } else {
#        stop("'phytools' is unavailable")
#    }
}

deltaTree = function(phy, delta, rescale=TRUE){
    .deprecate("deltaTree", "rescale.phylo")
    f=rescale.phylo(phy, model="delta")
    f(delta=delta, rescale=rescale) 
}

lambdaTree = function(phy, lambda){
    .deprecate("lambdaTree", "rescale.phylo")
    rescale.phylo(phy, "lambda", lambda=lambda)
}

kappaTree = function(phy, kappa){
    .deprecate("kappaTree", "rescale.phylo")
    rescale.phylo(phy, "kappa", kappa=kappa)
}

ouTree = function(phy, alpha){
    .deprecate("ouTree", "rescale.phylo")
    rescale.phylo(phy, "OU", alpha=alpha)
}

tworateTree = function(phy, breakPoint, endRate){
    .deprecate("tworateTree", "rescale.phylo")
    mt=max(heights(phy))
    bk=breakPoint/mt
    f=rescale.phylo(phy, "nrate")
    f(time=bk, rate=endRate, rescale=FALSE)
}

linearchangeTree = function(phy, endRate = NULL, slope=NULL){
    .deprecate("linearchangeTree", "rescale.phylo")
    flag="'endRate' or 'slope' must be supplied"
    if (is.null(slope) && is.null(endRate)) stop(flag)
    if(!is.null(slope) && !is.null(endRate)) stop(flag)
    
    rootdepth <- max(heights(phy))
    toslope=function(endRate, rootdepth){
        (endRate-1)/rootdepth
    }
    if (is.null(slope)) {
        slope = toslope(endRate, rootdepth)
    }
    
    rescale.phylo(phy, "trend", slope=slope)
}

exponentialchangeTree = function(phy, endRate=NULL, a=NULL){
    .deprecate("exponentialchangeTree", "rescale.phylo")
    
    flag="'endRate' or 'a' must be supplied"
    if (is.null(a) && is.null(endRate)) stop(flag)
    if(!is.null(a) && !is.null(endRate)) stop(flag)

    rootdepth <- max(heights(phy))
    if (is.null(a)) a <- log(endRate)/rootdepth
    
    rescale.phylo(phy, "EB", a=a)
}

speciationalTree = function(phy){
    .deprecate("speciationalTree", "rescale.phylo")
    rescale.phylo(phy, "kappa", kappa=0)

}

rescaleTree = function(phy, totalDepth){
    .deprecate("rescaleTree", "rescale.phylo")
    rescale.phylo(phy, "depth", depth=totalDepth)

}

Try the geiger package in your browser

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

geiger documentation built on April 4, 2023, 1:07 a.m.