R：记录函数的索引迭代 [英] R: Recording the Index Iterations of a Function

查看：18
本文介绍了R：记录函数的索引迭代的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我正在使用R编程语言。在上一个问题(R: Creating a Function to Randomly Replace Data from a Data Frame)中，我学习了如何根据不同的条件将数据集中的行随机替换为0：

  • 第1步：数据集有10个变量-在第1步中，从这些变量中随机选择(&q；n&q；必须小于10)。

    • 第2步：对于上述变量，如果它们是因数，则为每个因数变量随机选择级别的子集(大小)。对于每个非因素变量，在其最小值和最大值之间的某个点(称为该点)随机拆分它们。

  • 第三步：生成一个介于0和1之间的随机数(称之为&q；r&q；)。

  • 步骤4：选择步骤2中标识的所有行。对于这些行，考虑逻辑条件中未使用的列。对于这些列，这些行中的任何元素都可以替换为0的概率为%(&q；r&q；)。

  • 第5步：重复第1步到第4步10次。

    set.seed(123)

  num_var_1 <- rnorm(1000, 10, 1)
  num_var_2 <- rnorm(1000, 10, 5)
  num_var_3 <- rnorm(1000, 10, 10)
  num_var_4 <- rnorm(1000, 10, 10)
  num_var_5 <- rnorm(1000, 10, 10)

  factor_1 <- c("A","B", "C")
  factor_2 <- c("AA","BB", "CC")
  factor_3 <- c("AAA","BBB", "CCC", "DDD")
  factor_4 <- c("AAAA","BBBB", "CCCC", "DDDD", "EEEE")
  factor_5 <- c("AAAAA","BBBBB", "CCCCC", "DDDDD", "EEEEE", "FFFFFF")

  factor_var_1 <- as.factor(sample(factor_1, 1000, replace=TRUE, prob=c(0.3, 0.5, 0.2)))
  factor_var_2 <-  as.factor(sample(factor_2, 1000, replace=TRUE, prob=c(0.5, 0.3, 0.2)))
  factor_var_3 <-  as.factor(sample(factor_3, 1000, replace=TRUE, prob=c(0.5, 0.2, 0.2, 0.1)))
  factor_var_4 <-  as.factor(sample(factor_4, 1000, replace=TRUE, prob=c(0.5, 0.2, 0.1, 0.1, 0.1)))
  factor_var_5 <-  as.factor(sample(factor_4, 1000, replace=TRUE, prob=c(0.3, 0.2, 0.1, 0.1, 0.1)))

  my_data = data.frame(num_var_1, num_var_2, num_var_3, num_var_4, num_var_5, factor_var_1, factor_var_2, factor_var_3, factor_var_4, factor_var_5)

  random_drop <- function(x) {
    # Randomly select variables
    which_vars <- names(x[, sort(sample(ncol(x), sample(ncol(x), 1)))])
    # Randomly select factor levels subset or generate continuous cutoff value
    cutoff_vals <- lapply(
      which_vars,
      function(i) {
        if (is.factor(x[[i]])) {
          return(sample(levels(x[[i]]), sample(nlevels(x[[i]]), 1)))
        }
        runif(1, min(x[[i]], na.rm = TRUE), max(x[[i]], na.rm = TRUE))
      }
    )
    names(cutoff_vals) <- which_vars
    # Create random prob value
    r <- runif(1,0,1)
    # Generate idx for which rows to select
    row_idx <- Reduce(
      `&`,
      lapply(
        which_vars,
        function(i) {
          if (is.factor(x[[i]])) {
            return(x[[i]] %in% cutoff_vals[[i]])
          }
          x[[i]] > cutoff_vals[[i]]
        }
      )
    )
    x_sub <- x[row_idx, !colnames(x) %in% which_vars, drop = FALSE]
    # With prob. 'r' fill row values in with '0'
    r_mat <- matrix(
      sample(
        c(TRUE, FALSE), 
        ncol(x_sub)*nrow(x_sub), 
        replace = TRUE, 
        prob = c(r, 1 - r)
      ),
      nrow = nrow(x_sub),
      ncol = ncol(x_sub)
    )
    x_sub[r_mat] <- 0
    x[row_idx, !colnames(x) %in% which_vars] <- x_sub
    return(x)
  }

  random_drop_recurse <- function(x, n = 10) {
    if (n == 1) return(random_drop(x))
    random_drop_recurse(random_drop(x), n = n - 1)
  }

  suppressWarnings(
    head(
      random_drop_recurse(my_data[, c(1:3, 6:8)], 10),
      20
    )
  )
  #>    num_var_1 num_var_2 num_var_3 factor_var_1 factor_var_2 factor_var_3
  #> 1   9.439524  5.021006  4.883963            B           AA          AAA
  #> 2   9.769823  4.800225 12.369379            B           AA          AAA
  #> 3  11.558708  9.910099  0.000000            C           AA          BBB
  #> 4  10.070508  9.339124 22.192276            B           CC          DDD
  #> 5  10.129288 -2.746714 11.741359            B           AA          AAA
  #> 6  11.715065 15.202867  3.847317         <NA>           AA          CCC
  #> 7  10.460916 11.248629 -8.068930            C           CC         <NA>
  #> 8   8.734939 22.081037  0.000000            C           AA          BBB
  #> 9   9.313147 13.425991 30.460189            C           AA          BBB
  #> 10  9.554338  7.765203  4.392376            B           AA          AAA
  #> 11 11.224082 23.986956  1.640007            A         <NA>          AAA
  #> 12 10.359814 24.161130 16.529475            A           AA          AAA
  #> 13  0.000000  3.906441  0.000000            A           CC         <NA>
  #> 14 10.110683 12.345160 17.516291            B           CC          AAA
  #> 15  9.444159  8.943765  7.220249            A           AA          DDD
  #> 16 11.786913 10.935256 21.226542            B           CC          DDD
  #> 17 10.497850 11.137714 -1.726089            B           AA          AAA
  #> 18  8.033383  3.690498  9.511232            B           CC          CCC
  #> 19 10.701356 11.427948  2.958597            B           BB          AAA
  #> 20  9.527209 18.746237 16.807586            C           AA          BBB

