我有一个简单的表emp_id和job_code.我想payout基于此返回正确的job_code
我用嵌套的ifelse管理了这个,但是如果我有更多job_code的话呢?
library(dplyr)
set.seed(1)
emp_id <- round(rnorm(100, 500000, 10000))
job_code <- sample(c('a', 'b', 'c'), 100, replace = TRUE)
result <- sample(c(1,2,3,4), 100, replace = TRUE)
df <- data.frame(emp_id = emp_id, job_code = job_code, result = result)
job_a <- c(0, 500, 1000, 5000)
job_b <- c(0, 200, 500, 750)
job_c <- c(0, 250, 750, 1000)
# Works but sucky
df %>% mutate(payout = ifelse(job_code == 'a', job_a[result],
ifelse(job_code == 'b', job_b[result],
job_c[result])))
Run Code Online (Sandbox Code Playgroud)
而dput如果你喜欢:
structure(list(emp_id = c(493735, 501836, 491644, 515953, 503295,
491795, 504874, 507383, 505758, 496946, 515118, 503898, 493788,
477853, 511249, 499551, 499838, 509438, 508212, 505939, 509190,
507821, 500746, 480106, 506198, 499439, 498442, 485292, 495218,
504179, 513587, 498972, 503877, 499462, 486229, 495850, 496057,
499407, 511000, 507632, 498355, 497466, 506970, 505567, 493112,
492925, 503646, 507685, 498877, 508811, 503981, 493880, 503411,
488706, 514330, 519804, 496328, 489559, 505697, 498649, 524016,
499608, 506897, 500280, 492567, 501888, 481950, 514656, 501533,
521726, 504755, 492901, 506107, 490659, 487464, 502914, 495567,
500011, 500743, 494105, 494313, 498648, 511781, 484764, 505939,
503330, 510631, 496958, 503700, 502671, 494575, 512079, 511604,
507002, 515868, 505585, 487234, 494267, 487754, 495266), job_code = structure(c(1L,
1L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 3L, 3L, 1L, 3L, 3L, 3L, 1L, 2L,
3L, 3L, 2L, 1L, 1L, 1L, 2L, 3L, 2L, 1L, 1L, 2L, 3L, 2L, 1L, 2L,
2L, 2L, 3L, 3L, 2L, 2L, 2L, 1L, 2L, 3L, 1L, 2L, 1L, 2L, 1L, 2L,
3L, 3L, 3L, 2L, 2L, 2L, 1L, 1L, 2L, 2L, 3L, 2L, 1L, 1L, 3L, 3L,
1L, 1L, 3L, 2L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 3L, 1L,
2L, 3L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 1L, 2L, 3L, 1L,
1L, 1L, 3L), .Label = c("a", "b", "c"), class = "factor"), result = c(3,
1, 2, 2, 2, 4, 1, 4, 1, 2, 1, 1, 4, 3, 2, 2, 1, 2, 4, 3, 3, 2,
2, 4, 4, 4, 4, 4, 2, 4, 4, 2, 2, 4, 1, 2, 2, 1, 3, 4, 4, 1, 3,
2, 3, 2, 2, 1, 2, 3, 2, 1, 4, 2, 4, 2, 4, 1, 4, 2, 1, 2, 4, 2,
3, 4, 1, 3, 3, 2, 2, 3, 4, 1, 1, 2, 2, 4, 1, 2, 2, 3, 3, 4, 1,
1, 4, 4, 1, 4, 1, 1, 4, 3, 1, 2, 3, 2, 2, 1)), .Names = c("emp_id",
"job_code", "result"), row.names = c(NA, -100L), class = "data.frame")
Run Code Online (Sandbox Code Playgroud)
我理想的做法是在data.frame中获得支出,但不确定如何正确引用它:
job_payouts <- data.frame(a = job_a, b = job_b, c = job_c)
# Won't work...
df %>% mutate(payout = job_payouts$job_code[result])
Run Code Online (Sandbox Code Playgroud)
lmo*_*lmo 10
这可以通过基础R中的矩阵索引的超酷方法来实现,这非常快速和有效.
# build jobs payout lookup matrix, by hand (see edit below for an extension)
jobs <- rbind(job_a, job_b, job_c)
# add row names to the matrix for convenient reference
rownames(jobs) <- levels(df$job_code)
# get payout using matrix indexing
df$payout <- jobs[cbind(df$job_code, df$result)]
Run Code Online (Sandbox Code Playgroud)
这回来了
# print out first 6 observations
head(df)
emp_id job_code result payout
1 493735 a 3 1000
2 501836 a 1 0
3 491644 b 2 200
4 515953 a 2 500
5 503295 a 2 500
6 491795 b 4 750
# print out jobs matrix for comparison
jobs
[,1] [,2] [,3] [,4]
a 0 500 1000 5000
b 0 200 500 750
c 0 250 750 1000
Run Code Online (Sandbox Code Playgroud)
有一些值得一提的细节.
data.frame函数转换job_code字符向量,因此这df$job_code是一个因子变量,其中标签与自然数字1,2,3,...相关联.默认情况下,因子的级别按标签按字母顺序排序,因此,在此示例中,标签"a"对应于1,"b"对应于2,"c"对应3.您可以使用该levels函数查找因子变量的顺序,并在该模板之后构造作业矩阵.cbind(df$job_code, df$result)形成2乘nrow(df)(100)矩阵,用于nrow(df)使用矩阵索引从作业矩阵中查找每个雇员的支付值.所述ř介绍手册对矩阵索引一个很好的介绍部分和另外的细节中可以找到help("[").编辑: 自动构建查找矩阵
在对这个答案的评论中,OP表示担心手工构建查找矩阵(我称之为"作业")将是乏味的并且容易出错.为了解决这些有效的问题,我们可以使用一个有点模糊的mget函数参数,"ifnotfound".此参数允许我们控制列表元素的输出,这些元素mget在名称向量中存在时返回,但在环境中不存在.
在评论中,我建议使用NA以填写下面评论中的缺失级别.我们可以通过使用NA"ifnotfound"作为输入来扩展它.
假设df$job_code是按顺序具有级别"a","aa","b"和"c"的因子.然后我们构建查找矩阵如下:
# build vector for example, the actual code, using levels(), follows as a comment
job_codes <- c("a", "aa", "b", "c") # job_codes <- levels(df$jobcodes)
# get ordered list of payouts, with NA for missing payouts
payoutList <- mget(paste0("job_", job_codes), ifnotfound=NA)
Run Code Online (Sandbox Code Playgroud)
它返回一个命名列表.
payoutList
$job_a
[1] 0 500 1000 5000
$job_aa
[1] NA
$job_b
[1] 0 200 500 750
$job_c
[1] 0 250 750 1000
Run Code Online (Sandbox Code Playgroud)
请注意,这payoutList$job_aa是一个NA.现在,从此列表构建矩阵.
# build lookup matrix using do.call() and rbind()
jobs.lookupMat <- do.call(rbind, payoutList)
jobs.lookupMat
[,1] [,2] [,3] [,4]
job_a 0 500 1000 5000
job_aa NA NA NA NA
job_b 0 200 500 750
job_c 0 250 750 1000
Run Code Online (Sandbox Code Playgroud)
矩阵的行根据因子的级别正确排序df$job_code,方便地命名,并且NA在没有支付的情况下s填充行.