1

我有一个与此类似的数据集：

data= data.frame(a=c(33,44,55), b= c(99,77,NA,66), 
      var1=c(1,2,3,NA),var2=c(5,6,NA,7),var3=c(8,9,10,NA), x = c(6,5,4,3))

我需要创建一个列，它为每一行输出列 var1、var2 和 var3 中最接近 x 列的值，忽略 var1:var3 中的 NA。

就像是：

closest_x
  5
  6
  3
  7

在我真正的问题中，我有比这更多的列，所以我想starts_with用来选择要与 X 比较的列（上面表示为“var1”等的列）。

我尝试使用 X 列和“var”列之间的模块化差异创建列，然后我尝试了类似的方法：

data %>% mutate(pmin = pmin(starts_with("var")))

或者

mutate(data, C = pmin(starts_with("var")))

并且

data %>% with(pmin(starts_with("var")))

它说未设置变量上下文。除此之外，如果我不必使用这种模数差异创建许多其他变量会更好，并直接使用最接近 X 列的值。

我在这篇文章中发现了一些非常接近我需要的内容： Closest value to a specific column in R

但是，我不知道如何应用与我的问题类似的东西，因为我有更多的列并且我只想选择那些以特定单词开头的列。

编辑：我需要将变量中的 NA 与要忽略的“x”进行比较。

编辑 2：我的真实数据集的代码过去运行良好。现在我尝试再次运行它，但它不能正常工作。我试图找出发生了什么变化，甚至是否有任何包发生了变化，但似乎并非如此。

下面有一个代码来生成我的真实数据的一个小样本。而不是 var1、var2 等。我有ideolparty_A:ideolparty_I，而不是x（要比较的变量）我有ideol_self.

max.col直到几个月前，该解决方案才有效，使用以下代码：


temp_df <- -abs(cses_pr[cols] - cses_pr$ideol_self)
cses_pr$closest <- cses_pr[cols][cbind(1:nrow(cses_pr), 
                                       max.col(replace(temp_df, is.na(temp_df), -Inf)))]

但现在它产生以下代码：Error: Subscript `cbind(...)` is a matrix, it must be of type logical.在我可以运行最后一行代码之前：

cses_pr <- cses_pr %>% mutate (cong_closest = abs(closest-ideol_self))

