使用 R 中的 IF 语句将 NA 值分配给数值变量答案

【问题标题】：Assign an NA value to a numeric variable using IF statement in R使用 R 中的 IF 语句将 NA 值分配给数值变量
【发布时间】：2021-04-16 23:48:03
【问题描述】：

我有一个函数可以计算 2 个数据集中的行之间的差异（基于相同的列）。这是一个示例和函数

#################
##   Sample    ##
#################

# data frame for recipients

IDr= c(seq(1,4))
Blood_type_r=c("A","B","AB","O")
data_R=data.frame(IDr,Blood_type_r,A=rep(0,4),B=c(rep(0,3),1),C=c(rep(1,3),0),D=rep(1,4),E=c(rep(0,2),rep(1,1),0),stringsAsFactors=FALSE)

  data_R
  IDr Blood_type_r A B C D E
1   1            A 0 0 1 1 0
2   2            B 0 0 1 1 0
3   3           AB 0 0 1 1 1
4   4            O 0 1 0 1 0

# data frame for donors 

IDd= c(seq(1,8))
Blood_type_d= c(rep("A", each=2),rep("B", each=2),rep("AB", each=2),rep("O", each=2))
WD= c(rep(0.25, each=2),rep(0.125, each=2),rep(0.125, each=2),rep(0.5, each=2))
data_D=data.frame(IDd,Blood_type_d,A=c(rep(0,6),1,1),B=c(rep(0,6),1,1),C=c(rep(1,7),0),D=rep(1,8),E=c(rep(0,6),rep(1,1),0),WD,stringsAsFactors=FALSE)
  data_D
  IDd Blood_type_d A B C D E    WD
1   1            A 0 0 1 1 0 0.250
2   2            A 0 0 1 1 0 0.250
3   3            B 0 0 1 1 0 0.125
4   4            B 0 0 1 1 0 0.125
5   5           AB 0 0 1 1 0 0.125
6   6           AB 0 0 1 1 0 0.125
7   7            O 1 1 1 1 1 0.500
8   8            O 1 1 0 1 0 0.500

# function
soustraction.i=function(D,R,i,threshold){
  D=as.data.frame(D)
  R=as.data.frame(R)
  dif=map2_df(D, R[i,], `-`)
  dif[dif<0] = 0
  dif$mismatch=rowSums(dif)
  dif=dif[which(dif$mismatch <= threshold),]
  return(dif)
  
}

 soustraction.i(data_D[,3:7],data_R[,3:7],1,3)
# A tibble: 8 x 6
      A     B     C     D     E mismatch
  <dbl> <dbl> <dbl> <dbl> <dbl>    <dbl>
1     0     0     0     0     0        0
2     0     0     0     0     0        0
3     0     0     0     0     0        0
4     0     0     0     0     0        0
5     0     0     0     0     0        0
6     0     0     0     0     0        0
7     1     1     0     0     1        3
8     1     1     0     0     0        2

我想要做的是当我将阈值设置为0 并且我的mismatch 大于0 时，我不想让这些患者失去，而是我想保留他们并分配一个@987654325 @值，例如，如果我将阈值设置为0，我会得到

soustraction.i(data_D[,3:7],data_R[,3:7],1,0)
# A tibble: 6 x 6
      A     B     C     D     E mismatch
  <dbl> <dbl> <dbl> <dbl> <dbl>    <dbl>
1     0     0     0     0     0        0
2     0     0     0     0     0        0
3     0     0     0     0     0        0
4     0     0     0     0     0        0
5     0     0     0     0     0        0
6     0     0     0     0     0        0

我失去了 2 名患者，我想分配一个 NA 值。所以输出将是

# Desired output 
# A tibble: 8 x 6
      A     B     C     D     E mismatch
  <dbl> <dbl> <dbl> <dbl> <dbl>    <dbl>
1     0     0     0     0     0        0
2     0     0     0     0     0        0
3     0     0     0     0     0        0
4     0     0     0     0     0        0
5     0     0     0     0     0        0
6     0     0     0     0     0        0
7     1     1     0     0     1        NA
8     1     1     0     0     0        NA

这是我迄今为止尝试过的，它给了我一个警告，但没有做正确的事情

