简化嵌套Mapply语句

Question

我试图用一组简单的代码替换多个单独的mapply语句。最后，我让它使用了3个嵌套的mapply语句，但这似乎有点费解。我是新的R从其他语言，所以寻找一些帮助思考R的心态。如果这3条语句是最好的方法，我可以接受它，但需要输入。如果你有一个更好的方式来构造这样的子结构输出，我都是耳朵。

payments <- data.frame(
  Amount = sample(5:15,100,replace=TRUE),
  Tip.Amount = round(runif(100,0,2),2),
  "A" = sample(c(TRUE,FALSE),100,replace=TRUE),
  "B" = sample(c(TRUE,FALSE),100,replace=TRUE),
  "C" = sample(c(TRUE,FALSE),100,replace=TRUE),
  "D" = sample(c(TRUE,FALSE),100,replace=TRUE),
  "E" = sample(c(TRUE,FALSE),100,replace=TRUE),
  "F" = sample(c(TRUE,FALSE),100,replace=TRUE),
  Date = sample(seq(as.Date("2016-01-01"),as.Date("2016-01-31"),by="day"),100,replace=TRUE)
)
employees <- c("A","B","C","D","E","F")
dots <- lapply(c(employees,"Date"),as.symbol)

payments.by_date_employee <- payments %>%
  filter(!is.na(Date),!is.na(Amount)) %>%
  group_by_(.dots=dots) %>%
  summarise(Payment.Count=n(), Amount=sum(Amount),
            Tip.Count=sum(Tip.Amount>=0.01,na.rm=TRUE), Tip.Amount=sum(Tip.Amount,na.rm=TRUE)) %>%
  ungroup() %>%
  arrange(Date)

#long/manual way--------------------------------------------------------------------------------
t <- list()
t[["payments"]][["amount"]] <- mapply(function(name) list({
  t.test(subset(payments,payments[[name]]==TRUE)$Amount,
         subset(payments,payments[[name]]==FALSE)$Amount)$p.value
}),
employees)

t[["payments"]][["count"]] <- mapply(function(name) list({
  t.test(subset(payments.by_date_employee,payments.by_date_employee[[name]]==TRUE)$Amount,
         subset(payments.by_date_employee,payments.by_date_employee[[name]]==FALSE)$Amount)$p.value
}),
employees)

t[["tips"]][["amount"]] <- mapply(function(name) list({
  t.test(subset(payments,payments[[name]]==TRUE)$Tip.Amount,
         subset(payments,payments[[name]]==FALSE)$Tip.Amount)$p.value
}),
employees)

t[["tips"]][["count"]] <- mapply(function(name) list({
  t.test(subset(payments.by_date_employee,payments.by_date_employee[[name]]==TRUE)$Tip.Amount,
         subset(payments.by_date_employee,payments.by_date_employee[[name]]==FALSE)$Tip.Amount)$p.value
}),
employees)
#long/manual way--------------------------------------------------------------------------------

#attempt at single mapply statement ------------------------------------------------------------
y <- mapply(function(name,type,variable,df,nm) list({
  t.test(subset(eval(df),eval(df)[[name]]==TRUE)[[nm]],
         subset(eval(df),eval(df)[[name]]==FALSE)[[nm]])$p.value}),
  employees,
  c("payments","payments","tips","tips"),
  c("amount","count"),
  c(quote(payments),quote(payments),quote(payments.by_date_employee),quote(payments.by_date_employee)),
  c("Amount","Amount","Tip.Amount","Tip.Amount"),
  SIMPLIFY = FALSE
)
#attempt at single mapply statement ------------------------------------------------------------

#works but seems convoluted --------------------------------------------------------------------
z <- mapply(function(type) list({
  mapply(function(variable,df,nm) list({
    t[[type]][[variable]] <-mapply(function(name) list({
      t.test(subset(eval(df),eval(df)[[name]]==TRUE)[[nm]],
             subset(eval(df),eval(df)[[name]]==FALSE)[[nm]])$p.value}),
      employees)
  }),
  c("amount","count"),
  c(quote(payments),quote(payments),quote(payments.by_date_employee),quote(payments.by_date_employee)),
  c("Amount","Amount","Tip.Amount","Tip.Amount"),
  SIMPLIFY = FALSE
  )
}),
c("payments","tips")
)
#works but seems convoluted --------------------------------------------------------------------

Answer 1

下面是一种将问题分解为几个步骤的方法。首先，编写一个函数，该函数的名称为dataframe、变量名和雇员代码，并返回所需的值：

ttest <- function(data, varname, employee) {
  d <- get(data)
  do.call(t.test, setNames(split(d[[varname]], d[[employee]]), c("x", "y")))$p.value
}

现在，使用mapply在dataframe名称、变量名和员工代码向量上应用该函数：

out <- mapply(ttest, 
  rep(c("payments", "payments.by_date_employee"), each = length(employees)), 
  c(rep(c("Amount", "Tip.Amount"), each = length(employees) * 2)), 
  employees)

现在，我们有了我们所需要的所有价值。检查这些值是否与列表t中的值相同

all.equal(unname(out), unname(unlist(t)))
# [1] TRUE

剩下的步骤是组织这些值。我们可以把它们放进数据仓库：

d <- data.frame(
  type = rep(c("payments", "tips"), each = length(employees) * 2),
  variable = rep(c("amount", "count"), each = length(employees), times = 2),
  employee = rep(employees, times = 4),
  value = out
  )
#        type variable employee      value
# 1  payments   amount        A 0.23278642
# 2  payments   amount        B 0.77047594
# ...
# 7  payments    count        A 0.56123674
# 8  payments    count        B 0.81040604
# ...
# 13     tips   amount        A 0.92749503
# 14     tips   amount        B 0.08716570
# ...
# 23     tips    count        E 0.20672583
# 24     tips    count        F 0.23505606

如果您希望将结果作为嵌套列表，请再执行一步：

y <- lapply(split(d, d$type),
  function(x) lapply(split(x, x$variable),
    function(y) split(y$value, y$employee)
  )
)
all.equal(t, y)
# [1] TRUE

更新。要从t.test输出中获得附加值，首先修改我们的自定义ttest函数

ttest <- function(data, varname, employee) {
  d <- get(data)
  unlist(
    do.call(t.test, setNames(split(d[[varname]], d[[employee]]), c("x", "y")))[c("estimate", "p.value")]
  )
}

在本例中，我们提取estimate和p.value的值(对于其他值的名称，您可以检查任何t.test输出，例如str(t.test(1:3, 4:6)) )。unlist函数将我们检索的值(最初以列表的形式)扁平化为向量。

运行上面描述的mapply；现在，out对象是一个矩阵而不是一个向量。假设我们想要将这些值插入到dataframe中：

d <- data.frame(
  type = rep(c("payments", "tips"), each = length(employees) * 2),
  variable = rep(c("amount", "count"), each = length(employees), times = 2),
  employee = rep(employees, times = 4),
  x.mean = out[1, ],
  y.mean = out[2, ],
  p.value = out[3, ]
  )
      type variable employee    x.mean    y.mean   p.value
# 1 payments   amount        A 10.217391 10.240741 0.9714363
# 2 payments   amount        B  9.960784 10.510204 0.4022349
# 3 payments   amount        C 10.490196  9.959184 0.4153361
# . ...        ...