1
\$\begingroup\$

Consider the following dummy dataset:

library(dplyr)
set.seed(50)

df <- data.frame(PERSON_ID = sample(1:5, size = 32, replace = TRUE),
                 YEAR = sample(2000:2001, size = 32, replace = TRUE), 
                 VALUES = sample(c("APPLE 50", "GRAPE 20", "ORANGE 50",
                                   "BANANA 80", "TOMATO 100", "PEACH 30",
                                   "CHOCOLATE 90"), size = 32, replace = TRUE),
                 stringsAsFactors = FALSE) %>% unique()

person_ids <- unique(df$PERSON_ID)

The data frame, in reality, is approximately 280,000-300,000 rows. Here is how the dataset looks:

df

   PERSON_ID YEAR       VALUES
1          4 2000     APPLE 50
2          3 2001     APPLE 50
3          2 2000     PEACH 30
4          4 2001     APPLE 50
5          3 2000     APPLE 50
6          1 2001 CHOCOLATE 90
7          4 2000    BANANA 80
8          4 2000 CHOCOLATE 90
9          1 2000   TOMATO 100
10         1 2001     APPLE 50
11         2 2000 CHOCOLATE 90
12         2 2000     GRAPE 20
13         4 2000   TOMATO 100
15         2 2001   TOMATO 100
17         5 2001    BANANA 80
18         2 2001     APPLE 50
19         1 2001    ORANGE 50
20         1 2001    BANANA 80
21         4 2001    BANANA 80
22         1 2000     APPLE 50
24         5 2000   TOMATO 100
25         2 2001    BANANA 80
26         4 2001   TOMATO 100
27         3 2001   TOMATO 100
28         2 2000   TOMATO 100
29         2 2001     PEACH 30
31         2 2000     APPLE 50
32         3 2001    ORANGE 50

I would like to execute the following code in a more efficient manner, which generates all possible pairs, triplets, and quadruplets of VALUES given a PERSON_ID and a YEAR.

generate_value_combinations <- function(df, k){
  for (i in 1:length(person_ids)){
    temp_person_id <- person_ids[i]
    temp <- df %>% filter(PERSON_ID == temp_person_id)
    years <- unique(temp$YEAR)
    years_with_pairs <- 0
    for (j in 1:length(years)){
      temp_year <- temp %>% filter(YEAR == years[j])
      if (nrow(temp_year) >= k){
        years_with_pairs <- years_with_pairs + 1
        temp_year_pairs <- data.frame(t(combn(temp_year$VALUES, m = k)), 
                                      stringsAsFactors = FALSE)
        colnames(temp_year_pairs) <- paste0("VALUE_", 1:ncol(temp_year_pairs))
        rm(temp_year)
        temp_year_pairs$YEAR <- years[j]
        temp_year_pairs$PERSON_ID <- person_ids[i]
        if (years_with_pairs == 1){
          temp_year_out <- temp_year_pairs
          rm(temp_year_pairs)
        } else if (years_with_pairs > 1) {
          temp_year_out <- rbind(temp_year_out, temp_year_pairs)
          rm(temp_year_pairs)
        }
      }
    }
    rm(years, temp)

    if (i == 1 & exists("temp_year_out")){
      out <- temp_year_out
      rm(temp_year_out)
    } else if(i > 1 & exists("temp_year_out")) {
      out <- rbind(out, temp_year_out)
      rm(temp_year_out)
    }
    rm(temp_person_id)
  }
  return(out)
}

pairs <- generate_value_combinations(df, k = 2)
triples <- generate_value_combinations(df, k = 3)
quadruplets <- generate_value_combinations(df, k = 4)

The code above takes approximately 1-2 hours to execute on the data set of 280,000-300,000 rows.

For example, this is how pairs looks:

> pairs
        VALUE_1      VALUE_2 YEAR PERSON_ID
1      APPLE 50    BANANA 80 2000         4
2      APPLE 50 CHOCOLATE 90 2000         4
3      APPLE 50   TOMATO 100 2000         4
4     BANANA 80 CHOCOLATE 90 2000         4
5     BANANA 80   TOMATO 100 2000         4
6  CHOCOLATE 90   TOMATO 100 2000         4
7      APPLE 50    BANANA 80 2001         4
8      APPLE 50   TOMATO 100 2001         4
9     BANANA 80   TOMATO 100 2001         4
10     APPLE 50   TOMATO 100 2001         3
11     APPLE 50    ORANGE 50 2001         3
12   TOMATO 100    ORANGE 50 2001         3
13     PEACH 30 CHOCOLATE 90 2000         2
14     PEACH 30     GRAPE 20 2000         2
15     PEACH 30   TOMATO 100 2000         2
16     PEACH 30     APPLE 50 2000         2
17 CHOCOLATE 90     GRAPE 20 2000         2
18 CHOCOLATE 90   TOMATO 100 2000         2
19 CHOCOLATE 90     APPLE 50 2000         2
20     GRAPE 20   TOMATO 100 2000         2
21     GRAPE 20     APPLE 50 2000         2
22   TOMATO 100     APPLE 50 2000         2
23   TOMATO 100     APPLE 50 2001         2
24   TOMATO 100    BANANA 80 2001         2
25   TOMATO 100     PEACH 30 2001         2
26     APPLE 50    BANANA 80 2001         2
27     APPLE 50     PEACH 30 2001         2
28    BANANA 80     PEACH 30 2001         2
29 CHOCOLATE 90     APPLE 50 2001         1
30 CHOCOLATE 90    ORANGE 50 2001         1
31 CHOCOLATE 90    BANANA 80 2001         1
32     APPLE 50    ORANGE 50 2001         1
33     APPLE 50    BANANA 80 2001         1
34    ORANGE 50    BANANA 80 2001         1
35   TOMATO 100     APPLE 50 2000         1

