Sum values from selected column strsplit in dataframe in R
Suppose I have a data frame in R
with two columns: value
and my_letters
:
> my_foo
value my_letters
1 5 d f h b
2 3 j f i a b g
3 1 d g j f i
4 1 h i b e
5 4 c d a
6 6 i d j e
7 7 b h f i
8 5 h d g
9 10 h e i f a
10 3 h g d i
Each element my_letters
is 3-6 non-repeating letters , separated by spaces.
I can count how often each letter occurs:
> table( unlist( strsplit( as.character(my_foo$my_letters), " " ) ) )
a b c d e f g h i j
3 4 1 6 3 5 4 6 7 3
But what if I want to receive a weighted amount for value
?
So it a
appears three times: on line 2 with a value of 3, line 5 with a value of 4, line 9 with a value of 10. So for a
I want to see 3 + 4 + 10 = 17. (note that it value
can be repeated)
Is there a good way plyr
/ dplyr
/ tidyr
to do this? (or even apply
...)
Thank!
The code for creating this dataframe (which I'm sure there is a neater way):
library( plyr )
set.seed(1)
foo <- replicate( 10, letters[ sample( 10, sample(3:6, 1), replace = F ) ] )
foo2 <- laply( foo, function(d) paste(d, collapse = " ") )
my_foo <- data.frame( value=sample(10, replace=T), my_letters = foo2 )
my_foo
# count how often each letter appears
table( unlist( strsplit( as.character(my_foo$my_letters), " " ) ) )
source to share
I would use cSplit
from my splitstackshape package:
library(splitstackshape)
cSplit(my_foo, "my_letters", " ", "long")[, sum(value), by = my_letters]
# my_letters V1
# 1: d 24
# 2: f 26
# 3: h 31
# 4: b 16
# 5: j 10
# 6: i 31
# 7: a 17
# 8: g 12
# 9: e 17
# 10: c 4
By the way, here's an alternative to your line table
:
cSplit(my_foo, "my_letters", " ", "long")[, .N, by = my_letters]
Update - Benchmarks
@Nicola's basic solution is good, but it doesn't scale well. A better alternative would be to use:
xtabs(rep(as.numeric(my_foo$value), vapply(myletters, length, 1L) ~
unlist(myletters, use.names = FALSE))
as.numeric
becomes important if you expect the totals to be very large, at which point xtabs
will give you integer overflow errors.
Here are some comparison functions:
fun1 <- function() {
myletters <- strsplit( as.character(my_foo$my_letters), " ", TRUE)
xtabs(rep(as.numeric(my_foo$value),
vapply(myletters, length, 1L)) ~ unlist(myletters))
}
fun2 <- function() cSplit(my_foo, "my_letters", " ", "long")[, sum(value), by = my_letters]
fun3a <- function() {
myletters<-strsplit( as.character(my_foo$my_letters), " " )
table(unlist(mapply(rep,myletters,my_foo$value)))
}
fun3b <- function() {
myletters<-strsplit( as.character(my_foo$my_letters), " " , TRUE)
table(unlist(mapply(rep,myletters,my_foo$value)))
}
Here are some sample data. Change n
to experiment with different sizes. We'll start with a modest 1000 lines.
library( plyr )
set.seed(1)
n <- 1000
foo <- replicate(n, letters[ sample( 10, sample(3:6, 1), replace = F ) ] )
foo2 <- laply( foo, function(d) paste(d, collapse = " ") )
my_foo <- data.frame( value=sample(n, replace=T), my_letters = foo2 )
Initial timings:
system.time(fun1())
# user system elapsed
# 0.006 0.000 0.006
system.time(fun2())
# user system elapsed
# 0.013 0.000 0.013
system.time(fun3a())
# user system elapsed
# 0.844 0.024 0.870
system.time(fun3b())
# user system elapsed
# 0.533 0.020 0.561
Below are some timings with n <- 100000
before sample data generation:
system.time(fun1())
# user system elapsed
# 0.911 0.004 0.916
system.time(fun2())
# user system elapsed
# 0.537 0.004 0.551
source to share
You can use the solution base R
table(scan(text=with(my_foo,my_letters[rep(1:nrow(my_foo),
value)]), sep='', what='', quiet=TRUE))
# a b c d e f g h i j
#17 16 4 24 17 26 12 31 31 10
Or count
fromdplyr
lst <- strsplit( as.character(my_foo$my_letters), " " )
library(dplyr)
devtools::install_github("hadley/tidyr")
library(tidyr)
unnest(setNames(lst, my_foo$value), val) %>%
mutate(val=as.numeric(val)) %>%
count(x, wt=val)
# x n
#1 a 17
#2 b 16
#3 c 4
#4 d 24
#5 e 17
#6 f 26
#7 g 12
#8 h 31
#9 i 31
#10 j 10
source to share