R 将规则应用于增长窗口

R 将规则应用于增长窗口,r,for-loop,sliding-window,R,For Loop,Sliding Window,我想使用一个窗口循环数据帧Out: 一次增长一个增量(因此窗口的后部固定,窗口的前部增长-窗口变大) 每次增量时,应在窗口上运行以下规则: if (mean(Speed_out) <= 0.152682) Behaviour <- Lying else if (Movement_Out == “left”) <= 20.8 && (mean(Speed_Out) >= 0.200921) Behaviour <- Grazing 供您使用的数据帧

我想使用一个窗口循环数据帧
Out

  • 一次增长一个增量(因此窗口的后部固定,窗口的前部增长-窗口变大)
  • 每次增量时,应在窗口上运行以下规则:

    if (mean(Speed_out) <= 0.152682)
    Behaviour <- Lying
    else if (Movement_Out == “left”) <= 20.8 && (mean(Speed_Out) >= 
    0.200921)
    Behaviour <- Grazing
    
    供您使用的数据帧

    Out <- structure(list(Speed_Out = c(0.22, 0.155, 0.12, 0.09, 0.125, 
    0.125, 0.155, 0.34, 0.37, 0.185, 0.155, 0.22, 0.22, 0.28, 0.215, 
    0.06, 0.34, 0.555, 0.275, 0.215, 0.185, 0.06, 0.245, 0.31, 0.345, 
    0.375, 0.375, 0.87, 1.025, 0.405, 0, 0.185, 0.31, 0.155, 0.125, 
    0.22, 0.375, 0.345, 0.345, 0.405, 0.31, 0.34, 0.245, 0.155, 0.19, 
    0.22, 0.185, 0.12, 0.185, 0.155, 0.245, 0.31, 0.155, 0.155, 0.25, 
    0.215, 0.09, 0.06, 0.245, 0.495, 0.495, 0.34, 0.28, 0.31, 0.28, 
    0.25, 0.25, 0.185, 0.155, 0.25, 0.28, 0.28, 0.34, 0.215, 0.125, 
    0.155, 0.34, 0.34, 0.09, 0.59, 1.71, 1.18, 0.185, 0.215, 0.185, 
    0.185, 0.155, 0.19, 0.19, 0.19, 0.87, 2.045, 2.73, 1.585, 0.22, 
    0.25, 0.435, 0.405, 0.405, 0.405, 0.715, 0.62, 0.37, 0.4, 0.185, 
    0.375, 0.59, 0.525, 0.245, 0.495, 0.495, 0.68, 0.775, 0.25, 0.31, 
    0.34, 0.28, 0.28, 0.25, 1.55, 2.695, 1.705, 1.21, 0.87, 0.25, 
    1.52, 1.52, 0.405, 0.81, 2.08, 2.915, 1.705, 0.435, 0.22, 0.78, 
    1.215, 0.84, 0.495, 0.495, 0.56, 0.375, 0.28, 0.715, 1.025, 0.495, 
    0.65, 1.18, 1.09, 0.995, 0.87, 0.435, 0.125, 0.435, 0.555, 0.775, 
    1.12, 1.555, 1.15, 0.25, 0.87, 0.93, 0.28, 0.31, 0.31, 0.375, 
    0.78, 0.655, 0.53, 0.62, 0.525, 0.37, 0.555, 1.025, 0.655, 1.12, 
    1.585, 0.715, 0.155, 0.28, 1.12, 2.11, 1.645, 0.715, 0.465, 0.84, 
    0.81, 0.655, 0.84, 0.435, 0.28, 0.215, 0.93, 1.335, 0.65, 0.185, 
    0.155, 0.34, 0.4, 0.37, 0.435, 0.405, 0.28, 0.28, 0.25, 0.25, 
    0.745, 1.24, 0.805, 1.055, 1.085, 0.465, 0.375, 0.5, 0.59, 0.37, 
    0.185, 0.34, 0.37, 0.435, 0.405, 0.06, 0.125, 0.25, 0.31, 0.405, 
    0.78, 0.56, 0.215, 0.495, 0.87, 1.025, 0.62, 0.405, 0.405, 0.405, 
    0.31, 0.215, 0.465, 0.435, 0.34, 0.275, 0.215, 0.25, 0.22, 0.22, 
    0.125, 0.245, 0.34, 0.31, 0.37, 0.31, 0.31, 0.245, 0.185, 0.25, 
    0.22, 0.22, 0.31, 0.28, 0.22, 0.28, 0.53, 0.655, 0.375, 0.19, 
    0.405, 0.435, 0.28, 0.215, 0.77, 0.96, 1.865, 1.83, 0.495, 0.655, 
    1.615, 1.395, 0.31, 0.31, 0.25, 0.28, 0.34, 0.34), Movement_Out = structure(c(2L, 
    2L, 1L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 4L, 3L, 3L, 3L, 3L, 4L, 3L, 
    1L, 4L, 1L, 1L, 2L, 2L, 3L, 4L, 3L, 2L, 4L, 1L, 2L, 1L, 3L, 3L, 
    1L, 3L, 2L, 4L, 3L, 1L, 3L, 1L, 1L, 1L, 4L, 3L, 3L, 3L, 3L, 1L, 
    3L, 3L, 3L, 2L, 4L, 3L, 3L, 4L, 2L, 3L, 1L, 1L, 2L, 4L, 1L, 2L, 
    4L, 3L, 3L, 4L, 3L, 3L, 2L, 4L, 2L, 1L, 2L, 4L, 4L, 2L, 4L, 2L, 
    1L, 2L, 3L, 1L, 2L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 2L, 1L, 3L, 3L, 
    2L, 2L, 3L, 1L, 2L, 4L, 3L, 4L, 2L, 3L, 1L, 4L, 4L, 3L, 1L, 2L, 
    1L, 1L, 4L, 1L, 2L, 4L, 2L, 1L, 1L, 2L, 4L, 2L, 2L, 4L, 1L, 1L, 
    2L, 4L, 2L, 4L, 2L, 1L, 2L, 2L, 4L, 2L, 4L, 2L, 4L, 3L, 1L, 4L, 
    2L, 1L, 1L, 2L, 4L, 2L, 4L, 2L, 4L, 4L, 2L, 4L, 1L, 1L, 4L, 2L, 
    4L, 4L, 3L, 4L, 4L, 2L, 1L, 1L, 1L, 4L, 1L, 1L, 4L, 4L, 2L, 2L, 
    4L, 1L, 2L, 2L, 4L, 4L, 4L, 2L, 2L, 1L, 4L, 4L, 2L, 3L, 1L, 2L, 
    2L, 4L, 4L, 1L, 2L, 4L, 4L, 2L, 2L, 4L, 2L, 4L, 2L, 4L, 1L, 1L, 
    2L, 1L, 4L, 4L, 3L, 4L, 2L, 4L, 3L, 1L, 1L, 2L, 1L, 1L, 4L, 2L, 
    4L, 2L, 4L, 3L, 1L, 4L, 1L, 1L, 2L, 4L, 2L, 1L, 4L, 1L, 4L, 3L, 
    2L, 3L, 2L, 4L, 3L, 3L, 2L, 1L, 3L, 1L, 1L, 3L, 2L, 3L, 3L, 3L, 
    1L, 2L, 4L, 2L, 3L, 2L, 1L, 4L, 3L, 2L, 4L, 4L, 2L, 4L, 1L, 1L, 
    2L, 2L, 4L, 1L, 2L, 4L, 2L, 4L, 3L, 4L), .Label = c("forward", 
    "left", "non-moving", "right"), class = "factor")), .Names = c("Speed_Out", 
    "Movement_Out"), row.names = c(NA, 283L), class = "data.frame")
    

    Out好吧,我不得不说这比我想象的要简单。我的答案很难看,而且很可能不是最优的,但似乎有效

    似乎有几个地方,即使考虑到其余的数据,也没有一个条件得到满足,因此这些人的行为仍停留在NA

    library(dplyr)
    
    # Create id variable used to join results later
    Out <- Out %>%
      mutate(id=row_number())
    
    # Initial window size
    window_size <- 4
    
    # Initialize variables used in loop
    w <- window_size
    i<-1
    window_cnt<-1
    out_behaviour <- data.frame(id=as.numeric(), Behaviour=as.character(), stringsAsFactors = FALSE)
    
    while (i <= NROW(Out)){
    
      print(paste0("Row: ", i, ", Window Size: ", w))
    
      df <- Out[i:(i+w-1),] %>%
        mutate(mean_sp=mean(Speed_Out),
               mvmt=sum(ifelse(Movement_Out=="left",1 ,0))/NROW(.)) %>%
        mutate(Behaviour=case_when(mean_sp <= 0.152682 ~ "Lying",
                                   mvmt <= 0.208 & mean_sp >= 0.200921 ~ "Grazing",
                                   TRUE ~ as.character(NA)),
               window_nr=window_cnt)
    
      if (!all(is.na(df$Behaviour))){
        i<-w+i
        w<-window_size
        out_behaviour <- rbind(out_behaviour, df %>% select(id, Behaviour, window_nr))
        window_cnt<-window_cnt+1
      } else {
        if (w<=NROW(Out)-i){
          w<-w+1
        } else {
          w<-window_size
          i<-i+1
        }
      }
    
      rm(df)
    }
    
    # Join Behaviour column bacl to original data frame
    Out <- left_join(Out, out_behaviour, by="id") %>% select(-id)
    
    # Clean up workspace
    rm(i, w, window_size, window_cnt, out_behaviour)
    

    我知道代码很乱,所以如果需要额外的注释,请告诉我。

    我建议您在循环中添加一个print(I)和print(w),以查看进度,并确保您不会陷入无限循环。太好了-这项工作太棒了!如果需要,添加规则也很容易。作为一个新手,你建议把打印语句放在哪里?非常感谢。@PharmR先生,我已经更新了我的答案,使代码更加清晰,并为您添加了打印语句。非常感谢您的帮助!我的荣幸。这是一个需要解决的有趣问题:)
    library(dplyr)
    
    # Create id variable used to join results later
    Out <- Out %>%
      mutate(id=row_number())
    
    # Initial window size
    window_size <- 4
    
    # Initialize variables used in loop
    w <- window_size
    i<-1
    window_cnt<-1
    out_behaviour <- data.frame(id=as.numeric(), Behaviour=as.character(), stringsAsFactors = FALSE)
    
    while (i <= NROW(Out)){
    
      print(paste0("Row: ", i, ", Window Size: ", w))
    
      df <- Out[i:(i+w-1),] %>%
        mutate(mean_sp=mean(Speed_Out),
               mvmt=sum(ifelse(Movement_Out=="left",1 ,0))/NROW(.)) %>%
        mutate(Behaviour=case_when(mean_sp <= 0.152682 ~ "Lying",
                                   mvmt <= 0.208 & mean_sp >= 0.200921 ~ "Grazing",
                                   TRUE ~ as.character(NA)),
               window_nr=window_cnt)
    
      if (!all(is.na(df$Behaviour))){
        i<-w+i
        w<-window_size
        out_behaviour <- rbind(out_behaviour, df %>% select(id, Behaviour, window_nr))
        window_cnt<-window_cnt+1
      } else {
        if (w<=NROW(Out)-i){
          w<-w+1
        } else {
          w<-window_size
          i<-i+1
        }
      }
    
      rm(df)
    }
    
    # Join Behaviour column bacl to original data frame
    Out <- left_join(Out, out_behaviour, by="id") %>% select(-id)
    
    # Clean up workspace
    rm(i, w, window_size, window_cnt, out_behaviour)
    
       Speed_Out Movement_Out Behaviour window_nr
    1      0.220         left     Lying         1
    2      0.155         left     Lying         1
    3      0.120      forward     Lying         1
    4      0.090   non-moving     Lying         1
    5      0.125   non-moving   Grazing         2
    6      0.125   non-moving   Grazing         2
    7      0.155   non-moving   Grazing         2
    8      0.340      forward   Grazing         2
    9      0.370      forward   Grazing         2
    10     0.185      forward   Grazing         3
    11     0.155        right   Grazing         3
    12     0.220   non-moving   Grazing         3
    13     0.220   non-moving   Grazing         3
    14     0.280   non-moving   Grazing         3
    15     0.215   non-moving   Grazing         4
    16     0.060        right   Grazing         4
    17     0.340   non-moving   Grazing         4
    18     0.555      forward   Grazing         4
    19     0.275        right   Grazing         5
    20     0.215      forward   Grazing         5