R:计算该字符串中唯一字符的数量

Question

我有一个数据框，其中一列是字符串类型。
我想计算该字符串中唯一/不同字符的数量。

例如。

"banana" -> 3
'he' -> 2

一个可复制的例子:

我有一个数据框，其中一列是字符串类型。我需要过滤掉那些字符串只有一个不同字符的行。

col1         col2       col3 
new york
qqqq
melbourne
aaaaaa

我需要一个最终的数据框，比如

col1 col2 col3
纽约
墨尔本

所以完全删除这些行。

Answer 1

这不假设“字符”在 letters 中并避免制作 R 数据结构:

library(inline)

.char_unique_code <- "
std::vector < std::string > s = as< std::vector < std::string > >(x);
unsigned int input_size = s.size();

std::vector < std::string > chrs(input_size);

for (unsigned int i=0; i<input_size; i++) {

  std::string t = s[i];

  for (std::string::iterator chr=t.begin();
       chr != t.end(); ++chr) {

    if (chrs[i].find(*chr) == std::string::npos) {
      chrs[i] += *chr;
    }

  }

}
return(wrap(chrs));
"

char_unique <- 
  rcpp(sig=signature(x="std::vector < std::string >"),
       body=.char_unique_code,
       includes=c("#include <string>",
                 "#include <iostream>"))

nchar(char_unique("banana"))
## [1] 3

为什么要避免制作 R 列表？

library(stringr)
library(microbenchmark)
library(ggplot2)

str_char_ct_unique <- function(x) sum(!!str_count(x, letters))
char_ct_unique <- function(x) nchar(char_unique(x))
r_char_ct_unique <- function(x) length(unique(strsplit(x, "")[[1]]))

microbenchmark(stringr=str_char_ct_unique("banana"),
                  rcpp=char_ct_unique("banana"),
                     r=r_char_ct_unique("banana"),
               times=1000) -> mb

## Unit: microseconds
##     expr     min       lq       mean   median       uq     max neval cld
##  stringr 125.978 129.1765 139.271061 130.9415 139.3870 334.563  1000   c
##     rcpp   1.458   2.0160   3.002184   2.6345   3.1365  32.244  1000 a  
##        r   4.797   6.1070   8.292847   7.3380   8.0505  86.709  1000  b 

让我们制作 Cath 纯 R 解决方案的矢量化版本(不打扰另一个，因为它太受限制了)并与小随机字符串的向量进行比较:

library(random)
library(purrr)

char_ct_unique <- function(x) nchar(char_unique(x))
r_char_ct_unique <- function(x) map_int(map(x, function(x) unique(strsplit(x, "")[[1]])), length)

tst <- as.vector(randomStrings(n=100, len=20, unique=FALSE))

sum(char_ct_unique(tst) == r_char_ct_unique(tst))
## [1] 100

microbenchmark(rcpp=char_ct_unique(tst),
                  r=r_char_ct_unique(tst),
               times=1000) 

## Unit: microseconds
##  expr     min       lq      mean   median      uq      max neval cld
##  rcpp  53.643  56.2375  66.69311  60.2740  68.178  250.992  1000  a 
##     r 683.420 759.4070 952.14407 822.8905 922.710 6513.508  1000   b

并且，现在对于 10,000 个字符的随机字符串:

dat <- readLines("https://gist.githubusercontent.com/hrbrmstr/f80b157b383134b37fb3/raw/534b4c79e7c51710c6db6961bc5dc5ec25c4242b/gistfile1.txt")
digest::digest(dat, "sha1", serialize=FALSE)
## [1] "6c6695dd2f314762c81e6e6891ec1c138a4f3a08"

nchar(dat)
## [1] 10000

char_ct_unique(dat) == r_char_ct_unique(dat)
## [1] TRUE

microbenchmark(rcpp=char_ct_unique(dat),
                  r=r_char_ct_unique(dat),
               times=1000)

## Unit: microseconds
##  expr     min      lq     mean  median      uq      max neval cld
##  rcpp  73.801 110.681 122.9091 118.330 139.373  308.602  1000  a 
##     r 377.556 430.703 533.9120 448.631 492.466 4275.568  1000   b

我忘了做大卫的“固定”版本:

f_r_char_ct_unique <- function(x) map_int(map(x, function(x) unique(strsplit(x, "", fixed=TRUE)[[1]])), length)

而且，让我们让它更有趣:

dat <- c(dat, toupper(dat), tolower(dat))

microbenchmark(rcpp=char_ct_unique(dat),
                  r=r_char_ct_unique(dat),
                 fr=f_r_char_ct_unique(dat),
               times=1000) 

## Unit: microseconds
##  expr      min       lq     mean   median        uq       max neval
##  rcpp  218.299  284.143  331.319  332.281  358.1215   696.907  1000
##     r 1266.976 1442.460 1720.320 1494.167 1634.7870  5896.685  1000
##    fr 1260.027 1444.298 1769.664 1501.416 1652.8895 78457.729  1000