Создайте новую категориальную переменную в df1, которая учитывает одну переменную df1 и несколько переменных df2 с несколькими условиями - PullRequest
Новая
       20

Создайте новую категориальную переменную в df1, которая учитывает одну переменную df1 и несколько переменных df2 с несколькими условиями

0 голосов
/ 18 мая 2019

У меня есть фрейм данных, подобный тем, которые используются в этом и этом посте. Причина в том, что мне нужно создать три разные переменные в моем наборе данных, и я написал разные посты для каждого вопроса, поскольку подход к ним отличается друг от друга.

df1 суммирует глубину разных рыб с течением времени в разных местах. df2 суммирует интенсивность течений во времени (КАЖДЫЕ ТРИ ЧАСА) от поверхности до глубины 39 метров с интервалами в 8 метров (m0-7, m8-15, m16-23, m24-31 и m32-39) в конкретное место. Как пример: 

df1<-data.frame(Datetime=c("2016-08-01 15:34:07","2016-08-01 16:25:16","2016-08-01 17:29:16","2016-08-01 18:33:16","2016-08-01 20:54:16","2016-08-01 22:48:16"),Site=c("BD","BD","BD","BD","BD","BD"),Ind=c(16,17,19,16,17,16), Depth=c(5.3,24,36.4,42,NA,22.1))
df1$Datetime<-as.POSIXct(df1$Datetime, format="%Y-%m-%d %H:%M:%S",tz="UTC")


> df1
             Datetime Site Ind Depth
1 2016-08-01 15:34:07   BD  16   5.3
2 2016-08-01 16:25:16   BD  17  24.0
3 2016-08-01 17:29:16   BD  19  36.4
4 2016-08-01 18:33:16   BD  16  42.0
5 2016-08-01 20:54:16   BD  17    NA
6 2016-08-01 22:48:16   BD  16  22.1

df2<-data.frame(Datetime=c("2016-08-01 12:00:00","2016-08-01 15:00:00","2016-08-01 18:00:00","2016-08-01 21:00:00","2016-08-02 00:00:00"), Site=c("BD","BD","BD","BD","BD"),var1=c(2.75,4,6.75,2.25,4.3),var2=c(3,4,4.75,3,2.1),var3=c(2.75,4,9.8,2.25,1.4),var4=c(3.25,3,6.5,8.9,3.4),var5=c(3,4,2.3,2.6,1.7))
df2$Datetime<-as.POSIXct(df2$Datetime, format="%Y-%m-%d %H:%M:%S",tz="UTC")
colnames(df2)<-c("Datetime","Site","m0-7","m8-15","m16-23","m24-31","m32-39")

> df2
             Datetime Site m0-7 m8-15 m16-23 m24-31 m32-39
1 2016-08-01 12:00:00   BD 2.75  3.00   2.75   3.25    3.0
2 2016-08-01 15:00:00   BD 4.00  4.00   4.00   3.00    4.0
3 2016-08-01 18:00:00   BD 6.75  4.75   9.80   6.50    2.3
4 2016-08-01 21:00:00   BD 2.25  3.00   2.25   8.90    2.6
5 2016-08-02 00:00:00   BD 4.30  2.10   1.40   3.40    1.7

Я хочу создать в df1 новую переменную с именем Outside_currents, которая будет отражать, избегает ли рыба ВЫСОКИХ ТЕЧЕНИЙ. Я определяю столбец Outside_currents как «Скажите, если рыба ИЗБЕГАЕТ, чтобы быть в слое сильных течений, когда ОН имеет шанс быть там или нет». Мои рыбы ВСЕГДА движутся на глубине более 15 метров, поэтому я учитываю только эти три последних столбца (m16-23, m24-31 и m32-39).

Превратил это в математику:

Outside_currents: "когда один или два слоя из трех рассмотренных (m16-23, m24-31 и m32-39) имеют силы тока в ТРИ РАЗА БОЛЬШЕ, чем в другой-двух, рыба ВНЕ? ,

Возможные ответы:

  1. Yes: рыба находится в слое, в котором интенсивность тока в три раза ниже, чем в одном или двух других слоях.
  2. No: рыба находится в слое или слоях, сила тока которых в три раза выше, чем у остальных.
  3. NA: когда это условие не существует (нет слоя с силой тока в 3 раза больше, чем в других), или когда переменная глубина равна «NA».

