在已有的8个栏目基础上新建4个栏目

Question

下面你可以看到我的数据的复制样本。

DATA <- structure(list(ID = c("101", "101", "101", "101", "101", "101","101", "101", "101", "101"), IDA = c("1", "1", "2", "3", "4","5", "5", "1859", "1860", "1861"), DATE = structure(c(1300928400,1277946000, 1277946000, 1278550800, 1278550800, 1453770000, 1329958800,1506474000, 1485133200, 1485133200), tzone = "UTC", class = c("POSIXct","POSIXt")), NR = c("CH-0001", "CH-0001","CH-0002", "CH-0003", "CH-0004", "CH-0005","CH-0005", "CH-1859", "CH-1860", "CH-1861"), PAT = c("101-1", "101-1", "101-2", "101-3", "101-4", "101-5","101-5", "101-1859", "101-1860", "101-1861"), INT1 = c(245005,280040, 280040, 280040, 280040, 240040, 240040, NA, NA, NA),INT2 = c(NA_real_, NA_real_, NA_real_, NA_real_, NA_real_,NA_real_, NA_real_, NA_real_, NA_real_, NA_real_), INT3 = c(NA_real_,NA_real_, 280010, NA_real_, NA_real_, NA_real_, NA_real_,NA_real_, 245035, NA_real_), INT4 = c(NA_real_, NA_real_,NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, NA_real_,NA_real_, NA_real_), INTX1 = c(NA_real_, 275040, NA_real_,NA_real_, NA_real_, NA_real_, 240080, NA_real_, NA_real_,NA_real_), INTX2 = c(276790, NA_real_, 7612645, NA_real_,NA_real_, NA_real_, 5078219, NA_real_, NA_real_, NA_real_), INTX173 = c(NA_real_, NA_real_, NA_real_, 3456878,NA_real_, NA_real_, 3289778, NA_real_, NA_real_, NA_real_), INTX4 = c(NA_real_, NA_real_, 11198767, NA_real_,NA_real_, NA_real_, NA_real_, NA_real_, NA_real_, 7025676), KAT = c(0, 0, 0, 0, 0, 0, 0, 1, 1, 1)), row.names = c(NA,-10L), class = c("tbl_df", "tbl", "data.frame"))

如您所见，我有八列，名称为：INT1:INT4 和 INTX1:INTX4。对于每一行，这些变量最多只有四个值，其余为 NA。我需要创建四个名为 ING1:ING4 的新变量，并告诉 R 每行逐一检查 8 列，并将它在该行中找到的第一个值分配给 ING1，第二个值分配给 ING2，第三个值分配给 ING3，然后ING4 的第四个值。最后，对于一行，所有或部分 ING1:ING4 列可能都填充了值。 我希望第 1 行得到以下 ING 列：

ING1 == 245005, ING2 == 276790, ING3 == NA, ING4 ==NA

我想我需要为此编写一个循环，但由于我是初学者，所以我不知道该怎么做。你能帮我吗？

Answer 1

试试这个：

fun <- function(select, prefix = "ING", ncol = -1, data = cur_data()) {
  select <- substitute(select)
  out <- asplit(t(
    apply(subset(data, select = eval(select)), 1, function(z) z[order(is.na(z))])
    ), 2)
  names(out) <- paste0(prefix, seq_along(out))
  if (ncol > 0) out <- out[seq_len(ncol)]
  do.call(data.frame, out)
}

零件：

• apply(.., MARGIN=1, fun)

  将在数据的每个

  row

  (fun) 上调用函数

  MARGIN=1

  。
• 当跨行应用函数时，

  apply

  返回一个看似转置的矩阵，所以我们

  t

  将它转置回我们期望的暗淡
• 最终我们需要返回值是一个列表（每个元素一列/向量），所以我们从

  t(apply(...))

  和

  asplit

  中按列获取矩阵（好吧，所以也许我可以删除

  t

  和只是

  asplit

  行...... *耸肩*）

• substitute(select)

  和

  eval(select)

  部分是为了促进我们调用它的“整洁选择”性质，例如，

  INT1:INT4

• out[seq_len(ncol)]

  将结果过滤到由

  ncol=

  参数设置的前四列（我们使用

  ncol=4

  ）

它的用途：

dplyr

library(dplyr)
DATA %>%
  mutate(fun(INT1:INTX4, ncol=4))
