Automating "for loop" in R for the whole data set and counting

Viewed 167

I am doing an analysis and I am not so advanced in R. I am stuck in this stage. I would appreciate your cordial help in this regard.

In the example data set (data1), I have 7 columns (a, b, c, d, e, f, g). First 3 columns (a, b, c) are from one group and the other 4 columns (d, e, f, g) are from different group.

In my data1, I applied a formula for TRUE/FALSE (1/0) output for each and every combination pair from the 2 groups [a with every column of d, e, f, g (ad, ae, af, ag); b with every column (bd, be, bf, bg); c with every column (cd, ce, cf, cg)]. In my example, I tried to do it for c and d column (cd). But, it is not showing me the correct output. In my desired output, the second output should be 1 (TRUE). And also, I have no idea how to automate the loop for the whole data set.

**N.B. Since any value of parental line can satisfy the conditions, I used | in the loop to get the result. But, I am not sure if it is the correct or efficient way.

a <- c(0, 0.501, 0.501, 0, 0.57, 20)
b <- c(0.108, 0.96, 0.110, 0.10, 4, 2)
c <- c(0.110, 1, 0.118, 0.107, 0.34, 0.019)
d <- c(0.115, 0.113, 0.98, 0.1, 13, 2)
e <- c(1, 3.113, 0.98, 0.560, 0.15, 1)
f <- c(2.45, 4.16, 0.045, 0.9, 0.12, 70)
g <- c(2, 0.6, 3, 7, 0.12, 29)

data1 <- data.frame(a, b, c, d, e, f, g)
rownames(data1) <- c(("Man2"), paste0('Man', 4:8))
data1
#>           a     b     c      d     e      f     g
#> Man2  0.000 0.108 0.110  0.115 1.000  2.450  2.00
#> Man4  0.501 0.960 1.000  0.113 3.113  4.160  0.60
#> Man5  0.501 0.110 0.118  0.980 0.980  0.045  3.00
#> Man6  0.000 0.100 0.107  0.100 0.560  0.900  7.00
#> Man7  0.570 4.000 0.340 13.000 0.150  0.120  0.12
#> Man8 20.000 2.000 0.019  2.000 1.000 70.000 29.00
r <- c(1:6) #number of rows
c <- c(1:7)  #number of cols
f <- c(1:3) #first group (a, b, c)
s <- c(4:7)  #second group (d, e, f, g)

for (i in r) {
    if ((data1[i,3] >= 0.5 & data1[i,4] >= data1[i, 3]*2) | (data1[i,4] >= 0.5 & data1[i,3] >= data1[i,4]*2)) {
      print(1L)
    } else if ((data1[i,3] < 0.5  & data1[i,4] >= 1.0) | (data1[i,4] < 0.5 & data1[1,3] >= 1.0)) {
      print(1L)
    } else {
      print(0L)
    }
  }
#> [1] 0
#> [1] 0
#> [1] 0
#> [1] 0
#> [1] 1
#> [1] 1

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

For each combination,

  • if the value in any one column is >= 0.5, the value in the other column should be >= 2 folds,
  • and if the value is below 0.5 in any one column, the value in the other column need to be >= 1 for each row.

I look for an output like this df:

ad <- c(0L, 0L, 0L, 0L, 1L, 1L)
ae <- c(1L, 1L, 0L, 0L, 0L, 1L)
af <- c(1L, 1L, 0L, 0L, 0L, 1L)
ag <- c(1L, 0L, 1L, 1L, 0L, 0L)
bd <- c(0L, 0L, 0L, 0L, 1L, 0L)
be <- c(1L, 1L, 0L, 0L, 1L, 1L)
bf <- c(1L, 1L, 0L, 0L, 1L, 1L)
bg <- c(1L, 0L, 1L, 1L, 1L, 1L)
cd <- c(0L, 1L, 0L, 0L, 1L, 1L)
ce <- c(1L, 1L, 0L, 0L, 0L, 1L)
cf <- c(1L, 1L, 0L, 0L, 0L, 1L)
cg <- c(1L, 1L, 1L, 1L, 0L, 1L)
df <- data.frame(ad, ae, af, ag, bd, be, bf, bg, cd, ce, cf, cg)
rownames(df) <- c(("Man2"), paste0('Man', 4:8))
df
#>      ad ae af ag bd be bf bg cd ce cf cg
#> Man2  0  1  1  1  0  1  1  1  0  1  1  1
#> Man4  0  1  1  0  0  1  1  0  1  1  1  1
#> Man5  0  0  0  1  0  0  0  1  0  0  0  1
#> Man6  0  0  0  1  0  0  0  1  0  0  0  1
#> Man7  1  0  0  0  1  1  1  1  1  0  0  0
#> Man8  1  1  1  0  0  1  1  1  1  1  1  1

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

