s/sapply/vapply.

git-svn-id: https://svn.r-project.org/R/trunk@88290 00db46b3-68df-0310-9c12-caf00c1e9a41

Author: hornik

src/library/base/R/datetime.R

@@ -534,10 +534,12 @@ Math.POSIXt <- function (x, ...)
 
 .check_tzones <- function(...)
 {
-    tzs <- unique(sapply(list(...), function(x) {
-        y <- attr(x, "tzone")
-        if(is.null(y)) "" else y[1L]
-    }))
+    tzs <- unique(vapply(list(...),
+                         function(x) {
+                             y <- attr(x, "tzone")
+                             if(is.null(y)) "" else y[1L]
+                         },
+                         ""))
     tzs <- tzs[nzchar(tzs)]
     if(length(tzs) > 1L)
         warning("'tzone' attributes are inconsistent")

src/library/base/R/grep.R

@@ -564,7 +564,9 @@ function(x, m, invert = FALSE, value)
             value <- rep_len(value, np)
         }
         y <- y[pos]
-        x[pos] <- paste0(sapply(y, `[`, 1L), value, sapply(y, `[`, 2L))
+        x[pos] <- paste0(vapply(y, `[`, "", 1L),
+                         value,
+                         vapply(y, `[`, "", 2L))
         return(x)
     }
 

src/library/grDevices/R/unix/quartz.R

@@ -122,7 +122,7 @@ quartzFonts <- function(...) {
         fontNames <- names(fonts)
         nnames <- length(fontNames)
         if (nnames == 0L) {
-            if (!all(sapply(fonts, is.character)))
+            if (!all(vapply(fonts, is.character, NA)))
                 stop("invalid arguments in 'quartzFonts' (must be font names)")
             else
                 get(".Quartz.Fonts", envir=.Quartzenv)[unlist(fonts)]

src/library/grDevices/R/unix/x11.R

@@ -173,7 +173,7 @@ X11Fonts <- function(...)
         fontNames <- names(fonts)
         nnames <- length(fontNames)
         if (nnames == 0) {
-            if (!all(sapply(fonts, is.character)))
+            if (!all(vapply(fonts, is.character, NA)))
                 stop("invalid arguments in 'X11Fonts' (must be font names)")
             else
                 get(".X11.Fonts", envir=.X11env)[unlist(fonts)]

src/library/grDevices/R/windows/windows.R

@@ -218,7 +218,7 @@ print.SavedPlots <- function(x, ...)
     }
     cat("Saved Plots from R version 1.4.0 or later\n\n")
     cat("  Contains", x[[2L]], "out of a maximum", x[[3L]], "plots\n")
-    lens <- sapply(x[[5L]], length)[1L:x[[2L]]]
+    lens <- lengths(x[[5L]])[1L:x[[2L]]]
     cat("  #plot calls are", paste(lens, collapse=", "), "\n")
     cat("  Current position is plot", 1L + x[[4L]], "\n")
     invisible(x)
@@ -283,7 +283,7 @@ windowsFonts <- function(...)
         fontNames <- names(fonts)
         nnames <- length(fontNames)
         if (nnames == 0) {
-            if (!all(sapply(fonts, is.character)))
+            if (!all(vapply(fonts, is.character, NA)))
                 stop("invalid arguments in 'windowsFonts' (must be font names)")
             else
                 get(".Windows.Fonts", envir=.WindowsEnv)[unlist(fonts)]

src/library/tools/R/citation.R

@@ -135,7 +135,7 @@ function(file, encoding = "ASCII")
     out <- Filter(Negate(is.null), out)
     ## If we found nothing return nothing ...
     if(!length(out)) return(NULL)
-    entries <- sapply(out, `[[`, 1L)
+    entries <- vapply(out, `[[`, "", 1L)
     fields <- lapply(out, `[[`, 2L)
     out <- data.frame(File = file,
                       Entry = entries,

src/library/tools/R/encodings.R

@@ -49,7 +49,7 @@ function(file = NULL)
     MIME <- sapply(mapply(c, out$Name, out$Aliases),
                    function(u) {
                        if(any(ind <- grep("preferred MIME name", u)))
-                           sapply(strsplit(u[ind], " +"), `[[`, 1L)
+                           vapply(strsplit(u[ind], " +"), `[[`, "", 1L)
                        else
                            character()
                    })

src/library/tools/R/news.R

@@ -204,10 +204,10 @@ function(file)
             ire <- sprintf("^[[:space:]]*([%s])[[:space:]]+", sep)
             ind <- grepl(ire, lines)
             list(entries =
-                 sapply(split(lines, cumsum(ind)),
+                 vapply(split(lines, cumsum(ind)),
                         function(s)
-                        sub(ire, "", .collapse(sub("^\t?", "", s)))
-                        ),
+                            sub(ire, "", .collapse(sub("^\t?", "", s))),
+                        ""),
                  header = header,
                  chunk = chunk,
                  date = date)
@@ -577,7 +577,7 @@ function(file)
 function(x)
 {
     get_section_names <- function(x)
-        sapply(x, function(e) .Rd_get_text(e[[1L]]))
+        vapply(x, function(e) .Rd_get_text(e[[1L]]), "")
 
     get_item_texts <- function(x) {
         ## Currently, chunks should consist of a single \itemize list

src/library/tools/R/packages.R

@@ -168,7 +168,7 @@ function(files, type, fields, verbose, validate = FALSE)
     ## files was without path at this point in original code,
     ## use filetbs instead to compute pkg names and set db names
     filetbs <- basename(files)
-    packages <- sapply(strsplit(filetbs, "_", fixed = TRUE), `[`, 1L)
+    packages <- vapply(strsplit(filetbs, "_", fixed = TRUE), `[`, "", 1L)
     db <- vector(length(files), mode = "list")
     names(db) <- filetbs #files was not full paths before
     ## Many (roughly length(files)) warnings are *expected*, hence

src/library/tools/R/recode.R

@@ -52,11 +52,11 @@ encoded_text_to_latex <-
         paste(y, collapse="")
     }
     as.vector(switch(encoding,
-                     "latin1" = sapply(x, do_latin1),
-                     "latin2" = sapply(x, do_latin2),
-                     "latin9" = sapply(x, do_latin9),
-                     "UTF-8"  = sapply(x, do_utf8),
-                     "utf8"   = sapply(x, do_utf8),
+                     "latin1" = vapply(x, do_latin1, ""),
+                     "latin2" = vapply(x, do_latin2, ""),
+                     "latin9" = vapply(x, do_latin9, ""),
+                     "UTF-8"  = vapply(x, do_utf8, ""),
+                     "utf8"   = vapply(x, do_utf8, ""),
                      stop("unimplemented encoding")
                         ))
 }