我如何计算每行之前给定时间范围内的个体数量？

问题描述 投票：0回答：0
Llet说我有执行特定行为的人的时机和身份。我想知道在每种行为之前，有多少独特的人在特定的延迟中执行了焦点行为。 我的当前代码由三个步骤组成，所有步骤都可以优化。 我的数据集包含每个感兴趣延迟的列。例如，LAT_1变量包含在焦点行为之前最多1秒钟的前行（即，在给定延迟[列]处的当前行与当前行相关的前行最多1秒钟）。 在示例中，它可以达到7秒钟，但是在实际数据中，它可达30秒。 最终，我想为每个焦点行带来给定行为的影响环境。可以有六个不同的上下文：

NOONE_0：没有人能影响给定潜伏期（即没有人在给定延迟内执行行为）

    self_0：只有焦点人在给定的潜伏期内执行行为
  • self_1：焦点人和另一个人在给定潜伏期内执行行为
    • self_2：焦点和其他两个人在给定的潜伏期内执行了行为
  • other_1：另一个人（但不是焦点）在给定的潜伏期内执行了行为
    • other_2：2其他人（但不是焦点）在给定的潜伏期内执行了行为
    • 当前代码的3个步骤是：
  • 列表所有以前在给定潜伏期内执行行为的人
    • 将列表的长度降至最小长度
    • 报告影响的正确背景

