0
\$\begingroup\$

My problem

I am working with two objects, structured as follows:

test <- structure(list(rs1_A = c(0.1, 3), rs2_B = c(0.2, 2), rs22_C = c(2,
1)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-2L))
> test
# A tibble: 2 × 3
  rs1_A rs2_B rs22_C
  <dbl> <dbl>  <dbl>
1   0.1   0.2      2
2   3     2        1
coeff <- structure(list(SNP_ID = c("rs1_A", "rs2_B", "rs22_C"), coeff = c(0.3,
0.1, 0.01)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-3L))
> coeff
# A tibble: 3 × 2
  SNP_ID coeff
  <chr>  <dbl>
1 rs1_A   0.3
2 rs2_B   0.1
3 rs22_C  0.01

My code is meant to transform every variable starting with "rs" in test by multiplying it by a coefficient (stored in coeff$coeff), so that the final result is, e.g.

  rs1_A rs2_B rs22_C
1  0.03  0.02   0.02
2  0.9   0.2    0.01

Ideally, it should return the same result with unsorted data and with missing values in coeff (in which case, it should return NA).

My solutions

library(dplyr)
  1. Multiplying all the variables by the coefficient vector:
test %>% 
  rowwise() %>% 
  mutate(across(starts_with("rs"))*coeff$coeff)
# A tibble: 2 × 3
# Rowwise:
  rs1_A rs2_B rs22_C
  <dbl> <dbl>  <dbl>
1  0.03  0.02   0.02
2  0.9   0.2    0.01

This approach "works" if I sort both the columns in test and the rows in coeff beforehand, but it does not handle missingness implicitly.

  1. Matching column names with vector values, deriving an index value, and looking up the index value in the vector:
test %>% 
  rowwise() %>% 
  mutate(
    across(starts_with("rs"), 
    .fns = ~.x * coeff %>%
                 pull(coeff) %>% 
                 nth(which(cur_column() == pull(coeff, SNP_ID)))
    )
  )
# A tibble: 2 × 3
# Rowwise:
  rs1_A rs2_B rs22_C
  <dbl> <dbl>  <dbl>
1  0.03  0.02   0.02
2  0.9   0.2    0.01

I like this better, as it can deal with unsorted data in coeff:

coeff2 <- structure(list(SNP_ID = c("rs22_C", "rs2_B", "rs1_A"), coeff = c(0.01,
0.1, 0.3)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-3L))
> test %>% rowwise() %>% mutate(across(starts_with("rs"), .fns =~.x*coeff2 %>% pull(coeff) %>% nth(which(cur_column() == pull(coeff2, SNP_ID)))))
# A tibble: 2 × 3
# Rowwise:
  rs1_A rs2_B rs22_C
  <dbl> <dbl>  <dbl>
1  0.03  0.02   0.02
2  0.9   0.2    0.01
  1. Like 2., but using base functions for the lookup:
test %>% 
  rowwise() %>% 
  mutate(
    across(starts_with("rs"), 
          .fns = ~.x*coeff$coeff[which(cur_column() == coeff$SNP_ID)]
    )
  )

What I want to improve

  1. Speed: this works okay for 3 variables, but the lookup step in 2. and 3. doesn't scale well with 100k+ variables and make it slow;
  2. Handling missing data points: this currently works if I preprocess the inputs by removing the columns that aren't matching. Not a big deal, but it would be neat to handle it;
  3. Readability: I suspect there is going to be a more elegant way to do it in dplyr without all those function calls, but I can't think of any.

Do you have any suggestion on how to rewrite this? Thank you

\$\endgroup\$
2
  • \$\begingroup\$ Please clarify your specific problem or provide additional details to highlight exactly what you need. As it's currently written, it's hard to tell exactly what you're asking. \$\endgroup\$
    – Community Bot
    May 15, 2023 at 5:31
  • \$\begingroup\$ I tried to add more structure to the post. Please let me know if you think it needs further improvement \$\endgroup\$ May 15, 2023 at 12:27

1 Answer 1

1
\$\begingroup\$

I would probably do this with pivot - join - pivot set of operations in dplyr. I would pivot the test data longer, then left join the coeff data, modify the values and then pivot wider again. This operation will be much faster than rowwise() operations on larger data where rowwise() is very slow. This also allows you to handle the missing data problem in a couple of different ways. Here is an example:

library(dplyr)
library(tidyr)

