如何从行为序列证明合作

情况：两只鸟（雄性和雌性）在巢中保护它们的卵以防入侵者入侵。每只鸟都可以使用攻击或威胁来进行保护，并且可以在场或不在场。数据显示出一种行为可能是互补的模式-男性攻击而女性使用威胁显示，反之亦然。

我的问题是：如何从统计角度证明这种合作？ 还是有人知道一些进行类似分析的行为研究？我发现绝大多数的顺序分析都集中在DNA上。

在这里，我提供了一些虚拟数据，但是我的原始数据集是由数十对组成的，它们在捍卫巢穴的同时准确记录了10分钟。因此，每只鸟的行为序列长600个状态（每秒钟都有状态）。这些较短的数据应包含与整个数据集相似的模式。

male_seq <- rep(c("absent","present","attack","threat","present","attack",
                  "threat","present","attack","absent"),
                  times = c(3,4,8,2,6,3,2,6,2,1))

female_seq <- rep(c("absent","present","threat","present","threat","present",
                    "threat","attack","present","threat","attack","present",
                    "attack","threat","absent"),
                  times = c(2,6,2,1,2,1,1,3,5,3,1,3,3,2,2))

自您上次发表评论以来，我发布了第二个答案

通过合作，我的意思是“当男性在攻击时，女性会构成威胁”，我想用另一种选择来检验该假设：“当男性在攻击时，女性不喜欢进行威胁”（换句话说，女性的行为与男性行为无关）。

是改变游戏规则的人。似乎可以从完全不同的角度解决问题。首先，男性攻击时，您只对部分样本感兴趣。其次，您是否感兴趣，在这种情况下，女性做点心的次数是否多于我们随机做的事情。为了检验这种假设，我们可以使用置换检验：随机地将male_seq或随机洗female_seq（无关紧要），然后计算出的情况male_seq == "attack"并female_seq == "treat"获得零分布。接下来，将从数据中获取的计数与空分布中的计数进行比较，以获得值。$p$

prmfun <- function() {
  sum(female_seq[sample(male_seq) == "attack"] == "threat")
}

mean(replicate(1e5, prmfun()) >= sum(female_seq[male_seq == "attack"] == "threat"))
## [1] 5e-05

您可以根据如何定义女性的“偏好”来不同地定义测试统计量。这种情况下的排列检验是您对的直接解释：“女性的行为与男性的行为无关”，这导致：“女性行为是男性行为的随机结果”，因此行为在下会被随机打乱。高$H_0$$H_0$

而且，即使您假设这些行为出现在重复了一段时间的相同行为的集群中，也可以通过置换测试对整个集群进行混洗：

female_rle <- rle(female_seq)
n_rle <- length(female_rle$values)

prmfun2 <- function() {
  ord <- sample(n_rle)
  sim_female_seq <- rep(female_rle$values[ord], female_rle$lengths[ord])
  sum(sim_female_seq[male_seq == "attack"] == "threat")
}

mean(replicate(1e5, prmfun2()) >= sum(female_seq[male_seq == "attack"] == "threat"))
## [1] 0.00257

在这两种情况下，您提供的数据中的合作模式似乎都不是随机的。请注意，在这两种情况下，我们都忽略了这些数据的自相关性质，而是在问：如果我们随机选择男性攻击时的时间点，女性在同一时间进行治疗的可能性会变小还是变大？

既然你似乎是在谈论因果关系（“时......那么”），同时进行你可能有兴趣在比较置换检验男性行为时至女性的行为在时间（什么是女性的‘反应’来男性行为？），但这是你必须问自己的事情。排列测试非常灵活，可以轻松地适应您似乎要描述的问题。$t-1$$t$

$X$$Y$$X$$Y$$t$$X_{t-1,i} \rightarrow X_{t,j}$$X$$t-1$$t$$i$$j$$X$ $Y$

通过计算过渡历史并随后对概率进行归一化，可以轻松计算出过渡概率：

states <- c("absent", "present", "attack", "threat")
# data is stored in 3-dimensional array, initialized with
# a very small "default" non-zero count to avoid zeros.
female_counts <- male_counts <- array(1e-16, c(4,4,4), list(states, states, states))
n <- length(male_seq)

for (i in 1:n) {
  male_counts[female_seq[i-1], male_seq[i-1], male_seq[i]] <- male_counts[female_seq[i-1], male_seq[i-1], male_seq[i]] + 1
  female_counts[male_seq[i-1], female_seq[i-1], female_seq[i]] <- female_counts[male_seq[i-1], female_seq[i-1], female_seq[i]] + 1
}

male_counts/sum(male_counts)
female_counts/sum(female_counts)

也可以使用边际概率轻松地模拟它：

male_sim <- female_sim <- "absent"

for (i in 2:nsim) {
  male_sim[i] <- sample(states, 1, prob = male_counts[female_sim[i-1], male_sim[i-1], ])
  female_sim[i] <- sample(states, 1, prob = female_counts[male_sim[i-1], female_sim[i-1], ])
}

这种模拟的结果绘制在下面。

而且，它可以用于进行一步一步的预测：

male_pred <- female_pred <- NULL

for (i in 2:n) {
  curr_m <- male_counts[female_seq[i-1], male_seq[i-1], ]
  curr_f <- female_counts[male_seq[i-1], female_seq[i-1], ]
  male_pred[i] <- sample(names(curr_m)[curr_m == max(curr_m)], 1)
  female_pred[i] <- sample(names(curr_f)[curr_f == max(curr_f)], 1)
}

您提供的数据具有69-86％的准确性：

> mean(male_seq == male_pred, na.rm = TRUE)
[1] 0.8611111
> mean(female_seq == female_pred, na.rm = TRUE)
[1] 0.6944444

如果过渡随机发生，则过渡概率将遵循离散的均匀分布。这不是证明，而是可以用作使用简单模型思考数据的一种方式。