soustraction.j=function(D,R,i,threshold){
  D=as.data.frame(D)
  R=as.data.frame(R)
  dif=map2_df(D, R[i,], `-`)
  dif[dif<0] = 0
  dif$mismatch=rowSums(dif)
  if(threshold==0){
    if(dif$mismatch > 0){
      dif$mismatch= NA
    }
  }else{
    dif=dif[which(dif$mismatch <= threshold),]
  }
 
  return(dif)
  
}
soustraction.j(data_D[,3:7],data_R[,3:7],1,0)
# A tibble: 8 x 6
      A     B     C     D     E mismatch
  <dbl> <dbl> <dbl> <dbl> <dbl>    <dbl>
1     0     0     0     0     0        0
2     0     0     0     0     0        0
3     0     0     0     0     0        0
4     0     0     0     0     0        0
5     0     0     0     0     0        0
6     0     0     0     0     0        0
7     1     1     0     0     1        3
8     1     1     0     0     0        2

#Warning message:
#In if (dif$mismatch > 0) { :
 # the condition has length > 1 and only the first element will be used

提前感谢您的帮助

【问题讨论】：

标签： r if-statement na

【解决方案1】：

您可以将它们分配给NA，而不是获取行的子集，其中mismatch 大于threshold。

soustraction.i=function(D,R,i,threshold){
  D=as.data.frame(D)
  R=as.data.frame(R)
  dif= purrr::map2_df(D, R[i,], `-`)
  dif[dif<0] = 0
  dif$mismatch=rowSums(dif)
  dif$mismatch[dif$mismatch > threshold] <- NA
  return(dif)
}

你可以检查输出：

soustraction.i(data_D[,3:7],data_R[,3:7],1,3)
# A tibble: 8 x 6
#      A     B     C     D     E mismatch
#  <dbl> <dbl> <dbl> <dbl> <dbl>    <dbl>
#1     0     0     0     0     0        0
#2     0     0     0     0     0        0
#3     0     0     0     0     0        0
#4     0     0     0     0     0        0
#5     0     0     0     0     0        0
#6     0     0     0     0     0        0
#7     1     1     0     0     1        3
#8     1     1     0     0     0        2

soustraction.i(data_D[,3:7],data_R[,3:7],1,0)
# A tibble: 8 x 6
#      A     B     C     D     E mismatch
#  <dbl> <dbl> <dbl> <dbl> <dbl>    <dbl>
#1     0     0     0     0     0        0
#2     0     0     0     0     0        0
#3     0     0     0     0     0        0
#4     0     0     0     0     0        0
#5     0     0     0     0     0        0
#6     0     0     0     0     0        0
#7     1     1     0     0     1       NA
#8     1     1     0     0     0       NA

【讨论】：

【解决方案2】：

这是一个dplyr 解决方案。它应该适用于 threshold == 0 并推广到其他阈值：

soustraction.i=function(D,R,i,threshold){
  D=as.data.frame(D)
  R=as.data.frame(R)
  dif=map2_df(D, R[i,], `-`)
  dif[dif<0] = 0
  dif$mismatch=rowSums(dif)
  dif <- dif %>%
    mutate(mismatch = case_when(mismatch > threshold ~ NA_real_,
                                TRUE ~ mismatch))
return(dif)
}

输出：

soustraction.i(data_D[,3:7],data_R[,3:7],1,0)

# A tibble: 8 x 6
      A     B     C     D     E mismatch
  <dbl> <dbl> <dbl> <dbl> <dbl>    <dbl>
1     0     0     0     0     0        0
2     0     0     0     0     0        0
3     0     0     0     0     0        0
4     0     0     0     0     0        0
5     0     0     0     0     0        0
6     0     0     0     0     0        0
7     1     1     0     0     1       NA
8     1     1     0     0     0       NA

编辑

这是您的函数的“dplyr-ized”版本的一个示例

soustraction.i <- function(D,R,i,threshold){
  D <- as_tibble(D)
  R <- as_tibble(R)
  dif <- map2_df(D, R[i,], `-`) %>%
    mutate(across(everything(), ~ifelse(.x < 0, 0, .x))) %>%
    rowwise() %>%
    mutate(mismatch = sum(c_across(everything())),
           mismatch = case_when(as.numeric(mismatch) > threshold ~ NA_real_,
                                TRUE ~ mismatch))
  return(dif)
}

【讨论】：

感谢@latlio 的回复！这就是我一直在寻找的。我很感激。