如何在自定义函数中有条件地复制行并执行算术计算

Question

我试图解决一个问题，我想有条件地复制一些行，并对它们执行算术运算。感谢您的建议！

library(dplyr)
#-----------------------------------------------
# Dummy Data
#----------------------------------------------
emp_id <- c(1,2,3,4, 5, 6)
employee <- c('John Doe','Peter Gynn','Jolie Hope','Michael K', 'T  Big', 'Joo Pite')
salary <- c(21000, 23400, 26800, 1000, 2000, 1500)
date <- c('2010-11-01','2010-11-02','2010-11-03', '2010-11-04', '2010-11-05', '2010-11-06')
status <- c('no','yes','no','no','no','yes')

employ_data <- data.frame(emp_id, employee, salary, date, status)

输出：

emp_id    employee       salary     date         status
1          John Doe      21000      2010-11-01  no
2          Peter Gynn    23400      2010-11-02  yes
3          Jolie Hope    26800      2010-11-03  no
4          Michael K     1000       2010-11-04  no
5          T Big         2000       2010-11-05  no
6          Joo Pite      1500       2010-11-06  yes

in_date_range = seq(as.Date(min(employ_data$date)),by = 1, 
as.Date(max(employ_data$date)))
duplicate_and_adjust_row <- function(x){
result <–rep(x,length(.))
result$salary * -1
}
employ_data %>%
rowwise() %>%
mutate(salary = ifelse(status == 'yes' & date %in% in_date_range, 
duplicate_and_adjust_row(x), salary))

预期输出：

emp_id    employee       salary     date         status
1          John Doe      21000      2010-11-01  no
2          Peter Gynn    23400      2010-11-02  yes
3          Jolie Hope    26800      2010-11-03  no
4          Michael K     1000       2010-11-04  no
5          T Big         2000       2010-11-05  no
6          Joo Pite      1500       2010-11-06  yes
2          Peter Gynn   -23400      2010-11-02  yes
6          Joo Pite     -1500       2010-11-06  yes

Answer 1

注释。

in_date_range是日期。将其转换为文本。

那些dup_and_adj行的bind_rows。

in_date_range = seq(as.Date(min(employ_data$date)), 
as.Date(max(employ_data$date)), by = 1) %>%
format(format="%Y-%m-%d")
dup_adj <- function(dF, date_range) {
dF %>%
filter(status == "yes" && date %in% date_range) %>%
mutate(salary=salary*-1) 
}
employ_data %>%
bind_rows(., dup_adj(., in_date_range))