Блог

У меня есть строка, в которой я хотел бы извлечь заклинания из последовательности, например,

    A<- c('000001111000', '0110011', '110001')
 

Я хотел бы получить непрерывные длины заклинаний 0 и 1 в формате последовательности. Затем, используя длины заклинаний, я хотел бы вычислить описательную статистику, такую как среднее значение, режим, sd и т. Д., (spell_0 и spell_1 — это последовательности из вектора A.

Например,

     spell_0  spell_1   mean_spell_0   mean_spell_1

       5-3        4           4               4
       1-2        2-2         1.5             2
        3         2-1         3               1.5
 

Есть предложения?

Ваш вопрос включает в себя фактически несколько вопросов.

Из вашего исходного вектора вам сначала нужно получить разные последовательности, после разделения строк на символы. Этого можно достичь, rle как указано в комментариях. Затем для каждого значения («0» и «1») в вашем примере вам нужно получить значение lengths каждой последовательности, соответствующее значению. Затем вам нужно поместить их в нужный формат (хотя это может быть не самым подходящим.

Вот мое предложение сделать все это:

 seqA <- lapply(strsplit(A, ""), rle)

do.call(cbind,lapply(c("0", "1"), # this can be made more general, for example using unique(unlist(strsplit(A, "")))
       function(i){
         do.call(rbind, lapply(seqA, 
                function(x){
                lesSeq <- x$lengths[x$values==i]
                  res <- data.frame(paste(lesSeq, collapse="-"), mean(lesSeq))
                  colnames(res) <- paste(c("spell", "mean_spell"), i, sep="_")
                return(res)
            }))
       }))[, c(1, 3, 2, 4)] # this rearrangment may not be needed...
#  spell_0 spell_1 mean_spell_0 mean_spell_1
#1     5-3       4          4.0          4.0
#2     1-2     2-2          1.5          2.0
#3       3     2-1          3.0          1.5
 

Вы могли бы попробовать что-то вроде этого:

 do.call(rbind,
  lapply(strsplit(A, ""), 
         function(x) {
           lengths <- rle(x)$lengths
           values  <- rle(x)$values
           data.frame(spell_0      = paste(lengths[values == "0"], collapse = "-"),
                      spell_1      = paste(lengths[values == "1"], collapse = "-"),
                      mean_spell_0 = mean(lengths[values == "0"]),
                      mean_spell_1 = mean(lengths[values == "1"]))
           }))

#>   spell_0 spell_1 mean_spell_0 mean_spell_1
#> 1     5-3       4          4.0          4.0
#> 2     1-2     2-2          1.5          2.0
#> 3       3     2-1          3.0          1.5
 

Сначала мы извлекаем и подсчитываем 0 s и 1 s:

 library(stringr)
spell_0a <- sapply(str_extract_all(A, "0 "), function(x) str_count(x, "0"))
spell_1a <- sapply(str_extract_all(A, "1 "), function(x) str_count(x, "1"))
 

Затем мы сворачиваем результаты и выполняем математические операции:

 df <- data.frame(
# collapse results:
  spell_0 = unlist(lapply(spell_0a, function(x) paste0(x, collapse = "-"))),
  spell_1 = unlist(lapply(spell_1a, function(x) paste0(x, collapse = "-"))),
# calculate means:
  mean_spell_0 = unlist(lapply(spell_0a, function(x) ifelse(length(x)==1, x[1], sum(x[1] x[2])/2))),
  mean_spell_1 = unlist(lapply(spell_1a, function(x) ifelse(length(x)==1, x[1],sum(x[1] x[2])/2)))
)
 

Результат:

 df
  spell_0 spell_1 mean_spell_0 mean_spell_1
1     5-3       4          4.0          4.0
2     1-2     2-2          1.5          2.0
3       3     2-1          3.0          1.5
 

Вот удобное для всех решение, которое позволяет избежать apply функций.

 library(tidyverse)
library(stringr)

A <- c('000001111000', '0110011', '110001')

data.frame(A) %>% 
  mutate(A = str_replace_all(A, "01", "0-1"), 
         A = str_replace_all(A, "10", "1-0")) %>% 
  mutate(A_split = str_split(A, "-")) %>% 
  unnest(A_split) %>% 
  mutate(n_0 = str_count(A_split, "0"), 
         n_0 = ifelse(n_0 == 0, NA, n_0), 
         n_1 = str_count(A_split, "1"), 
         n_1 = ifelse(n_1 == 0, NA, n_1)) %>% 
  group_by(A) %>% 
  summarise(spell_0 = paste(na.omit(n_0), collapse = "-"), 
            spell_1 = paste(na.omit(n_1), collapse = "-"), 
            mean_spell_0 = mean(n_0, na.rm = T), 
            mean_spell_1 = mean(n_1, na.rm = T)) 
 

Результат:

 #>                A spell_0 spell_1 mean_spell_0 mean_spell_1
#> 1     0-11-00-11     1-2     2-2          1.5          2.0
#> 2 00000-1111-000     5-3       4          4.0          4.0
#> 3       11-000-1       3     2-1          3.0          1.5
 

^{Создано 2021-10-25 пакетом reprex (v2.0.1)}

 get_spells <- function(x, char){
  s <- sapply(gregexpr(paste0(char, " "), x), attr, "match")
  u <- sapply(s, paste0, collapse = "-")
  v <- sapply(s, mean)
  nms <- paste0("spell_", c(char, paste0("mean_", char)))
  setNames(data.frame(u, v) ,nms)
}

do.call(cbind, lapply(0:1, get_spells, x = A))
  spell_0 spell_mean_0 spell_1 spell_mean_1
1     5-3          4.0       4          4.0
2     1-2          1.5     2-2          2.0
3       3          3.0     2-1          1.5
 

Другим способом может быть:

 a <- strsplit(A, "(?<=(.))(?!\1)", perl=TRUE)


b <- lapply(a, function(x)
  unlist(tapply(nchar(x),sub("(.) ", "\1", x), function(x)
    c(setNames(paste(x, collapse = '-'), "spell"),
      setNames(mean(x), "mean_spell")))))

d <- type.convert(data.frame(do.call(rbind, b)), as.is = TRUE)
d
  X0.spell X0.mean_spell X1.spell X1.mean_spell
1      5-3           4.0        4           4.0
2      1-2           1.5      2-2           2.0
3        3           3.0      2-1           1.5