test <- structure(list(rs1_A = c(0.1, 3), rs2_B = c(0.2, 2), rs22_C = c(2,
1)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-2L))

coeff <- structure(list(SNP_ID = c("rs1_A", "rs2_B", "rs22_C"), coeff = c(0.3,
0.1, 0.01)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-3L))
test %>% 
  # add observation variable - makes pivot back easier
  mutate(obs = row_number()) %>% 
  # make names_to argument the same as the ID variable in coefficients
  pivot_longer(-obs, names_to="SNP_ID", values_to="val") %>% 
  # join the coefficient data - any unmatched IDs will have NA coeff values  
  left_join(coeff) %>% 
  # modify values by multiplying by coeff
  mutate(val = val*coeff) %>% 
  # remove coeff variable
  select(-coeff) %>% 
  # pivot back to original shape
  pivot_wider(names_from="SNP_ID", values_from="val")
#> Joining with `by = join_by(SNP_ID)`
#> # A tibble: 2 × 4
#>     obs rs1_A rs2_B rs22_C
#>   <int> <dbl> <dbl>  <dbl>
#> 1     1  0.03  0.02   0.02
#> 2     2  0.9   0.2    0.01

Below, I made a new dataset that has a variable that is unmatched in the coeff data.

test2 <- structure(list(rs1_A = c(0.1, 3), rs2_B = c(0.2, 2), rs22_C = c(2,
1), rs33_D = c(.4, .6)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-2L))

If you don't do anything, the values with missing coeff entries will be missing in the result.

test2 %>% 
  mutate(obs = row_number()) %>%
  pivot_longer(-obs, names_to="SNP_ID", values_to="val") %>% 
  left_join(coeff) %>% 
  mutate(val = val*coeff) %>% 
  select(-coeff) %>% 
  pivot_wider(names_from="SNP_ID", values_from="val")
#> Joining with `by = join_by(SNP_ID)`
#> # A tibble: 2 × 5
#>     obs rs1_A rs2_B rs22_C rs33_D
#>   <int> <dbl> <dbl>  <dbl>  <dbl>
#> 1     1  0.03  0.02   0.02     NA
#> 2     2  0.9   0.2    0.01     NA

If you wanted the values to retain their original values rather than be missing, you could replace missing coeff entries with 1 as below.

test2 %>% 
  mutate(obs = row_number()) %>%
  pivot_longer(-obs, names_to="SNP_ID", values_to="val") %>% 
  left_join(coeff) %>% 
  mutate(coeff= ifelse(is.na(coeff), 1, coeff), 
         val = val*coeff) %>% 
  select(-coeff) %>% 
  pivot_wider(names_from="SNP_ID", values_from="val")
#> Joining with `by = join_by(SNP_ID)`
#> # A tibble: 2 × 5
#>     obs rs1_A rs2_B rs22_C rs33_D
#>   <int> <dbl> <dbl>  <dbl>  <dbl>
#> 1     1  0.03  0.02   0.02    0.4
#> 2     2  0.9   0.2    0.01    0.6

Created on 2023-08-10 with reprex v2.0.2

In terms of speed, I made a dataset with 100 observations and 100,000 columns and a corresponding coefficient dataset. The algorithm suggested above completed in around 3 seconds (M1 Max MacBookPro, 64GB memory). The rowwise() code in your question I stopped executing at around 2 minutes. Here's the test:

large <- matrix(runif(100000*100, 0, 0), ncol=100000)
colnames(large) <- paste0("r_V", 1:100000)
large <- as.data.frame(large)

coeff_l <- data.frame(SNP_ID = paste0("r_V", 1:100000), 
                      coeff = runif(100000, 1, 3))

system.time({
out <- large %>% 
  mutate(obs = row_number()) %>%
  pivot_longer(-obs, names_to="SNP_ID", values_to="val") %>% 
  left_join(coeff_l) %>% 
  mutate(val = val*coeff) %>% 
  select(-coeff) %>% 
  pivot_wider(names_from="SNP_ID", values_from="val")
})
# Joining with `by = join_by(SNP_ID)`
#    user  system elapsed 
#   3.210   0.369   3.577 
system.time({
out <- large %>% 
  rowwise() %>% 
  mutate(
    across(starts_with("r"), 
           .fns = ~.x * coeff_l %>%
             pull(coeff) %>% 
             nth(which(cur_column() == pull(coeff_l, SNP_ID)))
    )
  )
})
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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