วิธีใช้ฟังก์ชันเดียวกันกับทุกคอลัมน์ที่ระบุใน data.table

ฉันมี data.table ที่ฉันต้องการดำเนินการเดียวกันกับบางคอลัมน์ ชื่อของคอลัมน์เหล่านี้กำหนดเป็นเวกเตอร์อักขระ ในตัวอย่างนี้ฉันต้องการคูณคอลัมน์เหล่านี้ทั้งหมดด้วย -1

ข้อมูลของเล่นบางส่วนและเวกเตอร์ที่ระบุคอลัมน์ที่เกี่ยวข้อง:

library(data.table)
dt <- data.table(a = 1:3, b = 1:3, d = 1:3)
cols <- c("a", "b")

ตอนนี้ฉันทำแบบนี้โดยวนซ้ำเวกเตอร์อักขระ:

for (col in 1:length(cols)) {
   dt[ , eval(parse(text = paste0(cols[col], ":=-1*", cols[col])))]
}

มีวิธีดำเนินการโดยตรงโดยไม่ต้องใช้ for loop หรือไม่?

ดูเหมือนว่าจะได้ผล:

dt[ , (cols) := lapply(.SD, "*", -1), .SDcols = cols]

ผลลัพธ์คือ

    a  b d
1: -1 -1 1
2: -2 -2 2
3: -3 -3 3

มีเทคนิคเล็กน้อยที่นี่:

• เนื่องจากมีวงเล็บอยู่(cols) :=ผลลัพธ์จึงถูกกำหนดให้กับคอลัมน์ที่ระบุในcolsแทนที่จะเป็นตัวแปรใหม่ชื่อ "cols"
• .SDcolsบอกสายว่าเรากำลังดูคอลัมน์เหล่านั้นเท่านั้นและอนุญาตให้เราใช้.SDส่วนSเสริมของData ที่เกี่ยวข้องกับคอลัมน์เหล่านั้น
• lapply(.SD, ...)ดำเนินการ.SDซึ่งเป็นรายการของคอลัมน์ (เช่น data.frames และ data.tables ทั้งหมด) lapplyส่งกลับรายการดังนั้นในท้ายที่สุดดูเหมือนjcols := list(...)

แก้ไข : นี่เป็นอีกวิธีหนึ่งที่อาจเร็วกว่าดังที่ @Arun กล่าวถึง:

for (j in cols) set(dt, j = j, value = -dt[[j]])

ฉันต้องการเพิ่มคำตอบเมื่อคุณต้องการเปลี่ยนชื่อคอลัมน์ด้วย สิ่งนี้มีประโยชน์มากหากคุณต้องการคำนวณลอการิทึมของหลายคอลัมน์ซึ่งมักเป็นกรณีในงานเชิงประจักษ์

cols <- c("a", "b")
out_cols = paste("log", cols, sep = ".")
dt[, c(out_cols) := lapply(.SD, function(x){log(x = x, base = exp(1))}), .SDcols = cols]

อัปเดต: ต่อไปนี้เป็นวิธีที่ทำได้โดยไม่ต้องวนซ้ำ

dt[,(cols):= - dt[,..cols]]

เป็นวิธีที่เรียบร้อยสำหรับการอ่านโค้ดที่ง่าย แต่สำหรับประสิทธิภาพนั้นยังคงอยู่เบื้องหลังโซลูชันของ Frank ตามผลลัพธ์ด้านล่างของ microbenchmark

mbm = microbenchmark(
  base = for (col in 1:length(cols)) {
    dt[ , eval(parse(text = paste0(cols[col], ":=-1*", cols[col])))]
  },
  franks_solution1 = dt[ , (cols) := lapply(.SD, "*", -1), .SDcols = cols],
  franks_solution2 =  for (j in cols) set(dt, j = j, value = -dt[[j]]),
  hannes_solution = dt[, c(out_cols) := lapply(.SD, function(x){log(x = x, base = exp(1))}), .SDcols = cols],
  orhans_solution = for (j in cols) dt[,(j):= -1 * dt[,  ..j]],
  orhans_solution2 = dt[,(cols):= - dt[,..cols]],
  times=1000
)
mbm

Unit: microseconds
expr                  min        lq      mean    median       uq       max neval
base_solution    3874.048 4184.4070 5205.8782 4452.5090 5127.586 69641.789  1000  
franks_solution1  313.846  349.1285  448.4770  379.8970  447.384  5654.149  1000    
franks_solution2 1500.306 1667.6910 2041.6134 1774.3580 1961.229  9723.070  1000    
hannes_solution   326.154  405.5385  561.8263  495.1795  576.000 12432.400  1000
orhans_solution  3747.690 4008.8175 5029.8333 4299.4840 4933.739 35025.202  1000  
orhans_solution2  752.000  831.5900 1061.6974  897.6405 1026.872  9913.018  1000

