Permalink
Browse files

cleaning

  • Loading branch information...
1 parent a452dde commit 83798616e786a66792d331d064b01e98ee18ff07 @josephwb committed Feb 1, 2012
Showing with 0 additions and 137 deletions.
  1. +0 −108 MEDUSA/R/backStep.R
  2. +0 −29 MEDUSA/man/turboMEDUSA-package.Rd
View
108 MEDUSA/R/backStep.R
@@ -1,108 +0,0 @@
-backStep <- function (currentModel, z, step, model, fixPar, criterion)
-{
-## As a first step, only consider removing entire shifts. Later deal with individual parameters.
-
- z.opt <- z;
- bestModel <- currentModel;
- bestScore <- as.numeric(bestModel[criterion]);
- allDeletedShifts <- NULL;
- bestRemoved <- NULL;
- improve <- T;
-
- while (improve) # may be possible to remove > 1 previously fit shift
- {
- allDeletedShifts <- c(allDeletedShifts, bestRemoved);
- currentModel <- bestModel;
- z <- z.opt;
- cuts <- bestModel$cut.at;
- nodes <- bestModel$split.at;
- pars <- bestModel$par;
- numModels <- length(bestModel$par)/2;
- improve <- F;
-
- if (numModels > 2)
- {
- for (i in 2:(numModels - 1)) # don't waste time removing last shift
- {
- fitModel <- currentModel;
- obj <- dissolveSplit(z, cut=cuts[i], node=nodes[i], aff=i);
- aff <- obj$affected;
- z.temp <- obj$z[obj$z[,"partition"] == aff,,drop=FALSE];
-
- # set par to mean of 2 affected partitions. perhaps weight (where weight comes form number of edges)
- sp <- c(mean(pars[c(aff,i),1]), mean(pars[c(aff,i),2], na.rm=T));
-
- fit <- getOptimalModelFlavour(z=z.temp, sp=sp, model=model, fixPar=fixPar, criterion=criterion);
-
- ## Update fit values
- fitModel$par[aff,] <- fit$par;
- fitModel$par <- fitModel$par[-i,];
- fitModel$lnLik.part[aff] <- fit$lnLik;
- fitModel$lnLik.part <- fitModel$lnLik.part[-i];
- fitModel$lnLik <- sum(fitModel$lnLik.part);
- model.fit <- calculateModelFit(fit=fitModel, z=z);
- fitModel$aic <- model.fit[1];
- fitModel$aicc <- model.fit[2];
- fitModel$num.par <- model.fit[3];
-
- if (fitModel[criterion] < bestScore)
- {
- fitModel$split.at <- fitModel$split.at[-i];
- fitModel$model[aff] <- fit$model;
- fitModel$model <- fitModel$model[-i];
- fitModel$cut.at <- fitModel$cut.at[-i];
- bestModel <- fitModel;
- bestScore <- as.numeric(fitModel[criterion]);
- z.opt <- updateZ(z=obj$z, deletedPart=i);
- bestRemoved <- nodes[i];
- improve <- T;
- }
- }
- if (improve) {step <- rbind(step, c("remove", bestRemoved));}
- }
- }
- return(list(fit=bestModel, z=z.opt, step=step, remove=bestRemoved));
-}
-
-
-dissolveSplit <- function (z, cut, node, aff)
-{
-## Grab ancestral branch partition membership
- anc <- z[which(z[,"dec"] == node)];
- root <- min(z[,"anc"]);
- tag <- NULL;
-
- if (cut == "node")
- {
- tag <- as.numeric(z[which(z[,"dec"] == node),"partition"]);
- } else if (cut == "stem" && anc > root)
- {
- tag <- as.numeric(z[which(z[,"dec"] == anc),"partition"]);
- } else if (cut == "stem" && anc == root) { # need to take other side of root
- dec <- z[which(z[,"anc"] == root),"dec"];
- tag <- as.numeric(z[which(z[,"dec"] == dec[which(dec != node)]),"partition"]); # ug. li.
- }
-
- idx <- which(z[,"partition"] == aff);
- z[idx,"partition"] <- tag;
-
- return(list(z=z, affected=tag));
-}
-
-
-updateZ <- function (z, deletedPart)
-{
- idx <- z[,"partition"] > deletedPart;
- z[idx,"partition"] <- z[idx,"partition"] - 1;
- return(z);
-}
-
-
-## Only print if model improves AIC score
-printRemovedShifts <- function (remove)
-{
- for (i in 1:length(remove))
- {
- cat(" Removing shift at node #", remove[i], "\n", sep="");
- }
-}
View
29 MEDUSA/man/turboMEDUSA-package.Rd
@@ -1,29 +0,0 @@
-\name{turboMEDUSA-package}
-\alias{turboMEDUSA-package}
-\alias{turboMEDUSA}
-\docType{package}
-\title{
-MEDUSA: Modeling Evolutionary Diversification Using Stepwise AIC
-}
-\description{
-Fits piecewise birth-death models to an ultrametric phylogenetic tree according to phylogenetic (edge-length) and taxonomic (richness) likelihoods. A reimplementation of the original \pkg{\link{geiger}} MEDUSA method, meant especially for the analysis of large trees. Optimal model size is determined via a stepwise AIC approach. Run with \code{\link{MEDUSA}} and summarize results with \code{\link{medusaSummary}}. Trees with coloured branches (depending on model membership) can be plotted using \code{\link{plotPrettyTree}}.
-}
-\details{
-\tabular{ll}{
-Package: \tab turboMEDUSA\cr
-Type: \tab Package\cr
-Version: \tab 0.19\cr
-Date: \tab 2011-08-03\cr
-License: \tab GPL version 2 or greater\cr
-LazyLoad: \tab yes\cr
- }
-}
-
-\references{
-Alfaro, ME, F Santini, C Brock, H Alamillo, A Dornburg, DL Rabosky, G Carnevale, and LJ Harmon. 2009. Nine exceptional radiations plus high turnover explain species diversity in jawed vertebrates. \emph{Proceedings of the National Academy of Sciences} \bold{106}: 13410-13414.
-}
-
-\author{
-Joseph W. Brown, Richard G. FitzJohn, Michael E. Alfaro, and Luke J. Harmon.
-
-Maintainer: Joseph W. Brown <josephwb@uidaho.edu>}

0 comments on commit 8379861

Please sign in to comment.