Я бы ожидал этого: 

> df1
             Datetime Site Ind Depth Out_current
1 2016-08-01 15:34:07   BD  16   5.3          NA
2 2016-08-01 16:25:16   BD  17  24.0          NA
3 2016-08-01 17:29:16   BD  19  36.4         YES
4 2016-08-01 18:33:16   BD  16  42.0         YES
5 2016-08-01 19:33:16   BD  17  24.0          NO
6 2016-08-01 20:54:16   BD  16    NA          NA
7 2016-08-01 22:48:16   BD  16  22.1          NA

Ответы [ 2 ]

1 голос
/ 18 мая 2019

Я думаю, что что-то упустил в вашем вопросе.Кажется, вы смотрите только на df2, и каждый раз, когда ток помечается в 3 раза выше, чем на одной глубине, ток будет помечен как 3х ниже на одной из других глубин.Я положил это вместе.Посмотрите, может ли это помочь вам начать. 

library(tidyverse)

outside_calcs <-
  df2 %>% 
  gather(depth, value, m16_23:m32_39) %>% 
  left_join(df2) %>% 
  mutate(
    comp_16 = m16_23/value,
    comp_24 = m24_31/value,
    comp_32 = m32_39/value,
    min_diff = pmin(comp_16, comp_24, comp_32),
    max_diff = pmax(comp_16, comp_24, comp_32)
  ) %>% 
  mutate(
    outside_currents = 
      case_when(
        min_diff < 0.33 ~ "Yes",
        max_diff > 3 ~ "No",
        TRUE ~ NA_character_
      )
  )

#            Datetime Site  depth value m16_23 m24_31 m32_39 comp_16 comp_24 comp_32 min_diff max_diff outside_currents
# 2016-08-18 21:00:00   BD m16_23  2.25   2.25    8.9    2.6   1.000    3.96   1.156    1.000     3.96               No
# 2016-08-18 21:00:00   BD m24_31  8.90   2.25    8.9    2.6   0.253    1.00   0.292    0.253     1.00              Yes
# 2016-08-18 21:00:00   BD m32_39  2.60   2.25    8.9    2.6   0.865    3.42   1.000    0.865     3.42               No

final_outside <-
  outside_calcs %>% 
  mutate(depth = str_replace(depth, "m", "c")) %>% 
  select(
    Datetime, Site,
    depth, outside_currents
  ) %>% 
  spread(depth, outside_currents) %>% 
  left_join(df2) %>% 
  select(Datetime, Site, starts_with("m"), starts_with("c"))

final_outside  

#            Datetime Site m16_23 m24_31 m32_39 c16_23 c24_31 c32_39
# 2016-08-18 12:00:00   BD   2.75   3.25    3.0   <NA>   <NA>   <NA>
# 2016-08-18 15:00:00   BD   4.00   3.00    4.0   <NA>   <NA>   <NA>
# 2016-08-18 18:00:00   BD   9.80   6.50    2.3    Yes   <NA>     No
# 2016-08-18 21:00:00   BD   2.25   8.90    2.6     No    Yes     No
# 2016-08-19 00:00:00   BD   1.40   3.40    1.7   <NA>   <NA>   <NA>
0 голосов
/ 20 мая 2019

Решение: 

library(data.table)

library(lubridate)

library(dplyr)

df1<-data.frame(Datetime=c("2016-08-01 12:34:07","2016-08-01 15:34:07","2016-08-01 16:25:16","2016-08-01 17:29:16","2016-08-01 18:33:16","2016-08-01 19:23:16","2016-08-01 20:01:16","2016-08-01 20:54:16","2016-08-01 22:48:16","2016-08-01 23:48:16","2016-08-02 01:07:16"), Site=c("BD","BD","HG","BD","BD","BD","BD","BD","BD","HG","BD"),Ind=c(16,16,17,19,16,16,17,16,16,17,16), Depth=c(15.50,5.30,24.00,36.40,42.00,25.00,NA,22.10,54.00,27.00,21.50))
df1$Datetime<-as.POSIXct(df1$Datetime, format="%Y-%m-%d %H:%M:%S",tz="UTC")
df1$Datetime_rounded<-round_date(df1$Datetime, "3 hour")

