我一直在尝试将bctau函数（及其包含的theil）映射到数据集的选定元素上。此功能使用两步过程来计算AB单箱设计的效果大小。它需要两个参数（a =基线阶段的所有值； b =干预阶段的所有值）。在下面，您可以找到Tarlow (2017)开发的两个功能。
library(Kendall)
library(dplyr)
library(purrr)
library(tidyr)
bctau <- function(a,b) {
# The bctau() function accepts two arguments, a and b, which
# are vectors for each phase in an AB single-case design
n <- length(a) + length(b)
ta <- 1:(length(a))
tb <- (length(a) + 1):(length(a) + length(b))
# if baseline trend is not statistically significant,
# return tau result (no trend correction)
if (Kendall(a,ta)$sl > .05) {
results <- Kendall(c(a,b), c(rep(0,length(a)), rep(1,length(b))))
tau <- as.numeric(results$tau)
p <- as.numeric(results$sl)
se <- sqrt((2/n) * (1 - (tau^2)))
return(list(tau = tau, p = p, se = se, corrected = FALSE))
}
# if baseline trend is statistically significant,
# get Theil-Sen residuals
theilsen <- theil(ta, a)
slope <- theilsen$slope
intercept <- theilsen$int
correcteda <- as.numeric()
correctedb <- as.numeric()
for (i in 1:length(a)) {
correcteda[i] <- a[i] - (slope*i + intercept)
}
for (i in 1:length(b)) {
correctedb[i] <- b[i] - (slope*(i + length(a)) + intercept)
}
results <- Kendall(c(correcteda,correctedb),c(rep(0,length(a)),rep(1,length(b))))
tau <- as.numeric(results$tau)
p <- as.numeric(results$sl)
se <- sqrt((2/n) * (1 - (tau^2)))
return(list(tau = tau, p = p, se = se, corrected = TRUE, int = intercept, slope = slope, correcteda = correcteda, correctedb = correctedb))
}
theil <- function(x,y) {
# returns theil-sen slope and intercept estimates;
# x and y are two equal length vectors (x & y coords)
n <- length(x)
slopes <- as.numeric()
ints <- as.numeric()
for (i in 1:(n - 1)) {
for (j in (i + 1):n) {
slopes <- c(slopes, ((y[j] - y[i]) / (x[j] - x[i])))
}
}
b <- median(slopes)
for (i in 1:n) {
ints <- c(ints, (y[i] - (b*x[i])))
}
results <- list(slope = b, int = median(ints))
return(results)
}
我的数据集由五列组成： 1. Scalex：为参与者评分的行为量表； 2. IDx：参与者ID（请注意，每个参与者都完成了两个量表）； 3. Timex：会话号（每次阶段更改时重新启动）； 4.阶段：基线（A）或干预阶段（B）； 5. Ratex：评分量表分数（从1到20）。
Scalex <- c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
IDx <- c("C1", "C1", "C1", "C1", "C1", "C1", "C1", "C1", "C1", "C1", "C1", "C2", "C2", "C2", "C2", "C2", "C2", "C2", "C2", "C1", "C1", "C1", "C1", "C1", "C1", "C1", "C1", "C2", "C2", "C2", "C2", "C2", "C2", "C2", "C2", "C2")
Timex <- c(1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 6, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4, 5)
Phasex <- c("A", "A", "A", "A", "A", "B", "B", "B", "B", "B", "B", "A", "A", "A", "A", "B", "B", "B", "B", "A", "A", "A", "A", "B", "B", "B", "B", "A", "A", "A", "A", "B", "B", "B", "B", "B")
Ratex <- c(4, 8, 10, 12, 15, 7, 7, 9, 14, 15, 16, 4, 3, 2, 2, 7, 7, 9, 14, 2, 3, 6, 6, 7, 5, 9, 11, 5, 6, 3, 4, 8, 7, 9, 3, 3)
db <- data.frame(Scalex, IDx, Timex, Phasex, Ratex)
我想做的是按比例将数据分组，然后将bctau（）函数应用于每个参与者。我试图将参与者嵌套到秤中，这就是结果。
d <- db %>%
group_by(Scalex) %>%
nest()
# A tibble: 2 x 2
# Scalex data
# <dbl> <list>
#1 1 <tibble [19 x 4]>
#2 2 <tibble [17 x 4]>
这是其中一个嵌套的小对象的样子。 Phasex指示评估是在基准阶段（A）还是干预阶段（B）进行的，Ratex指示学生的行为评分。
d$data[[1]]
#[[1]]
# # A tibble: 19 x 4
# IDx Timex Phasex Ratex
# <fct> <dbl> <fct> <dbl>
# 1 C1 1 A 4
# 2 C1 2 A 8
# 3 C1 3 A 10
# 4 C1 4 A 12
# 5 C1 5 A 15
# 6 C1 1 B 7
# 7 C1 2 B 7
# 8 C1 3 B 9
# 9 C1 4 B 14
#10 C1 5 B 15
#11 C1 6 B 16
#12 C2 1 A 4
#13 C2 2 A 3
#14 C2 3 A 2
#15 C2 4 A 2
#16 C2 1 B 7
#17 C2 2 B 7
#18 C2 3 B 9
#19 C2 4 B 14
我试图编写这段代码。我使用了map2_df，因为我正在使用两个变量。我的代码每次都占用两列，并将第一列用作基线，第二列用作干预。然后计算bctau值和与其相关的其他统计参数（标准误差，p值等）
f <- db %>%
filter(Scalex == 1) %>%
unite(ID2x, IDx, Phasex) %>%
spread(ID2x, Ratex) %>%
dplyr::select(-Scalex, -Timex) %>%
data.frame()
#> f
# C1_A C1_B C2_A C2_B
#1 4 7 4 7
#2 8 7 3 7
#3 10 9 2 9
#4 12 14 2 14
#5 15 15 NA NA
#6 NA 16 NA NA
f1 <- f %>% select(C2_A, C2_B)
> g <- map2_df(.x = f1[seq(1, ncol(f1), 2)], .y = f1[seq(2, ncol(f1), 2)], ~ bctau(.x, .y))
> g
# A tibble: 1 x 4
# tau p se corrected
# <dbl> <dbl> <dbl> <lgl>
#1 0.784 0.0284 0.253 FALSE
仅当函数bctau不需要调用函数theil时，代码才似乎起作用（这意味着基线趋势不需要使用非参数Theil-Sen估计器对A和B阶段进行校正）。调用theil函数时，还将调用软件包Kendall，并且NA值似乎会产生一些问题。但是，我无法摆脱它们，因为基线和干预阶段的长度并不总是相同。
g <- map2_df(.x = f[seq(1, ncol(f), 2)], .y = f[seq(2, ncol(f), 2)], ~ bctau(.x, .y))
#WARNING: Error exit, tauk2. IFAULT = 10
#Error in bind_rows_(x, .id) : Argument 7 must be length 1, not 6
即使很好，我也不必使用purrr。
更新
我能够摆脱部分问题。如果我删除了bctau函数中**之间的代码部分（我实际上并不需要），则第二条错误行将不再显示。
return(list(tau = tau, p = p, se = se, corrected = TRUE))
code removed from the bctau function: **int = intercept, slope = slope, correcteda = correcteda, correctedb = correctedb**
很遗憾，#WARNING: Error exit, tauk2. IFAULT = 10仍在那儿，它不允许在结果中报告校正后的估计值。
g <- map2_df(.x = f[seq(1, ncol(f), 2)], .y = f[seq(2, ncol(f), 2)], ~ bctau(.x, .y))
#WARNING: Error exit, tauk2. IFAULT = 10
g
# A tibble: 2 x 4
# tau p se corrected
# <dbl> <dbl> <dbl> <lgl>
#1 1 1 0 TRUE
#2 0.784 0.0284 0.253 FALSE
更新2
当我从列中手动删除NA值时，出现解决方案。因此，我的猜测是，当需要进行基线校正时，如果涉及NA值，则theil函数将无法计算新的估算值。有没有办法告诉函数不要考虑NA值？
f2$C1_A
#[1] 4 8 10 12 15 NA
f2$C1_B
#[1] 7 7 9 14 15 16
#bl <- c(4, 8, 10, 12, 15, NA)
#i <- c(7, 7, 9, 14, 15, 16)
#bctau(bl, i)
#WARNING: Error exit, tauk2. IFAULT = 10
bl <- c(4, 8, 10, 12, 15) #remove NA manually
bl
#[1] 4 8 10 12 15
i
#[1] 7 7 9 14 15 16
bctau(bl, i) #calculate bctau
#$`tau`
#[1] -0.7385489
#$p
#[1] 0.008113123
#$se
#[1] 0.2874798
#$corrected
#[1] TRUE
答案 0 :(得分：1)
我认为您需要按Scalex和IDx嵌套data.frame，然后在嵌套的data.frame上使用匿名函数。我认为这段代码可以满足您的需求：
db %>%
spread(Phasex, Ratex) %>%
group_by(Scalex, IDx) %>%
nest() %>%
mutate(m = map(data, function(d) bctau(a = d$A, b = d$B))) %>%
unnest(m)