วิธีการพิสูจน์ความร่วมมือจากลำดับพฤติกรรม

สถานการณ์:นกสองตัว (ตัวผู้และตัวเมีย) ปกป้องไข่ของพวกมันในรังจากผู้บุกรุก นกแต่ละตัวสามารถใช้การโจมตีหรือการคุกคามเพื่อการป้องกันและอาจมีอยู่หรือขาดหายไป มีรูปแบบที่เกิดขึ้นจากข้อมูลที่พฤติกรรมอาจเสริม - การโจมตีชายในขณะที่การใช้งานของผู้หญิงแสดงภัยคุกคามและในทางกลับกัน

คำถามของฉันคือ: วิธีการพิสูจน์ความร่วมมือดังกล่าวทางสถิติ? หรือใครสามารถรู้การศึกษาพฤติกรรมที่เกี่ยวข้องกับการวิเคราะห์ที่คล้ายกัน? การวิเคราะห์ตามลำดับส่วนใหญ่ที่ฉันพบนั้นมุ่งเน้นไปที่ 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"เพื่อให้ได้การแจกแจงแบบโมฆะ จากนั้นเปรียบเทียบจำนวนที่ได้รับจากข้อมูลของคุณเพื่อนับในการแจกแจงค่า Null ที่จะได้รับ$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

หากการเปลี่ยนเกิดขึ้นแบบสุ่มความน่าจะเป็นในการเปลี่ยนแปลงจะเป็นไปตามการกระจายตัวแบบไม่ต่อเนื่อง นี่ไม่ใช่ข้อพิสูจน์แต่สามารถใช้เป็นวิธีคิดเกี่ยวกับข้อมูลของคุณโดยใช้แบบจำลองที่เรียบง่าย