ดังแสดงในแผนภูมิด้านล่าง

คำตอบก่อนหน้าของฉัน: สิ่งต่อไปนี้ใช้ได้เช่นกัน

for (j in cols)
  dt[,(j):= -1 * dt[,  ..j]]

ดูเหมือนว่าไม่มีวิธีแก้ปัญหาใด ๆ ข้างต้นที่ทำงานร่วมกับการคำนวณตามกลุ่ม ต่อไปนี้เป็นสิ่งที่ดีที่สุดที่ฉันได้รับ:

for(col in cols)
{
    DT[, (col) := scale(.SD[[col]], center = TRUE, scale = TRUE), g]
}

ในการเพิ่มตัวอย่างการสร้างคอลัมน์ใหม่โดยยึดตามเวกเตอร์สตริงของคอลัมน์ ขึ้นอยู่กับคำตอบของ Jfly:

dt <- data.table(a = rnorm(1:100), b = rnorm(1:100), c = rnorm(1:100), g = c(rep(1:10, 10)))

col0 <- c("a", "b", "c")
col1 <- paste0("max.", col0)  

for(i in seq_along(col0)) {
  dt[, (col1[i]) := max(get(col0[i])), g]
}

dt[,.N, c("g", col1)]

library(data.table)
(dt <- data.table(a = 1:3, b = 1:3, d = 1:3))

Hence:

   a b d
1: 1 1 1
2: 2 2 2
3: 3 3 3

Whereas (dt*(-1)) yields:

    a  b  d
1: -1 -1 -1
2: -2 -2 -2
3: -3 -3 -3

dplyrฟังก์ชันทำงานบนdata.tables ดังนั้นนี่คือdplyrวิธีแก้ปัญหาที่ "หลีกเลี่ยง for-loop" ด้วย :)

dt %>% mutate(across(all_of(cols), ~ -1 * .))

ฉันวัดประสิทธิผลโดยใช้รหัสของ Orhan (เพิ่มแถวและคอลัมน์) และคุณจะเห็นdplyr::mutateด้วยacrossส่วนใหญ่ดำเนินการได้เร็วกว่ามากที่สุดของการแก้ปัญหาอื่น ๆ และช้ากว่าการแก้ปัญหาโดยใช้ data.table lapply

library(data.table); library(dplyr)
dt <- data.table(a = 1:100000, b = 1:100000, d = 1:100000) %>% 
  mutate(a2 = a, a3 = a, a4 = a, a5 = a, a6 = a)
cols <- c("a", "b", "a2", "a3", "a4", "a5", "a6")

dt %>% mutate(across(all_of(cols), ~ -1 * .))
#>               a       b      d      a2      a3      a4      a5      a6
#>      1:      -1      -1      1      -1      -1      -1      -1      -1
#>      2:      -2      -2      2      -2      -2      -2      -2      -2
#>      3:      -3      -3      3      -3      -3      -3      -3      -3
#>      4:      -4      -4      4      -4      -4      -4      -4      -4
#>      5:      -5      -5      5      -5      -5      -5      -5      -5
#>     ---                                                               
#>  99996:  -99996  -99996  99996  -99996  -99996  -99996  -99996  -99996
#>  99997:  -99997  -99997  99997  -99997  -99997  -99997  -99997  -99997
#>  99998:  -99998  -99998  99998  -99998  -99998  -99998  -99998  -99998
#>  99999:  -99999  -99999  99999  -99999  -99999  -99999  -99999  -99999
#> 100000: -100000 -100000 100000 -100000 -100000 -100000 -100000 -100000

library(microbenchmark)
mbm = microbenchmark(
  base_with_forloop = for (col in 1:length(cols)) {
    dt[ , eval(parse(text = paste0(cols[col], ":=-1*", cols[col])))]
  },
  franks_soln1_w_lapply = dt[ , (cols) := lapply(.SD, "*", -1), .SDcols = cols],
  franks_soln2_w_forloop =  for (j in cols) set(dt, j = j, value = -dt[[j]]),
  orhans_soln_w_forloop = for (j in cols) dt[,(j):= -1 * dt[,  ..j]],
  orhans_soln2 = dt[,(cols):= - dt[,..cols]],
  dplyr_soln = (dt %>% mutate(across(all_of(cols), ~ -1 * .))),
  times=1000
)

library(ggplot2)
ggplot(mbm) +
  geom_violin(aes(x = expr, y = time)) +
  coord_flip()

^{สร้างเมื่อ 2020-10-16 โดยแพ็คเกจ reprex (v0.3.0)}