df2<-data.frame(Datetime=c("2016-08-01 12:00:00","2016-08-01 15:00:00","2016-08-01 18:00:00","2016-08-01 21:00:00","2016-08-02 00:00:00"), 
            Site=c("BD","BD","BD","BD","BD"),
            var1=c(2.75,4.00,6.75,2.25,4.30),
            var2=c(3.80,7.75,4.75,3.00,2.10),
            var3=c(2.20,4.30,6.80,2.25,3.40),
            var4=c(5.40,1.10,2.25,3.30,6.50),
            var5=c(7.30,5.20,1.30,2.60,1.70))
df2$Datetime<-as.POSIXct(df2$Datetime, format="%Y-%m-%d %H:%M:%S",tz="UTC")
colnames(df2)<-c("Datetime","Site","m0-7","m8-15","m16-23","m24-31","m32-39")

df1<-df1[,c(1,5,2,3,4)] # Rearrange the data frame

setDT(df1) # We convert into data.table
setDT(df2)

setkey(df1, Site, Datetime_rounded) # We indicate the key variables.
setkey(df2, Site, Datetime)

df_merge = df2[df1, roll = -Inf] # Associate one table with the other.
df_merge<-df_merge[,c(8,2,9,10,3:7)] # Rearrange the data.table

df_merge[, Outside_current := case_when(
  Site != "BD" ~ "NA",
  Depth == "NA" ~ "NA",
  Depth < 15 ~ "NA",
  Depth >= 15 & Depth < 24 & (`m16-23`*3 < `m24-31` | `m16-23`*3 < `m32-39` | `m16-23`*3 < (`m24-31`+`m32-39`)/2 ) ~ "Yes",
  Depth >= 24 & Depth < 32 & (`m24-31`*3 < `m16-23` | `m24-31`*3 < `m32-39` | `m24-31`*3 < (`m16-23`+`m32-39`)/2 ) ~ "Yes",
  Depth >= 32 & (`m32-39`*3 < `m16-23` | `m32-39`*3 < `m24-31` | `m32-39`*3 < (`m16-23`+`m24-31`)/2 ) ~ "Yes",
  Depth >= 24 & (`m16-23`*3 < `m24-31` | `m16-23`*3 < `m32-39` | `m16-23`*3 < (`m24-31`+`m32-39`)/2 ) ~ "No",
  (Depth >= 15 & Depth <24 | Depth >= 32) & (`m24-31`*3 < `m16-23` | `m24-31`*3 < `m32-39`  | `m24-31`*3 < (`m16-23`+`m32-39`)/2 ) ~ "No",
  Depth < 32 & (`m32-39`*3 < `m16-23` | `m32-39`*3 < `m24-31` | `m32-39`*3 < (`m16-23`+`m24-31`)/2 ) ~ "No",
  T ~ "NA")]

> df_merge
             i.Datetime Site Ind Depth m0-7 m8-15 m16-23 m24-31 m32-39 Outside_current
 1: 2016-08-01 12:34:07   BD  16  15.5 2.75  3.80   2.20   5.40    7.3             Yes
 2: 2016-08-01 15:34:07   BD  16   5.3 4.00  7.75   4.30   1.10    5.2              NA
 3: 2016-08-01 17:29:16   BD  19  36.4 6.75  4.75   6.80   2.25    1.3             Yes
 4: 2016-08-01 18:33:16   BD  16  42.0 6.75  4.75   6.80   2.25    1.3             Yes
 5: 2016-08-01 19:23:16   BD  16  25.0 6.75  4.75   6.80   2.25    1.3             Yes
 6: 2016-08-01 20:01:16   BD  17    NA 2.25  3.00   2.25   3.30    2.6              NA
 7: 2016-08-01 20:54:16   BD  16  22.1 2.25  3.00   2.25   3.30    2.6              NA
 8: 2016-08-01 22:48:16   BD  16  54.0 4.30  2.10   3.40   6.50    1.7             Yes
 9: 2016-08-02 01:07:16   BD  16  21.5 4.30  2.10   3.40   6.50    1.7              No
10: 2016-08-01 16:25:16   HG  17  24.0   NA    NA     NA     NA     NA              NA
11: 2016-08-01 23:48:16   HG  17  27.0   NA    NA     NA     NA     NA              NA
...