Forløpsanalyse på treningsdata

Et forsøk på å skvise noe mer innsikt ut av treningsdataene med forløpsanalyse.

Eivind Hageberg https://suppe-og-analyse.netlify.app
2019-10-29

Sist så jeg nærmere på treningsdataene mine, og fant litt ulike måter å visualisere dem på. Men kan de også kjøres gjennom en forløpsanalyse?

Her finnes det to tilnærminger, og to interessante forløp å studere. - Den ene er tida mellom enkelttreninger, dvs. egentlig hvor lange pausene er, og hva som bidrar til kortere vs. lengre pausetider. - Den andre er tida i en lengre treningsperiode, bestående av flere treningsøkter, før den brytes opp.

Hva konklusjonen blir? Dette fungerer sånn passe godt som eksempel på en ide som ikke viser å gi stort, men ikke så mye mer.

For å få dette over på et forløpsformat, lager jeg en data.frame med alle datoer i rekka, før jeg joiner inn treningsdataene:

df_alle = data.frame(dato = seq(from = as.Date(ymd_hms(min(df$start_time))), to = as.Date(ymd_hms(max(df$start_time))), by = 1)) %>%
  left_join(., df) %>%
  arrange(dato) %>%
  mutate(er_trening = ifelse(is.na(start_time), FALSE, TRUE)
         ) 
#her må jeg også håndtere datoer som har to treningsøkter registrert.

Dagers pause

Så kan jeg kartlegge hvor mange dagers pause jeg har mellom treningsøkter. I samme slengen legger jeg på en identifikator, som identifiserer hver treningsøkt + dagene med restitusjon som tilhørende til en “økt”.

i = 1
j = 0
`økt` = 0 

df_alle$dager_siden_trening = NULL
df_alle$økt_id = NULL

#faktisk
for(i in 1:length(df_alle$dato)){
  if(df_alle$er_trening[[i]] == TRUE){
    j = 0
    `økt` = `økt` + 1
    df_alle$dager_siden_trening[[i]] = j
    df_alle$`økt_id`[[i]] = `økt`
  }
  if(df_alle$er_trening[[i]] == FALSE){
    j = j+1
    df_alle$dager_siden_trening[[i]] = j
    df_alle$`økt_id`[[i]] = `økt`
  }
}

#av en eller anna grunn, jeg forstår ikke hvorfor, blir variablene som redigeres her
#lister. Dette er jo noe nytt R har begynt med siden jeg først lagde denne
#unlister dem ganske enkelt ???

df_alle = mutate(df_alle,
                 dager_siden_trening = unlist(dager_siden_trening),
                 `økt_id` = unlist(`økt_id`)
                 )

temp1 = group_by(df_alle, `økt_id`) %>%
  summarise(dager_restitusjon = max(dager_siden_trening))

temp2 = ungroup(temp1) %>%
  group_by(dager_restitusjon) %>%
  summarise(antall = n())

ggplot(data = temp2) + 
  geom_col(aes(x = dager_restitusjon, y = antall))

Langt de fleste resitusjonsperiodene er på 1-4 dager - nærmere 250 av de 292 treningsaktivitetene ble etterfulgt av ei slik pause. Men så dras snittet opp av de lengre periodene på ei uke, to uker og mer.

Min teori er at det ikke er stort å hente her ved å se på dette som et forløp: alle pausene er avslutta med en ny treningsøkt, og sensurering av observasjoner er ikke et problem.

Det er to grunnleggende biter informasjon jeg trenger for å se på dette i et forløps-oppsett: Tid til hendelse, og en indikator på hvilken hendelse som inntraff. Hendelsen er en ny treningsøkt. Tida er lengden på pausen mellom treningsøkter, i dager.

df_survival = ungroup(df_alle) %>%
  select(dato, dager_siden_trening, økt_id, er_trening) %>%
  group_by(økt_id) %>%
  filter(dager_siden_trening == max(dager_siden_trening)) %>%
  mutate(
    pauselengde = dager_siden_trening,
    hendelse = !er_trening
    )

#en kikk på Surv-objektet
trening_survival = survfit(Surv(pauselengde, hendelse == TRUE)~1, data = df_survival)
trening_survival
Call: survfit(formula = Surv(pauselengde, hendelse == TRUE) ~ 1, data = df_survival)

       n events median 0.95LCL 0.95UCL
[1,] 292    286      2       2       2
temp = broom::tidy(trening_survival) %>%
  filter(time < 50)

ggplot(data = temp, aes(x = time, y = estimate))+
  geom_line() +
  geom_ribbon(aes(ymin=conf.low,ymax=conf.high),alpha=0.2) +
  labs(x = "Dagers pause", y = "Sannsynlighet for å fortsette treningspausa", title = "Sannsynlighet for å fortsette treningspause, etter antall dager", subtitle = "Kaplan-Meier-kurve")

Her ser vi det samme mønsteret som i grafen over: langt de fleste pausene er korte, og sannsynligheten for å fortsette ei pause faller ganske bratt de første fire dagene. Deretter flater den ut, og faller langt langsommere etter det.

Jeg har ingen egentlig informasjon om pausen, utover lengden på den, og en dato som forteller noe om hvilken del av året pausen var i.

Treningsperioder

Mens vi over så på hver enkelt pause, og sannsynligheten for å avbryte pausa og gå tilbake i trening, er det kanskje mer interessant å se på lengre bolker av trening: Det er ikke noe mål i seg selv å ha kortest mulig pauser mellom treningsøktene, også pausene er viktige.

