通过间接引用列修改数据框中的某些值
Modify certain values in a data frame by indirect reference to the columns
我正在争论一些数据，我们在这些数据中将失败分类到 bin 中，并按批次计算每个分类 bin 的有限产量。
我有一个元 table 描述了分类箱。 行按测试顺序升序排列，一些分类标签出现in 使用非句法名称。
sort_tbl <- tibble::tribble(~weight, ~label,
0, "fail A",
0, "fail B",
0, "fail C",
100, "pass")
> sort_tbl
# A tibble: 4 x 2
weight label
<dbl> <chr>
1 0 fail A
2 0 fail B
3 0 fail C
4 100 pass
我有一个数据 table 产量有限，按分类箱 每批一行一行，每个分类箱一列。因为这个 table 是从一个转置构造的，所以我们得到了一个特定排序从未发生过很多的实例，结果值为 NA。 请注意，此 table 中的列按测试顺序降序排列。
yld_tbl <- tibble::tribble( ~lot, ~pass, ~`fail C`, ~`fail B`, ~`fail A`,
"lot1", NA, NA, 0.00, NA,
"lot2", NA, 0.00, 0.80, NA,
"lot3", 0.49, NA, 0.50, 0.98,
"lot4", 0.70, 0.95, 0.74, 0.99)
> yld_tbl
# A tibble: 4 x 5
lot pass `fail C` `fail B` `fail A`
<chr> <dbl> <dbl> <dbl> <dbl>
1 lot1 NA NA 0.00 NA
2 lot2 NA 0.00 0.80 NA
3 lot3 0.49 NA 0.50 0.98
4 lot4 0.70 0.95 0.74 0.99
一些缺失值意味着 100% 的有限收益率，而另一些则反映了未定义的值，因为我们在流程的早期是零收益率。 我的任务是把之前的那组NA适当的替换成1.00。
如果随后的有限产量不是 NA，则从左到右（降序测试顺序）完成此工作的一种算法将 NA 替换为 1.00。在示例数据集的第一行中，我们不更改 fail C，因为缺少 pass。但是我们确实用 1.00 替换了 fail A 因为 fail B 没有丢失。
正确的示例输出为：
> fill_ones(yld_tbl, sort_tbl)
# A tibble: 4 x 5
lot pass `fail C` `fail B` `fail A`
<chr> <dbl> <dbl> <dbl> <dbl>
1 lot1 NA NA 0.00 1.00
2 lot2 NA 0.00 0.80 1.00
3 lot3 0.49 1.00 0.50 0.98
4 lot4 0.70 0.95 0.74 0.99
要生成输出 table 我编写了以下函数：
library(rlang)
library(dplyr)
fill_ones <- function(df, meta) {
fail_labels <- meta[meta$weight == 0, ]$label
last_val <- NULL
for ( i in length(fail_labels):1) {
if (is.null(last_val)) last_val <- df$pass
else last_val <- eval_tidy(sym(fail_labels[[i+1]]), df)
this_name <- sym(fail_labels[[i]])
this_val <- eval_tidy(this_name, df)
this_val[intersect(which(!is.na(last_val)), which(is.na(this_val)))] <- 1
df <- mutate(df, !!!new_definition(this_name, this_val))
}
df
}
此函数遍历 meta 中定义的失败排序并计算数据中相应列的更改 table df.
调用 sym(fail_labels[[i]]) 查找每一列的名称并 eval_tidy(..., df) 在数据框中提取相应的向量。
表达式 intersect(which(!is.na(last_val)), which(is.na(this_val))) 定义了 NA 的子集，它将被 1.00 替换。
使用 mutate() 用新值覆盖整个列。为了减少引用和取消引用的数量，我使用 new_definition() 而不是 :=.
我不相信我已经达到了间接引用数据中列的最简单语法 table。使用非句法名称没有帮助。此外，我们只需要修改有限数量的 NA，但此解决方案会逐列重写每个数据条目。我还没有想出一个好的语法来避免这种情况（不转向 data.table）。
如果有人有更好的方法，我很想听听。
如果你把它想成"first replace all the NAs with 1, then replace all 1s after the first 0 with NA."
，这个问题就会变得更容易一些
这里有两种方法，一种使用矩阵运算，一种使用 dplyr。
在矩阵方法中，您将值提取为数字矩阵，使用 apply 找到需要用 NA 替换的位置，然后 return 它们。
# extract as a matrix, with left-to-right bins
m <- as.matrix(yld_tbl[, sort_tbl$label])
# replace NAs with 1
m[is.na(m)] <- 1
# find 1s happening after a zero in each row
after_zero <- t(apply(m == 0, 1, cumsum)) & (m == 1)
# replace them with NA
m[after_zero] <- NA
# return them in the table
yld_tbl[, sort_tbl$label] <- m
使用 dplyr/tidyr，您首先 gather() 列（使用 arrange() 将它们按所需顺序排列），替换 NA（group_by/ mutate 完成与上面 apply 相同的事情），并且 spread 它们变回宽格式。
library(dplyr)
library(tidyr)
yld_tbl %>%
gather(label, value, -lot) %>%
arrange(lot, match(label, sort_tbl$label)) %>%
replace_na(list(value = 1)) %>%
group_by(lot) %>%
mutate(value = ifelse(cumsum(value == 0) > 0 & value == 1, NA, value)) %>%
spread(label, value)
请注意，与基于矩阵的方法不同，这不会保留列的顺序。
按照 OP 从左到右填充缺失的 1.00 的方法，可以使用 melt()、dcast() 和 rleid():
来实现
library(data.table)
mDT <- melt(setDT(yld_tbl), id.var = "lot")
mDT[
mDT[, grp := rleid(is.na(value)), by = lot][, .I[is.na(value) & grp > 1]]
, value := 1][
, dcast(.SD, lot ~ variable)]
lot pass fail C fail B fail A
1: lot1 NA NA 0.00 1.00
2: lot2 NA 0.00 0.80 1.00
3: lot3 0.49 1.00 0.50 0.98
4: lot4 0.70 0.95 0.74 0.99
5: lot5 0.95 0.95 1.00 1.00
数据
yld_tbl <- tibble::tribble( ~lot, ~pass, ~`fail C`, ~`fail B`, ~`fail A`,
"lot1", NA, NA, 0.00, NA,
"lot2", NA, 0.00, 0.80, NA,
"lot3", 0.49, NA, 0.50, 0.98,
"lot4", 0.70, 0.95, 0.74, 0.99,
"lot5", 0.95, 0.95, NA, NA)
注意附加的 "lot5" 行。
我正在争论一些数据，我们在这些数据中将失败分类到 bin 中，并按批次计算每个分类 bin 的有限产量。
我有一个元 table 描述了分类箱。 行按测试顺序升序排列，一些分类标签出现in 使用非句法名称。
sort_tbl <- tibble::tribble(~weight, ~label,
0, "fail A",
0, "fail B",
0, "fail C",
100, "pass")
> sort_tbl
# A tibble: 4 x 2
weight label
<dbl> <chr>
1 0 fail A
2 0 fail B
3 0 fail C
4 100 pass
我有一个数据 table 产量有限，按分类箱 每批一行一行，每个分类箱一列。因为这个 table 是从一个转置构造的，所以我们得到了一个特定排序从未发生过很多的实例，结果值为 NA。 请注意，此 table 中的列按测试顺序降序排列。
yld_tbl <- tibble::tribble( ~lot, ~pass, ~`fail C`, ~`fail B`, ~`fail A`,
"lot1", NA, NA, 0.00, NA,
"lot2", NA, 0.00, 0.80, NA,
"lot3", 0.49, NA, 0.50, 0.98,
"lot4", 0.70, 0.95, 0.74, 0.99)
> yld_tbl
# A tibble: 4 x 5
lot pass `fail C` `fail B` `fail A`
<chr> <dbl> <dbl> <dbl> <dbl>
1 lot1 NA NA 0.00 NA
2 lot2 NA 0.00 0.80 NA
3 lot3 0.49 NA 0.50 0.98
4 lot4 0.70 0.95 0.74 0.99
一些缺失值意味着 100% 的有限收益率，而另一些则反映了未定义的值，因为我们在流程的早期是零收益率。 我的任务是把之前的那组NA适当的替换成1.00。
如果随后的有限产量不是 NA，则从左到右（降序测试顺序）完成此工作的一种算法将 NA 替换为 1.00。在示例数据集的第一行中，我们不更改 fail C，因为缺少 pass。但是我们确实用 1.00 替换了 fail A 因为 fail B 没有丢失。
正确的示例输出为：
> fill_ones(yld_tbl, sort_tbl)
# A tibble: 4 x 5
lot pass `fail C` `fail B` `fail A`
<chr> <dbl> <dbl> <dbl> <dbl>
1 lot1 NA NA 0.00 1.00
2 lot2 NA 0.00 0.80 1.00
3 lot3 0.49 1.00 0.50 0.98
4 lot4 0.70 0.95 0.74 0.99
要生成输出 table 我编写了以下函数：
library(rlang)
library(dplyr)
fill_ones <- function(df, meta) {
fail_labels <- meta[meta$weight == 0, ]$label
last_val <- NULL
for ( i in length(fail_labels):1) {
if (is.null(last_val)) last_val <- df$pass
else last_val <- eval_tidy(sym(fail_labels[[i+1]]), df)
this_name <- sym(fail_labels[[i]])
this_val <- eval_tidy(this_name, df)
this_val[intersect(which(!is.na(last_val)), which(is.na(this_val)))] <- 1
df <- mutate(df, !!!new_definition(this_name, this_val))
}
df
}
此函数遍历 meta 中定义的失败排序并计算数据中相应列的更改 table df.
调用 sym(fail_labels[[i]]) 查找每一列的名称并 eval_tidy(..., df) 在数据框中提取相应的向量。
表达式 intersect(which(!is.na(last_val)), which(is.na(this_val))) 定义了 NA 的子集，它将被 1.00 替换。
使用 mutate() 用新值覆盖整个列。为了减少引用和取消引用的数量，我使用 new_definition() 而不是 :=.
我不相信我已经达到了间接引用数据中列的最简单语法 table。使用非句法名称没有帮助。此外，我们只需要修改有限数量的 NA，但此解决方案会逐列重写每个数据条目。我还没有想出一个好的语法来避免这种情况（不转向 data.table）。
如果有人有更好的方法，我很想听听。
如果你把它想成"first replace all the NAs with 1, then replace all 1s after the first 0 with NA."
，这个问题就会变得更容易一些这里有两种方法，一种使用矩阵运算，一种使用 dplyr。
在矩阵方法中，您将值提取为数字矩阵，使用 apply 找到需要用 NA 替换的位置，然后 return 它们。
# extract as a matrix, with left-to-right bins
m <- as.matrix(yld_tbl[, sort_tbl$label])
# replace NAs with 1
m[is.na(m)] <- 1
# find 1s happening after a zero in each row
after_zero <- t(apply(m == 0, 1, cumsum)) & (m == 1)
# replace them with NA
m[after_zero] <- NA
# return them in the table
yld_tbl[, sort_tbl$label] <- m
使用 dplyr/tidyr，您首先 gather() 列（使用 arrange() 将它们按所需顺序排列），替换 NA（group_by/ mutate 完成与上面 apply 相同的事情），并且 spread 它们变回宽格式。
library(dplyr)
library(tidyr)
yld_tbl %>%
gather(label, value, -lot) %>%
arrange(lot, match(label, sort_tbl$label)) %>%
replace_na(list(value = 1)) %>%
group_by(lot) %>%
mutate(value = ifelse(cumsum(value == 0) > 0 & value == 1, NA, value)) %>%
spread(label, value)
请注意，与基于矩阵的方法不同，这不会保留列的顺序。
按照 OP 从左到右填充缺失的 1.00 的方法，可以使用 melt()、dcast() 和 rleid():
library(data.table)
mDT <- melt(setDT(yld_tbl), id.var = "lot")
mDT[
mDT[, grp := rleid(is.na(value)), by = lot][, .I[is.na(value) & grp > 1]]
, value := 1][
, dcast(.SD, lot ~ variable)]
lot pass fail C fail B fail A 1: lot1 NA NA 0.00 1.00 2: lot2 NA 0.00 0.80 1.00 3: lot3 0.49 1.00 0.50 0.98 4: lot4 0.70 0.95 0.74 0.99 5: lot5 0.95 0.95 1.00 1.00
数据
yld_tbl <- tibble::tribble( ~lot, ~pass, ~`fail C`, ~`fail B`, ~`fail A`,
"lot1", NA, NA, 0.00, NA,
"lot2", NA, 0.00, 0.80, NA,
"lot3", 0.49, NA, 0.50, 0.98,
"lot4", 0.70, 0.95, 0.74, 0.99,
"lot5", 0.95, 0.95, NA, NA)
注意附加的 "lot5" 行。