To make these pairs/triplets/quadruplets consistent among different PERSON_ID and YEAR combination, we must sort the value columns. The case of pairs has already been covered at https://codereview.stackexchange.com/a/205923/69157:

pairs[c('VALUE_1', 'VALUE_2')] <- list(pmin(pairs$VALUE_1, pairs$VALUE_2),
                                       pmax(pairs$VALUE_1, pairs$VALUE_2))

> pairs
        VALUE_1      VALUE_2 YEAR PERSON_ID
1      APPLE 50    BANANA 80 2000         4
2      APPLE 50 CHOCOLATE 90 2000         4
3      APPLE 50   TOMATO 100 2000         4
4     BANANA 80 CHOCOLATE 90 2000         4
5     BANANA 80   TOMATO 100 2000         4
6  CHOCOLATE 90   TOMATO 100 2000         4
7      APPLE 50    BANANA 80 2001         4
8      APPLE 50   TOMATO 100 2001         4
9     BANANA 80   TOMATO 100 2001         4
10     APPLE 50   TOMATO 100 2001         3
11     APPLE 50    ORANGE 50 2001         3
12    ORANGE 50   TOMATO 100 2001         3
13 CHOCOLATE 90     PEACH 30 2000         2
14     GRAPE 20     PEACH 30 2000         2
15     PEACH 30   TOMATO 100 2000         2
16     APPLE 50     PEACH 30 2000         2
17 CHOCOLATE 90     GRAPE 20 2000         2
18 CHOCOLATE 90   TOMATO 100 2000         2
19     APPLE 50 CHOCOLATE 90 2000         2
20     GRAPE 20   TOMATO 100 2000         2
21     APPLE 50     GRAPE 20 2000         2
22     APPLE 50   TOMATO 100 2000         2
23     APPLE 50   TOMATO 100 2001         2
24    BANANA 80   TOMATO 100 2001         2
25     PEACH 30   TOMATO 100 2001         2
26     APPLE 50    BANANA 80 2001         2
27     APPLE 50     PEACH 30 2001         2
28    BANANA 80     PEACH 30 2001         2
29     APPLE 50 CHOCOLATE 90 2001         1
30 CHOCOLATE 90    ORANGE 50 2001         1
31    BANANA 80 CHOCOLATE 90 2001         1
32     APPLE 50    ORANGE 50 2001         1
33     APPLE 50    BANANA 80 2001         1
34    BANANA 80    ORANGE 50 2001         1
35     APPLE 50   TOMATO 100 2000         1

For triples and quadruplets, we have:

sort_df <- function(df){
  value_idx <- max(as.numeric(sub("VALUE_", "", colnames(df)[grepl("VALUE_", colnames(df))])))
  for (i in 1:nrow(df)){
    if (value_idx == 3){
      values <- sort(c(df$VALUE_1[i], df$VALUE_2[i], df$VALUE_3[i]))
    }
    if (value_idx == 4){
      values <- sort(c(df$VALUE_1[i], df$VALUE_2[i], df$VALUE_3[i], df$VALUE_4[i]))
    }
    df$VALUE_1[i] <- values[1]
    df$VALUE_2[i] <- values[2]
    if (value_idx == 3){
      df$VALUE_3[i] <- values[3]
    }
    if (value_idx == 4){
      df$VALUE_4[i] <- values[4]
    }
  }
  return(df)
}
triples <- sort_df(triples)
quadruplets <- sort_df(quadruplets)

How can this code be made more efficient?

Edit: I would like to mention that I know that "growing" data frames - which I do plenty of here - is considered bad practice in R, but I am unaware of how to alternatively code this.

\$\endgroup\$
2
\$\begingroup\$

That you know to use dplyr is a good start; I'd recommend you read a good tutorial to grasp the important concepts. For example, instead of looping on the PERSON_ID and YEAR, you should use group_by. Then, within each PERSON_ID/YEAR, you should apply a same function via do. See how the combn function from the utils package can do a lot of the heavy-lifting:

combn(c("A", "B", "C"), 2)
#      [,1] [,2] [,3]
# [1,] "A"  "A"  "B" 
# [2,] "B"  "C"  "C"

You can wrap it as follows to create a data.frame of pairs, triplets, etc.:

combo <- function(x, n) {
  x <- as.data.frame(t(combn(x, n)), stringsAsFactors = FALSE)
  names(x) <- paste0("VALUES_", 1:n)
  x
}

combo(c("A", "B", "C"), 2)
#   VALUES_1 VALUES_2
# 1        A        B
# 2        A        C
# 3        B        C

Putting it all together:

pairs <- df %>%
         group_by(PERSON_ID, YEAR) %>%
         filter(n() >= 2) %>%
         do(combo(.$VALUES, 2))

triplets <- df %>%
            group_by(PERSON_ID, YEAR) %>%
            filter(n() >= 3) %>%
            do(combo(.$VALUES, 3))

quadruplets <- df %>%
               group_by(PERSON_ID, YEAR) %>%
               filter(n() >= 4) %>%
               do(combo(.$VALUES, 4))

Note that everywhere I used a filter step to ensure that combn is never called with insufficient data otherwise it will die (e.g. if asking for pairs when there is only one data point).

I hope this will be fast enough on your large data, please let me know otherwise.

\$\endgroup\$
  • \$\begingroup\$ Thank you for teaching me about do()! I had no idea it existed. \$\endgroup\$ – Clarinetist Oct 26 '18 at 19:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.