Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Sum values from select strsplit column in dataframe in R

Tags:

r

dplyr

plyr

tidyr

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 of my_lettersis 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 a weighted sum by value?

So, a appears three times: in row 2 with value 3, row 5 with value 4, row 9 with value 10. So for a I want to see 3 + 4 + 10 = 17. (note that value may repeat)

Is there a nice plyr/dplyr/tidyr way to do this? (or even apply...)

Thank you!!

Code to generate this data frame (which I'm sure there's a neater way to do):

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), " " ) ) )
like image 251
sai Avatar asked Apr 21 '26 01:04

sai


2 Answers

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 table line:

cSplit(my_foo, "my_letters", " ", "long")[, .N, by = my_letters]

Update -- Benchmarks

@nicola's base solution is nice, 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))

The as.numeric becomes important if you expect the summed values to be very large, at which point xtabs would give you integer overflow errors.

Here are some functions to compare:

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's the sample data. Change n to experiment with different sizes. We'll start with a modest 1,000 rows.

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 

Here are some timings with n <- 100000 before making the sample data:

system.time(fun1())
#    user  system elapsed 
#   0.911   0.004   0.916 
system.time(fun2())
#    user  system elapsed 
#   0.537   0.004   0.551 
like image 198
A5C1D2H2I1M1N2O1R2T1 Avatar answered Apr 22 '26 13:04

A5C1D2H2I1M1N2O1R2T1


A base R solution:

    myletters<-strsplit( as.character(my_foo$my_letters), " " )
    table(unlist(mapply(rep,myletters,my_foo$value)))
like image 26
nicola Avatar answered Apr 22 '26 14:04

nicola