Skip to content

Commit 0a86797

Browse files
author
hornik
committed
s/sapply/vapply.
git-svn-id: https://svn.r-project.org/R/trunk@88301 00db46b3-68df-0310-9c12-caf00c1e9a41
1 parent b7391e2 commit 0a86797

File tree

11 files changed

+51
-33
lines changed

11 files changed

+51
-33
lines changed

‎src/library/base/R/dynload.R‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -127,9 +127,9 @@ function(x, ...)
127127
{
128128
if(length(x)) {
129129
m <- data.frame(numParameters =
130-
sapply(x, function(x) x$numParameters),
130+
vapply(x, `[[`, 0L, "numParameters"),
131131
row.names =
132-
sapply(x, function(x) x$name))
132+
vapply(x, `[[`, "", "name"))
133133
print(m, ...)
134134
}
135135
invisible(x)
@@ -154,10 +154,10 @@ function(x, ...)
154154
sapply(names(x),
155155
function(id) {
156156
d[[id]] <<- rep.int("", n)
157-
names <- vapply(x[[id]], function(x) x$name, "")
157+
names <- vapply(x[[id]], `[[`, "", "name")
158158
if(length(names)) d[[id]][seq_along(names)] <<- names
159159
d[[paste(id, "numParameters")]] <<- rep.int("", n)
160-
names <- sapply(x[[id]], function(x) x$numParameters)
160+
names <- vapply(x[[id]], `[[`, 0L, "numParameters")
161161
if(length(names))
162162
d[[paste(id, "numParameters")]][seq_along(names)] <<- names
163163
})
@@ -201,9 +201,9 @@ print.DLLInfo <- function(x, ...)
201201
print.DLLInfoList <- function(x, ...)
202202
{
203203
if(length(x)) {
204-
m <- data.frame(Filename = sapply(x, function(x) x[["path"]]),
204+
m <- data.frame(Filename = vapply(x, `[[`, "", "path"),
205205
"Dynamic Lookup" =
206-
sapply(x, function(x) x[["dynamicLookup"]]))
206+
vapply(x, `[[`, NA, "dynamicLookup"))
207207
print(m, ...)
208208
}
209209
invisible(x)

‎src/library/stats/R/AIC.R‎

Lines changed: 18 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -32,10 +32,13 @@ AIC.default <- function(object, ..., k = 2)
3232
ll <- if(isNamespaceLoaded("stats4")) stats4::logLik else logLik
3333
if(!missing(...)) {# several objects: produce data.frame
3434
lls <- lapply(list(object, ...), ll)
35-
vals <- sapply(lls, function(el) {
36-
c(as.numeric(el), attr(el, "df"),
37-
attr(el, "nobs") %||% NA_integer_)
38-
})
35+
vals <- vapply(lls,
36+
function(el) {
37+
c(as.numeric(el),
38+
attr(el, "df"),
39+
attr(el, "nobs") %||% NA_integer_)
40+
},
41+
numeric(3L))
3942
val <- data.frame(df = vals[2L,], ll = vals[1L,])
4043
nos <- na.omit(vals[3L,])
4144
if (length(nos) && any(nos != nos[1L]))
@@ -63,10 +66,13 @@ BIC.default <- function(object, ...)
6366
Nobs <- if(isNamespaceLoaded("stats4")) stats4::nobs else nobs
6467
if(!missing(...)) {# several objects: produce data.frame
6568
lls <- lapply(list(object, ...), ll)
66-
vals <- sapply(lls, function(el) {
67-
c(as.numeric(el), attr(el, "df"),
68-
attr(el, "nobs") %||% NA_integer_)
69-
})
69+
vals <- vapply(lls,
70+
function(el) {
71+
c(as.numeric(el),
72+
attr(el, "df"),
73+
attr(el, "nobs") %||% NA_integer_)
74+
},
75+
numeric(3L))
7076
val <- data.frame(df = vals[2L,], ll = vals[1L,], nobs = vals[3L,])
7177
nos <- na.omit(val$nobs)
7278
if (length(nos) && any(nos != nos[1L]))
@@ -75,8 +81,10 @@ BIC.default <- function(object, ...)
7581
unknown <- is.na(val$nobs)
7682
if(any(unknown))
7783
val$nobs[unknown] <-
78-
sapply(list(object, ...)[unknown],
79-
function(x) tryCatch(Nobs(x), error = function(e) NA_real_))
84+
vapply(list(object, ...)[unknown],
85+
function(x)
86+
tryCatch(Nobs(x), error = function(e) NA_real_),
87+
0)
8088
val <- data.frame(df = val$df, BIC = -2*val$ll + log(val$nobs)*val$df)
8189
row.names(val) <- as.character(match.call()[-1L])
8290
val

‎src/library/stats/R/glm.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -589,7 +589,7 @@ anova.glmlist <- function(object, ..., dispersion=NULL, test=NULL)
589589
domain = NA)
590590
}
591591

592-
ns <- sapply(object, function(x) length(x$residuals))
592+
ns <- vapply(object, function(x) length(x$residuals), 0)
593593
if(any(ns != ns[1L]))
594594
stop("models were not all fitted to the same size of dataset")
595595

‎src/library/stats/R/interaction.plot.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ interaction.plot <-
4242
}
4343
xlabs <- rownames(cells)
4444
ylabs <- colnames(cells)
45-
nch <- max(sapply(ylabs, nchar, type="width"))
45+
nch <- max(vapply(ylabs, nchar, 0, type="width"))
4646
if(is.null(xlabs)) xlabs <- as.character(xvals)
4747
if(is.null(ylabs)) ylabs <- as.character(1L:nc)
4848
xlim <- range(xvals)

