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

时间:2021-06-18 09:16:08

标签: r

我正在尝试解决一个问题,我想有条件地复制一些行并对它们执行算术运算。感谢您的任何建议!

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

1 个答案:

答案 0 :(得分:0)

注意事项。

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

bind_rows 用于那些 dup_and_adj 行。

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