# # A tibble: 10 × 18
#    ID    IDA   DATE                    NR      PAT        INT1  INT2   INT3  INT4  INTX1   INTX2 INTX173    INTX4   KAT    ING1    ING2    ING3     ING4
#    <chr> <chr> <dttm>                  <chr>   <chr>     <dbl> <dbl>  <dbl> <dbl>  <dbl>   <dbl>   <dbl>    <dbl> <dbl>   <dbl>   <dbl>   <dbl>    <dbl>
#  1 101   1     2011-03-24 01:00:00.000 CH-0001 101-1    245005    NA     NA    NA     NA  276790      NA       NA     0  245005  276790      NA       NA
#  2 101   1     2010-07-01 01:00:00.000 CH-0001 101-1    280040    NA     NA    NA 275040      NA      NA       NA     0  280040  275040      NA       NA
#  3 101   2     2010-07-01 01:00:00.000 CH-0002 101-2    280040    NA 280010    NA     NA 7612645      NA 11198767     0  280040  280010 7612645 11198767
#  4 101   3     2010-07-08 01:00:00.000 CH-0003 101-3    280040    NA     NA    NA     NA      NA 3456878       NA     0  280040 3456878      NA       NA
#  5 101   4     2010-07-08 01:00:00.000 CH-0004 101-4    280040    NA     NA    NA     NA      NA      NA       NA     0  280040      NA      NA       NA
#  6 101   5     2016-01-26 01:00:00.000 CH-0005 101-5    240040    NA     NA    NA     NA      NA      NA       NA     0  240040      NA      NA       NA
#  7 101   5     2012-02-23 01:00:00.000 CH-0005 101-5    240040    NA     NA    NA 240080 5078219 3289778       NA     0  240040  240080 5078219  3289778
#  8 101   1859  2017-09-27 01:00:00.000 CH-1859 101-1859     NA    NA     NA    NA     NA      NA      NA       NA     1      NA      NA      NA       NA
#  9 101   1860  2017-01-23 01:00:00.000 CH-1860 101-1860     NA    NA 245035    NA     NA      NA      NA       NA     1  245035      NA      NA       NA
# 10 101   1861  2017-01-23 01:00:00.000 CH-1861 101-1861     NA    NA     NA    NA     NA      NA      NA  7025676     1 7025676      NA      NA       NA

基础R

cbind(DATA, fun(data = DATA, INT1:INTX4, ncol=4))
#     ID  IDA                DATE      NR      PAT   INT1 INT2   INT3 INT4  INTX1   INTX2 INTX173    INTX4 KAT    ING1    ING2    ING3     ING4
# 1  101    1 2011-03-24 01:00:00 CH-0001    101-1 245005   NA     NA   NA     NA  276790      NA       NA   0  245005  276790      NA       NA
# 2  101    1 2010-07-01 01:00:00 CH-0001    101-1 280040   NA     NA   NA 275040      NA      NA       NA   0  280040  275040      NA       NA
# 3  101    2 2010-07-01 01:00:00 CH-0002    101-2 280040   NA 280010   NA     NA 7612645      NA 11198767   0  280040  280010 7612645 11198767
# 4  101    3 2010-07-08 01:00:00 CH-0003    101-3 280040   NA     NA   NA     NA      NA 3456878       NA   0  280040 3456878      NA       NA
# 5  101    4 2010-07-08 01:00:00 CH-0004    101-4 280040   NA     NA   NA     NA      NA      NA       NA   0  280040      NA      NA       NA
# 6  101    5 2016-01-26 01:00:00 CH-0005    101-5 240040   NA     NA   NA     NA      NA      NA       NA   0  240040      NA      NA       NA
# 7  101    5 2012-02-23 01:00:00 CH-0005    101-5 240040   NA     NA   NA 240080 5078219 3289778       NA   0  240040  240080 5078219  3289778
# 8  101 1859 2017-09-27 01:00:00 CH-1859 101-1859     NA   NA     NA   NA     NA      NA      NA       NA   1      NA      NA      NA       NA
# 9  101 1860 2017-01-23 01:00:00 CH-1860 101-1860     NA   NA 245035   NA     NA      NA      NA       NA   1  245035      NA      NA       NA
# 10 101 1861 2017-01-23 01:00:00 CH-1861 101-1861     NA   NA     NA   NA     NA      NA      NA  7025676   1 7025676      NA      NA       NA

编辑仅按

NA

-ness排序，保留非空值的原始顺序。