‎src/library/tools/R/Rd.R‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -513,7 +513,11 @@ function(x, which, predefined = TRUE)
513513
## the elements the title and the body, respectively.
514514
x <- x[RdTags(x) == "\\section"]
515515
if(length(x)) {
516-
ind <- sapply(x, function(e) .Rd_get_text(e[[1L]])) == which
516+
ind <- vapply(x,
517+
function(e)
518+
paste(.Rd_get_text(e[[1L]]),
519+
collapse = " ") == which,
520+
NA)
517521
x <- lapply(x[ind], `[[`, 2L)
518522
}
519523
}
@@ -779,7 +783,7 @@ function(x)
779783
if(!length(x)) return(y)
780784
x <- x[RdTags(x) == "\\item"]
781785
if(!length(x)) return(y)
782-
x <- lapply(x[lengths(x) == 2L], sapply, .Rd_deparse)
786+
x <- lapply(x[lengths(x) == 2L], vapply, .Rd_deparse, "")
783787
matrix(unlist(x), ncol = 2L, byrow = TRUE)
784788
}
785789

‎src/library/tools/R/encodings.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@ function(file = NULL)
4646
## Prefer 'Aliases' for historical reasons.
4747
names(out)[names(out) == "Alias"] <- "Aliases"
4848
## Preferred MIME names.
49-
MIME <- sapply(mapply(c, out$Name, out$Aliases),
49+
MIME <- lapply(mapply(c, out$Name, out$Aliases),
5050
function(u) {
5151
if(any(ind <- grep("preferred MIME name", u)))
5252
vapply(strsplit(u[ind], " +"), `[[`, "", 1L)

‎src/library/utils/R/completion.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -642,7 +642,7 @@ normalCompletions <-
642642
dot_internals = TRUE)
643643
if (.CompletionEnv$settings[["func"]] && check.mode && !is.null(add.fun))
644644
{
645-
which.function <- sapply(comps, function(s) exists(s, mode = "function"))
645+
which.function <- vapply(comps, exists, NA, mode = "function")
646646
if (any(which.function))
647647
comps[which.function] <-
648648
sprintf("%s%s", comps[which.function], add.fun)

‎src/library/utils/R/package.skeleton.R‎

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -217,30 +217,33 @@ package.skeleton <-
217217
file.path(docs_dir,
218218
sprintf("%s-package.Rd", name)),
219219
lib.loc = path)
220-
sapply(list,
220+
vapply(list,
221221
function(item) {
222222
prompt(get(item, envir = environment),
223223
name = item,
224224
filename =
225225
file.path(docs_dir,
226226
sprintf("%s.Rd", list0[item])))
227-
})
228-
sapply(classesList,
227+
},
228+
"")
229+
vapply(classesList,
229230
function(item) {
230231
methods::promptClass(item,
231232
filename =
232233
file.path(docs_dir,
233234
sprintf("%s-class.Rd", classes0[item])),
234235
where = environment)
235-
})
236-
sapply(methodsList,
236+
},
237+
"")
238+
vapply(methodsList,
237239
function(item) {
238240
methods::promptMethods(item,
239241
filename =
240242
file.path(docs_dir,
241243
sprintf("%s-methods.Rd", methods0[item])),
242244
methods::findMethods(item, where = environment))
243-
})
245+
},
246+
"")
244247
}))
245248
## don't document generic functions from other packages
246249
for(item in methodsList) {

‎src/library/utils/R/rtags.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -74,7 +74,8 @@ write.etags <-
7474
lines <-
7575
switch(shorten.lines,
7676
none = lines,
77-
simple = sapply(strsplit(lines, "function", fixed = TRUE), `[`, 1),
77+
simple = vapply(strsplit(lines, "function", fixed = TRUE),
78+
`[`, "", 1),
7879
token = mapply(shorten.to.string, lines, tokens))
7980
tag.lines <-
8081
paste(sprintf("%s\x7f%s\x01%d,%d",

‎src/library/utils/R/sessionInfo.R‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -122,8 +122,9 @@ sessionInfo <- function(package = NULL)
122122
## no need to re-encode given what we extract.
123123
pkgDesc <- lapply(package, packageDescription, encoding = NA)
124124
if(length(package) == 0) stop("no valid packages were specified")
125-
basePkgs <- sapply(pkgDesc,
126-
function(x) !is.null(x$Priority) && x$Priority=="base")
125+
basePkgs <- vapply(pkgDesc,
126+
function(x) !is.null(x$Priority) && x$Priority=="base",
127+
NA)
127128
## Hmm, see tools:::.get_standard_package_names()$base
128129
z$basePkgs <- package[basePkgs]
129130
if(any(!basePkgs)){

0 commit comments

Comments
 (0)