问题：现在，我正在尝试学习如何记录每次迭代的结果-即，每次选择变量组合替换为0时，我都希望记录该组合。

有人能教我怎么做吗？

谢谢！

推荐答案

嘿@stats555感谢您将这个问题分成一个新问题！我对前一个问题中的代码做了非常小的调整；即random_drop_recurse函数现在看起来如下所示：

random_drop_recurse <- function(x, n = 10) {
  if (n == 1) {
    dropped <- random_drop(x)
    return(list(x = dropped, x_dropped = is.na(dropped) | dropped == 0))
  }
  random_drop_recurse(random_drop(x), n = n - 1)
}
现在，它不再只是返回包含已删除条目的矩阵，而是返回一个布尔矩阵，其中显示了已删除的所有索引。下面的代码块演示了您提供的数据：

set.seed(123)

num_var_1 <- rnorm(1000, 10, 1)
num_var_2 <- rnorm(1000, 10, 5)
num_var_3 <- rnorm(1000, 10, 10)
num_var_4 <- rnorm(1000, 10, 10)
num_var_5 <- rnorm(1000, 10, 10)

factor_1 <- c("A","B", "C")
factor_2 <- c("AA","BB", "CC")
factor_3 <- c("AAA","BBB", "CCC", "DDD")
factor_4 <- c("AAAA","BBBB", "CCCC", "DDDD", "EEEE")
factor_5 <- c("AAAAA","BBBBB", "CCCCC", "DDDDD", "EEEEE", "FFFFFF")

factor_var_1 <- as.factor(sample(factor_1, 1000, replace=TRUE, prob=c(0.3, 0.5, 0.2)))
factor_var_2 <-  as.factor(sample(factor_2, 1000, replace=TRUE, prob=c(0.5, 0.3, 0.2)))
factor_var_3 <-  as.factor(sample(factor_3, 1000, replace=TRUE, prob=c(0.5, 0.2, 0.2, 0.1)))
factor_var_4 <-  as.factor(sample(factor_4, 1000, replace=TRUE, prob=c(0.5, 0.2, 0.1, 0.1, 0.1)))
factor_var_5 <-  as.factor(sample(factor_4, 1000, replace=TRUE, prob=c(0.3, 0.2, 0.1, 0.1, 0.1)))

my_data = data.frame(num_var_1, num_var_2, num_var_3, num_var_4, num_var_5, factor_var_1, factor_var_2, factor_var_3, factor_var_4, factor_var_5)

