Compute frequency list of final words in utterances of variable length

user_8039978 0
Viewed 46

I have a large dataframe with utterances of variable sizes:

df <- structure(list(size = c(2, 2, 3, 3, 4, 4, 3, 3), 
                     w1 = c("come", "why", "er", "well", "she", "well", "er", "well"), 
                     w2 = c("on","that", "i", "not", "'s", "thanks", "super", "she"), 
                     w3 = c(NA, NA, "can", "today", "going", "they", "cool", "can"), 
                     w4 = c(NA,NA, NA, NA, "on", "can", NA, NA)), 
                row.names = c(NA, -8L), class = "data.frame")

I'd like to compare the utterance-initial words in w1 with all the utterance-final words in the other w columns with frequency lists with counts and proportions. I can compute a frequency list of the utterance-initial words:

library(dplyr)
df %>%
  group_by(w1) %>%
  summarise(n = n()) %>%
  mutate(prop = n / sum(n)) %>%
  arrange(desc(prop))
# A tibble: 5 x 3
  w1        n  prop
  <chr> <int> <dbl>
1 well      3 0.375
2 er        2 0.25 
3 come      1 0.125
4 she       1 0.125
5 why       1 0.125

But how to compute the list of the utterance-final words when these are in different w columns?

Expected:

# A tibble: 5 x 3
  w_last    n  prop
  <chr> <int> <dbl>
1 can       3 0.375
2 on        2 0.25 
3 cool      1 0.125
4 that      1 0.125
5 today     1 0.125

Here's at long last another solution:

df %>%
  mutate(w_last = c(apply(., 1, function(x) tail(na.omit(x), 1)))) %>%
  group_by(w_last) %>%
  summarise(n = n()) %>%
  mutate(prop = n / sum(n)) %>%
  arrange(desc(prop))
dplyr r
3 Answers

Three methods in tidyverse style of syntax

1 You may extract final_word in a different column and create prop.table on it. (in dplyr only)

df %>% rowwise() %>%
  mutate(final_word = get(paste0('w', size))) %>%
  janitor::tabyl(final_word)

final_word n percent
        can 3   0.375
       cool 1   0.125
         on 2   0.250
       that 1   0.125
      today 1   0.125

2 restructuring data a bit.

  • pivoted the format.
  • kept only those rows where size matches with word_number
  • used janitor::tabyl() to generate your prop.table (which can further be formatted in a useful manner in janitor)
df <- structure(list(size = c(2, 2, 3, 3, 4, 4, 3, 3), 
                     w1 = c("come", "why", "er", "well", "she", "well", "er", "well"), 
                     w2 = c("on","that", "i", "not", "'s", "thanks", "super", "she"), 
                     w3 = c(NA, NA, "can", "today", "going", "they", "cool", "can"), 
                     w4 = c(NA,NA, NA, NA, "on", "can", NA, NA)), 
                row.names = c(NA, -8L), class = "data.frame")


df
#>   size   w1     w2    w3   w4
#> 1    2 come     on  <NA> <NA>
#> 2    2  why   that  <NA> <NA>
#> 3    3   er      i   can <NA>
#> 4    3 well    not today <NA>
#> 5    4  she     's going   on
#> 6    4 well thanks  they  can
#> 7    3   er  super  cool <NA>
#> 8    3 well    she   can <NA>
library(tidyverse)
library(janitor)

df %>% pivot_longer(!size, values_drop_na = T) %>%
  filter(as.numeric(substr(name, 2, nchar(name))) == size) %>%
  janitor::tabyl(value)
#>  value n percent
#>    can 3   0.375
#>   cool 1   0.125
#>     on 2   0.250
#>   that 1   0.125
#>  today 1   0.125

Created on 2021-05-06 by the reprex package (v2.0.0)

3 By the way, you can specifically reverse the sequence, and count words from last column too, in tidyr using unite and separate

df %>% unite('W', starts_with('w'), sep = '=', na.rm = T, remove = T) %>%
  separate(W, into = paste0('w', seq_len(1 + max(str_count(.$W, '=')))), fill = 'left', sep = '=')

  size   w1     w2    w3    w4
1    2 <NA>   <NA>  come    on
2    2 <NA>   <NA>   why  that
3    3 <NA>     er     i   can
4    3 <NA>   well   not today
5    4  she     's going    on
6    4 well thanks  they   can
7    3 <NA>     er super  cool
8    3 <NA>   well   she   can
user_28848590

You can subset df by using the row (seq_len(nrow(df)) and the value in df$size, make a table and calculate the proportions.

tt <- table(df[-1][cbind(seq_len(nrow(df)), df$size)])
cbind(tt, proportions(tt))
#      tt      
#can    3 0.375
#cool   1 0.125
#on     2 0.250
#that   1 0.125
#today  1 0.125
user_104885040

A base R option

out <- rev(
  stack(
    prop.table(
      table(apply(df, 1, function(x) tail(na.omit(x), 1)))
    )
  )
)

gives

    ind values
1   can  0.375
2  cool  0.125
3    on  0.250
4  that  0.125
5 today  0.125

If you want to order the rows in a descending manner, you can do

> out[order(-out$value), ]
    ind values
1   can  0.375
3    on  0.250
2  cool  0.125
4  that  0.125
5 today  0.125
user_121587570
Related