在 r 中创建二元运算符

Question

我需要一些帮助来创建一种特殊的减法。 我有一个数据表x，我必须减去两列，比如a 和b。 但是，任何一列都可能不存在。 如果一列不存在，则其减法中的值应设置为零。

到目前为止，我已经通过尝试定义一个新的减法运算符%-%来解决这个问题

因此，例如，如果x = data.table(a = 5, b = 2)，那么a %-% b 应该是3，而a %-% d 应该是5。

我试图定义这个减法运算符，如下所示。然而，由于某种原因，我的减法总是产生零！谁能帮我理解我做错了什么以及如何更正我的代码？

library(data.table)
x = data.table(a = floor(10 * runif(5)), b = floor(10 * runif(5)), c =floor(10 * runif(5)))

`%-%` <- function(e1,e2, DT = x){
  ifelse(is.numeric(substitute(e1, DT)), e1 <- substitute(e1, DT), e1 <- 0)
  ifelse(is.numeric(substitute(e2, DT)), e2 <- substitute(e2, DT), e2 <- 0)
  return(e1 - e2)
}

x[, d := a %-% b]
x

x[, d := a %-% d]
x

非常感谢！

Answer 1

我们可以使用intersect 创建一个函数，将列名传递给.SDcols，然后Reduce 通过减去.SD（Data.table 的子集）中每列的相应行来创建一个函数

f1 <- function(dat, .x, .y) intersect(names(dat), c(.x, .y))
x[, d := Reduce('-', .SD), .SDcols = f1(x, 'a', 'b')]
x[, e := Reduce(`-`, .SD), .SDcols = f1(x, 'a', 'f')]

x
#   a b c  d e
#1: 7 0 8  7 7
#2: 3 6 4 -3 3
#3: 9 9 8  0 9
#4: 3 6 2 -3 3
#5: 0 2 3 -2 0

---

或者，如果我们想通过传递不带引号的参数来更改 OP 的函数，则使用 enquo 将其转换为 from quosure，然后使用 quo_name 将其重新转换回字符串。从数据集的列名创建一个intersection 向量，并在Reduce 中使用-

library(dplyr)
`%-%` <- function(e1,e2, DT){
           e1 <- quo_name(enquo(e1))
           e2 <- quo_name(enquo(e2))
           nm1 <- intersect(names(DT), c(e1, e2))
           DT[, Reduce(`-`, .SD), .SDcols = nm1]
    }

x[, d := `%-%`(a, b, .SD)]
x[, e := `%-%`(a, f, .SD)]

数据

x <- structure(list(a = c(7L, 3L, 9L, 3L, 0L), b = c(0L, 6L, 9L, 6L, 
2L), c = c(8L, 4L, 8L, 2L, 3L)), .Names = c("a", "b", "c"), row.names = c("1:", 
"2:", "3:", "4:", "5:"), class = "data.frame")
setDT(x)

Answer 2

`%-%`=function(a,b){
  DT=eval(sys.status()$sys.calls[[2]][[2]])
  a=substitute(a)
  b=substitute(b)
  stopifnot(is.name(a),is.name(b),is.data.table(DT))
  a=deparse(a)
  b=deparse(b)
  d=numeric(nrow(DT))
  a=if(!exists(a,DT)) d else get(a,DT)
  b=if(!exists(b,DT)) d else get(b,DT)
  a-b
 }
set.seed(5)
x = data.table(a = floor(10 * runif(5)), b = floor(10 * runif(5)), c =floor(10 * runif(5)))
x
   a b c
1: 2 7 2
2: 6 5 4
3: 9 8 3
4: 2 9 5
5: 1 1 2

x[,a%-%b]
[1] -5  1  1 -7  0
x[,a%-%f]# F is just a column of zeros since it does not exist:
[1] 2 6 9 2 1

或者你可以这样做：

x[,c("d","e","f"):=.(a%-%b,a%-%h,g%-%h)]
x
   a b c  d e f
1: 2 7 2 -5 2 0
2: 6 5 4  1 6 0
3: 9 8 3  1 9 0
4: 2 9 5 -7 2 0
5: 1 1 2  0 1 0

此函数仅适用于数据表。例如：

 setDF(x)[,a%-%b]

 Error: is.data.table(DT) is not TRUE 
 setDT(x)[,a%-%b]
 [1] -5  1  1 -7  0

编辑：这个答案给出了关于订单的正确值。 （下面给出的大部分答案都没有通过这个测试）

setDT(x)[,a%-%b]#Column subtract another
[1] -5  1  1 -7  0
setDT(x)[,b%-%a]#Reversing the order
[1]  5 -1 -1  7  0
setDT(x)[,b%-%b]#Column Subtract itself
[1] 0 0 0 0 0
setDT(x)[,a%-%f]#Column subtract a non-existing column
[1] 2 6 9 2 1
setDT(x)[,f%-%a]#a non-existing column subtract an existing column
[1] -2 -6 -9 -2 -1
x[,g%-%f] #subtract two non-existing columns
[1] 0 0 0 0 0

Answer 3

IIUC，你可以试试这个方法。我们使用exist 函数来确保该列在数据中是否可用。

# helper function
do_sub <- function(df, col1 = 'a', col2='b')
{
  ans <- integer()
  if (exists(col1, df) & exists(col2, df)){
    ans <- append(ans, df[[col1]] - df[[col2]])
  } else if (exists(col1, df)){
    ans <- append(ans, df[[col1]] - 0)
  } else {
    ans <- append(ans, 0 - df[[col2]])
  }
  return (ans)

}

# compute new columns
df[, d := do_sub(.SD, col1 = 'a', col2 = 'b')]
df[, e := do_sub(.SD, col1 = 'a', col2 = 'f')]

print(df)

   a b c  d e
1: 7 0 8  7 7
2: 3 6 4 -3 3
3: 9 9 8  0 9
4: 3 6 2 -3 3
5: 0 2 3 -2 0