[RÉSOLU] chronologie d'événements

[Laëtitia VIBERT]

EDIT: j'ai réussi à contourner le problème en faisant autrement, mais si toutefois qqn sait comment résoudre ce problème d'axe temporel, cela m'intéresse ! Merci

Bonjour,
mon jeu de données représente des événements (plongées) successifs pour plusieurs individus, sur un pas de temps relativement long. Chaque individu effectue plusieurs plongées, et j'aimerais visualiser lesquels plongent en même temps, à 5 minutes près (mes données étant à la seconde près).
Pour cela, j'ai essayé plusieurs choses (avec ggplot2, timelinne...) sans succès. J'ai essayé de créer un axe du temps et de positionner un à un les événements, mais ça ne marche pas non plus (un exemple ici avec juste 2 plongées du premier individu et 3 plongées du deuxième individu) :

Code : Tout sélectionner

getOption("digits.secs")
options(digits.secs=4)  # to deal with thousandths of a second from accelerometer data
library(data.table) # fread funtion
library(lubridate)  # date - time management
library(ggplot2) #graphic

trip_tab <- data.frame("RFID" <- c(20190111_2086644,20190111_2086644,20190110_3975011,20190110_3975011,20190110_3975011),
   "beg" <- c(2018-12-27 00:16:56,2018-12-29 21:17:24,2018-12-25 22:01:39,2018-12-28 14:36:14,2018-12-31 04:40:55),
    "end" <- c(2018-12-28 12:47:48,2018-12-31 03:08:13,2018-12-26 21:12:08,2018-12-29 18:23:00,2019-01-01 18:20:08)

list.Pengu <- unique(trip_tab$RFID)
trip_tab$beg <- strptime(trip_tab$beg,"%d/%m/%Y %H:%M:%OS",tz = "UTC")
trip_tab$end <- strptime(trip_tab$end,"%d/%m/%Y %H:%M:%OS",tz = "UTC")
range.date <- time_length(min(trip_tab$beg),max(trip_tab$end)) #create timeline range
 
for (a in 1:length(list.Pengu)) { #for each individual
  x0=trip_tab$beg[which(trip_tab$RFID == list.Pengu[a])] #begin of dive
  y0=trip_tab$end[which(trip_tab$RFID == list.Pengu[a])] #end of dive
  plot(NA,ylim = c(-1,1), xlim = range(), ann=F, axes=F) #plot timeline axis
  abline(h=0,lwd=2)
  segments(x0,y0,1,1) #include events
}

Quelqu'un aurait-il déjà été confronté à ce genre de problème ?
Je vous remercie d'avance de votre aide =)

[Mickael Canouil]

Bonjour,

Qu'est-ce qu'un code reproductible ?
Comment insérer des données dans un message ?

Code : Tout sélectionner

range.date <- time_length(min(trip_tab$beg),max(trip_tab$end)) #create timeline range
#> Error in time_length(min(trip_tab$beg), max(trip_tab$end)): could not find function "time_length"

for (a in 1:length(list.Pengu)) { #for each individual
x0=trip_tab$beg[which(trip_tab$date_RFID == list.Pengu[a])] #begin of dive
y0=trip_tab$end[which(trip_tab$date_RFID == list.Pengu[a])] #end of dive
plot(NA,ylim = c(-1,1), xlim = range(), ann=F, axes=F) #plot timeline axis
abline(h=0,lwd=2)
segments(x0,y0,1,1) #include events
}
#> Error in eval(expr, envir, enclos): object 'list.Pengu' not found

PS: pour le code, il y a des balises "code".

Cordialement,

[Laëtitia VIBERT]

Merci Mickael. J'ai modifié mon message.
Finalement, j'ai réussi à contourner le problème en faisant autrement, mais si toutefois vous savez comment résoudre ce problème d'axe temporel, cela m'intéresse quand même !
Bien à vous,
L.

[Mickael Canouil]

Bonjour,

un code reproductible est un code qui fonctionne (le code doit fonctionner avec un simple copier-coller), ce n'est pas vraiment le cas en raison de plusieurs erreurs de syntaxe pour insérer les données (cf. le lien donné dans mon message précédent pour insérer des données)

Code : Tout sélectionner

trip_tab <- data.frame("RFID" <- c=(20190111_2086644,20190111_2086644,20190110_3975011,20190110_3975011,20190110_3975011
#> Error: unexpected '=' in "trip_tab <- data.frame("RFID" <- c="
),"beg" <- c=(2018-12-27 00:16:56,2018-12-29 21:17:24,2018-12-25 22:01:39,2018-12-28 14:36:14,2018-12-31 04:40:55), "end" <- c=(2018-12-28 12:47:48,2018-12-31 03:08:13,2018-12-26 21:12:08,2018-12-29 18:23:00,2019-01-01 18:20:08))
#> Error: unexpected ')' in ")"

Sinon voici une proposition de visualisation:

Code : Tout sélectionner

options(digits.secs = 4)

library(tidyverse)
library(lubridate)

trip_tab <- data.frame(
  "RFID" = c("20190111_2086644", "20190111_2086644", "20190110_3975011", "20190110_3975011", "20190110_3975011"),
  "beg" = c("2018-12-27 00:16:56", "2018-12-29 21:17:24", "2018-12-25 22:01:39", "2018-12-28 14:36:14", "2018-12-31 04:40:55"),
  "end" = c("2018-12-28 12:47:48", "2018-12-31 03:08:13", "2018-12-26 21:12:08", "2018-12-29 18:23:00", "2019-01-01 18:20:08"),
  stringsAsFactors = FALSE
)

gg_trip_tab <- trip_tab %>%
  tibble::as_tibble() %>% # data.frame amélioré
  dplyr::mutate_at(.vars = vars(beg, end), .funs = ~lubridate::as_datetime(., tz = "UTC"))  %>% # transformation des colonnes beg et end dans le format "date"
  tidyr::gather(key = "dive_io", value = "time", -RFID) %>%  # regroupement dans la même colonne des dates beg et end
  dplyr::mutate(dive_io = c("beg" = 0, "end" = 1)[dive_io]) # recodage de "beg" et "end" en 0 et 1

ggplot(
  data = gg_trip_tab,
  mapping = aes(x = time, y = dive_io, xend = time, yend = dive_io, colour = RFID)
) +
  geom_line() +
  scale_y_continuous(breaks = c("In" = 0, "Out" = 1)) +
  labs(x = "Time", y = "Dive")

EDIT: Ayant du temps ce midi, je propose le code ci-dessous pour visualiser les "plongeurs simultanés" (à 5 minutes près):

Code : Tout sélectionner

options(digits.secs = 4)

library(tidyverse)
library(lubridate)

set.seed(20190424)
fake_data <- tibble(
  RFID = rep(LETTERS, each = 4),
  time = origin + years(48),
  dive_io = rep(c(0, 1), length(RFID)/2)
) %>%
  group_by(RFID) %>%
  mutate(
    time = time + minutes(sort(sample(10000, size = n())))
  ) %>%
  ungroup()


ggplot(
  data = fake_data,
  mapping = aes(x = time, y = dive_io, xend = time, yend = dive_io, colour = RFID)
) +
  geom_line() +
  scale_y_continuous(breaks = c("In" = 0, "Out" = 1)) +
  labs(x = "Time", y = "Dive")

Code : Tout sélectionner

same_dive_data <- fake_data %>%
  filter(dive_io==0) %>%
  mutate(
    interval_5min = interval(
      start = time - minutes(5),
      end = time + minutes(5)
    ),
    all_interval = list(interval_5min)
  ) %>%
  arrange(time) %>%
  mutate(
    same_dive = map2_chr(
      .x = interval_5min, .y = all_interval,
      .f = function(.x, .y) {
        paste(which(int_overlaps(.x, .y)), collapse = "_")
      }
    ),
    interval_5min = NULL,
    all_interval = NULL,
    dive_io = NULL
  )

fake_data <- full_join(
  x = fake_data,
  y = same_dive_data,
  by = c("RFID", "time")
) %>%
  fill(same_dive) %>%
  group_by(same_dive) %>%
  add_count(same_dive) %>%
  mutate(
    gg_facet = ifelse(n<=2, "alone", same_dive),
    gg_label = ifelse(n<=2 | dive_io==0, NA, RFID),
  ) %>%
  ungroup()

ggplot(
  data = fake_data,
  mapping = aes(x = time, y = dive_io, xend = time, yend = dive_io, colour = RFID)
) +
  geom_line() +
  geom_label(mapping = aes(label = gg_label), na.rm = TRUE) +
  scale_y_continuous(breaks = c("In" = 0, "Out" = 1)) +
  labs(x = "Time", y = "Dive") +
  facet_wrap(facets = vars(gg_facet))

Code : Tout sélectionner

fake_data %>%
  filter(n>2) %>%
  arrange(same_dive) %>%
  select(-starts_with("gg_"), -n)
#> # A tibble: 12 x 4
#>    RFID  time                     dive_io same_dive
#>    <chr> <dttm>                     <dbl> <chr>   
#>  1 G     2018-01-01 16:16:00.0000       0 13_47   
#>  2 G     2018-01-01 23:17:00.0000       1 13_47   
#>  3 X     2018-01-01 16:21:00.0000       0 13_47   
#>  4 X     2018-01-02 18:43:00.0000       1 13_47   
#>  5 H     2018-01-01 11:47:00.0000       0 15_43   
#>  6 H     2018-01-01 17:03:00.0000       1 15_43   
#>  7 V     2018-01-01 11:44:00.0000       0 15_43   
#>  8 V     2018-01-05 03:57:00.0000       1 15_43   
#>  9 I     2018-01-05 13:28:00.0000       0 17_48   
#> 10 I     2018-01-07 02:46:00.0000       1 17_48   
#> 11 X     2018-01-05 13:27:00.0000       0 17_48   
#> 12 X     2018-01-07 17:57:00.0000       1 17_48

Cordialement,

[Laëtitia VIBERT]

Bonjour Mickael,

navrée pour les erreurs dans le script, c'est désormais corrigé, je ferai plus attention la prochaine fois.

Merci pour les propositions de code, ça m'a l'air de correspondre à ce que je m'étais imaginé. Je vais potasser un peu le package tidyverse que je ne connaissais pas du tout et qui m'a l'air d'avoir une syntaxe très spécifique, et je vais voir comment adapter cela à ma data.

Encore merci.

PS: dois-je marquer ce post comme résolu dans le titre ?

[Mickael Canouil]

Le tidyverse n'est pas un package à proprement parler, c'est un ensemble de package partageant une philosophie/syntaxe commune.
https://www.tidyverse.org/
https://r4ds.had.co.nz/

Vous pouvez l'indiquer comme "RESOLU", si c'est le cas.