Подсчитать каждое вхождение каждого элемента в строке

Я хотел бы подсчитать вхождения для каждого отдельного символа в строке и вывести их в кадр данных.

Вот моя попытка:

q.data<-data.frame(number=1,string=c("COUNTTHESECHARACTERS"))
q.data[,3]<-string.counter(strings=q.data$string, pattern="A")
q.data[,3]<-string.counter(strings=q.data$string, pattern="B")

И я хотел бы получить вывод, подобный этому:

x <- c("string","C","O","U","...")
colnames(df) <- x
df[1,] <- c("COUNTTHESECHARACTERS","3","1","1","...")
df

r string count find-occurrences
person user2904120    schedule 18.10.2019    source источник

Ответы (2)


arrow_upward
3
arrow_downward

Я добавил еще одну строку в ваш пример, чтобы иметь немного больше вариаций. Это должно быть довольно эффективно:

library(tibble)
library(purrr)
library(dplyr)
library(stringr)

q_data <- tibble(number = 1:2, string = c("COUNTTHESECHARACTERS", "countthesecharacters"))

tmp_data <- map_df(q_data$string, function(s) {
  tmp <- t(str_count(s, fixed(LETTERS, ignore_case = TRUE)))
  tmp <- as_tibble(tmp, .name_repair = "minimal")
  colnames(tmp) <- LETTERS
  tmp
}) %>% 
  bind_rows()

q_data_new <- cbind(q_data, tmp_data)
q_data_new
#>   number               string A B C D E F G H I J K L M N O P Q R S T U V
#> 1      1 COUNTTHESECHARACTERS 2 0 3 0 3 0 0 2 0 0 0 0 0 1 1 0 0 2 2 3 1 0
#> 2      2 countthesecharacters 2 0 3 0 3 0 0 2 0 0 0 0 0 1 1 0 0 2 2 3 1 0
#>   W X Y Z
#> 1 0 0 0 0
#> 2 0 0 0 0

Создано 18 октября 2019 г. с помощью пакета reprex (v0.3.0)

Если вы посмотрите ?str_count из stringr, вы увидите еще пару вариантов, которые могут быть полезны в вашем случае.

Обновлять

Только из другого ответа я понял, что вы пытаетесь подсчитать все элементы строки, а не только буквы. В этом случае вы в основном ищете матрицу признаков документа:

library(quanteda)
tmp <- q_data$string %>% 
    tokens("character", remove_separators = FALSE) %>% 
    dfm() %>% 
    convert("data.frame") %>% 
    select(-document) %>% 
    select(noquote(order(colnames(.)))) %>% # this is just for ordering alpabetically
    as_tibble() # just for better comparison to other results
  q_data_new <- cbind(q_data, tmp)
  q_data_new

Это даже намного быстрее, чем два варианта, уже приведенные в ответах. Сравнительный анализ:

q_data <- tibble(number = 1:2000, string = stringi::stri_rand_strings(2000, 20))


stringr <- function(q_data, pattern = c(0:9, letters)) {

  tmp_data <- map_df(q_data$string, function(s) {
    tmp <- t(str_count(s, fixed(pattern, ignore_case = TRUE)))
    tmp <- as_tibble(tmp, .name_repair = "minimal")
    colnames(tmp) <- pattern
    tmp
  }) %>% 
    bind_rows() %>% 
    mutate_if(is.integer, as.numeric)

  q_data_new <- bind_cols(q_data, tmp_data)
  q_data_new
}

tidytext <- function(q_data) {

  q_data %>%
    group_by(number, string) %>%
    unnest_tokens(character, string, token = "characters", drop = FALSE) %>%
    count(number, character) %>%
    complete(character = letters) %>%
    spread(character, n, fill = 0) %>% 
    ungroup()

}

quanteda <- function(q_data) {
  tmp <- q_data$string %>% 
    tokens("character", remove_separators = FALSE) %>% 
    dfm() %>% 
    convert("data.frame") %>% 
    select(-document) %>% 
    select(noquote(order(colnames(.)))) %>% 
    as_tibble()
  q_data_new <- cbind(q_data, tmp)
  q_data_new
}

полученные результаты

res <- bench::mark(
  stringr = stringr(q_data),
  tidytext = tidytext(q_data),
  quanteda = quanteda(q_data)
)
res
#> # A tibble: 3 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 stringr       1.82s    1.82s     0.549   17.05MB     3.84
#> 2 tidytext      6.06s    6.06s     0.165   35.17MB     2.31
#> 3 quanteda     56.4ms  70.74ms    13.9      8.75MB     5.95
person JBGruber    schedule 18.10.2019
comment
Спасибо за эталон. Я знаю, что tidytext не самый быстрый, но он прост в использовании и понимании, поэтому я предпочитаю использовать его в небольших настройках. Но интересно, насколько быстрее Quanteda. - person Adam; 18.10.2019
comment
То же самое. tidytext удивительно, и его так легко освоить. Тестирование было в основном для удовлетворения моего собственного любопытства. - person JBGruber; 18.10.2019

arrow_upward
2
arrow_downward

По сути, вы хотите маркировать строку по символам. Тогда это просто какая-то манипуляция, чтобы получить то, что вы хотите.

library(dplyr)
library(tidyr)
library(tidytext)

q.data <- data.frame(number=c(1, 2),string=c("COUNTTHESECHARACTERS", "COUNTTHISTOO"), stringsAsFactors = FALSE)

q.data %>%
  group_by(number, string) %>%
  unnest_tokens(character, string, token = "characters", drop = FALSE) %>%
  count(number, character) %>%
  complete(character = letters) %>%
  spread(character, n, fill = 0)

# A tibble: 2 x 28
# Groups:   number, string [2]
  number string        a     b     c     d     e     f     g     h     i     j     k
   <dbl> <chr>     <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1      1 COUNTTHE~     2     0     3     0     3     0     0     2     0     0     0
2      2 COUNTTHI~     0     0     1     0     0     0     0     1     1     0     0
# ... with 15 more variables: l <dbl>, m <dbl>, n <dbl>, o <dbl>, p <dbl>, q <dbl>,
#   r <dbl>, s <dbl>, t <dbl>, u <dbl>, v <dbl>, w <dbl>, x <dbl>, y <dbl>, z <dbl>

Если вы хотите сохранить все в родном регистре (т. е. не преобразовывать в нижний регистр), вы можете добавить to_lower = FALSE в unnest_tokens().

person Adam    schedule 18.10.2019
comment
хорошее использование tidytext! - person JBGruber; 18.10.2019