R;对于 A 列中的每个级别，替换 B 列中的值，遵循 C 列中的条件

Question

我有 N 个地点的物种观察列表。观察结果是存在、不存在或未知 (1, 0, 'na')。我需要做的是，对于每个物种，满足条件：

对于每个 SITE，如果没有 1 %in% SITE，则将所有 0 替换为 'na'

我已经使用嵌套循环和列表管理了一个解决方法，但这似乎非常低效。与列中匹配值有关的一些问题提供了更优雅的解决方案，但我无法将它们应用于更复杂的设置。

这是一些虚拟数据：

x <- c(1,2,3,4,5,6,7,8,9,10)
site <- c(1,1,1,2,2,2,3,3,3,1)
sp1 <- factor(c(1,1,'na','na',0,0,'na','na','na',0))
sp2 <- factor(c(0,0,1,1,'na','na',0,1,'na','na'))
table <- cbind.data.frame(x,site,sp1,sp2)

我做了什么：

for (j in c(3:4)){
  site.present <- unique(table$site[which(table[,j]==1)])
  for (i in (1:length(table[,j]))) {
    ifelse(!(table[i,2]%in%site.present), 
           ifelse(table[i,j]==0,table[i,j]<-'na',T),T)
  }
}

在此示例中，[5,3] 和 [6,3] 应变为“na”而不是 0（因为 sp1 在站点 2 中不存在）。上面的代码有效，但处理数百万个条目似乎很愚蠢......

非常感谢！

Answer 1

使用 dplyr 和 base::replace。我们可以用 NA 替换任何零，其中该站点中没有物种等于 1。

library(dplyr)
df <- table

df %>% mutate_all(~as.numeric(as.character(.))) %>% 
       group_by(site) %>% 
       #mutate(sp1_mod=replace(sp1,all(sp1!=1, na.rm = TRUE) & sp1==0,NA)) #for one column
       mutate_at(vars('sp1','sp2'), list(~replace(.,all(.!=1, na.rm = TRUE) & .==0,NA))) 

此外，我们可以使用 Select helpers 之一，而不是一一命名vars 中的变量，参见?dplyr::select，例如我们可以使用matches 匹配任何以 sp 开头并带有一个或多个数字的列名

mutate_at(vars(matches('sp\\d+')), list(~replace(.,any(.==1, na.rm = TRUE) & .==0,NA)))

Answer 2

这是你要找的吗？

library(dplyr)

table %>%
  group_by(site) %>%
  mutate(sp1 = if_else(
    !any(sp1 == 1) & sp1 == 0,
    "na",
    as.character(sp1)
  ))

Answer 3

如果我的理解正确，您需要一个紧凑且快速的解决方案，可以同时应用于从 1 到 n 个物种的整个范围。

我会先reshape将数据设置为长格式，然后使用bysp*设置NA，如果它是每个c(0, NA)的元素site .第三，我们可以选择reshape 回到原来的大格式。

tmp <- reshape(dat, varying=list(3:ncol(dat)), v.names="sp", idvar=1:2, direction="long")
tmp <- do.call(rbind, by(tmp, tmp[c("site", "time")], function(x)
  if (all(x$sp %in% c(0, NA))) cbind(x[-4], sp=NA) else x))
dat <- reshape(tmp, timevar="time", idvar=c("x", "site"), direction="wide", sep="")
dat
#         x site  sp1  sp2
# 1.1.1   1    1    1    0
# 2.1.1   2    1    1    0
# 3.1.1   3    1 <NA>    1
# 10.1.1 10    1    0 <NA>
# 4.2.1   4    2 <NA>    1
# 5.2.1   5    2 <NA> <NA>
# 6.2.1   6    2 <NA> <NA>
# 7.3.1   7    3 <NA>    0
# 8.3.1   8    3 <NA>    1
# 9.3.1   9    3 <NA> <NA>

如果我们想要更快的速度，我们可以使用 data.table 包中的 melt 和 dcast 进行重塑过程，这几乎可以将速度提高一倍。代码略有改动：

library(data.table)
tmp <- melt(dat, id.vars=c("x", "site"), variable.name="time", value.name="sp")
tmp <- do.call(rbind, by(tmp, tmp[c("site", "time")], function(x)
  if (all(x$sp %in% c(0, NA))) cbind(x[-4], sp=NA) else x))
dcast(tmp, x + site ~ time, value.var="sp")

要测试两者是否有效，请将数据集扩展为 Zoraptera 物种的数量，即 28，然后再次运行代码：

set.seed(42)
n <- 28 - 2
add <- setNames(as.data.frame(
  replicate(n, factor(sample(c(1, 0, NA), nrow(dat), replace=TRUE)))), 
  paste0("sp", 3:(n + 2)))
dat <- cbind(dat, add)

数据

# I'd rather use a neutral name for the data, since `table` is a function name, see `?table`
dat <- structure(list(x = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), site = c(1, 
1, 1, 2, 2, 2, 3, 3, 3, 1), sp1 = structure(c(2L, 2L, 3L, 3L, 
1L, 1L, 3L, 3L, 3L, 1L), .Label = c("0", "1", "na"), class = "factor"), 
    sp2 = structure(c(1L, 1L, 2L, 2L, 3L, 3L, 1L, 2L, 3L, 3L), .Label = c("0", 
    "1", "na"), class = "factor")), class = "data.frame", row.names = c(NA, 
-10L))

# first thing to do is make proper NAs!
levels(dat$sp1) <- levels(dat$sp2) <- c(0, 1, NA)