到目前为止，我的代码是我到目前为止的代码。总体方法为我提供了我的需求，但远非优化。欢迎任何帮助:-)

    library(tidyverse) LD_SO <- data.frame(Group = "Gr02", Individual = c("B", "A", "B", "B", "A", "A", "C", "A", "B", "C", "A", "A", "C", "A", "A", "A", "B", "C"), Event_type = "Behaviour1", Start_cor = c(2.25, 2.8, 5.9, 6.1, 30.56, 33.45, 34.12, 35.49, 49.78, 54.89, 55.12, 59.24, 136.45, 137, 138.49, 140.21, 141.73, 200.24), Lat_1 = c(0L, 1L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 0L), Lat_2 = c(0L, 1L, 0L, 1L, 0L, 0L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 1L, 1L, 0L), Lat_3 = c(NA, NA, 0L, 1L, 0L, 1L, 1L, 2L, 0L, 0L, 1L, 0L, 0L, 0L, 2L, 1L, 1L, 0L), Lat_4 = c(NA, NA, 2L, 3L, 0L, 1L, 2L, 2L, 0L, 0L, 1L, 0L, 0L, 0L, 2L, 3L, 2L, 0L), Lat_5 = c(NA, NA, 2L, 3L, 0L, 1L, 2L, 3L, 0L, 0L, 1L, 2L, 0L, 0L, 2L, 3L, 3L, 0L), Lat_6 = c(NA, NA, NA, 3L, 0L, 1L, 2L, 3L, 0L, 1L, 2L, 2L, 0L, 0L, 2L, 3L, 4L, 0L), Lat_7 = c(NA, NA, NA, NA, 0L, 1L, 2L, 3L, 0L, 1L, 2L, 2L, 0L, 0L, 2L, 3L, 4L, 0L)) ### # first step: list all relevant previous individuals ### # the values in Lat_1:Lat_7 indicate how many previous events took place within a certain latency [1 to 7 seconds] LD_SO_step1 <- LD_SO %>% mutate( # Identify all relevant previous individuals up to 1 second before the focal behaviour Infl_1 = case_when(is.na(Lat_1) ~ "Y", # in order to transform NAs into specific letter for later Lat_1 == 0 ~ "Z", # in order to indicate that nobody started the behaviour within that latency Lat_1 == 1 ~ paste0(lag(Individual, 1)), # retrieve the identity of the person performing the previous behaviour Lat_1 == 2 ~ paste0(lag(Individual, 1), lag(Individual, 2)), # retrieve the identity of the persons performing the two previous behaviours Lat_1 == 3 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3)), # retrieve the identity of the persons performing the three previous behaviours Lat_1 == 4 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3), lag(Individual, 4))), # and so on # Identify all relevant previous individuals up to 2 seconds before the focal behaviour Infl_2 = case_when(is.na(Lat_2) ~ "Y", Lat_2 == 0 ~ "Z", Lat_2 == 1 ~ paste0(lag(Individual, 1)), Lat_2 == 2 ~ paste0(lag(Individual, 1), lag(Individual, 2)), Lat_2 == 3 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3)), Lat_2 == 4 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3), lag(Individual, 4))), # Identify all relevant previous individuals up to 3 seconds before the focal behaviour Infl_3 = case_when(is.na(Lat_3) ~ "Y", Lat_3 == 0 ~ "Z", Lat_3 == 1 ~ paste0(lag(Individual, 1)), Lat_3 == 2 ~ paste0(lag(Individual, 1), lag(Individual, 2)), Lat_3 == 3 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3)), Lat_3 == 4 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3), lag(Individual, 4))), # and so on Infl_4 = case_when(is.na(Lat_4) ~ "Y", Lat_4 == 0 ~ "Z", Lat_4 == 1 ~ paste0(lag(Individual, 1)), Lat_4 == 2 ~ paste0(lag(Individual, 1), lag(Individual, 2)), Lat_4 == 3 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3)), Lat_4 == 4 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3), lag(Individual, 4))), Infl_5 = case_when(is.na(Lat_5) ~ "Y", Lat_5 == 0 ~ "Z", Lat_5 == 1 ~ paste0(lag(Individual, 1)), Lat_5 == 2 ~ paste0(lag(Individual, 1), lag(Individual, 2)), Lat_5 == 3 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3)), Lat_5 == 4 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3), lag(Individual, 4))), Infl_6 = case_when(is.na(Lat_6) ~ "Y", Lat_6 == 0 ~ "Z", Lat_6 == 1 ~ paste0(lag(Individual, 1)), Lat_6 == 2 ~ paste0(lag(Individual, 1), lag(Individual, 2)), Lat_6 == 3 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3)), Lat_6 == 4 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3), lag(Individual, 4))), Infl_7 = case_when(is.na(Lat_7) ~ "Y", Lat_7 == 0 ~ "Z", Lat_7 == 1 ~ paste0(lag(Individual, 1)), Lat_7 == 2 ~ paste0(lag(Individual, 1), lag(Individual, 2)), Lat_7 == 3 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3)), Lat_7 == 4 ~ paste0(lag(Individual, 1), lag(Individual, 2), lag(Individual, 3), lag(Individual, 4))), .after = Individual) ### # second step: sort unique contributors [so that I can use str_length() in step 3] ### # the strings in Infl_1:Infl_7 should be as concise as possible LD_SO_step2 <- LD_SO_step1 %>% rowwise() %>% mutate(Infl_1 = str_c(str_sort(str_unique(str_split_1(Infl_1, ""))), collapse = ""), Infl_2 = str_c(str_sort(str_unique(str_split_1(Infl_2, ""))), collapse = ""), Infl_3 = str_c(str_sort(str_unique(str_split_1(Infl_3, ""))), collapse = ""), Infl_4 = str_c(str_sort(str_unique(str_split_1(Infl_4, ""))), collapse = ""), Infl_5 = str_c(str_sort(str_unique(str_split_1(Infl_5, ""))), collapse = ""), Infl_6 = str_c(str_sort(str_unique(str_split_1(Infl_6, ""))), collapse = ""), Infl_7 = str_c(str_sort(str_unique(str_split_1(Infl_7, ""))), collapse = "")) ### # third step: identify which type of influence it was ### # if Infl_1 == "Y", it was impossible to have influence # if Infl_1 == "Z", no one had influence # if Individual is in Infl_1 with 2 other letters (length == 3), then influence is Self + 2 # if Individual is in Infl_1 with 1 other letter (length == 2), then influence is Self + 1 # if Individual is in Infl_1 with 0 other letter (length == 1), then influence is Self + 0 # if Individual is not in Infl_1 with 1 other letter (length == 2), then influence is Other + 1 # if Individual is not in Infl_1 with 0 other letter (length == 1), then influence is Other + 0 LD_SO_step3 <- LD_SO_step2 %>% mutate(IT_1 = case_when(Infl_1 == "Y" ~ NA, Infl_1 == "Z" ~ "NoOne_0", (str_detect(Infl_1, Individual)) & str_length(Infl_1) == 3 ~ "Self_2", (str_detect(Infl_1, Individual)) & str_length(Infl_1) == 2 ~ "Self_1", (str_detect(Infl_1, Individual)) & str_length(Infl_1) == 1 ~ "Self_0", !(str_detect(Infl_1, Individual)) & str_length(Infl_1) == 2 ~ "Other_2", !(str_detect(Infl_1, Individual)) & str_length(Infl_1) == 1 ~ "Other_1"), .after = Infl_1) %>% mutate(IT_2 = case_when(Infl_2 == "Y" ~ NA, Infl_2 == "Z" ~ "NoOne_0", (str_detect(Infl_2, Individual)) & str_length(Infl_2) == 3 ~ "Self_2", (str_detect(Infl_2, Individual)) & str_length(Infl_2) == 2 ~ "Self_1", (str_detect(Infl_2, Individual)) & str_length(Infl_2) == 1 ~ "Self_0", !(str_detect(Infl_2, Individual)) & str_length(Infl_2) == 2 ~ "Other_2", !(str_detect(Infl_2, Individual)) & str_length(Infl_2) == 1 ~ "Other_1"), .after = Infl_2) %>% mutate(IT_3 = case_when(Infl_3 == "Y" ~ NA, Infl_3 == "Z" ~ "NoOne_0", (str_detect(Infl_3, Individual)) & str_length(Infl_3) == 3 ~ "Self_2", (str_detect(Infl_3, Individual)) & str_length(Infl_3) == 2 ~ "Self_1", (str_detect(Infl_3, Individual)) & str_length(Infl_3) == 1 ~ "Self_0", !(str_detect(Infl_3, Individual)) & str_length(Infl_3) == 2 ~ "Other_2", !(str_detect(Infl_3, Individual)) & str_length(Infl_3) == 1 ~ "Other_1"), .after = Infl_3) %>% mutate(IT_4 = case_when(Infl_4 == "Y" ~ NA, Infl_4 == "Z" ~ "NoOne_0", (str_detect(Infl_4, Individual)) & str_length(Infl_4) == 3 ~ "Self_2", (str_detect(Infl_4, Individual)) & str_length(Infl_4) == 2 ~ "Self_1", (str_detect(Infl_4, Individual)) & str_length(Infl_4) == 1 ~ "Self_0", !(str_detect(Infl_4, Individual)) & str_length(Infl_4) == 2 ~ "Other_2", !(str_detect(Infl_4, Individual)) & str_length(Infl_4) == 1 ~ "Other_1"), .after = Infl_4) %>% mutate(IT_5 = case_when(Infl_5 == "Y" ~ NA, Infl_5 == "Z" ~ "NoOne_0", (str_detect(Infl_5, Individual)) & str_length(Infl_5) == 3 ~ "Self_2", (str_detect(Infl_5, Individual)) & str_length(Infl_5) == 2 ~ "Self_1", (str_detect(Infl_5, Individual)) & str_length(Infl_5) == 1 ~ "Self_0", !(str_detect(Infl_5, Individual)) & str_length(Infl_5) == 2 ~ "Other_2", !(str_detect(Infl_5, Individual)) & str_length(Infl_5) == 1 ~ "Other_1"), .after = Infl_5) %>% mutate(IT_6 = case_when(Infl_6 == "Y" ~ NA, Infl_6 == "Z" ~ "NoOne_0", (str_detect(Infl_6, Individual)) & str_length(Infl_6) == 3 ~ "Self_2", (str_detect(Infl_6, Individual)) & str_length(Infl_6) == 2 ~ "Self_1", (str_detect(Infl_6, Individual)) & str_length(Infl_6) == 1 ~ "Self_0", !(str_detect(Infl_6, Individual)) & str_length(Infl_6) == 2 ~ "Other_2", !(str_detect(Infl_6, Individual)) & str_length(Infl_6) == 1 ~ "Other_1"), .after = Infl_6) %>% mutate(IT_7 = case_when(Infl_7 == "Y" ~ NA, Infl_7 == "Z" ~ "NoOne_0", (str_detect(Infl_7, Individual)) & str_length(Infl_7) == 3 ~ "Self_2", (str_detect(Infl_7, Individual)) & str_length(Infl_7) == 2 ~ "Self_1", (str_detect(Infl_7, Individual)) & str_length(Infl_7) == 1 ~ "Self_0", !(str_detect(Infl_7, Individual)) & str_length(Infl_7) == 2 ~ "Other_2", !(str_detect(Infl_7, Individual)) & str_length(Infl_7) == 1 ~ "Other_1"), .after = Infl_7) %>% ungroup()
    • 该解决方案在行上迭代，将您的逻辑应用于在给定延迟相对于每一行的事件中的个人。
  • library(purrr) library(dplyr) compute_IT <- function(individual, time, latency) { map2_chr(individual, time, \(indiv_i, time_i) { latencies <- time_i - time influencers <- unique(individual[latencies > 0 & latencies <= latency]) n_influencers <- length(influencers) if (indiv_i %in% influencers) { paste0("Self_", n_influencers - 1) } else if (n_influencers > 0) { paste0("Other_", n_influencers) } else { "NoOne" } }) } for (i in seq(7)) { LD_SO <- mutate( LD_SO, "IT_{i}" := compute_IT(Individual, Start_cor, latency = i), .by = c(Group, Event_type) ) }
