1## File src/library/utils/R/strcapture.R 2## Part of the R package, https://www.R-project.org 3## 4## Copyright (C) 1995-2019 The R Core Team 5## 6## This program is free software; you can redistribute it and/or modify 7## it under the terms of the GNU General Public License as published by 8## the Free Software Foundation; either version 2 of the License, or 9## (at your option) any later version. 10## 11## This program is distributed in the hope that it will be useful, 12## but WITHOUT ANY WARRANTY; without even the implied warranty of 13## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14## GNU General Public License for more details. 15## 16## A copy of the GNU General Public License is available at 17## https://www.R-project.org/Licenses/ 18 19strcapture <- function(pattern, x, proto, perl = FALSE, useBytes = FALSE) { 20 m <- regexec(pattern, x, perl=perl, useBytes=useBytes) 21 str <- regmatches(x, m) 22 ntokens <- length(proto) + 1L 23 nomatch <- lengths(str) == 0L 24 str[nomatch] <- list(rep.int(NA_character_, ntokens)) 25 if (length(str) > 0L && length(str[[1L]]) != ntokens) { 26### FIXME: this will not always detect an error when there are no matches 27 stop("The number of captures in 'pattern' != 'length(proto)'") 28 } 29 mat <- matrix(as.character(unlist(str)), ncol=ntokens, 30 byrow=TRUE)[,-1L,drop=FALSE] 31 conformToProto(mat, proto) 32} 33 34## Not yet exported 35strextract <- function(pattern, x, perl = FALSE, useBytes = FALSE) { 36 m <- regexec(pattern, x, perl=perl, useBytes=useBytes) 37 unlist(regmatches(x, m)) 38} 39 40conformToProto <- function(mat, proto) { 41 ans <- lapply(seq_along(proto), function(i) { 42 if (isS4(proto[[i]])) { 43 methods::as(mat[,i], class(proto[[i]])) 44 } else { 45 fun <- match.fun(paste0("as.", class(proto[[i]]))) 46 fun(mat[,i]) 47 } 48 }) 49 names(ans) <- names(proto) 50 if (isS4(proto)) { 51 methods::as(ans, class(proto)) 52 } else { 53 as.data.frame(ans, optional=TRUE, stringsAsFactors=FALSE) 54 } 55} 56 57## Not yet exported 58strslice <- function(x, split, proto, fixed = FALSE, perl = FALSE, 59 useBytes = FALSE) 60{ 61 str <- strsplit(x, split, fixed=fixed, perl=perl, useBytes=useBytes) 62 ntokens <- length(proto) 63 if (length(str) > 0L) { 64 if (length(str[[1L]]) != ntokens) { 65 stop("The number of tokens != 'length(proto)'") 66 } else if (length(unique(lengths(str))) > 1L) { 67 stop("The number of tokens is not consistent across 'x'") 68 } 69 } 70 mat <- matrix(as.character(unlist(str)), ncol=ntokens, byrow=TRUE) 71 conformToProto(mat, proto) 72} 73 74## not yet exported; called from tools:::config_val_to_logical() 75str2logical <- function(x) { 76 if(!is.character(x)) x <- as.character(x) 77 if(!is.na(v <- as.logical(x))) # via fast C code, e.g. for "True" 78 return(v) 79 v <- tolower(x) 80 if (v %in% c("1", "yes")) TRUE 81 else if (v %in% c("0", "no")) FALSE 82 else { 83 warning(gettextf("cannot coerce %s to logical", sQuote(x)), 84 domain = NA) 85 NA 86 } 87} 88