Создание бинарного оператора в r - PullRequest
Новая
       25

Создание бинарного оператора в r

0 голосов
/ 06 мая 2018

Мне нужна помощь в создании специального вида вычитания. У меня есть таблица данных 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

Большое спасибо!

Ответы [ 3 ]

0 голосов
/ 06 мая 2018

Мы можем создать функцию с 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, чтобы преобразовать его в выражение quosure, а затем преобразовать обратно в строку с помощью quo_name. Создайте intersect ионный вектор из имен столбцов набора данных и используйте - в 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)
0 голосов
/ 06 мая 2018 
`%-%`=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
0 голосов
/ 06 мая 2018

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
...