structure(list(election = c("PER_2000", "PER_2006", "PER_2006", 
"USA_2008", "MEX_2012", "ROU_1996", "MEX_2012", "TWN_2008", "USA_1996", 
"PER_2016", "ARG_2015", "FRA_2012", "MEX_2012", "SRB_2012", "USA_1996", 
"ROU_2014", "ROU_2004", "ROU_2009", "RUS_2000", "ROU_2014", "CHL_1999", 
"BRA_2006", "RUS_2004", "BRA_2002", "TWN_2012", "MEX_2012", "TWN_2008", 
"SRB_2012", "USA_2004", "BRA_2002", "PER_2000", "USA_2008", "ARG_2015", 
"FRA_2012", "PHL_2016", "TWN_2012", "LTU_1997", "URY_2009", "BRA_2006", 
"PER_2006", "MEX_2012", "CHL_1999", "BRA_2010", "PER_2016", "MEX_2000", 
"BRA_2002", "PER_2011", "ROU_2009", "FRA_2012", "TWN_2012", "FRA_2002", 
"PER_2000", "CHL_1999", "PER_2011", "MEX_2006", "ROU_2009", "ROU_1996", 
"BRA_2014", "ROU_1996", "ROU_2014", "ROU_2014", "FRA_2012", "PER_2016", 
"MEX_2006", "USA_2012", "ROU_2009", "ROU_2009", "BRA_2014", "KEN_2013", 
"PHL_2016", "BLR_2001", "BRA_2006", "PER_2016", "FRA_2012", "CHL_2005", 
"CHL_2009", "LTU_1997", "RUS_2000", "ROU_2014", "TWN_2012", "BRA_2006", 
"USA_2008", "USA_2004", "MEX_2012", "ROU_2004", "TWN_2012", "BRA_2014", 
"USA_2008", "TWN_2004", "PER_2000", "MEX_2006", "PHL_2004", "BRA_2002", 
"PER_2011", "CHL_2005", "PER_2006", "RUS_2000", "ARG_2015", "BRA_2010", 
"TWN_2012", "MEX_2006", "ARG_2015", "BRA_2014", "TWN_2004", "BRA_2006", 
"PER_2016", "PHL_2016", "URY_2009", "RUS_2000", "PER_2006", "FRA_2002", 
"BRA_2002", "KEN_2013", "RUS_2004", "PER_2006", "TWN_2012", "PER_2011", 
"PHL_2010", "PER_2006", "FRA_2012", "PHL_2016", "MEX_2000", "RUS_2000", 
"TWN_2004", "BRA_2002", "ARG_2015", "FRA_2012"), ideol_self = c(10, 
NA, 0, 6, 10, NA, 5, 5, 8, 2, 5, 5, 3, NA, 3, 5, 5, 10, 5, NA, 
10, 3, 6, 6, NA, NA, 5, 10, 5, 5, NA, NA, NA, 2, 5, NA, 10, 8, 
5, 6, 10, 5, 10, 0, 10, 3, NA, 9, 5, NA, 10, 6, 5, 7, NA, 6, 
NA, NA, NA, 9, NA, 2, 9, 10, 10, NA, 5, 7, NA, 8, NA, 8, NA, 
5, 6, 0, 6, 0, 7, NA, NA, 3, 2, NA, 7, NA, 4, 1, 4, NA, 6, 6, 
NA, 4, NA, 10, 5, 9, NA, NA, 1, 5, NA, 5, 3, 7, 3, 3, 0, 8, 4, 
0, 5, 6, 5, NA, 6, 10, NA, 7, 7, NA, 3, NA, NA, 4, 1), ideolparty_A = c(5, 
5, 0, 7, 10, NA, NA, 5, NA, 2, 3, 2, 9, 9, NA, 9, 0, 10, NA, 
NA, NA, 6, 7, 2, NA, 9, NA, 8, 7, 6, 5, NA, NA, 0, 8, NA, NA, 
2, NA, 5, 10, NA, 0, NA, 0, 4, NA, 8, 2, NA, 5, 3, NA, 3, 10, 
6, NA, NA, NA, 2, NA, 4, 10, 0, 10, NA, 10, NA, NA, 6, NA, 4, 
NA, 3, 10, 10, NA, NA, 1, NA, NA, 6, 10, NA, 3, NA, NA, 1, 2, 
NA, 8, 6, 3, 3, NA, 7, NA, 9, 6, NA, 10, 4, NA, 3, 7, 6, 5, 3, 
NA, 1, 7, 1, 10, 7, NA, NA, 0, 0, 2, 1, 9, NA, NA, NA, 8, 5, 
1), ideolparty_B = c(9, 5, 10, 5, 1, NA, NA, 5, NA, 7, 6.5, 8, 
1, 5, NA, 5, 10, 0, NA, NA, NA, 6, 2, 7, NA, 9, NA, 6, 5, 4, 
8, NA, NA, 10, 10, NA, NA, 9, NA, 4, 10, NA, 10, NA, 0, 6, NA, 
9, 5, NA, 10, 0, NA, 5, 6, 3, NA, NA, NA, 9, NA, 8, 6, 0, 0, 
NA, 0, NA, NA, 7, NA, 2, NA, 7, 8, 10, NA, NA, 10, NA, NA, 4, 
4, NA, 8, NA, NA, 10, 8, NA, 4, 7, NA, 5, NA, 8, NA, 2.5, 7, 
NA, 0, 8.5, NA, 5, 1, 8, 4, 10, NA, 10, 10, 6, 4, 0, NA, NA, 
4, 10, 0, 8, 1, NA, NA, NA, 10, 8.5, 8), ideolparty_C = c(7, 
7, 10, NA, 1, NA, NA, NA, NA, 2, 5, 3, 0, 0, NA, 8, 10, 0, NA, 
NA, NA, 6, 2, 0, NA, 2, NA, 2, NA, 4, 4, NA, NA, 7, NA, NA, 10, 
5, NA, 4, 0, NA, 7, 0, 10, 2, NA, 9, 10, NA, 3, NA, NA, 5, 10, 
7, NA, NA, NA, 3, NA, 10, 0, 10, NA, NA, 10, NA, NA, NA, NA, 
8, NA, 8, 6, 5, 8, NA, NA, NA, NA, NA, 9, NA, 9, NA, NA, NA, 
7, NA, 5, 6, NA, 7, NA, 0, NA, 4, 3, NA, 0, 4, NA, 6, 7, 0, NA, 
10, NA, 1, 5, NA, 8, 0, NA, NA, 7, 10, 8, 10, NA, NA, NA, NA, 
NA, 6, 10), ideolparty_D = c(7, 6, NA, NA, NA, NA, NA, NA, NA, 
5, NA, 3, 9, 6, NA, NA, 0, 0, NA, NA, NA, 6, 4, 8, NA, 9, NA, 
5, NA, 4, 3, NA, NA, 4, 3, NA, 4, NA, NA, 1, 10, NA, NA, NA, 
10, 7, NA, 3, 2, NA, 7, 0, NA, 6, 7, 0, NA, NA, NA, 2, NA, 2, 
9, 0, NA, NA, 5, NA, NA, 7, NA, 6, NA, 3, 10, 5, 6, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, 3, NA, 5, 5, NA, 7, NA, 0, NA, 
NA, NA, NA, 0, NA, NA, 4, 10, 8, 5, 10, NA, 1, 9, 2, 2, 5, NA, 
NA, 10, 10, NA, 1, 0, NA, NA, NA, NA, NA, 0), ideolparty_E = c(5, 
5, 0, NA, 1, NA, NA, NA, NA, NA, NA, 5, 0, NA, NA, 9, 10, 10, 
NA, NA, NA, 6, 4, NA, NA, 2, NA, 1, NA, NA, 4, NA, NA, 5, 3, 
NA, 8, NA, NA, 0, 0, NA, 10, NA, 0, NA, NA, 6, 5, NA, NA, 0, 
NA, 5, 5, NA, NA, NA, NA, 3, NA, NA, NA, 0, NA, NA, 5, NA, NA, 
7, NA, 4, NA, 4, 5, 2, 6, NA, 10, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, 3, NA, 2, 4, NA, 7, NA, 8, NA, 5, NA, NA, 0, 7, NA, 3, 
5, NA, 4, 3, NA, 2, 1, NA, NA, 10, NA, NA, 5, 0, 0, 2, 9, NA, 
NA, NA, NA, 4, 8), ideolparty_F = c(7, 5, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, 5, 0, 4, NA, 1, 10, NA, NA, NA, NA, 6, 4, NA, 
NA, 8, NA, 7, NA, NA, 6, NA, NA, 5, 4, NA, NA, NA, NA, NA, 10, 
NA, NA, NA, 0, NA, NA, NA, 5, NA, NA, 3, NA, 7, 8, NA, NA, NA, 
NA, 2, NA, 5, 6, 0, NA, NA, NA, NA, NA, 6, NA, 8, NA, 6, 1, NA, 
NA, NA, 6, NA, NA, NA, NA, NA, 2, NA, NA, NA, NA, NA, 5, 5, NA, 
10, NA, 0, NA, NA, NA, NA, 0, NA, NA, NA, 7, 3, 3, NA, NA, 1, 
7, NA, NA, 5, NA, NA, 2, 5, NA, 1, 2, NA, NA, NA, NA, NA, 2), 
    ideolparty_G = c(NA, 7, NA, NA, NA, NA, NA, NA, NA, NA, 7, 
    NA, 0, 7, NA, NA, NA, 0, NA, NA, NA, NA, NA, 7, NA, 2, NA, 
    0, NA, 4, NA, NA, NA, NA, NA, NA, 4, NA, NA, NA, 0, NA, NA, 
    NA, NA, 6, NA, 8, NA, NA, 2, NA, NA, NA, 8, NA, NA, NA, NA, 
    NA, NA, NA, 4, 0, NA, NA, 5, NA, NA, NA, NA, NA, NA, NA, 
    NA, 1, 6, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA, NA, NA, NA, 0, NA, 0, NA, NA, 0, 10, NA, NA, 
    NA, 2, NA, NA, NA, 1, 3, 6, NA, NA, NA, NA, NA, NA, 0, NA, 
    NA, NA, NA, NA, 10, 8, NA), ideolparty_H = c(NA, NA, NA, 
    NA, NA, NA, NA, NA, NA, NA, 6, NA, NA, NA, NA, NA, 0, NA, 
    NA, NA, NA, NA, NA, 1, NA, NA, NA, NA, NA, 3, NA, NA, NA, 
    NA, NA, NA, 0, NA, NA, NA, NA, NA, 0, NA, NA, 1, NA, NA, 
    NA, NA, 5, NA, NA, NA, 7, NA, NA, NA, NA, NA, NA, NA, NA, 
    0, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 2, NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA, NA, 5, 3, NA, 0, 7, NA, NA, NA, NA, NA, NA, NA, 
    NA, 8, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, 9, NA), ideolparty_I = c(NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA, 4, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 10, NA, 2, 
    NA, NA, NA, NA, NA, 0, NA, NA, NA, NA, NA, NA, NA, 0, NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    NA, NA, 7, NA, NA, NA, NA, NA, NA, 10, NA, NA, NA, NA, NA, 
    NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
    9, NA, NA, NA, 4, NA, NA, NA, NA, 5, NA, NA, NA, 1, NA, NA, 
    NA, NA, NA, NA, 4, NA, NA, 2, NA, NA, NA, NA, 6, NA)), row.names = c(NA, 
-127L), class = c("tbl_df", "tbl", "data.frame"))
4