#> select(LD_SO, c(Individual, Start_cor, IT_1:IT_7)) Individual Start_cor IT_1 IT_2 IT_3 IT_4 IT_5 IT_6 IT_7 1 B 2.25 NoOne NoOne NoOne NoOne NoOne NoOne NoOne 2 A 2.80 Other_1 Other_1 Other_1 Other_1 Other_1 Other_1 Other_1 3 B 5.90 NoOne NoOne NoOne Self_1 Self_1 Self_1 Self_1 4 B 6.10 Self_0 Self_0 Self_0 Self_1 Self_1 Self_1 Self_1 5 A 30.56 NoOne NoOne NoOne NoOne NoOne NoOne NoOne 6 A 33.45 NoOne NoOne Self_0 Self_0 Self_0 Self_0 Self_0 7 C 34.12 Other_1 Other_1 Other_1 Other_1 Other_1 Other_1 Other_1 8 A 35.49 NoOne Other_1 Self_1 Self_1 Self_1 Self_1 Self_1 9 B 49.78 NoOne NoOne NoOne NoOne NoOne NoOne NoOne 10 C 54.89 NoOne NoOne NoOne NoOne NoOne Other_1 Other_1 11 A 55.12 Other_1 Other_1 Other_1 Other_1 Other_1 Other_2 Other_2 12 A 59.24 NoOne NoOne NoOne NoOne Self_1 Self_1 Self_1 13 C 136.45 NoOne NoOne NoOne NoOne NoOne NoOne NoOne 14 A 137.00 Other_1 Other_1 Other_1 Other_1 Other_1 Other_1 Other_1 15 A 138.49 NoOne Self_0 Self_1 Self_1 Self_1 Self_1 Self_1 16 A 140.21 NoOne Self_0 Self_0 Self_1 Self_1 Self_1 Self_1 17 B 141.73 NoOne Other_1 Other_1 Other_1 Other_1 Other_2 Other_2 18 C 200.24 NoOne NoOne NoOne NoOne NoOne NoOne NoOne 





r

dplyr

data-wrangling




    


  

  

    
最新问题


  





  

    © www.soinside.com 2019 - 2025. All rights reserved.