如何计算循环迭代的次数并将其作为数据框列中的值？

Question

我有一个包含 3 列的数据框，它对 A 列是否大于 B 列进行分类。

dataf <- data.frame(category = c("Above", "Below", "In Range", "Above"),
                    A = c(1.99, 4.99, 6.99, 5.99),
                    B = c(0.99, 9.99, 6.99, 1.99))

目标是创建一个具有以下逻辑的新列：

如果类别 =“以上”，如果最大变化量为 20%，请计算将 A 减小到 B 的 10% 以内的次数
如果类别 =“低于”，如果最大变化量为 20%，请计算将 A 增加到等于或高于 B 的次数
如果类别=“在范围内”，记录0个更改

我想将其记录在新的 dataf 列中。

所需的输出如下所示：

desired_dataf <- data.frame(category = c("Above", "Below", "In Range", "Above"),
A = c(1.99, 4.99, 6.99, 5.99),
B = c(0.99, 9.99, 6.99, 1.99),
C = c(3, 4, 0, 5))

这是我解决这个问题的尝试：

dataf <- data.frame(category = c("Above", "Below", "In Range", "Above"),
                    A = c(1.99, 4.99, 6.99, 3.99),
                    B = c(0.99, 7.99, 6.99, 1.99))

decrease_func <- function(x, y, count=0, max=1.1) {
  new_x <- x
  while((new_x/y) > max) {
    new_x = new_x * (.8)
    count = count + 1
  }
  return(count)
}

increase_func <- function(x, y, count=0, min=1.0) {
  new_x <- x
  while((new_x / y) < min) {
    new_x = new_x * (1.2)
    count = count + 1
  }
  return(count)
}

new_df <- dataf %>%
  mutate(new_col = case_when(category == "Above" ~ decrease_func(A,B),
  category == "Below" ~ increase_func(A,B),
  TRUE ~ 0))

new_df

但是运行它给了我这个错误：

Error in mutate(., new_col = case_when(category == "Above" ~ decrease_func(A,  : 
  
Caused by error in `case_when()`:
! Failed to evaluate the right-hand side of formula 1.
Caused by error in `while ((new_x / y) > max) {
    new_x = new_x * (0.8)
    count = count + 1
  }`:
! the condition has length > 1

在数据框之外测试这些函数可以正常工作。

decrease_func(1.99, .99)

increase_func(4.99, 9.99)

decrease_func(5.99, 1.99

输出：

[1] 3
[1] 4
[1] 5

我猜这是尝试在 mutate 中使用 while 循环的问题？有更好的方法来实现这一点吗？预先感谢您！

Answer 1

并非所有数字都如此。如果没有正确的解决方案怎么办？例如

x = 1; y=0.58

没有多少次你可以将 x 减少 20% 来达到 y 的 10% 之内。即如果你运行

decrease_func(1, 0.58)

它会给你 2 作为解决方案。但是将 x 减少 20% 两次就会得到 0.64，与 0.58 相差

10.34%

。如果尝试 3 次，您将得到 0.512，与 0.58 相差 11.72%。因此，对于给定的示例，不存在解决方案。但当然我们可以取

2

，因为 10.34 更接近，但不在 10% 之内。

从数学上来说，我们可以将方程解为：

fn <- function(x,y, change = 0.2){
    round(log(y/x)/log((1 - change * ((x > y) - (x < y)))))
}
transform(dataf, new_col = fn(A, B))
  category    A    B new_col
1    Above 1.99 0.99       3
2    Below 4.99 9.99       4
3 In Range 6.99 6.98       0
4    Above 5.99 1.99       5

请注意，这将给出所需的解决方案。那么为什么我们不检查是否在10%以内呢？你应该。这改变了功能 abit:

fn <- function(x,y, change = 0.2, within = 0.1){
    z <- y %o% (1 + within * c(-1,1))
    d <- (1 - change * ((x > y) - (x < y)))
    r <- round(log(z/x)/log(d))
    idx <- r[,1] == r[,2]
    neg_idx <- !idx
    res <- numeric(length(x))
    res[idx] <- r[idx, 1]
    e <- abs(x[neg_idx] * d[neg_idx]^r[neg_idx,] - y[neg_idx])/y[neg_idx]
    res[neg_idx] <- r[neg_idx,][cbind(seq(sum(neg_idx)), max.col(-e))]
    res
}

transform(dataf, new_col = fn(A, B))
 category    A    B new_col
1    Above 1.99 0.99       3
2    Below 4.99 9.99       4
3 In Range 6.99 6.98       0
4    Above 5.99 1.99       5