I have two groups in the combination pairs as well. I want to count number of "1s" in one group c(ad, ae, bg, be, bf, cd) and also in the other group c(af, ag, bd, ce, cf, cg) for each row. Is it a good idea to save the 1/0 output in a new data frame like df or just putting the count of "1s" in two new columns (like in df2)? The working data set is a huge one. So, memory and efficient way are the issues here. My desired output is something like this [counting 1s for the first combination group c(ad, ae, bg, be, bf, cd) and also counting 1s for the second combination group c(af, ag, bd, ce, cf, cg) for each row]:

ad <- c(0L, 0L, 0L, 0L, 1L, 1L)
ae <- c(1L, 1L, 0L, 0L, 0L, 1L)
af <- c(1L, 1L, 0L, 0L, 0L, 1L)
ag <- c(1L, 0L, 1L, 1L, 0L, 0L)
bd <- c(0L, 0L, 0L, 0L, 1L, 0L)
be <- c(1L, 1L, 0L, 0L, 1L, 1L)
bf <- c(1L, 1L, 0L, 0L, 1L, 1L)
bg <- c(1L, 0L, 1L, 1L, 1L, 1L)
cd <- c(0L, 1L, 0L, 0L, 1L, 1L)
ce <- c(1L, 1L, 0L, 0L, 0L, 1L)
cf <- c(1L, 1L, 0L, 0L, 0L, 1L)
cg <- c(1L, 0L, 1L, 1L, 0L, 1L)
#first_group <- c(ad, ae, bg, be, bf, cd)
#second_group <- c(af, ag, bd, ce, cf, cg) 
first_combi <- c(4, 4, 1, 1, 5, 5)
second_combi <- c(5, 3, 2, 2, 1, 4)
df2 <- data.frame(ad, ae, af, ag, bd, be, bf, bg, cd, ce, cf, cg, first_combi, second_combi)
rownames(df2) <- c(("Man2"), paste0('Man', 4:8))
df2
#>      ad ae af ag bd be bf bg cd ce cf cg first_combi second_combi
#> Man2  0  1  1  1  0  1  1  1  0  1  1  1           4            5
#> Man4  0  1  1  0  0  1  1  0  1  1  1  0           4            3
#> Man5  0  0  0  1  0  0  0  1  0  0  0  1           1            2
#> Man6  0  0  0  1  0  0  0  1  0  0  0  1           1            2
#> Man7  1  0  0  0  1  1  1  1  1  0  0  0           5            1
#> Man8  1  1  1  0  0  1  1  1  1  1  1  1           5            4

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

So, I need two suggestions:

  1. How to automate the loop for the whole data set
  2. How to store the 1/0 (TRUE/FALSE) for the two combination groups and counting "1s" for the groups.

Please, pave me on these two problems with the data set.

3 Answers

tidyverse strategy. For the second part I'm Assuming you want colsums in matrix form.

  • I have divided your column-names into two groups say grp_1 and grp_2
  • exapnd.grid will generate all combinations of both name groups
  • next we will pass this into pmap_dfc as its first argument
  • for the function part, I have
    • stored the logical values into a temp variable x say. Before storing I have wrapped whole condition with + which converts logical values to numeric
    • next I have set names for this x as per group combinations using paste0
  • Since pmap_dfc is used, the results will be binded into columns automatically
  • last code restores the row names

For the second part I have used -

  • outer function, in combination with
  • colSums.

Using colSums will directly give you results as per column names instead of a matrix

library(tidyverse)

#optimised solution #for the loop part
gr_1 <- c('a', 'b', 'c')
gr_2 <- c('d', 'e', 'f', 'g')