Derfor grupperer jeg disse i bolker av trening, der en tilstrekkelig lang pause gir “frafall” fra treninga. Hvor mange dagers pause gir fall i kondisjonen, slik at en ny oppstart kan sies å starte på et betraktelig lavere nivå enn der man slapp opp? Det spørs på intensiteten på treninga, men det ser (ifølge denne artikkelen) ut til å være slik at:

Hvor mange ulike perioder snakker vi potensielt her om, hvis vi setter cutoffen et sted mellom 4 dager og 28 dager?

#settings for loopen i pauselengder
temp = data.frame(pauselengde = 4:28, antall_perioder = NA)

for(a in min(temp$pauselengde):max(temp$pauselengde)){
#settings for treningsloopen
i = 1
df_alle$periode[[1]] = 1
periode = 1 

for(i in 2:length(df_alle$dato)){
  if(df_alle$er_trening[[i]] == TRUE){
    if(df_alle$dager_siden_trening[[i-1]] <= a-1){
      df_alle$periode[[i]] = periode
    }
    if(df_alle$dager_siden_trening[[i-1]] > a-1){
      periode = periode + 1
      df_alle$periode[[i]] = periode
    }
  }
  if(df_alle$er_trening[[i]] == FALSE){
    df_alle$periode[[i]] = periode
  }
}
 df_alle$periode = unlist(df_alle$periode)
 temp[a - (min(temp$pauselengde)-1),2] = max(df_alle$periode)
}


ggplot(data = temp) + 
  geom_line(aes(x = pauselengde, y = antall_perioder)) + 
  labs(title = "Antall treningsperioder", x = "Dagers pause for ny periode", y = "Antall perioder")

Hvis vi setter cut-off ved 4 dager, er jeg oppe i nærmere 70 distinkte treningsperioder. Antallet perioder avtar ganske bratt til rundt ca. 8 dagers pause, hvorfra det flater ut. Med 12 dagers pause er antallet treningsperioder 15, og 28 er det 6 perioder.

Vi går for 12 dager, den korteste pausa forskninga over henviser til som betraktelig dårlig:

#settings for treningsloopen
i = 1
df_alle$periode[[1]] = 1
periode = 1 

for(i in 2:length(df_alle$dato)){
  if(df_alle$er_trening[[i]] == TRUE){
    if(df_alle$dager_siden_trening[[i-1]] <= 11){
      df_alle$periode[[i]] = periode
    }
    if(df_alle$dager_siden_trening[[i-1]] > 11){
      periode = periode + 1
      df_alle$periode[[i]] = periode
    }
  }
  if(df_alle$er_trening[[i]] == FALSE){
    df_alle$periode[[i]] = periode
  }
}

df_alle = group_by(df_alle, periode)%>%
  mutate(dag_periode = seq_along(dato))

#lager en dataframe med den nødvendige informasjonen
df_survival = ungroup(df_alle) %>%
  select(dato, periode, dag_periode, er_trening) %>%
  group_by(periode) %>%
  filter(dag_periode == max(dag_periode)) %>%
  mutate(
    hendelse = !er_trening
    )

Mens vi i analysen over så på tiden fra en treningsøkt og fram til neste pause, og sannsynligheten for å avslutte en restitusjonsperiode, ser vi her på lengden på en treningsperiode før den blir avbrutt av en 12-dagerspause - en pause så lang at det skjer et betraktelig fall i kondisjonen.

Den lengste perioden ble avslutta i januar 2019, på nærmere 300 dager - store deler av 2018. Juni 2016 markerte slutten på en nesten like lang treningsperiode.

ggplot(data = df_survival) + 
  geom_point(aes(x = dag_periode, y = fct_reorder(as.factor(dato), dag_periode))) + 
  labs(x = "Varighet på treningsperiode", y = "periode_id", title = "Lengde på periode") + 
  scale_x_continuous(limits = c(0, 300))

Så hvordan ser dette ut, når vi estimerer en kurve for sannsynligheten for treningsperiode-avbrudd?

#en kikk på Surv-objektet
trening_survival = survfit(Surv(dag_periode, hendelse == TRUE)~1, data = df_survival)
trening_survival
Call: survfit(formula = Surv(dag_periode, hendelse == TRUE) ~ 1, data = df_survival)

      n events median 0.95LCL 0.95UCL
[1,] 15     14     58      36     279
temp = broom::tidy(trening_survival)

ggplot(data = temp, aes(x = time, y = estimate))+
  geom_line() +
  geom_ribbon(aes(ymin=conf.low,ymax=conf.high),alpha=0.2) +
  labs(x = "Dagers varighet på treningsperiode", y = "Sannsynlighet for å fortsette trening", title = "Sannsynlighet for å fortsette en treningsperiode, etter antall dager", subtitle = "Kaplan-Meier-kurve")

Siden vi bare har 15 observasjoner, hvorav 1 er sensurert, blir sannsynligheten temmelig usikkert estimert. Den starter på mellom 80 % og 100 % rundt to ukers tid, faller ganske krapt fram til rundt to måneder - men faller så mer slakt av. Betyr det at om jeg klarer å holde en treningsperiode oppe i rundt to måneder, så er det blitt en mer innarbeida vane? Kanskje. For å finne ut av det burde jeg også få brukt treningsinformasjonen til noe fornuftig - men det får bli seinere.