简体   繁体   中英

Summing elements without using loops in R

Say I have the numeric strings

str1 <- c(1, 2, 3) , str2 <- c(4, 7, 10, 18, 20)

and a set of data hex_np <- c(2, 4, 6, 8, 10) .

I want to display each of str1[a] * hex_np + str2[b] where with a=1,2,3 and b=1,2,3,4,5 .

That is,

str1[1] * hex_np + str2[1] , str1[1] * hex_np + str2[2] , ..., str1[1] * hex_np + str2[5] , str1[2] * hex_np + str2[1] str1[2] * hex_np + str2[2] , ..., str1[2] * hex_np + str2[5] , str1[3] * hex_np + str2[1] , str1[3] * hex_np + str2[2] , ..., str1[3] * hex_np + str2[5]

How should I do this without using loops?

Using expand.grid to get all combinations for str1 and str2 , then loop through the rows and use your formula:

myResult <- apply(expand.grid(str1, str2), 1, function(i)
  i[1] * hex_np + i[2])

class(myResult)
# [1] "matrix"

myResult
#       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15]
# [1,]    6    8   10    9   11   13   12   14   16    20    22    24    22    24    26
# [2,]    8   12   16   11   15   19   14   18   22    22    26    30    24    28    32
# [3,]   10   16   22   13   19   25   16   22   28    24    30    36    26    32    38
# [4,]   12   20   28   15   23   31   18   26   34    26    34    42    28    36    44
# [5,]   14   24   34   17   27   37   20   30   40    28    38    48    30    40    50

Or we can use mapply :

ab <- expand.grid(str1, str2)
myResult2 <- mapply(function(a, b){a * hex_np + b}, ab[, 1], ab[, 2])
identical(myResult, myResult2)
# [1] TRUE

Edit: If we want 3 way combination, see below:

myResult3 <- data.frame(expand.grid(str1, hex_np, str2))
colnames(myResult3) <- c("str1", "hex_np", "str2")

myResult3$res <- with(myResult3, str1 * hex_np + str2)

head(myResult3)
#   str1 hex_np str2 res
# 1    1      2    4   6
# 2    2      2    4   8
# 3    3      2    4  10
# 4    1      4    4   8
# 5    2      4    4  12
# 6    3      4    4  16

Setting up the data

str1 = c(1, 2, 3)
str2 = c(4, 7, 10, 18, 20)
hex_np = c(2, 4, 6, 8, 10)

Solution #1

If you can use your result in a three-dimensional array , you can try simply:

outer(outer(str1, hex_np), str2, "+")

Solution #2

If not, we need to change the dimensions of our array in a way to match the desired format. We can achieve that using base::aperm .

array(aperm(a = outer(outer(str1, hex_np), str2, "+"), perm = c(3,1,2)), c(15,5))

#      [,1] [,2] [,3] [,4] [,5]
# [1,]    6    8   10   12   14
# [2,]    9   11   13   15   17
# [3,]   12   14   16   18   20
# [4,]   20   22   24   26   28
# [5,]   22   24   26   28   30
# [6,]    8   12   16   20   24
# [7,]   11   15   19   23   27
# [8,]   14   18   22   26   30
# [9,]   22   26   30   34   38
#[10,]   24   28   32   36   40
#[11,]   10   16   22   28   34
#[12,]   13   19   25   31   37
#[13,]   16   22   28   34   40
#[14,]   24   30   36   42   48
#[15,]   26   32   38   44   50

Microbenchmark

To compare the solutions presented, here's a microbenchmark::microbenchmark

library(microbenchmark)

str1 = c(1, 2, 3)
str2 = c(4, 7, 10, 18, 20)
hex_np = c(2, 4, 6, 8, 10)

microbenchmark(
    'catastrophic-failure' = array(aperm(a = outer(outer(str1, hex_np), str2, "+"), perm = c(3,1,2)), c(15,5)),
    zx8754_a = apply(expand.grid(str1, str2), 1, function(i) i[1] * hex_np + i[2]),
    zx8754_b = {ab <- expand.grid(str1, str2); mapply(function(a, b){a * hex_np + b}, ab[, 1], ab[, 2])},
    'Tom Wenseleers' = t(apply(expand.grid(str1=c(1, 2, 3), str2=c(4, 7, 10, 18, 20)), 1, function(r) r[1]*hex_np+r[2])),
    times = 1000L)
 #Unit: microseconds # expr min lq mean median uq max neval cld # catastrophic-failure 27.526 38.723 43.18418 41.989 45.7210 191.279 1000 a # zx8754_a 226.268 237.932 258.80061 243.064 257.5265 2259.418 1000 c # zx8754_b 167.486 188.946 210.34001 195.944 207.1410 1780.289 1000 b # Tom Wenseleers 243.064 251.928 279.18529 257.993 275.2545 2764.673 1000 d 

Therefore, for the data presented, my solution is way faster, perhaps due to the use of arrays directly.

To have result as a row-wise matrix just do:

t(apply(expand.grid(str1=c(1, 2, 3), str2=c(4, 7, 10, 18, 20)),
        1, function(r) r[1]*hex_np+r[2]))
      [,1] [,2] [,3] [,4] [,5]
 [1,]    6    8   10   12   14
 [2,]    8   12   16   20   24
 [3,]   10   16   22   28   34
 [4,]    9   11   13   15   17
 [5,]   11   15   19   23   27
 [6,]   13   19   25   31   37
 [7,]   12   14   16   18   20
 [8,]   14   18   22   26   30
 [9,]   16   22   28   34   40
[10,]   20   22   24   26   28
[11,]   22   26   30   34   38
[12,]   24   30   36   42   48
[13,]   22   24   26   28   30
[14,]   24   28   32   36   40
[15,]   26   32   38   44   50

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM