separar - extraer caracteres de una cadena en r
Crear todas las combinaciones de sustitución de letras en cadena (7)
Tengo una cadena "ECET" y me gustaría crear todas las cadenas posibles donde sustituyo una o más letras (todas menos la primera) con "X".
Entonces en este caso mi resultado sería:
> result
[1] "EXET" "ECXT" "ECEX" "EXXT" "EXEX" "ECXX" "EXXX"
¿Alguna idea sobre cómo abordar el problema?
Esto no es solo crear las posibles combinaciones / permutaciones de "X" sino también cómo combinarlas con la cadena existente.
Algo así como para agregar otra opción usando lógica binaria:
Asumiendo que su cadena siempre tiene 4 caracteres de largo:
input<-"ECET"
invec <- strsplit(input,'''')[[1]]
sapply(1:7, function(x) {
z <- invec
z[rev(as.logical(intToBits(x))[1:4])] <- "X"
paste0(z,collapse = '''')
})
[1] "ECEX" "ECXT" "ECXX" "EXET" "EXEX" "EXXT" "EXXX"
Si la cadena tiene que ser más larga, puede calcular los valores con una potencia de 2, algo como esto debería hacer:
input<-"ECETC"
pow <- nchar(input)
invec <- strsplit(input,'''')[[1]]
sapply(1:(2^(pow-1) - 1), function(x) {
z <- invec
z[rev(as.logical(intToBits(x))[1:(pow)])] <- "X"
paste0(z,collapse = '''')
})
[1] "ECETX" "ECEXC" "ECEXX" "ECXTC" "ECXTX" "ECXXC" "ECXXX" "EXETC" "EXETX" "EXEXC" "EXEXX" "EXXTC" "EXXTX" "EXXXC"
[15] "EXXXX"
La idea es conocer el número de posibles alteraciones, es un binario de 3 posiciones, por lo que 2 ^ 3 menos 1, ya que no queremos mantener la cadena sin reemplazo: 7
intToBits devuelve el valor binario del entero, para 5:
> intToBits(5)
[1] 01 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
R usa 32 bits por defecto, pero solo queremos un vector lógico que se corresponda con nuestra longitud de cadena, por lo que solo conservamos el valor nominal de la cadena original. Luego convertimos a lógico e invertimos estos 4 valores booleanos, ya que nunca dispararemos el último bit (8 para 4 caracteres) nunca será cierto:
> intToBits(5)
[1] 01 00 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
> tmp<-as.logical(intToBits(5)[1:4])
> tmp
[1] TRUE FALSE TRUE FALSE
> rev(tmp)
[1] FALSE TRUE FALSE TRUE
Para evitar sobrescribir nuestro vector original, lo copiamos en z y luego reemplazamos la posición en z usando este vector lógico.
Para una salida agradable, devolvemos el paste0 con el colapso como nada para recrear una sola cadena y recuperar un vector de caracteres.
Aquí hay una solución base R, pero me parece complicada, con 3 bucles anidados.
replaceChar <- function(x, char = "X"){
n <- nchar(x)
res <- NULL
for(i in seq_len(n)){
cmb <- combn(n, i)
r <- apply(cmb, 2, function(cc){
y <- x
for(k in cc)
substr(y, k, k) <- char
y
})
res <- c(res, r)
}
res
}
x <- "ECET"
replaceChar(x)
replaceChar(x, "Y")
replaceChar(paste0(x, x))
Aquí hay una solución recursiva:
f <- function(x,pos=2){
if(pos <= nchar(x))
c(f(x,pos+1), f(`substr<-`(x, pos, pos, "X"),pos+1))
else x
}
f(x)[-1]
# [1] "ECEX" "ECXT" "ECXX" "EXET" "EXEX" "EXXT" "EXXX"
O usando expand.grid :
do.call(paste0, expand.grid(c(substr(x,1,1),lapply(strsplit(x,"")[[1]][-1], c, "X"))))[-1]
# [1] "EXET" "ECXT" "EXXT" "ECEX" "EXEX" "ECXX" "EXXX"
O usando combn / Reduce / substr<- :
combs <- unlist(lapply(seq(nchar(x)-1),combn, x =seq(nchar(x))[-1],simplify = F),F)
sapply(combs, Reduce, f= function(x,y) `substr<-`(x,y,y,"X"), init = x)
# [1] "EXET" "ECXT" "ECEX" "EXXT" "EXEX" "ECXX" "EXXX"
Segunda solución explicada
pairs0 <- lapply(strsplit(x,"")[[1]][-1], c, "X") # pairs of original letter + "X"
pairs1 <- c(substr(x,1,1), pairs0) # including 1st letter (without "X")
do.call(paste0, expand.grid(pairs1))[-1] # expand into data.frame and paste
Otra versión con combn, utilizando purrr:
s <- "ECET"
f <- function(x,y) {substr(x,y,y) <- "X"; x}
g <- function(x) purrr::reduce(x,f,.init=s)
unlist(purrr::map(1:(nchar(s)-1), function(x) combn(2:nchar(s),x,g)))
#[1] "EXET" "ECXT" "ECEX" "EXXT" "EXEX" "ECXX" "EXXX"
o sin purrr:
s <- "ECET"
f <- function(x,y) {substr(x,y,y) <- "X"; x}
g <- function(x) Reduce(f,x,s)
unlist(lapply(1:(nchar(s)-1),function(x) combn(2:nchar(s),x,g)))
Un método vectorizado con indexación booleana:
permX <- function(text, replChar=''X'') {
library(gtools)
library(stringr)
# get TRUE/FALSE permutations for nchar(text)
idx <- permutations(2, nchar(text),c(T,F), repeats.allowed = T)
# we don''t want the first character to be replaced
idx <- idx[1:(nrow(idx)/2),]
# split string into single chars
chars <- str_split(text,'''')
# build data.frame with nrows(df) == nrows(idx)
df = t(data.frame(rep(chars, nrow(idx))))
# do replacing
df[idx] <- replChar
row.names(df) <- c()
return(df)
}
permX(''ECET'')
[,1] [,2] [,3] [,4]
[1,] "E" "C" "E" "T"
[2,] "E" "C" "E" "X"
[3,] "E" "C" "X" "T"
[4,] "E" "C" "X" "X"
[5,] "E" "X" "E" "T"
[6,] "E" "X" "E" "X"
[7,] "E" "X" "X" "T"
[8,] "E" "X" "X" "X"
Una solución más simple
# expand.grid to get all combinations of the input vectors, result in a matrix
m <- expand.grid( c(''E''),
c(''C'',''X''),
c(''E'',''X''),
c(''T'',''X'') )
# then, optionally, apply to paste the columns together
apply(m, 1, paste0, collapse='''')[-1]
[1] "EXET" "ECXT" "EXXT" "ECEX" "EXEX" "ECXX" "EXXX"
Usando el argumento FUN de combn :
a <- "ECET"
fun <- function(n, string) {
combn(nchar(string), n, function(x) {
s <- strsplit(string, '''')[[1]]
s[x] <- ''X''
paste(s, collapse = '''')
} )
}
lapply(seq_len(nchar(a)), fun, string = a)
[[1]] [1] "XCET" "EXET" "ECXT" "ECEX" [[2]] [1] "XXET" "XCXT" "XCEX" "EXXT" "EXEX" "ECXX" [[3]] [1] "XXXT" "XXEX" "XCXX" "EXXX" [[4]] [1] "XXXX"
unlist para obtener un solo vector. Probablemente hay soluciones más rápidas disponibles.
Para dejar tu primer personaje sin cambios:
paste0(
substring(a, 1, 1),
unlist(lapply(seq_len(nchar(a) - 1), fun, string = substring(a, 2)))
)
[1] "EXET" "ECXT" "ECEX" "EXXT" "EXEX" "ECXX" "EXXX"