R：创建一个函数来随机替换数据框中的数据
R: Creating a Function to Randomly Replace Data from a Data Frame
我正在使用 R 编程语言。假设我有以下数据 ("my_data"):
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)))
id = 1:1000
my_data = data.frame(id,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)
> head(my_data)
id 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
1 1 9.439524 5.021006 4.883963 8.496925 11.965498 B AA AAA CCCC AAAA
2 2 9.769823 4.800225 12.369379 6.722429 16.501132 B AA AAA AAAA AAAA
3 3 11.558708 9.910099 4.584108 -4.481653 16.710042 C AA BBB AAAA CCCC
4 4 10.070508 9.339124 22.192276 3.027154 -2.841578 B CC DDD BBBB AAAA
5 5 10.129288 -2.746714 11.741359 35.984902 -10.261096 B AA AAA DDDD DDDD
6 6 11.715065 15.202867 3.847317 9.625850 32.053261 B AA CCC BBBB EEEE
我的问题： 鉴于上述数据集，我正在尝试创建一个函数（重复）以下列方式从上述数据集中删除随机行：
第 1 步： 数据集有 10 个变量 - 在第 1 步中，随机 select“n”个变量（“n”有小于 10).
第2步：对于上述"n"个变量，如果是"factor"，则随机select一个子集（大小为" m") 中每个因子变量的水平。对于每个非因子变量，在它们的最小值和最大值之间的一个点随机拆分它们（将此点称为“p”）。
第 3 步： 生成一个介于 0 和 1 之间的随机数（称之为“r”）。
第 4 步： Select 第 2 步中标识的所有行。对于这些行，考虑逻辑条件中未使用的列.对于这些列，这些行中的任何元素都可以用 0 替换的概率为“r”。
步骤 5:重复步骤 1 - 步骤 4 10 次。
例如，这看起来像这样：
第一步：假设随机选择n为4。选择了4个随机变量：num_var_2，num_var_5，factor_var_3, factor_var_4
步骤 2： 对于 num_var_2，选择 7 处的点。对于 num_var_5，选择了 19 处的一个点。对于 factor_var_3，选择了 2 个级别：“BBB”和“CCC”。对于 factor_var_4，3 级“AAAA”、“DDDD”、“EEEE”。
第三步：选择随机数0.25
第 4 步： SELECT * FROM my_table WHERE num_var_2 >7 & num_var_5 > 19 & factor_var_3 = "BBB, CCC" & factor_var_4 = "AAAA, DDDD, EEEE" 。对于未select编辑的列中的每一行（num_var_1、num_var_3、num_var_4、factor_var_1、factor_var_2、factor_var_5） ，该行中的每个元素现在有 25% 的机会被替换为 0。
步骤5：重复步骤1-步骤4，10次。在某些时候，可能会 selected 过去已被 0 替换的行。这不会有任何区别，因为 0 替换为 0 仍然是 0。
有人可以告诉我如何编写执行此操作的函数吗？
目前，我正在尝试手动执行此操作：
# 4 variables are selected
n = sample.int(10, 1)
[1] 4
# which 4 variables are selected (each number corresponds to their position):
sample.int(10, length(n))
[1] 6 2 1 4
num_var_1
num_var_2
num_var_4
factor_var_1
#select random points for the continuous variables
p1 <- runif(1, min(num_var_1), max(num_var_1))
p2 <- runif(1, min(num_var_2), max(num_var_2))
p4 <- runif(1, min(num_var_4), max(num_var_4))
#select random factor levels for the factor variable
nlevel = nlevels(factor_var_1)
nlevels = sample.int(nlevel, 1)
[1] 2
sample(factor_1, nlevels, replace=TRUE, prob=c(0.3, 0.5, 0.2))
[1] "A" "B"
#generate random probability number
r = runif(1,0,1)
[1] 0.4514667
#identify rows matching the above condition
identified_rows = my_data[which(my_data$num_var_1 > p1 & my_data$num_var_2 > p2 & my_data$num_var_4 > p4 & my_data$factor_var_1 %in% c("A", "B")), ]
> identified_rows
id 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
208 208 9.405383 15.53998 4.348425 29.87149 23.46945 B CC BBB DDDD DDDD
589 589 10.582991 18.84683 5.437036 31.53734 11.16494 B BB AAA BBBB CCCC
现在，对于第 208 行，其余 6 列（num_var_3、num_var_5、factor_var_2、factor_var_3、factor_var_4、factor_var_5) 将被替换为 0。对于第 589 行，其余 6 列中的任何一列 (num_var_3, num_var_5, factor_var_2, factor_var_3, factor_var_4, factor_var_5) 将替换为 0.
在此之后，我将再次重复整个过程 9 次。
这是一条很长的路要走 - 谁能帮我写一个函数来加快速度（例如重复 100 次）？
谢谢！
这是一个解决方案（我认为）。以下函数实现了您在上面概述的 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)
}
注意：0 不是有效的因子水平，因此此函数将在尝试将因子值替换为 0 时生成警告，而是将因子值替换为 NA .
使用上面提供的数据子集，这就是它的样子 运行 函数分别是 10 次和 100 次：
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
suppressWarnings(
head(
random_drop_recurse(my_data[, c(1:3, 6:8)], 100),
20
)
)
#> num_var_1 num_var_2 num_var_3 factor_var_1 factor_var_2 factor_var_3
#> 1 9.439524 0.00000 0.000000 B <NA> <NA>
#> 2 9.769823 0.00000 12.369379 B <NA> <NA>
#> 3 11.558708 0.00000 0.000000 <NA> <NA> BBB
#> 4 10.070508 0.00000 0.000000 B <NA> <NA>
#> 5 10.129288 0.00000 0.000000 B <NA> <NA>
#> 6 11.715065 0.00000 0.000000 B <NA> <NA>
#> 7 10.460916 0.00000 0.000000 C <NA> <NA>
#> 8 0.000000 22.08104 0.000000 <NA> AA <NA>
#> 9 9.313147 0.00000 0.000000 C <NA> <NA>
#> 10 0.000000 0.00000 0.000000 B AA AAA
#> 11 11.224082 0.00000 0.000000 <NA> <NA> AAA
#> 12 10.359814 0.00000 0.000000 A <NA> <NA>
#> 13 10.400771 0.00000 0.000000 A <NA> <NA>
#> 14 10.110683 0.00000 0.000000 B <NA> <NA>
#> 15 9.444159 0.00000 0.000000 A <NA> <NA>
#> 16 11.786913 0.00000 0.000000 B <NA> <NA>
#> 17 10.497850 0.00000 0.000000 B <NA> <NA>
#> 18 8.033383 0.00000 0.000000 B <NA> <NA>
#> 19 0.000000 0.00000 2.958597 B BB AAA
#> 20 9.527209 0.00000 0.000000 C <NA> BBB
我正在使用 R 编程语言。假设我有以下数据 ("my_data"):
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)))
id = 1:1000
my_data = data.frame(id,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)
> head(my_data)
id 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
1 1 9.439524 5.021006 4.883963 8.496925 11.965498 B AA AAA CCCC AAAA
2 2 9.769823 4.800225 12.369379 6.722429 16.501132 B AA AAA AAAA AAAA
3 3 11.558708 9.910099 4.584108 -4.481653 16.710042 C AA BBB AAAA CCCC
4 4 10.070508 9.339124 22.192276 3.027154 -2.841578 B CC DDD BBBB AAAA
5 5 10.129288 -2.746714 11.741359 35.984902 -10.261096 B AA AAA DDDD DDDD
6 6 11.715065 15.202867 3.847317 9.625850 32.053261 B AA CCC BBBB EEEE
我的问题： 鉴于上述数据集，我正在尝试创建一个函数（重复）以下列方式从上述数据集中删除随机行：
第 1 步： 数据集有 10 个变量 - 在第 1 步中，随机 select“n”个变量（“n”有小于 10).
第2步：对于上述"n"个变量，如果是"factor"，则随机select一个子集（大小为" m") 中每个因子变量的水平。对于每个非因子变量，在它们的最小值和最大值之间的一个点随机拆分它们（将此点称为“p”）。
第 3 步： 生成一个介于 0 和 1 之间的随机数（称之为“r”）。
第 4 步： Select 第 2 步中标识的所有行。对于这些行，考虑逻辑条件中未使用的列.对于这些列，这些行中的任何元素都可以用 0 替换的概率为“r”。
步骤 5:重复步骤 1 - 步骤 4 10 次。
例如，这看起来像这样：
第一步：假设随机选择n为4。选择了4个随机变量：num_var_2，num_var_5，factor_var_3, factor_var_4
步骤 2： 对于 num_var_2，选择 7 处的点。对于 num_var_5，选择了 19 处的一个点。对于 factor_var_3，选择了 2 个级别：“BBB”和“CCC”。对于 factor_var_4，3 级“AAAA”、“DDDD”、“EEEE”。
第三步：选择随机数0.25
第 4 步：
SELECT * FROM my_table WHERE num_var_2 >7 & num_var_5 > 19 & factor_var_3 = "BBB, CCC" & factor_var_4 = "AAAA, DDDD, EEEE"。对于未select编辑的列中的每一行（num_var_1、num_var_3、num_var_4、factor_var_1、factor_var_2、factor_var_5） ，该行中的每个元素现在有 25% 的机会被替换为 0。步骤5：重复步骤1-步骤4，10次。在某些时候，可能会 selected 过去已被 0 替换的行。这不会有任何区别，因为 0 替换为 0 仍然是 0。
有人可以告诉我如何编写执行此操作的函数吗？
目前，我正在尝试手动执行此操作：
# 4 variables are selected
n = sample.int(10, 1)
[1] 4
# which 4 variables are selected (each number corresponds to their position):
sample.int(10, length(n))
[1] 6 2 1 4
num_var_1
num_var_2
num_var_4
factor_var_1
#select random points for the continuous variables
p1 <- runif(1, min(num_var_1), max(num_var_1))
p2 <- runif(1, min(num_var_2), max(num_var_2))
p4 <- runif(1, min(num_var_4), max(num_var_4))
#select random factor levels for the factor variable
nlevel = nlevels(factor_var_1)
nlevels = sample.int(nlevel, 1)
[1] 2
sample(factor_1, nlevels, replace=TRUE, prob=c(0.3, 0.5, 0.2))
[1] "A" "B"
#generate random probability number
r = runif(1,0,1)
[1] 0.4514667
#identify rows matching the above condition
identified_rows = my_data[which(my_data$num_var_1 > p1 & my_data$num_var_2 > p2 & my_data$num_var_4 > p4 & my_data$factor_var_1 %in% c("A", "B")), ]
> identified_rows
id 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
208 208 9.405383 15.53998 4.348425 29.87149 23.46945 B CC BBB DDDD DDDD
589 589 10.582991 18.84683 5.437036 31.53734 11.16494 B BB AAA BBBB CCCC
现在，对于第 208 行，其余 6 列（num_var_3、num_var_5、factor_var_2、factor_var_3、factor_var_4、factor_var_5) 将被替换为 0。对于第 589 行，其余 6 列中的任何一列 (num_var_3, num_var_5, factor_var_2, factor_var_3, factor_var_4, factor_var_5) 将替换为 0.
在此之后，我将再次重复整个过程 9 次。
这是一条很长的路要走 - 谁能帮我写一个函数来加快速度（例如重复 100 次）？
谢谢！
这是一个解决方案（我认为）。以下函数实现了您在上面概述的 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)
}
注意：0 不是有效的因子水平，因此此函数将在尝试将因子值替换为 0 时生成警告，而是将因子值替换为 NA .
使用上面提供的数据子集，这就是它的样子 运行 函数分别是 10 次和 100 次：
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
suppressWarnings(
head(
random_drop_recurse(my_data[, c(1:3, 6:8)], 100),
20
)
)
#> num_var_1 num_var_2 num_var_3 factor_var_1 factor_var_2 factor_var_3
#> 1 9.439524 0.00000 0.000000 B <NA> <NA>
#> 2 9.769823 0.00000 12.369379 B <NA> <NA>
#> 3 11.558708 0.00000 0.000000 <NA> <NA> BBB
#> 4 10.070508 0.00000 0.000000 B <NA> <NA>
#> 5 10.129288 0.00000 0.000000 B <NA> <NA>
#> 6 11.715065 0.00000 0.000000 B <NA> <NA>
#> 7 10.460916 0.00000 0.000000 C <NA> <NA>
#> 8 0.000000 22.08104 0.000000 <NA> AA <NA>
#> 9 9.313147 0.00000 0.000000 C <NA> <NA>
#> 10 0.000000 0.00000 0.000000 B AA AAA
#> 11 11.224082 0.00000 0.000000 <NA> <NA> AAA
#> 12 10.359814 0.00000 0.000000 A <NA> <NA>
#> 13 10.400771 0.00000 0.000000 A <NA> <NA>
#> 14 10.110683 0.00000 0.000000 B <NA> <NA>
#> 15 9.444159 0.00000 0.000000 A <NA> <NA>
#> 16 11.786913 0.00000 0.000000 B <NA> <NA>
#> 17 10.497850 0.00000 0.000000 B <NA> <NA>
#> 18 8.033383 0.00000 0.000000 B <NA> <NA>
#> 19 0.000000 0.00000 2.958597 B BB AAA
#> 20 9.527209 0.00000 0.000000 C <NA> BBB