random_drop <- function(x) {
  # Randomly select variables
  which_vars <- names(x[, sort(sample(ncol(x), sample(ncol(x), 1)))])
  # Randomly select factor levels subset or generate continuous cutoff value
  cutoff_vals <- lapply(
    which_vars,
    function(i) {
      if (is.factor(x[[i]])) {
        return(sample(levels(x[[i]]), sample(nlevels(x[[i]]), 1)))
      }
      runif(1, min(x[[i]], na.rm = TRUE), max(x[[i]], na.rm = TRUE))
    }
  )
  names(cutoff_vals) <- which_vars
  # Create random prob value
  r <- runif(1,0,1)
  # Generate idx for which rows to select
  row_idx <- Reduce(
    `&`,
    lapply(
      which_vars,
      function(i) {
        if (is.factor(x[[i]])) {
          return(x[[i]] %in% cutoff_vals[[i]])
        }
        x[[i]] > cutoff_vals[[i]]
      }
    )
  )
  x_sub <- x[row_idx, !colnames(x) %in% which_vars, drop = FALSE]
  # With prob. 'r' fill row values in with '0'
  r_mat <- matrix(
    sample(
      c(TRUE, FALSE), 
      ncol(x_sub)*nrow(x_sub), 
      replace = TRUE, 
      prob = c(r, 1 - r)
    ),
    nrow = nrow(x_sub),
    ncol = ncol(x_sub)
  )
  x_sub[r_mat] <- 0
  x[row_idx, !colnames(x) %in% which_vars] <- x_sub
  return(x)
}

random_drop_recurse <- function(x, n = 10) {
  if (n == 1) {
    dropped <- random_drop(x)
    return(list(x = dropped, x_dropped = is.na(dropped) | dropped == 0))
  }
  random_drop_recurse(random_drop(x), n = n - 1)
}

test <- suppressWarnings(
  random_drop_recurse(my_data[, c(1:3, 6:8)], 10)
)

# View the first 20 entries of the matrix with the dropped entries
test$x[1:20, ]
#>    num_var_1 num_var_2 num_var_3 factor_var_1 factor_var_2 factor_var_3
#> 1   9.439524  5.021006  4.883963            B           AA          AAA
#> 2   9.769823  4.800225 12.369379            B           AA          AAA
#> 3  11.558708  9.910099  0.000000            C           AA          BBB
#> 4  10.070508  9.339124 22.192276            B           CC          DDD
#> 5  10.129288 -2.746714 11.741359            B           AA          AAA
#> 6  11.715065 15.202867  3.847317         <NA>           AA          CCC
#> 7  10.460916 11.248629 -8.068930            C           CC         <NA>
#> 8   8.734939 22.081037  0.000000            C           AA          BBB
#> 9   9.313147 13.425991 30.460189            C           AA          BBB
#> 10  9.554338  7.765203  4.392376            B           AA          AAA
#> 11 11.224082 23.986956  1.640007            A         <NA>          AAA
#> 12 10.359814 24.161130 16.529475            A           AA          AAA
#> 13  0.000000  3.906441  0.000000            A           CC         <NA>
#> 14 10.110683 12.345160 17.516291            B           CC          AAA
#> 15  9.444159  8.943765  7.220249            A           AA          DDD
#> 16 11.786913 10.935256 21.226542            B           CC          DDD
#> 17 10.497850 11.137714 -1.726089            B           AA          AAA
#> 18  8.033383  3.690498  9.511232            B           CC          CCC
#> 19 10.701356 11.427948  2.958597            B           BB          AAA
#> 20  9.527209 18.746237 16.807586            C           AA          BBB

# View the corresponding boolean matrix showing dropped indices
test$x_dropped[1:20, ]
#>       num_var_1 num_var_2 num_var_3 factor_var_1 factor_var_2 factor_var_3
#>  [1,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE
#>  [2,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE
#>  [3,]     FALSE     FALSE      TRUE        FALSE        FALSE        FALSE
#>  [4,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE
#>  [5,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE
#>  [6,]     FALSE     FALSE     FALSE         TRUE        FALSE        FALSE
#>  [7,]     FALSE     FALSE     FALSE        FALSE        FALSE         TRUE
#>  [8,]     FALSE     FALSE      TRUE        FALSE        FALSE        FALSE
#>  [9,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE
#> [10,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE
#> [11,]     FALSE     FALSE     FALSE        FALSE         TRUE        FALSE
#> [12,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE
#> [13,]      TRUE     FALSE      TRUE        FALSE        FALSE         TRUE
#> [14,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE
#> [15,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE
#> [16,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE
#> [17,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE
#> [18,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE
#> [19,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE
#> [20,]     FALSE     FALSE     FALSE        FALSE        FALSE        FALSE

# If you want the actual indices
which(test$x_dropped[1:20, ], arr.ind = TRUE)
#>      row col
#> [1,]  13   1
#> [2,]   3   3
#> [3,]   8   3
#> [4,]  13   3
#> [5,]   6   4
#> [6,]  11   5
#> [7,]   7   6
#> [8,]  13   6

这篇关于R：记录函数的索引迭代的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
其他开发最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