简化嵌套Mapply语句

Question

我试图用一组简单的代码替换多个单独的Mapply语句。我终于得到它与3嵌套mapply声明，但似乎有点复杂的方法。我是来自其他语言的新手，所以在R心态寻找一些帮助来思考。如果这三个陈述是最好的方法，我可以接受它，但要寻找输入。如果你有更好的方法来构造像这样的子集化输出，那么我就是耳朵。

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

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

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

现在，使用mapply超过数据帧的名字向量应用函数，变量姓名和职员代码：

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对象是一个矩阵，而不是一个向量假设我们要将值插入一个数据框：

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 
# . ...  ...