Разделение строки на вектор символов с фиксированной шириной
У меня есть объект, содержащий текстовую строку:
x <- "xxyyxyxy"
и я хочу разделить это на вектор с каждым элементом, содержащим две буквы:
[1] "xx" "yy" "xy" "xy"
Кажется, что strsplit должен быть моим билетом, но поскольку у меня нет регулярного выражения foo, я не могу понять, как заставить эту функцию разрезать строку на куски так, как я хочу. Как мне это сделать?
13 ответов
С помощью substring это лучший подход:
substring(x, seq(1, nchar(x), 2), seq(2, nchar(x), 2))
Но вот решение с plyr:
library("plyr")
laply(seq(1, nchar(x), 2), function(i) substr(x, i, i+1))
Вот быстрое решение, которое разбивает строку на символы, а затем вставляет вместе четные и нечетные элементы.
x <- "xxyyxyxy"
sst <- strsplit(x, "")[[1]]
paste0(sst[c(TRUE, FALSE)], sst[c(FALSE, TRUE)])
Настройка бенчмарка:
library(microbenchmark)
GSee <- function(x) {
sst <- strsplit(x, "")[[1]]
paste0(sst[c(TRUE, FALSE)], sst[c(FALSE, TRUE)])
}
Shane1 <- function(x) {
substring(x, seq(1,nchar(x),2), seq(2,nchar(x),2))
}
library("plyr")
Shane2 <- function(x) {
laply(seq(1,nchar(x),2), function(i) substr(x, i, i+1))
}
seth <- function(x) {
strsplit(gsub("([[:alnum:]]{2})", "\\1 ", x), " ")[[1]]
}
geoffjentry <- function(x) {
idx <- 1:nchar(x)
odds <- idx[(idx %% 2) == 1]
evens <- idx[(idx %% 2) == 0]
substring(x, odds, evens)
}
drewconway <- function(x) {
c<-strsplit(x,"")[[1]]
sapply(seq(2,nchar(x),by=2),function(y) paste(c[y-1],c[y],sep=""))
}
KenWilliams <- function(x) {
n <- 2
sapply(seq(1,nchar(x),by=n), function(xx) substr(x, xx, xx+n-1))
}
RichardScriven <- function(x) {
regmatches(x, gregexpr("(.{2})", x))[[1]]
}
Контрольный показатель 1:
x <- "xxyyxyxy"
microbenchmark(
GSee(x),
Shane1(x),
Shane2(x),
seth(x),
geoffjentry(x),
drewconway(x),
KenWilliams(x),
RichardScriven(x)
)
# Unit: microseconds
# expr min lq median uq max neval
# GSee(x) 8.032 12.7460 13.4800 14.1430 17.600 100
# Shane1(x) 74.520 80.0025 84.8210 88.1385 102.246 100
# Shane2(x) 1271.156 1288.7185 1316.6205 1358.5220 3839.300 100
# seth(x) 36.318 43.3710 45.3270 47.5960 67.536 100
# geoffjentry(x) 9.150 13.5500 15.3655 16.3080 41.066 100
# drewconway(x) 92.329 98.1255 102.2115 105.6335 115.027 100
# KenWilliams(x) 77.802 83.0395 87.4400 92.1540 163.705 100
# RichardScriven(x) 55.034 63.1360 65.7545 68.4785 108.043 100
Контрольный показатель 2:
Теперь с большими данными.
x <- paste(sample(c("xx", "yy", "xy"), 1e5, replace=TRUE), collapse="")
microbenchmark(
GSee(x),
Shane1(x),
Shane2(x),
seth(x),
geoffjentry(x),
drewconway(x),
KenWilliams(x),
RichardScriven(x),
times=3
)
# Unit: milliseconds
# expr min lq median uq max neval
# GSee(x) 29.029226 31.3162690 33.603312 35.7046155 37.805919 3
# Shane1(x) 11754.522290 11866.0042600 11977.486230 12065.3277955 12153.169361 3
# Shane2(x) 13246.723591 13279.2927180 13311.861845 13371.2202695 13430.578694 3
# seth(x) 86.668439 89.6322615 92.596084 92.8162885 93.036493 3
# geoffjentry(x) 11670.845728 11681.3830375 11691.920347 11965.3890110 12238.857675 3
# drewconway(x) 384.863713 438.7293075 492.594902 515.5538020 538.512702 3
# KenWilliams(x) 12213.514508 12277.5285215 12341.542535 12403.2315015 12464.920468 3
# RichardScriven(x) 11549.934241 11730.5723030 11911.210365 11989.4930080 12067.775651 3
Как насчет
strsplit(gsub("([[:alnum:]]{2})", "\\1 ", x), " ")[[1]]
В основном, добавьте разделитель (здесь " "), а затем используйте strsplit
strsplit будет проблематичным, посмотрите на регулярное выражение, как это
strsplit(z, '[[:alnum:]]{2}')
он будет разделен в правильных точках, но ничего не осталось
Вы можете использовать подстроку и друзей
z <- 'xxyyxyxy'
idx <- 1:nchar(z)
odds <- idx[(idx %% 2) == 1]
evens <- idx[(idx %% 2) == 0]
substring(z, odds, evens)
Вот один из способов, но без использования регулярных выражений:
a <- "xxyyxyxy"
n <- 2
sapply(seq(1,nchar(a),by=n), function(x) substr(a, x, x+n-1))
ВНИМАНИЕ с подстрокой, если длина строки не кратна вашей запрашиваемой длине, тогда вам понадобится +(n-1) во второй последовательности:
substring(x,seq(1,nchar(x),n),seq(n,nchar(x)+n-1,n))
Всего взломать, JD, но это делается
x <- "xxyyxyxy"
c<-strsplit(x,"")[[1]]
sapply(seq(2,nchar(x),by=2),function(y) paste(c[y-1],c[y],sep=""))
[1] "xx" "yy" "xy" "xy"
Вспомогательная функция:
fixed_split <- function(text, n) {
strsplit(text, paste0("(?<=.{",n,"})"), perl=TRUE)
}
fixed_split(x, 2)
[[1]]
[1] "xx" "yy" "xy" "xy"
Используя C++, можно быть еще быстрее. Сравнение с версией GSee:
GSee <- function(x) {
sst <- strsplit(x, "")[[1]]
paste0(sst[c(TRUE, FALSE)], sst[c(FALSE, TRUE)])
}
rstub <- Rcpp::cppFunction( code = '
CharacterVector strsplit2(const std::string& hex) {
unsigned int length = hex.length()/2;
CharacterVector res(length);
for (unsigned int i = 0; i < length; ++i) {
res(i) = hex.substr(2*i, 2);
}
return res;
}')
x <- "xxyyxyxy"
all.equal(GSee(x), rstub(x))
#> [1] TRUE
microbenchmark::microbenchmark(GSee(x), rstub(x))
#> Unit: microseconds
#> expr min lq mean median uq max neval
#> GSee(x) 4.272 4.4575 41.74284 4.5855 4.7105 3702.289 100
#> rstub(x) 1.710 1.8990 139.40519 2.0665 2.1250 13722.075 100
set.seed(42)
x <- paste(sample(c("xx", "yy", "xy"), 1e5, replace = TRUE), collapse = "")
all.equal(GSee(x), rstub(x))
#> [1] TRUE
microbenchmark::microbenchmark(GSee(x), rstub(x))
#> Unit: milliseconds
#> expr min lq mean median uq max neval
#> GSee(x) 17.931801 18.431504 19.282877 18.738836 19.47943 27.191390 100
#> rstub(x) 3.197587 3.261109 3.404973 3.341099 3.45852 4.872195 100
Я начал искать векторизованное решение этой проблемы, чтобы избежать
lapply()одно из однострочных решений для длинных векторов. Не сумев найти существующее решение, я каким-то образом попал в кроличью нору и кропотливо написал его на C. В итоге это оказалось до смешного сложным по сравнению со многими однострочными решениями R, показанными здесь (нет, благодаря тому, что я решил также обрабатывать строки Unicode). чтобы соответствовать версиям R), но я подумал, что поделюсь результатом, если он когда-нибудь кому-нибудь поможет. Вот что в итоге из этого вышло:
#define R_NO_REMAP
#include <R.h>
#include <Rinternals.h>
// Find the width (in bytes) of a UTF-8 character, given its first byte
size_t utf8charw(char b) {
if (b == 0x00) return 0;
if ((b & 0x80) == 0x00) return 1;
if ((b & 0xe0) == 0xc0) return 2;
if ((b & 0xf0) == 0xe0) return 3;
if ((b & 0xf8) == 0xf0) return 4;
return 1; // Really an invalid character, but move on
}
// Find the number of UTF-8 characters in a string
size_t utf8nchar(const char* str) {
size_t nchar = 0;
while (*str != '\0') {
str += utf8charw(*str); nchar++;
}
return nchar;
}
SEXP C_str_chunk(SEXP x, SEXP size_) {
// Allocate a list to store the result
R_xlen_t n = Rf_xlength(x);
SEXP result = PROTECT(Rf_allocVector(VECSXP, n));
int size = Rf_asInteger(size_);
for (R_xlen_t i = 0; i < n; i++) {
const char* str = Rf_translateCharUTF8(STRING_ELT(x, i));
// Figure out number of chunks
size_t nchar = utf8nchar(str);
size_t nchnk = nchar / size + (nchar % size != 0);
SEXP chunks = PROTECT(Rf_allocVector(STRSXP, nchnk));
for (size_t j = 0, nbytes = 0; j < nchnk; j++, str += nbytes) {
// Find size of next chunk in bytes
nbytes = 0;
for (int cp = 0; cp < size; cp++) {
nbytes += utf8charw(str[nbytes]);
}
// Assign to chunks vector as an R string
SET_STRING_ELT(chunks, j, Rf_mkCharLenCE(str, nbytes, CE_UTF8));
}
SET_VECTOR_ELT(result, i, chunks);
}
// Clean up
UNPROTECT(n);
UNPROTECT(1);
return result;
}
Затем я поместил это чудовище в файл с именем
str_chunk.c, и скомпилировано с
R CMD SHLIB str_chunk.c. Чтобы попробовать это, нам нужно немного настроить на стороне R:
str_chunk <- function(x, n) {
.Call("C_str_chunk", x, as.integer(n))
}
# The (currently) accepted answer
str_chunk_one <- function(x, n) {
substring(x, seq(1, nchar(x), n), seq(n, nchar(x), n))
}
dyn.load("str_chunk.dll")
Итак, чего мы достигли с версией C, так это взять векторные входные данные и вернуть список:
str_chunk(rep("0123456789AB", 2), 2)
#> [[1]]
#> [1] "01" "23" "45" "67" "89" "AB"
#>
#> [[2]]
#> [1] "01" "23" "45" "67" "89" "AB"
Теперь приступим к бенчмаркингу.
Мы начинаем с 200-кратного улучшения для длинного (почти) вектора коротких строк:
x <- rep("0123456789AB", 1000)
microbenchmark::microbenchmark(
accepted = lapply(x, str_chunk_one, 2),
str_chunk(x, 2)
) |> print(unit = "relative")
#> Unit: relative
#> expr min lq mean median uq max neval
#> accepted 229.5826 216.8246 182.5449 203.785 182.3662 25.88823 100
#> str_chunk(x, 2) 1.0000 1.0000 1.0000 1.000 1.0000 1.00000 100
… который затем сокращается до явно менее впечатляющего 3-кратного улучшения для больших строк.
x <- rep(strrep("0123456789AB", 1000), 10)
microbenchmark::microbenchmark(
accepted = lapply(x, str_chunk_one, 2),
str_chunk(x, 2)
) |> print(unit = "relative")
#> Unit: relative
#> expr min lq mean median uq max neval
#> accepted 2.77981 2.802641 3.304573 2.787173 2.846268 13.62319 100
#> str_chunk(x, 2) 1.00000 1.000000 1.000000 1.000000 1.000000 1.00000 100
dyn.unload("str_chunk.dll")
Итак, оно того стоило? Ну, абсолютно не учитывая, сколько времени потребовалось, чтобы на самом деле начать работать должным образом — но если бы это было в пакете, это сэкономило бы довольно много времени в моем случае использования (короткие строки, длинные векторы).
Из моего тестирования приведенный ниже код работает быстрее, чем предыдущие методы, которые были сравнены. stri_sub довольно быстрый, а seq.int лучше, чем seq. Также легко изменить размер строк, изменив все 2L на что-то еще.
library(stringi)
split_line <- function(x) {
row_length <- stri_length(x)
stri_sub(x, seq.int(1L, row_length, 2L), seq.int(2L, row_length, 2L))
}
Я не заметил разницы, когда куски строки были длиной 2 символа, но для больших кусков это немного лучше.
split_line <- function(x) {
stri_sub(x, seq.int(1L, stri_length(x), 109L), length = 109L)
}
Ну, я использовал следующий псевдокод для выполнения этой задачи:
- Вставьте специальную последовательность в каждый кусок длины n.
- Разбейте строку по указанной последовательности.
В коде я сделал
chopS <- function( text, chunk_len = 2, seqn)
{
# Specify select and replace patterns
insert <- paste("(.{",chunk_len,"})", sep = "")
replace <- paste("\\1", seqn, sep = "")
# Insert sequence with replaced pattern, then split by the sequence
interp_text <- gsub( pattern, replace, text)
strsplit( interp_text, seqn)
}
Это возвращает список с вектором разделения внутри, но не вектор.
Вот один из вариантов использования stringi::stri_sub(), Пытаться:
x <- "xxyyxyxy"
stringi::stri_sub(x, seq(1, stringi::stri_length(x), by = 2), length = 2)
# [1] "xx" "yy" "xy" "xy"