expand.grid(gr_1, gr_2, stringsAsFactors = F) %>%
  pmap_dfc(~ {x <- +((data1[[..1]] >= 0.5 & data1[[..2]] >  2 * data1[[..1]]) |
                       (data1[[..2]] >= 0.5 & data1[[..1]] >  2 * data1[[..2]]) | 
                       (data1[[..2]] < 0.5 &  data1[[..1]] >= 1) |
                       (data1[[..1]] < 0.5 &  data1[[..2]] >= 1)); setNames(list(x), paste0(..1, ..2))} ) %>%
  as.data.frame() %>%
  `rownames<-`(rownames(data1)) -> res

res
#>      ad bd cd ae be ce af bf cf ag bg cg
#> Man2  0  0  0  1  1  1  1  1  1  1  1  1
#> Man4  0  0  1  1  1  1  1  1  1  0  0  0
#> Man5  0  0  0  0  0  0  0  0  0  1  1  1
#> Man6  0  0  0  0  0  0  0  0  0  1  1  1
#> Man7  1  1  1  0  1  0  0  1  0  0  1  0
#> Man8  1  0  1  1  0  1  1  1  1  0  1  1

Second part

#second part
out_gr1 <- c('ad', 'ae', 'bg', 'be', 'bf', 'cd')

split.default(res,  c('Gr1', 'Gr2')[1 + !(names(res) %in% out_gr1)]) %>%
  sapply(rowSums)
  
     Gr1 Gr2
Man2   4   5
Man4   4   3
Man5   1   2
Man6   1   2
Man7   5   1
Man8   5   4

Doing it in one pipe

gr_1 <- c('a', 'b', 'c')
gr_2 <- c('d', 'e', 'f', 'g')
out_gr1 <- c('ad', 'ae', 'bg', 'be', 'bf', 'cd')

expand.grid(gr_1, gr_2, stringsAsFactors = F) %>%
  pmap_dfc(~ {x <- +((data1[[..1]] >= 0.5 & data1[[..2]] >  2 * data1[[..1]]) |
                       (data1[[..2]] >= 0.5 & data1[[..1]] >  2 * data1[[..2]]) | 
                       (data1[[..2]] < 0.5 &  data1[[..1]] >= 1) |
                       (data1[[..1]] < 0.5 &  data1[[..2]] >= 1)); setNames(list(x), paste0(..1, ..2))} ) %>%
  as.data.frame() %>%
  `rownames<-`(rownames(data1)) %>% cbind(split.default(., c('First_combi', 'Second_combi')[1 + !(names(.) %in% out_gr1)]) %>%
  sapply(rowSums))

     ad bd cd ae be ce af bf cf ag bg cg First_combi Second_combi
Man2  0  0  0  1  1  1  1  1  1  1  1  1           4            5
Man4  0  0  1  1  1  1  1  1  1  0  0  0           4            3
Man5  0  0  0  0  0  0  0  0  0  1  1  1           1            2
Man6  0  0  0  0  0  0  0  0  0  1  1  1           1            2
Man7  1  1  1  0  1  0  0  1  0  0  1  0           5            1
Man8  1  0  1  1  0  1  1  1  1  0  1  1           5            4

You can write a function for the comparison and loop the columns to get the results in a dataframe. Then, use lapply() to run table() through each column of the dataframe to get the number of 1s.

# A function for the comparison
compare <- function(x, y) {
  ifelse(
    (x >= 0.5 & y >= (x * 2)) | (y >= 0.5 & x >= (y * 2)) | (x < 0.5 & y >= 1) | (y < 0.5 & x >= 1),
    1L, 0L
  )
}

# Get all combinations
comb <- expand.grid(first = c("a", "b", "c"),
                    second = c("d", "e",  "f", "g"),
                    stringsAsFactors = FALSE)
n <- nrow(comb)

# Create an empty list
res <- vector("list", n)

for (i in seq_len(n)) {
  res[[i]] <- compare(data1[[ comb$first[i] ]],
                      data1[[ comb$second[i] ]])
}

