[Analogue-commits] r213 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Mar 26 20:18:54 CET 2011
Author: gsimpson
Date: 2011-03-26 20:18:54 +0100 (Sat, 26 Mar 2011)
New Revision: 213
Modified:
pkg/R/Stratiplot.R
pkg/R/cma.R
pkg/R/distance.R
pkg/R/fuse.dist.R
pkg/R/join.R
pkg/R/plot.mat.R
pkg/R/plot.mcarlo.R
pkg/R/plot.wa.R
pkg/R/stdError.R
pkg/R/summary.cma.R
pkg/R/summary.logitreg.R
pkg/man/Stratiplot.Rd
Log:
Some sapply() tweaks
Modified: pkg/R/Stratiplot.R
===================================================================
--- pkg/R/Stratiplot.R 2011-03-14 14:39:28 UTC (rev 212)
+++ pkg/R/Stratiplot.R 2011-03-26 19:18:54 UTC (rev 213)
@@ -111,7 +111,7 @@
stop("Ambiguous entry in 'varTypes'.\nMust be one of \"relative\", or \"absolute\"")
## compute max abundances per relative column, which is used
## to scale the panel widths layout.widths parameter)
- max.abun <- sapply(x, function(x) round(max(x), 1))
+ max.abun <- sapply(x, function(x) round(max(x), 1), USE.NAMES = FALSE)
## absolute panels should be set to absoluteSize of max.abun
panelWidths <- max.abun
ABS <- which(varTypes == "absolute")
@@ -121,8 +121,8 @@
xlimits <- lapply(max.abun * 1.05, function(x) c(0, x))
if(any(ABS)) {
## but need any "absolute" panels setting to +/- 0.05(range)
- min.vars <- sapply(x[ABS], min)
- max.vars <- sapply(x[ABS], max)
+ min.vars <- sapply(x[ABS], min, USE.NAMES = FALSE)
+ max.vars <- sapply(x[ABS], max, USE.NAMES = FALSE)
ranges <- (0.04 * (max.vars - min.vars))
xlimits[ABS] <- as.list(data.frame(t(cbind(min.vars - ranges,
max.vars + ranges))))
@@ -139,7 +139,7 @@
convertWidth(grobWidth(textGrob(x, gp = gp)), "lines",
valueOnly = TRUE)
}
- str.max <- max(sapply(levels(sx$ind), convWidth, gp))
+ str.max <- max(sapply(levels(sx$ind), convWidth, gp, USE.NAMES = FALSE))
str.max <- ceiling(str.max) + topPad
}
## Legend specification for Zones
Modified: pkg/R/cma.R
===================================================================
--- pkg/R/cma.R 2011-03-14 14:39:28 UTC (rev 212)
+++ pkg/R/cma.R 2011-03-26 19:18:54 UTC (rev 213)
@@ -43,7 +43,7 @@
x <- x[x <= cutoff]})
if(length(close) == 0)
close <- vector(mode = "list", length = length(nams))
- each.analogs <- sapply(close, length)
+ each.analogs <- sapply(close, length, USE.NAMES = FALSE)
names(each.analogs) <- names(close) <- nams
.call <- match.call()
.call[[1]] <- as.name("cma")
@@ -82,7 +82,7 @@
for(i in seq_along(close)) {
close[[i]] <- sortByK(object$Dij[, i], ks)
}
- each.analogs <- sapply(close, length)
+ each.analogs <- sapply(close, length, USE.NAMES = FALSE)
names(each.analogs) <- names(close) <- nams
} else {
sortByCutoff <- function(x, cutoff) {
@@ -90,7 +90,7 @@
x <- x[x <= cutoff]
}
close <- apply(object$Dij, 2, sortByCutoff, cutoff = cutoff)
- each.analogs <- sapply(close, length)
+ each.analogs <- sapply(close, length, USE.NAMES = FALSE)
k <- NULL
names(each.analogs) <- names(close) <- nams
}
@@ -136,7 +136,7 @@
for(i in seq_along(close)) {
close[[i]] <- sortByK(object$Dij[, i], ks)
}
- each.analogs <- sapply(close, length)
+ each.analogs <- sapply(close, length, USE.NAMES = FALSE)
names(each.analogs) <- names(close) <- nams
} else {
sortByCutoff <- function(x, cutoff) {
@@ -144,7 +144,7 @@
x <- x[x <= cutoff]
}
close <- apply(object$Dij, 2, sortByCutoff, cutoff = cutoff)
- each.analogs <- sapply(close, length)
+ each.analogs <- sapply(close, length, USE.NAMES = FALSE)
k <- NULL
names(each.analogs) <- names(close) <- nams
}
Modified: pkg/R/distance.R
===================================================================
--- pkg/R/distance.R 2011-03-14 14:39:28 UTC (rev 212)
+++ pkg/R/distance.R 2011-03-26 19:18:54 UTC (rev 213)
@@ -149,8 +149,8 @@
}
if(method == "mixed") {
## sanity check: are same columns in x and y factors
- facs.x <- sapply(as.data.frame(x), is.factor)
- facs.y <- sapply(as.data.frame(y), is.factor)
+ facs.x <- sapply(as.data.frame(x), is.factor, USE.NAMES = FALSE)
+ facs.y <- sapply(as.data.frame(y), is.factor, USE.NAMES = FALSE)
if(sum(facs.x - facs.y) > 0)
stop("Different columns (species) are coded as factors in 'x' and 'y'")
## sanity check: levels of factors also need to be the same
Modified: pkg/R/fuse.dist.R
===================================================================
--- pkg/R/fuse.dist.R 2011-03-14 14:39:28 UTC (rev 212)
+++ pkg/R/fuse.dist.R 2011-03-26 19:18:54 UTC (rev 213)
@@ -11,7 +11,7 @@
## reset the storage back to a minimal set
dots <- lapply(dots, as.dist, diag = FALSE, upper = TRUE)
## sanity check to make sure all objects are dist objects
- if(any(!sapply(dots, inherits, c("dist"))))
+ if(any(!sapply(dots, inherits, c("dist"), USE.NAMES = FALSE)))
stop(paste("All dissimilarities must be of class",
dQuote("dist")))
## bind dist vectors to a matrix
Modified: pkg/R/join.R
===================================================================
--- pkg/R/join.R 2011-03-14 14:39:28 UTC (rev 212)
+++ pkg/R/join.R 2011-03-26 19:18:54 UTC (rev 213)
@@ -89,7 +89,7 @@
return(joined)
}
x <- list(...)
- if(any(!sapply(x, inherits, "data.frame")))
+ if(any(!sapply(x, inherits, "data.frame", USE.NAMES = FALSE)))
stop("\nall objects to be merged must be data frames.")
dims <- do.call(rbind, lapply(x, dim))
n.joined <- nrow(dims)
Modified: pkg/R/plot.mat.R
===================================================================
--- pkg/R/plot.mat.R 2011-03-14 14:39:28 UTC (rev 212)
+++ pkg/R/plot.mat.R 2011-03-26 19:18:54 UTC (rev 213)
@@ -126,7 +126,8 @@
## turn cut intervals into numeric
interv <- lapply(strsplit(sapply(levels(groups),
function(x) substr(x, 2,
- nchar(x)-1)), ","),
+ nchar(x)-1),
+ USE.NAMES = FALSE), ","),
as.numeric)
## reformat cut intervals as 2 col matrix for easy plotting
interv <- matrix(unlist(interv), ncol = 2, byrow = TRUE)
Modified: pkg/R/plot.mcarlo.R
===================================================================
--- pkg/R/plot.mcarlo.R 2011-03-14 14:39:28 UTC (rev 212)
+++ pkg/R/plot.mcarlo.R 2011-03-26 19:18:54 UTC (rev 213)
@@ -39,7 +39,8 @@
if (show[2]) {
num.dists <- length(x)
cumfreq <- sapply(evalDists,
- function(x, y) length(y[y <= x]), x)/num.dists
+ function(x, y) length(y[y <= x]), x,
+ USE.NAMES = FALSE) / num.dists
cummu <- data.frame(distances = evalDists, cumfreq = cumfreq)
suppressWarnings(critical <- approx(cummu$cumfreq, cummu$distances,
alpha))
Modified: pkg/R/plot.wa.R
===================================================================
--- pkg/R/plot.wa.R 2011-03-14 14:39:28 UTC (rev 212)
+++ pkg/R/plot.wa.R 2011-03-26 19:18:54 UTC (rev 213)
@@ -55,8 +55,10 @@
bias <- aggregate(as.vector(Resi), list(group = groups),
mean)$x
interv <- lapply(strsplit(sapply(levels(groups),
- function(x) substr(x, 2, nchar(x) - 1)), ","),
- as.numeric)
+ function(x) substr(x, 2,
+ nchar(x) - 1),
+ USE.NAMES = FALSE), ","),
+ as.numeric)
interv <- matrix(unlist(interv), ncol = 2, byrow = TRUE)
arrows(interv[, 1], bias, interv[, 2], bias,
length = ifelse(one.fig, 0.05, 0.01),
Modified: pkg/R/stdError.R
===================================================================
--- pkg/R/stdError.R 2011-03-14 14:39:28 UTC (rev 212)
+++ pkg/R/stdError.R 2011-03-26 19:18:54 UTC (rev 213)
@@ -31,10 +31,10 @@
ords <- apply(object$Dij, 2, getOrd)
SEQ <- seq_len(ncol(ords))
## weights = 1/Dij
- wts <- 1 / sapply(SEQ, getWts, object$Dij, ords, k.seq)
+ wts <- 1 / sapply(SEQ, getWts, object$Dij, ords, k.seq, USE.NAMES = FALSE)
## produce matrix of Env data for each site
env <- sapply(SEQ, getEnv, object$Dij, ords, k.seq,
- object$orig.y)
+ object$orig.y, USE.NAMES = FALSE)
## mean of env of k closest analogues
ybar <- colMeans(env)
wtdSD <- sqrt(colSums(wts * sweep(env, 2, ybar, "-")^2) /
@@ -69,10 +69,10 @@
ords <- apply(object$Dij, 2, getOrd)
SEQ <- seq_len(ncol(ords))
## weights = 1/Dij
- wts <- 1 / sapply(SEQ, getWts, object$Dij, ords, k.seq)
+ wts <- 1 / sapply(SEQ, getWts, object$Dij, ords, k.seq, USE.NAMES = FALSE)
## produce matrix of Env data for each site
env <- sapply(SEQ, getEnv, object$Dij, ords, k.seq,
- object$observed)
+ object$observed, USE.NAMES = FALSE)
## mean of env of k closest analogues
ybar <- colMeans(env)
wtdSD <- sqrt(colSums(wts * sweep(env, 2, ybar, "-")^2) /
Modified: pkg/R/summary.cma.R
===================================================================
--- pkg/R/summary.cma.R 2011-03-14 14:39:28 UTC (rev 212)
+++ pkg/R/summary.cma.R 2011-03-26 19:18:54 UTC (rev 213)
@@ -14,7 +14,7 @@
} else {
return(x)}
})
- each.analogs <- sapply(close, length)
+ each.analogs <- sapply(close, length, USE.NAMES = FALSE)
max.analogs <- max(each.analogs)
samples <- distances <- matrix(NA, nrow = max.analogs,
ncol = length(close))
Modified: pkg/R/summary.logitreg.R
===================================================================
--- pkg/R/summary.logitreg.R 2011-03-14 14:39:28 UTC (rev 212)
+++ pkg/R/summary.logitreg.R 2011-03-26 19:18:54 UTC (rev 213)
@@ -8,7 +8,7 @@
c(IN, OUT, coefs, unname(dose[1]),
unname(attr(dose, "SE")[,1]))
}
- DF <- t(sapply(object, FOO, p = p))
+ DF <- t(sapply(object, FOO, p = p, USE.NAMES = FALSE))
DF <- data.frame(DF)
names(DF) <- c("In","Out","Est.(Dij)","Std.Err", "Z-value","p-value",
paste("Dij(p=", format(p), ")", sep = ""),
Modified: pkg/man/Stratiplot.Rd
===================================================================
--- pkg/man/Stratiplot.Rd 2011-03-14 14:39:28 UTC (rev 212)
+++ pkg/man/Stratiplot.Rd 2011-03-26 19:18:54 UTC (rev 213)
@@ -154,45 +154,39 @@
(plt <- Stratiplot(Depths ~ O.univ + G.ruber + G.tenel + G.pacR,
data = V12.122, type = c("h","l","g","smooth")))
-(plt2 <- Stratiplot(Depths ~ O.univ + G.ruber + G.tenel + G.pacR,
- data = V12.122, type = c("poly","g")))
-
## Order taxa by WA in depth --- ephasises change over time
-(plt3 <- Stratiplot(Depths ~ O.univ + G.ruber + G.tenel + G.pacR,
- data = V12.122, type = c("h"), sort = "wa"))
+(plt <- Stratiplot(Depths ~ O.univ + G.ruber + G.tenel + G.pacR,
+ data = V12.122, type = c("h"), sort = "wa"))
## Using the default interface
spp.want <- c("O.univ","G.ruber","G.tenel","G.pacR")
-(plt4 <- Stratiplot(V12.122[, spp.want], y = Depths,
- type = c("poly", "g")))
+(plt <- Stratiplot(V12.122[, spp.want], y = Depths,
+ type = c("poly", "g")))
-## Addin zones to a Stratigraphic plot
-
+## Adding zones to a Stratigraphic plot
## Default labelling and draw zone legend
## Here we choose 4 arbitrary Depths as the zone boundaries
set.seed(123)
Zones <-sample(Depths, 4)
-(plt5 <- Stratiplot(Depths ~ O.univ + G.ruber + G.tenel + G.pacR,
- data = V12.122, type = c("poly","g"),
- zones = Zones))
+(plt <- Stratiplot(Depths ~ O.univ + G.ruber + G.tenel + G.pacR,
+ data = V12.122, type = c("poly","g"),
+ zones = Zones))
## As before, but supplying your own zone labels
zone.labs <- c("A","B","C","D","E")
-(plt6 <- Stratiplot(Depths ~ O.univ + G.ruber + G.tenel + G.pacR,
- data = V12.122, type = c("poly","g"),
- zones = Zones, zoneNames = zone.labs))
+(plt <- Stratiplot(Depths ~ O.univ + G.ruber + G.tenel + G.pacR,
+ data = V12.122, type = c("poly","g"),
+ zones = Zones, zoneNames = zone.labs))
## Suppress the drawing of the zone legend
-(plt7 <- Stratiplot(Depths ~ O.univ + G.ruber + G.tenel + G.pacR,
- data = V12.122, type = c("poly","g"),
- zones = Zones, drawLegend = FALSE))
+(plt <- Stratiplot(Depths ~ O.univ + G.ruber + G.tenel + G.pacR,
+ data = V12.122, type = c("poly","g"),
+ zones = Zones, drawLegend = FALSE))
## Add zones and draw a legend, but do not label the zones
-(plt8 <- Stratiplot(Depths ~ O.univ + G.ruber + G.tenel + G.pacR,
- data = V12.122, type = c("poly","g"),
- zones = Zones, zoneNames = ""))
-
-
+(plt <- Stratiplot(Depths ~ O.univ + G.ruber + G.tenel + G.pacR,
+ data = V12.122, type = c("poly","g"),
+ zones = Zones, zoneNames = ""))
}
% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.
More information about the Analogue-commits
mailing list