Bagaimana membuktikan kerja sama dari urutan perilaku

Situasi: Dua burung (jantan dan betina) melindungi telur mereka di sarang dari pengganggu. Setiap burung dapat menggunakan serangan atau ancaman untuk perlindungan, dan hadir atau tidak ada. Ada pola yang muncul dari data bahwa perilaku mungkin saling melengkapi - serangan laki-laki sementara perempuan menggunakan tampilan ancaman dan sebaliknya.

Pertanyaan saya adalah: Bagaimana cara membuktikan kerja sama seperti itu secara statistik? Atau adakah yang bisa mengetahui studi perilaku yang berkaitan dengan analisis serupa? Mayoritas analisis sekuensial yang saya temukan difokuskan pada DNA.

Di sini saya memberikan beberapa data dummy , tetapi dataset asli saya terdiri dari puluhan pasangan yang direkam tepat 10 menit saat mempertahankan sarang mereka. Karenanya, urutan perilaku setiap burung adalah 600 negara (setiap detik memiliki keadaan). Data yang lebih pendek ini harus berisi pola yang mirip dengan seluruh dataset.

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

Saya memposting jawaban kedua sejak komentar terakhir Anda

Maksud saya, "ketika laki-laki menyerang, perempuan membuat ancaman", dan saya ingin menguji hipotesis ini terhadap suatu alternatif: "ketika laki-laki menyerang, perempuan tidak suka membuat ancaman" (dengan kata lain, perilaku perempuan tidak tergantung pada perilaku pria).

adalah game-changer. Tampaknya masalahnya bisa menjadi pendekatan dari perspektif yang sama sekali berbeda. Pertama, Anda hanya tertarik pada sebagian sampel Anda ketika laki-laki menyerang. Kedua, Anda tertarik jika dalam kasus-kasus seperti itu perempuan lebih sering memperlakukan daripada yang kami harapkan jika mereka melakukannya secara acak. Untuk menguji hipotesis seperti itu kita dapat menggunakan tes permutasi: acak acak baik male_seqatau female_seq(tidak masalah) dan kemudian menghitung kasus di mana male_seq == "attack"dan female_seq == "treat"untuk mendapatkan distribusi nol. Selanjutnya, bandingkan jumlah yang diperoleh dari data Anda dengan jumlah dalam distribusi nol untuk mendapatkan nilai- .$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

Anda dapat menentukan statistik pengujian secara berbeda, berdasarkan pada bagaimana Anda mendefinisikan "preferensi" perempuan. Uji permutasi dalam kasus ini adalah interpretasi langsung Anda : "perilaku wanita tidak tergantung pada perilaku pria", yang mengarah ke: "perilaku wanita secara acak diberikan perilaku pria", sehingga perilaku secara acak dikocok di bawah .H $H_0$$H_0$

Selain itu, bahkan jika Anda mengasumsikan bahwa perilaku muncul dalam kelompok perilaku yang sama diulang untuk beberapa periode waktu, dengan tes permutasi Anda dapat mengacak seluruh kelompok:

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

Dalam salah satu kasus, pola kerja sama dalam data yang Anda berikan tampaknya jauh dari acak. Perhatikan bahwa dalam kedua kasus kami mengabaikan sifat autokorelasi dari data ini, kami agak bertanya: jika kami memilih titik acak pada saat pria menyerang, apakah wanita akan lebih sedikit atau lebih mungkin untuk membuat hadiah pada saat yang sama?

Karena Anda tampaknya berbicara tentang kausalitas ("kapan ... lalu"), saat melakukan tes permutasi, Anda mungkin tertarik untuk membandingkan perilaku laki-laki pada waktu dengan perilaku perempuan pada waktu (apa yang "reaksi" perempuan terhadap perilaku laki-laki?), tetapi ini adalah sesuatu yang harus Anda tanyakan pada diri sendiri. Tes permutasi fleksibel dan dapat dengan mudah disesuaikan dengan jenis masalah yang Anda uraikan.$t-1$$t$

Anda dapat memikirkan data Anda dalam kaitan dengan rantai Markov bivariat. Anda memiliki dua variabel berbeda untuk wanita dan untuk pria, yang menggambarkan proses perubahan stokastik dan pada waktu ke salah satu dari empat negara yang berbeda. Mari kita dilambangkan dengan transisi untuk dari ke waktu , dari -th ke -th state. Dalam hal ini, transisi dalam waktu ke negara lain tergantung pada kondisi sebelumnya di dan di :Y X Y t X t - 1 , i → X t , j X t - 1 t i j X $X$$Y$$X$$Y$$t$$X_{t-1,i} \rightarrow X_{t,j}$$X$$t-1$$t$$i$$j$$X$ $Y$

Probabilitas transisi dapat dengan mudah dihitung dengan menghitung histori transisi dan menormalisasi probabilitas setelahnya:

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)

Dapat juga disimulasikan dengan mudah menggunakan probabilitas marginal:

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], ])
}

Hasil simulasi tersebut diplot di bawah ini.

Selain itu, dapat digunakan untuk membuat prediksi satu langkah di depan:

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

dengan akurasi 69-86% pada data yang Anda berikan:

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

Jika transisi terjadi secara acak, probabilitas transisi akan mengikuti distribusi seragam diskrit. Ini bukan bukti , tetapi bisa berfungsi sebagai cara berpikir tentang data Anda menggunakan model sederhana.