From 4920f848c6f729d54048c1e1f08cfb3fdcdfe857 Mon Sep 17 00:00:00 2001 From: Klaus Schliep Date: Sat, 30 Nov 2024 07:03:38 +0100 Subject: [PATCH] add leading zero --- R/Densi.R | 4 ++-- R/clanistic.R | 4 ++-- R/discrete.gamma.R | 4 ++-- R/lento.R | 6 +++--- R/phylo.R | 28 ++++++++++++++-------------- R/plotAnc.R | 4 ++-- R/pmlMix.R | 6 +++--- 7 files changed, 28 insertions(+), 28 deletions(-) diff --git a/R/Densi.R b/R/Densi.R index a2c1c79c..0ca0b252 100644 --- a/R/Densi.R +++ b/R/Densi.R @@ -129,7 +129,7 @@ add_tiplabels <- function(xy, tip.label, direction, adj, font, srt = 0, cex = 1, #' @export densiTree <- function(x, type = "phylogram", ..., alpha = 1 / length(x), consensus = NULL, direction = "rightwards", optim = FALSE, - scaleX = FALSE, col = 1, width = 1, lty = 1, cex = .8, + scaleX = FALSE, col = 1, width = 1, lty = 1, cex = 0.8, font = 3, tip.color = 1, adj = 0, srt = 0, underscore = FALSE, label.offset = 0, scale.bar = TRUE, jitter = list(amount = 0, random = TRUE), tip.dates=NULL, @@ -140,7 +140,7 @@ densiTree <- function(x, type = "phylogram", ..., alpha = 1 / length(x), consensus$edge.length <- rep(1.0, nrow(consensus$edge)) } if (is.null(consensus)) { - consensus <- tryCatch(consensus(x, p = .5), + consensus <- tryCatch(consensus(x, p = 0.5), error = function(e) unroot(midpoint(superTree(x)))) } if (inherits(consensus, "multiPhylo")) consensus <- consensus[[1]] diff --git a/R/clanistic.R b/R/clanistic.R index 4c33b0fe..369fe8fe 100644 --- a/R/clanistic.R +++ b/R/clanistic.R @@ -353,7 +353,7 @@ getDiv <- function(tree, x, native=NULL){ clans <- getClans(tree) labels <- tree$tip.label x <- subset(x, labels) - LHG <- E_Intruder_2(clans, subset(x,,1)) + LHG <- E_Intruder_2(clans, subset(x,select=1)) if(!is.null(native)){ ll <- match(native, attr(x, "allLevels")) ind <- (as.numeric(x) %in% ll) @@ -367,7 +367,7 @@ getDiv <- function(tree, x, native=NULL){ } else tree2 <- NULL list(c(shannon(rowSums(LHG)), - summary(factor(attr(x, "allLevels"))[as.numeric(subset(x,,1))]), + summary(factor(attr(x, "allLevels"))[as.numeric(subset(x,select=1))]), parsimony(tree, x)), tree2 ) } diff --git a/R/discrete.gamma.R b/R/discrete.gamma.R index 25422071..557b9754 100644 --- a/R/discrete.gamma.R +++ b/R/discrete.gamma.R @@ -162,7 +162,7 @@ plot_gamma_plus_inv <- function(shape=1, inv=0, k=4, discrete=TRUE, cdf=TRUE, if(!append) plot(g, w, xlim = xlim, #c(-.5, 1.25 * max(g)), ylim=c(0, 1), type="n", xlab=xlab, ylab=ylab, ...) - plot(function(x)cdf_fun(x, shape, inv), xlim[1], -.001, add=TRUE, ...) + plot(function(x)cdf_fun(x, shape, inv), xlim[1], -0.001, add=TRUE, ...) plot(function(x)cdf_fun(x, shape, inv), 0, xlim[2], add=TRUE, ...) points(0, inv, ...) if(verticals) segments(0, 0, 0, inv, ...) @@ -231,7 +231,7 @@ plotRates <- function(obj, cdf.color="blue", main="cdf", ...){ plot(ecdf_pscores, verticals = TRUE, do.points=FALSE, main=main, ...) rug(jitter(pscores)) # rug(sort(unique(pscores))) el <- obj$tree$edge.length - xlim <- c(-.25, 1.1 * max(pscores)) + xlim <- c(-0.25, 1.1 * max(pscores)) plot_gamma_plus_inv(k=obj$k, shape=obj$shape, inv=obj$inv, append=TRUE, xlim = xlim, edge.length=sum(el), verticals=TRUE, col=cdf.color, diff --git a/R/lento.R b/R/lento.R index 963cac99..c1c35ca7 100644 --- a/R/lento.R +++ b/R/lento.R @@ -32,7 +32,7 @@ #' @export lento lento <- function(obj, xlim = NULL, ylim = NULL, main = "Lento plot", sub = NULL, xlab = NULL, ylab = NULL, bipart = TRUE, - trivial = FALSE, col = rgb(0, 0, 0, .5), ...) { + trivial = FALSE, col = rgb(0, 0, 0, 0.5), ...) { if (inherits(obj, "phylo")) { if (inherits(obj, "phylo", TRUE) == 1) obj <- as.splits(obj)[obj$edge[, 2]] obj <- as.splits(obj) @@ -79,11 +79,11 @@ lento <- function(obj, xlim = NULL, ylim = NULL, main = "Lento plot", at <- min(ylim) + (1:l) * aty if (bipart) { Y <- rep(at, n) - X <- rep( (1:n) - .5, each = l) + X <- rep( (1:n) - 0.5, each = l) Circles <- matrix(1, l, n) for (i in 1:n) Circles[obj[[ord[i]]], i] <- 19 col <- rep(col, each = l) - text(x = n + .1, y = at, labels, pos = 4, ...) + text(x = n + 0.1, y = at, labels, pos = 4, ...) points(X, Y, pch = as.numeric(Circles), col = col, ...) } invisible(list(support = cbind(support, conflict), splits = obj[ord])) diff --git a/R/phylo.R b/R/phylo.R index 7ccf79fb..be821261 100644 --- a/R/phylo.R +++ b/R/phylo.R @@ -132,7 +132,7 @@ optimGamma <- function(tree, data, shape = 1, k = 4, ...) { fn <- function(shape, tree, data, k, ...) pml.fit(tree, data, shape = shape, k = k, ...) res <- optimize(f = fn, interval = c(0.1, 100), lower = 0.1, upper = 100, - maximum = TRUE, tol = .001, tree = tree, data = data, k = k, ...) + maximum = TRUE, tol = 0.001, tree = tree, data = data, k = k, ...) res } @@ -145,12 +145,12 @@ optimInv <- function(tree, data, inv = 0.01, INV, ...) { fn <- function(inv, tree, data, ...) pml.fit(tree, data, inv = inv, INV = INV, ll.0 = NULL, ...) res <- optimize(f = fn, interval = c(0, max_inv), lower = 0, upper = max_inv, - maximum = TRUE, tol = .0001, tree = tree, data = data, ...) + maximum = TRUE, tol = 0.0001, tree = tree, data = data, ...) res } -optimFreeRate <- function(tree, data, g = c(.25, .75, 1, 2), k=4, w=w, ...) { +optimFreeRate <- function(tree, data, g = c(0.25, 0.75, 1, 2), k=4, w=w, ...) { g0 <- c(g[1], diff(g)) g0[g0 < 1e-8] <- 1e-8 # required by constrOptim R <- matrix(0, k, k) @@ -172,7 +172,7 @@ optimFreeRate <- function(tree, data, g = c(.25, .75, 1, 2), k=4, w=w, ...) { } -optimWs <- function(tree, data, w = c(.25, .25, .25, .25), g=g, ...) { +optimWs <- function(tree, data, w = c(0.25, 0.25, 0.25, 0.25), g=g, ...) { k <- length(w) nenner <- 1 / w[1] eta <- log(w * nenner) @@ -207,7 +207,7 @@ optimRate <- function(tree, data, rate = 1, ...) { } -optimBf <- function(tree, data, bf = c(.25, .25, .25, .25), trace = 0, ...) { +optimBf <- function(tree, data, bf = c(0.25, 0.25, 0.25, 0.25), trace = 0, ...) { l <- length(bf) nenner <- 1 / bf[l] lbf <- log(bf * nenner) @@ -228,7 +228,7 @@ optimBf <- function(tree, data, bf = c(.25, .25, .25, .25), trace = 0, ...) { # ML F3x4 model -optimF3x4 <- function(tree, data, bf_codon = matrix(.25, 4, 3), trace = 0, ...){ +optimF3x4 <- function(tree, data, bf_codon = matrix(0.25, 4, 3), trace = 0, ...){ l <- nrow(bf_codon) nenner <- 1 / bf_codon[l, ] lbf <- log(bf_codon * rep(nenner, each = 4)) @@ -1489,11 +1489,11 @@ optimRooted <- function(tree, data, bf, g, w, eig, ll.0, tree$edge.length <- tree$edge.length * t pml.fit4(tree, data, ...) } - min_scaler <- max(.25, tau / min(tree$edge.length) ) + min_scaler <- max(0.25, tau / min(tree$edge.length) ) min_scaler <- min(min_scaler, 1) # if(min_scaler>1) browser() optimize(f = fn, interval = c(min_scaler, 4), tree = tree, data = data, ..., - maximum = TRUE, tol = .00001) + maximum = TRUE, tol = 0.00001) } # ensure that each edge is at least tau long # tips have the same height @@ -1718,7 +1718,7 @@ rooted.nni <- function(tree, data, eig, w, g, bf, rate, ll.0, INV, RELL=NULL, parent <- tree$edge[, 1] ll <- pml.fit4(tree, data, bf = bf, eig = eig, ll.0 = ll.0, w = w, g = g, ...) llstart <- ll - eps <- .00001 + eps <- 0.00001 iter <- 1 EL <- numeric(max(tree$edge)) EL[tree$edge[, 2]] <- tree$edge.length @@ -1810,15 +1810,15 @@ rooted.nni <- function(tree, data, eig, w, g, bf, rate, ll.0, INV, RELL=NULL, tree3$edge <- X3 edge1 <- X1[, 2] edge1[4] <- dad - res1 <- optim(par = c(.1, .1), optRootU, gr = NULL, tree = tree1, + res1 <- optim(par = c(0.1, 0.1), optRootU, gr = NULL, tree = tree1, data = data, nh = nh[X1[, 2]], g = g, w = w, eig = eig, bf = bf, ll.0 = ll.0, ..., method = "L-BFGS-B", lower = 1e-8, upper = 5, control = list(fnscale = -1)) - res2 <- optim(par = c(.1, .1), optRootU, gr = NULL, tree = tree2, + res2 <- optim(par = c(0.1, 0.1), optRootU, gr = NULL, tree = tree2, data = data, nh = nh[X2[, 2]], g = g, w = w, eig = eig, bf = bf, ll.0 = ll.0, ..., method = "L-BFGS-B", lower = 1e-8, upper = 5, control = list(fnscale = -1)) - res3 <- optim(par = c(.1, .1), optRootU, gr = NULL, tree = tree3, + res3 <- optim(par = c(0.1, 0.1), optRootU, gr = NULL, tree = tree3, data = data, nh = nh[X3[, 2]], g = g, w = w, eig = eig, bf = bf, ll.0 = ll.0, ..., method = "L-BFGS-B", lower = 1e-8, upper = 5, control = list(fnscale = -1)) @@ -1868,7 +1868,7 @@ rooted.nni <- function(tree, data, eig, w, g, bf, rate, ll.0, INV, RELL=NULL, tree1$edge <- X1 tree2$edge <- X2 tree3$edge <- X3 - tt <- c(.3, .5) + tt <- c(0.3, 0.5) res1 <- optim(par = tt, optEdgeU, gr = NULL, tree = tree1, data, nh = nh[X1[, 2]], g = g, w = w, eig = eig, bf = bf, ll.0 = ll.0, @@ -2701,7 +2701,7 @@ optimQuartet <- function(tree, data, eig, w, g, bf, rate, ll.0, nTips, # allow weight Matrix or return site likelihood -pml.quartet <- function(tree, data, bf = rep(.25, 4), k = 1, rate = 1, g, w, +pml.quartet <- function(tree, data, bf = rep(0.25, 4), k = 1, rate = 1, g, w, eig, ll.0 = NULL, #ind.ll0 = NULL, inv=0, llMix = NULL, wMix = 0, nTips, weight, nr, nc, contrast, nco, ..., diff --git a/R/plotAnc.R b/R/plotAnc.R index 8b674db5..463f6b4f 100644 --- a/R/plotAnc.R +++ b/R/plotAnc.R @@ -77,7 +77,7 @@ getTransition <- function(scheme, levels){ #' @rdname plot.ancestral #' @export plotAnc <- function(x, i = 1, type="phylogram", ..., col = NULL, - cex.pie = .5, pos = "bottomright", scheme=NULL) { + cex.pie = 0.5, pos = "bottomright", scheme=NULL) { stopifnot(inherits(x, "ancestral")) type <- match.arg(type, c("phylogram", "cladogram", "fan", "unrooted", "radial", "tidy")) @@ -153,7 +153,7 @@ my_ggseqlogo <-function (data, facet = "wrap", scales = "free_x", ncol = NULL, nrow = NULL, start=NULL, end=NULL, ...) { x <- ggseqlogo::geom_logo(data = data, ...) - x[[2]] <- ggplot2::scale_x_continuous(limits = c(start-0.5, end+.5) , + x[[2]] <- ggplot2::scale_x_continuous(limits = c(start-0.5, end+0.5) , breaks=pretty(seq(start, end))) p <- ggplot2::ggplot() + x + ggseqlogo::theme_logo() if (!"list" %in% class(data)) return(p) diff --git a/R/pmlMix.R b/R/pmlMix.R index d701b9ff..2b94fe9e 100644 --- a/R/pmlMix.R +++ b/R/pmlMix.R @@ -123,7 +123,7 @@ optimAllRate <- function(object, rate = 1, omega, ...) { -optimMixBf <- function(object, bf = c(.25, .25, .25, .25), omega, ...) { +optimMixBf <- function(object, bf = c(0.25, 0.25, 0.25, 0.25), omega, ...) { l <- length(bf) nenner <- 1 / bf[l] lbf <- log(bf * nenner) @@ -157,7 +157,7 @@ optimMixInv <- function(object, inv = 0.01, omega, ...) { res } res <- optimize(f = fn, interval = c(0, 1), lower = 0, upper = 1, - maximum = TRUE, tol = .0001, object, omega = omega, ...) + maximum = TRUE, tol = 0.0001, object, omega = omega, ...) res[[1]] } @@ -231,7 +231,7 @@ optimMixEdge <- function(object, omega, trace = 1, ...) { iter <- 0 scalep <- 1 if (trace > 0) cat(ll0) - while (abs(eps) > .0001 & iter < 10) { + while (abs(eps) > 0.0001 & iter < 10) { dl <- matrix(0, p, q) for (i in 1:n) dl <- dl + dl(object[[i]], TRUE) * omega[i] dl <- dl / lv1