จะคำนวณจำนวนการเกิดขึ้นของอักขระที่กำหนดในแต่ละแถวของคอลัมน์สตริงได้อย่างไร?


105

ฉันมี data.frame ที่ตัวแปรบางตัวมีสตริงข้อความ ฉันต้องการนับจำนวนครั้งของอักขระที่กำหนดในแต่ละสตริง

ตัวอย่าง:

q.data<-data.frame(number=1:3, string=c("greatgreat", "magic", "not"))

ฉันต้องการสร้างคอลัมน์ใหม่สำหรับ q.data ที่มีจำนวนครั้งของ "a" ในสตริง (เช่น c (2,1,0))

วิธีเดียวที่ซับซ้อนที่ฉันจัดการได้คือ:

string.counter<-function(strings, pattern){  
  counts<-NULL
  for(i in 1:length(strings)){
    counts[i]<-length(attr(gregexpr(pattern,strings[i])[[1]], "match.length")[attr(gregexpr(pattern,strings[i])[[1]], "match.length")>0])
  }
return(counts)
}

string.counter(strings=q.data$string, pattern="a")

 number     string number.of.a
1      1 greatgreat           2
2      2      magic           1
3      3        not           0

คำตอบ:


143

แพ็คเกจ stringr มีstr_countฟังก์ชันที่ดูเหมือนจะทำในสิ่งที่คุณสนใจ

# Load your example data
q.data<-data.frame(number=1:3, string=c("greatgreat", "magic", "not"), stringsAsFactors = F)
library(stringr)

# Count the number of 'a's in each element of string
q.data$number.of.a <- str_count(q.data$string, "a")
q.data
#  number     string number.of.a
#1      1 greatgreat           2
#2      2      magic           1
#3      3        not           0

1
ของคุณเร็วขึ้นมากแม้ว่าจะต้องการ as.character () รอบอาร์กิวเมนต์หลักเพื่อให้ประสบความสำเร็จกับปัญหาที่วางไว้
IRTFM

1
@DWin - นั่นเป็นความจริง แต่ฉันหลีกเลี่ยงปัญหานั้นโดยการเพิ่มstringsAsFactors = FALSEเมื่อกำหนดกรอบข้อมูล
Dason

ขออภัยฉันไม่ชัดเจน ฉันกำลังตอบสนองต่อ tim riffe และบอกเขาว่าฟังก์ชันของเขาทำให้เกิดข้อผิดพลาดกับปัญหา เขาอาจใช้นิยามปัญหาของคุณใหม่ แต่เขาไม่ได้พูดเช่นนั้น
IRTFM

ใช่ฉันทำstringsAsFactors=TRUEในคอมพ์ของฉันด้วย แต่ไม่ได้พูดถึงเรื่องนี้
tim riffe

การค้นหาสตริงในแฟคเตอร์จะใช้งานได้เช่น str_count (d $ factor_column, 'A') แต่ไม่ใช่ในทางกลับกัน
Nitro

65

หากคุณไม่ต้องการออกจากฐาน R นี่เป็นความเป็นไปได้ที่ค่อนข้างสั้นและชัดเจน:

x <- q.data$string
lengths(regmatches(x, gregexpr("a", x)))
# [1] 2 1 0

2
โอเค - อาจจะรู้สึกแสดงออกได้ก็ต่อเมื่อคุณใช้regmatchesและgregexprร่วมกันไม่กี่ครั้ง แต่คำสั่งผสมนั้นมีประสิทธิภาพมากพอที่ฉันคิดว่ามันสมควรได้รับปลั๊ก
Josh O'Brien

regmatchesค่อนข้างใหม่ ได้รับการแนะนำใน 2.14
Dason

ฉันไม่คิดว่าคุณต้องการบิตรีแมตช์ ฟังก์ชัน gregexpr ส่งคืนรายการที่มีดัชนีของเหตุการณ์ที่ตรงกันสำหรับแต่ละองค์ประกอบของ x
savagent

@savagent - คุณช่วยแชร์รหัสที่คุณใช้คำนวณจำนวนการจับคู่ในแต่ละสตริงได้ไหม
Josh O'Brien

1
ขออภัยฉันลืมเกี่ยวกับ -1 ใช้งานได้ก็ต่อเมื่อแต่ละบรรทัดมีการจับคู่อย่างน้อยหนึ่งรายการ sapply (gregexpr ("g", q.data $ string), length)
savagent

18
nchar(as.character(q.data$string)) -nchar( gsub("a", "", q.data$string))
[1] 2 1 0

