Замена циклов оператором if в R - PullRequest
Новая
       14

Замена циклов оператором if в R

0 голосов
/ 16 октября 2018

Привет, что будет лучшим способом сделать следующие циклы в R? 

for (i in 1:nrow(df1)) {
  counter <- 0
  for (j in 1:nrow(df2)) {
    if (df2$x[j] >= df1$a[i] & df2$x[j] < df1$b[i]{counter = counter + 1}
  }
  df1$counter[i] <- counter
}

1 Ответ

0 голосов
/ 16 октября 2018

Есть несколько способов напасть на что-то подобное.Я покажу несколько.Поскольку вы не предоставили данные, посмотрите на образцы внизу.

  1. Исправьте код, который у вас есть (думаю, вам не хватает близкого друга): 

    for (i in 1:nrow(df1)) {
  counter1 <- 0
  for (j in 1:nrow(df2)) {
    if (df2$x[j] >= df1$a[i] & df2$x[j] < df1$b[i]) { counter1 = counter1 + 1; }
  }
  df1$counter1[i] <- counter1
}
df1
#    a  b counter1
# 1  7 49        3
# 2 18 87        4
# 3 29  3        0
# 4 89 21        0
# 5 58 13        0
# 6 22 66        4
# 7 62 68        0
# 8 97 98        0

    (С этого момента я не буду показывать вывод, будьте уверены, что это то же самое. Если вы мне не верите, попробуйте. Я буду продолжать нумерацию столбцов counter, чтобы вы могли видеть их сбокув сторону.)

  2. Мы можем извлечь выгоду из векторизации R вещей.Это означает, что вместо c(1+9, 2+9, 3+9) вы можете написать c(1,2,3)+9 и сделать все сразу.Точно так же вы можете суммировать вектор логических значений (logical), который должен делать то, что вы ожидаете (sum(T,T,F) равно 2).По этим темам давайте удалим внутренний цикл: 

    for (i in 1:nrow(df1)) {
  df1$counter2[i] <- sum(df2$x >= df1$a[i] & df2$x < df1$b[i])
}

  3. Это все еще немного не-R-onic (адаптация pythonic ).Давайте попробуем один из apply вариантов, предназначенных для работы с простым вектором, и вернем вектор, который мы запишем в качестве счетчика: 

    df1$counter3 <- sapply(seq_len(nrow(df1)),
                       function(i) sum(df2$x >= df1$a[i] & df2$x < df1$b[i]))

  4. Другой метод - менее-частый, но может быть полезен время от времени (в зависимости от того, как / где вы его применяете).Функция outer эффективно дает вам все комбинации двух векторов (аналогично, но отличается от expand.grid). 

    outer(seq_len(nrow(df1)), seq_len(nrow(df2)),
      function(i, j) df2$x[j] >= df1$a[i] & df2$x[j] < df1$b[i])
#       [,1]  [,2]  [,3]  [,4]  [,5]
# [1,] FALSE  TRUE  TRUE  TRUE FALSE
# [2,]  TRUE  TRUE FALSE  TRUE  TRUE
# [3,] FALSE FALSE FALSE FALSE FALSE
# [4,] FALSE FALSE FALSE FALSE FALSE
# [5,] FALSE FALSE FALSE FALSE FALSE
# [6,]  TRUE  TRUE FALSE  TRUE  TRUE
# [7,] FALSE FALSE FALSE FALSE FALSE
# [8,] FALSE FALSE FALSE FALSE FALSE

    На самом деле есть только один вызов функции, где, если вы должны смотреть, когдаэто называется, вы увидите это: 

    i
#  [1] 1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8 1 2 3 4 5 6 7 8 1 2 3 4
# [37] 5 6 7 8
j
#  [1] 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4 5 5 5 5
# [37] 5 5 5 5

    Отсюда эта внутренняя функция разворачивается в нечто вроде: 

    # df2$x[j] >= df1$a[i] & df2$x[j] < df1$b[i] # i,j
  df2$x[1] >= df1$a[1] & df2$x[1] < df1$b[1] # 1,1
  df2$x[1] >= df1$a[2] & df2$x[1] < df1$b[2] # 2,1
  df2$x[1] >= df1$a[3] & df2$x[1] < df1$b[3] # 3,1
  # ...
  df2$x[1] >= df1$a[8] & df2$x[1] < df1$b[8] # 8,1
  df2$x[2] >= df1$a[1] & df2$x[2] < df1$b[1] # 1,2
  df2$x[2] >= df1$a[2] & df2$x[2] < df1$b[2] # 2,2
  # ...
  df2$x[5] >= df1$a[7] & df2$x[5] < df1$b[7] # 7,5
  df2$x[5] >= df1$a[8] & df2$x[5] < df1$b[8] # 8,5

    , а затем принимает форму matrix с соответствующимиколичество строк и столбцов в зависимости от длины входных векторов.(С этой функцией outer -произведения вы можете сделать множество вещей, похожих на матрицы, это переходит от математического к поиску / вычислению.)

    Теперь, когда у вас есть matrix из logical s, достаточно просто определить суммы строк с помощью colSums: 

    rowSums(outer(seq_len(nrow(df1)), seq_len(nrow(df2)),
              function(i, j) df2$x[j] >= df1$a[i] & df2$x[j] < df1$b[i]))
# [1] 3 4 0 0 0 4 0 0

    (которые могли быть назначены с помощью df1$counter4 <- rowSums(...))

Данные: 

set.seed(20181015)
n1 <- 5
n2 <- 8
df1 <- data.frame(a = sample(100, size=n2), b = sample(100, size=n2))
df1
#    a  b
# 1  7 49
# 2 18 87
# 3 29  3
# 4 89 21
# 5 58 13
# 6 22 66
# 7 62 68
# 8 97 98
df2 <- data.frame(x = sample(100, size=n1))
df2
#    x
# 1 51
# 2 31
# 3 17
# 4 41
# 5 49

Бенчмаркинг, для любопытных: 

library(microbenchmark)
microbenchmark(
  c1 = {
    for (i in 1:nrow(df1)) {
      counter1 <- 0
      for (j in 1:nrow(df2)) {
        if (df2$x[j] >= df1$a[i] & df2$x[j] < df1$b[i]) { counter1 = counter1 + 1; }
      }
      df1$counter1[i] <- counter1
    }
  },
  c2 = {
    for (i in 1:nrow(df1)) {
      df1$counter2[i] <- sum(df2$x >= df1$a[i] & df2$x < df1$b[i])
    }
  },
  c3 = {
    sapply(seq_len(nrow(df1)),
           function(i) sum(df2$x >= df1$a[i] & df2$x < df1$b[i]))
  },
  c4 = {
    rowSums(outer(seq_len(nrow(df1)), seq_len(nrow(df2)),
                  function(i, j) df2$x[j] >= df1$a[i] & df2$x[j] < df1$b[i]))
  },
  times=100
)
# Unit: microseconds
#  expr    min      lq     mean median      uq     max neval
#    c1 7022.1 7669.45 9608.953 8301.4 8989.25 19038.8   100
#    c2 4168.5 4634.00 5698.094 4998.5 5405.45 15927.4   100
#    c3  153.7  182.60  237.050  194.1  216.40  3209.6   100
#    c4   35.2   48.30   62.348   61.5   70.95   141.0   100
...