# Assign names to the list
names(res) <- paste0(comb$first, comb$second, collpase = "")
# Convert the list to a dataframe
res <- list2DF(res)
# Assign row names
rownames(res) <- c(("Man2"), paste0('Man', 4:8))

res

#      ad bd cd ae be ce af bf cf ag bg cg
# Man2  0  0  0  1  1  1  1  1  1  1  1  1
# Man4  0  0  1  1  1  1  1  1  1  0  0  0
# Man5  0  0  0  0  0  0  0  0  0  1  1  1
# Man6  0  0  0  0  0  0  0  0  0  1  1  1
# Man7  1  1  1  0  1  0  0  1  0  0  1  0
# Man8  1  0  1  1  1  1  1  1  1  0  1  1

# use lapply to get the counts of 1s and 0s in each column
res_count <- lapply(res, table)
res_count

# $ad
# 
# 0 1 
# 4 2 
# 
# $bd
# 
# 0 1 
# 5 1 
# 
# $cd
# 
# 0 1 
# 3 3 
# <omitted>

You can also use the following solution:

library(dplyr)
library(purrr)

# First we create every combinations of column names between 2 groups
expand.grid(names(data1)[1:3], names(data1[4:7])) -> cols

# Then we check your desired conditions
map2(cols$Var1, cols$Var2, ~ data1[, c(.x, .y)]) %>%
  map(~ .x %>% 
        mutate(!!paste0(names(.x), collapse = "") :=  
                 pmap_dbl(.x, ~ {x <- c(...)[-3];
                 if((..1 > 0.5 & ..2 >= ..1 * 2) | (..2 > 0.5 & ..1 >= ..2 * 2) |
                    (..1 < 0.5 & ..2 >= 1) | (..2 < 0.5 & ..1 >= 1)) {
                   1
                 } else {
                   0
                 }}))) %>%
  map_dfc(~ .x %>% select(3)) -> df

  ad bd cd ae be ce af bf cf ag bg cg
1  0  0  0  1  1  1  1  1  1  1  1  1
2  0  0  1  1  1  1  1  1  1  0  0  0
3  0  0  0  0  0  0  0  0  0  1  1  1
4  0  0  0  0  0  0  0  0  0  1  1  1
5  1  1  1  0  1  0  0  1  0  0  1  0
6  1  0  1  1  1  1  1  1  1  0  1  1

With regard to your second question, if I understood what you are looking for correctly and you would like to count the number of 1 for each row in each pair, you can use this:

col1 <- c("ad", "ae", "bg", "be", "bf", "cd")
col2 <- c("af", "ag", "bd", "ce", "cf", "cg")

split.default(df, names(df) %in% col1) %>%
  map(~ .x %>% 
        rowwise() %>%
        mutate(count = reduce(cur_data(), `+`)))

$`FALSE`
# A tibble: 6 x 7
# Rowwise: 
     bd    ce    af    cf    ag    cg count
  <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1     0     1     1     1     1     1     5
2     0     1     1     1     0     0     3
3     0     0     0     0     1     1     2
4     0     0     0     0     1     1     2
5     1     0     0     0     0     0     1
6     0     1     1     1     0     1     4

$`TRUE`
# A tibble: 6 x 7
# Rowwise: 
     ad    cd    ae    be    bf    bg count
  <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1     0     0     1     1     1     1     4
2     0     1     1     1     1     0     4
3     0     0     0     0     0     1     1
4     0     0     0     0     0     1     1
5     1     1     0     1     1     1     5
6     1     1     1     1     1     1     6

In order to calculate the euclidean distance you could use the following solution:

gr_1 <- c('a', 'b', 'c')
gr_2 <- c('d', 'e', 'f', 'g')

expand.grid(gr_1, gr_2) %>%
  {map2(.$Var1, .$Var2, ~ data1[c(.x, .y)])} %>%
  map_dfc(~ .x %>%
        summarise(!!sym(paste0(names(.x), collapse = "")) := sqrt(sum((.x[[1]] - .x[[2]]) ^ 2))))

        ad       bd       cd       ae       be       ce       af       bf       cf       ag
1 21.88397 9.081539 12.87361 19.22347 4.714029 2.683949 50.20569 68.23066 70.09625 11.85147
        bg       cg
1 28.35006 29.99164
Related