สังเกตว่าฉันบังคับให้ตัวแปรแฟกเตอร์เป็นอักขระก่อนที่จะส่งไปยัง nchar ดูเหมือนว่าฟังก์ชัน regex จะทำเช่นนั้นภายใน

นี่คือผลการวัดประสิทธิภาพ (โดยปรับขนาดการทดสอบเป็น 3000 แถว)

 q.data<-q.data[rep(1:NROW(q.data), 1000),]
 str(q.data)
'data.frame':   3000 obs. of  3 variables:
 $ number     : int  1 2 3 1 2 3 1 2 3 1 ...
 $ string     : Factor w/ 3 levels "greatgreat","magic",..: 1 2 3 1 2 3 1 2 3 1 ...
 $ number.of.a: int  2 1 0 2 1 0 2 1 0 2 ...

 benchmark( Dason = { q.data$number.of.a <- str_count(as.character(q.data$string), "a") },
 Tim = {resT <- sapply(as.character(q.data$string), function(x, letter = "a"){
                            sum(unlist(strsplit(x, split = "")) == letter) }) }, 

 DWin = {resW <- nchar(as.character(q.data$string)) -nchar( gsub("a", "", q.data$string))},
 Josh = {x <- sapply(regmatches(q.data$string, gregexpr("g",q.data$string )), length)}, replications=100)
#-----------------------
   test replications elapsed  relative user.self sys.self user.child sys.child
1 Dason          100   4.173  9.959427     2.985    1.204          0         0
3  DWin          100   0.419  1.000000     0.417    0.003          0         0
4  Josh          100  18.635 44.474940    17.883    0.827          0         0
2   Tim          100   3.705  8.842482     3.646    0.072          0         0

3
นี่คือวิธีที่เร็วที่สุดในคำตอบ แต่จะทำ ~ 30% ได้เร็วขึ้นในมาตรฐานของคุณโดยผ่านทางเลือกที่จะfixed=TRUE gsubนอกจากนี้ยังมีกรณีที่fixed=TRUEจะต้อง (เช่นเมื่อตัวละครที่คุณต้องการนับอาจจะตีความว่าเป็นคำยืนยัน regex เช่น.)
C8H10N4O2


6

stringiแพคเกจให้ฟังก์ชั่นstri_countและstri_count_fixedที่เป็นไปอย่างรวดเร็วมาก

stringi::stri_count(q.data$string, fixed = "a")
# [1] 2 1 0

เกณฑ์มาตรฐาน

เมื่อเทียบกับแนวทางที่เร็วที่สุดจากคำตอบ @ 42และกับฟังก์ชันเทียบเท่าจากstringrแพ็คเกจสำหรับเวกเตอร์ที่มีองค์ประกอบ 30,000,000

library(microbenchmark)

benchmark <- microbenchmark(
  stringi = stringi::stri_count(test.data$string, fixed = "a"),
  baseR = nchar(test.data$string) - nchar(gsub("a", "", test.data$string, fixed = TRUE)),
  stringr = str_count(test.data$string, "a")
)

autoplot(benchmark)

ข้อมูล

q.data <- data.frame(number=1:3, string=c("greatgreat", "magic", "not"), stringsAsFactors = FALSE)
test.data <- q.data[rep(1:NROW(q.data), 10000),]

ป้อนคำอธิบายภาพที่นี่



2

ฉันแน่ใจว่าใครบางคนทำได้ดีกว่า แต่มันได้ผล:

sapply(as.character(q.data$string), function(x, letter = "a"){
  sum(unlist(strsplit(x, split = "")) == letter)
})
greatgreat      magic        not 
     2          1          0 

หรือในฟังก์ชัน:

countLetter <- function(charvec, letter){
  sapply(charvec, function(x, letter){
    sum(unlist(strsplit(x, split = "")) == letter)
  }, letter = letter)
}
countLetter(as.character(q.data$string),"a")

ดูเหมือนว่าฉันจะได้รับข้อผิดพลาดกับอันแรก ... และอันที่สอง ... (กำลังพยายามเปรียบเทียบสิ่งเหล่านี้ทั้งหมด)
IRTFM

1

คุณสามารถใช้การแบ่งสตริง