2 回答 2

4

这是一种使用矢量化的方式max.col

cols <- grep("^var", names(data))
data$closest_x <- data[cols][cbind(1:nrow(data), 
                      max.col(-abs(data[cols] - data$x)))]

#   a  b var1 var2 var3  x closest_x
#1 33 99   24   15   45 11        15
#2 44 77   12   30   27 22        27
#3 55 66   76   20   15 33        20

或使用apply

data$closest_x <- apply(data, 1, function(p) 
                  p[cols][which.min(abs(p[cols] - p["x"]))])

如果数据中有NA值，我们可以将它们替换为-Inf然后子集

temp_df <- -abs(data[cols] - data$x)
data$closest_x <- data[cols][cbind(1:nrow(data), 
                   max.col(replace(temp_df, is.na(temp_df), -Inf)))]
于 2019-07-01T02:35:50.587 回答
1

“整洁”的方法

一个更“整洁”的解决方案可能是这些方面的东西。

data %>%

    # reshape data to long format w/ row numbers
    mutate(row = row_number()) %>%
    gather(col, val, starts_with('var')) %>%

    # compute the minimum difference row-by-row
    group_by(row) %>%
    summarize(closest_to_x = val[which.min(abs(val - x))]) %>%

    # the next two lines just take the new column and paste it back onto the original data
    select(closest_to_x) %>%
    bind_cols(data, .)

它有点冗长，但我觉得它相当易读（当然是 YMMV）。不确定性能。它不使用max.col()or pmin()，而是依赖于将数据重新格式化为“整洁”的格式，其中您关心的所有列的值都放入单个val列中。

于 2019-07-01T23:29:08.667 回答