require(roperators)
my_strings <- c('apple', banana', 'pear', 'melon')
my_strings %s/% 'a'

ซึ่งจะให้ 1, 3, 1, 0 คุณยังสามารถใช้การแบ่งสตริงกับนิพจน์ทั่วไปและทั้งคำ


0

วิธีที่ง่ายและสะอาดที่สุด IMHO คือ:

q.data$number.of.a <- lengths(gregexpr('a', q.data$string))

#  number     string number.of.a`
#1      1 greatgreat           2`
#2      2      magic           1`
#3      3        not           0`

เป็นอย่างไรบ้าง? สำหรับผมlengths(gregexpr('a', q.data$string))ผลตอบแทนไม่ได้2 1 1 2 1 0
Finn Årup Nielsen

0

คำถามด้านล่างถูกย้ายมาที่นี่ แต่ดูเหมือนว่าหน้านี้จะไม่ตอบคำถามของ Farah El โดยตรง วิธีหาหมายเลข 1 ใน 101 ใน R

ผมจะเขียนคำตอบไว้ที่นี่เผื่อว่า

library(magrittr)
n %>% # n is a number you'd like to inspect
  as.character() %>%
  str_count(pattern = "1")

https://stackoverflow.com/users/8931457/farah-el


0

อีกbase Rทางเลือกหนึ่งอาจเป็น:

lengths(lapply(q.data$string, grepRaw, pattern = "a", all = TRUE, fixed = TRUE))

[1] 2 1 0

-1

นิพจน์ถัดไปใช้งานได้และยังใช้กับสัญลักษณ์ไม่เพียง แต่ตัวอักษรเท่านั้น

นิพจน์ทำงานดังนี้:

1: ใช้ lapply บนคอลัมน์ของ dataframe q.data เพื่อวนซ้ำในแถวของคอลัมน์ 2 ("lapply (q.data [, 2],"),

2: ใช้กับแต่ละแถวของคอลัมน์ 2 a function "function (x) {sum ('a' == strsplit (as.character (x), '') [[1]])}" ฟังก์ชันรับค่าแถวแต่ละคอลัมน์ของคอลัมน์ 2 (x) แปลงเป็นอักขระ (ในกรณีที่เป็นตัวประกอบเป็นต้น) และทำการแยกสตริงในทุกอักขระ ("strsplit (as.character (x)," ') "). ด้วยเหตุนี้เราจึงมีเวกเตอร์ aa ที่มีอักขระแต่ละตัวของค่าสตริงสำหรับแต่ละแถวของคอลัมน์ 2

3: ค่าเวกเตอร์แต่ละค่าของเวกเตอร์จะถูกเปรียบเทียบกับอักขระที่ต้องการให้นับในกรณีนี้คือ "a" ("'a' ==") การดำเนินการนี้จะส่งคืนเวกเตอร์ของค่า True และ False "c (True, False, True, .... )" เป็น True เมื่อค่าในเวกเตอร์ตรงกับอักขระที่ต้องการให้นับ

4: จำนวนครั้งทั้งหมดที่อักขระ "a" ปรากฏในแถวคำนวณเป็นผลรวมของค่า "True" ทั้งหมดในเวกเตอร์ "sum (.... )"

5: จากนั้นจะใช้ฟังก์ชัน "ไม่เป็นรายการ" เพื่อแกะผลลัพธ์ของฟังก์ชัน "lapply" และกำหนดให้กับคอลัมน์ใหม่ใน dataframe ("q.data $ number.of.a <-unlist (.... ")

q.data$number.of.a<-unlist(lapply(q.data[,2],function(x){sum('a' == strsplit(as.character(x), '')[[1]])}))

>q.data

#  number     string     number.of.a
#1   greatgreat         2
#2      magic           1
#3      not             0

1
คำตอบของคุณจะดีขึ้นมากหากมีการเปิดเผยสิ่งที่ทำโดยเฉพาะอย่างยิ่งสำหรับผู้ใช้ใหม่เนื่องจากไม่ใช่สำนวนง่ายๆ
Khaine775

ขอบคุณ @ Khaine775 สำหรับความคิดเห็นของคุณและขออภัยที่ไม่มีคำอธิบายของโพสต์ ฉันได้แก้ไขโพสต์และเพิ่มความคิดเห็นเพื่ออธิบายวิธีการทำงานที่ดีขึ้น
bacnqn

-2
s <- "aababacababaaathhhhhslsls jsjsjjsaa ghhaalll"
p <- "a"
s2 <- gsub(p,"",s)
numOcc <- nchar(s) - nchar(s2)

อาจไม่ได้ประสิทธิภาพ แต่แก้จุดประสงค์ของฉัน

โดยการใช้ไซต์ของเรา หมายความว่าคุณได้อ่านและทำความเข้าใจนโยบายคุกกี้และนโยบายความเป็นส่วนตัวของเราแล้ว
Licensed under cc by-sa 3.0 with attribution required.