Analisis de Hormonas
Manuel Jimenez
2023-10-23
dfClong=dfC %>% rename(C_pre_12_8=C_basal_temporada) %>% select(CODE,contains("_pre_")) %>% pivot_longer(-CODE) %>%
mutate(mesDia=str_replace(name,"C_pre_([0-9]+)_([0-9]+)","\\2-\\1")) %>%
separate(col = "mesDia",into = c("mes","dia"),sep = "-") %>%
mutate(mes=as.integer(mes),dia=as.integer(dia),ano=as.integer(ifelse(mes>=7,2022,2023))) %>%
mutate(Fecha=make_date(month = mes,day = dia, year=ano)) %>%
select(CODE,Fecha,Cortisol=value) %>% filter(complete.cases(.))%>%
group_by(CODE) %>% mutate(CortisolZ=scale(Cortisol)) %>% ungroup()
dfClong %>% head()## # A tibble: 6 × 4
## CODE Fecha Cortisol CortisolZ[,1]
## <chr> <date> <dbl> <dbl>
## 1 COD1 2022-08-12 4.8 0.421
## 2 COD1 2022-08-18 3.99 -0.123
## 3 COD1 2022-08-26 3.23 -0.634
## 4 COD1 2022-08-30 4.3 0.0852
## 5 COD1 2022-09-07 5.6 0.958
## 6 COD1 2022-09-15 6.29 1.42dfTlong=dfT %>% rename(T_pre_12_8=T_basal_temporada) %>% select(CODE,contains("_pre_")) %>% pivot_longer(-CODE) %>%
mutate(mesDia=str_replace(name,"T_pre_([0-9]+)_([0-9]+)","\\2-\\1")) %>%
separate(col = "mesDia",into = c("mes","dia"),sep = "-") %>%
mutate(mes=as.integer(mes),dia=as.integer(dia),ano=as.integer(ifelse(mes>=7,2022,2023))) %>%
mutate(Fecha=make_date(month = mes,day = dia, year=ano)) %>%
select(CODE,Fecha,Testosterona=value) %>% filter(complete.cases(.)) %>%
group_by(CODE) %>% mutate(TestosteronaZ=scale(Testosterona)) %>% ungroup()
dfTlong %>% head()## # A tibble: 6 × 4
## CODE Fecha Testosterona TestosteronaZ[,1]
## <chr> <date> <dbl> <dbl>
## 1 COD1 2022-08-12 298 1.66
## 2 COD1 2022-08-18 254 0.832
## 3 COD1 2022-08-26 277 1.26
## 4 COD1 2022-08-30 287 1.45
## 5 COD1 2022-09-07 267 1.08
## 6 COD1 2022-09-15 250 0.757Vamos a Unir datos de partidos con los datos de T y C del del mismo día o anteriores Hay muchos entrenamientos, antes de una toma de Cortisol o Testosterona, pero enlazamos con la más cercana en el tiempo posterior o en el mismo dia. Añadimos la restricción que la medición de hormona no puede hacerse más de 6 días antes del partido para considerarse válida. (No queremos que se usen las hormonas de dos partidos posteriores en caso de que alguna vez no se haya hecho la medida.)
comp_date <- function(x, y) x > y
comp_code <- function(x, y) x == y
dfPartidos_CAnterior <- dfPartidos %>% select(Fecha) %>%
fuzzy_left_join(dfClong , by = c("Fecha" = "Fecha"),
match_fun = list(comp_date)) %>%
group_by(Fecha.x) %>%
filter(Fecha.y == max(Fecha.y)) %>%
ungroup() %>%
rename(Fecha=Fecha.x,Fecha_C=Fecha.y) %>%
select(CODE,Fecha,Fecha_C,everything())
dfPartidos_TAnterior <- dfPartidos %>% select(Fecha) %>%
fuzzy_left_join(dfTlong , by = c("Fecha" = "Fecha"),
match_fun = list(comp_date)) %>%
group_by(Fecha.x) %>%
filter(Fecha.y == max(Fecha.y)) %>%
ungroup() %>%
rename(Fecha=Fecha.x,Fecha_T=Fecha.y) %>%
select(CODE,Fecha,Fecha_T,everything())
dfPartidos_CT=dfPartidos %>% inner_join(dfPartidos_CAnterior) %>%
inner_join(dfPartidos_TAnterior) %>%
filter(Fecha<Fecha_C+7,Fecha<Fecha_T+7)## Joining with `by = join_by(Fecha)`
## Joining with `by = join_by(Fecha, CODE)`dfPartidos_CT %>% head(10)## # A tibble: 10 × 11
## Fecha Resultado Puntos Acumulado CODE Fecha_C Cortisol CortisolZ[,1]
## <date> <fct> <dbl> <dbl> <chr> <date> <dbl> <dbl>
## 1 2022-08-19 L 0 0 COD1 2022-08-18 3.99 -0.123
## 2 2022-08-19 L 0 0 COD10 2022-08-18 3.61 -0.373
## 3 2022-08-19 L 0 0 COD11 2022-08-18 4.32 -0.677
## 4 2022-08-19 L 0 0 COD12 2022-08-18 6.37 -0.380
## 5 2022-08-19 L 0 0 COD13 2022-08-18 3.21 -0.807
## 6 2022-08-19 L 0 0 COD16 2022-08-18 3.92 -0.654
## 7 2022-08-19 L 0 0 COD19 2022-08-18 3.94 -0.813
## 8 2022-08-19 L 0 0 COD20 2022-08-18 2.34 -1.04
## 9 2022-08-19 L 0 0 COD21 2022-08-18 3.2 -0.583
## 10 2022-08-19 L 0 0 COD22 2022-08-18 2.45 -1.28
## # ℹ 3 more variables: Fecha_T <date>, Testosterona <dbl>,
## # TestosteronaZ <dbl[,1]>En este punto no estoy seguro de que sea lo más conveniente, pero nos olvidamos de los jugadores y nos quedamos con las medias en cada fecha de partido y sus respectivas mediciones de T y C anteriores. Podríamos quedarnos con todos los datos, jugador a jugador para un análisis multinivel, pero esto es lo que tenemos escrito que vamos a hacer:
dfPartidos_CT_mean=dfPartidos_CT %>% select(-CODE) %>% group_by(Fecha,Resultado,Puntos,Acumulado) %>% summarise_all(mean,na.rm=T)
dfPartidos_CT_mean ## # A tibble: 27 × 10
## # Groups: Fecha, Resultado, Puntos [27]
## Fecha Resultado Puntos Acumulado Fecha_C Cortisol CortisolZ
## <date> <fct> <dbl> <dbl> <date> <dbl> <dbl>
## 1 2022-08-19 L 0 0 2022-08-18 3.84 -0.650
## 2 2022-09-02 L 0 3 2022-08-30 6.72 0.584
## 3 2022-09-09 L 0 3 2022-09-07 6.96 0.667
## 4 2022-09-16 L 0 3 2022-09-15 6.93 0.650
## 5 2022-09-23 D 1 4 2022-09-18 9.42 1.84
## 6 2022-10-07 D 1 6 2022-10-05 6.72 0.442
## 7 2022-10-12 L 0 6 2022-10-08 6.74 0.505
## 8 2022-10-21 L 0 9 2022-10-18 3.90 -0.856
## 9 2022-10-28 L 0 9 2022-10-26 5.59 0.108
## 10 2022-11-01 L 0 9 2022-10-26 5.59 0.108
## # ℹ 17 more rows
## # ℹ 3 more variables: Fecha_T <date>, Testosterona <dbl>, TestosteronaZ <dbl>dfPartidos_CT_mean %>% ggplot(aes(y=Cortisol,x=Fecha))+
geom_point(aes(color=Resultado),alpha=0.5,size=2)+
geom_smooth(se = FALSE)+
scale_color_manual(values=c("D"="Gray","L"="darkred","W"="darkgreen"))+
scale_x_date(date_breaks = "1 week", date_labels = "%Y-%m-%d") +
theme_minimal()+
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
guides(color = guide_legend(ncol = 5))+
theme(legend.position = "top")## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
dfPartidos_CT_mean %>% ggplot(aes(y=CortisolZ,x=Fecha))+
geom_point(aes(color=Resultado),alpha=0.5,size=2)+
geom_smooth(se = FALSE)+
scale_color_manual(values=c("D"="Gray","L"="darkred","W"="darkgreen"))+
scale_x_date(date_breaks = "1 week", date_labels = "%Y-%m-%d") +
theme_minimal()+
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
guides(color = guide_legend(ncol = 5))+
theme(legend.position = "top")## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
dfPartidos_CT_mean %>% ggplot(aes(y=Testosterona,x=Fecha))+
geom_point(aes(color=Resultado),alpha=0.5,size=2)+
geom_smooth(se = FALSE)+
scale_color_manual(values=c("D"="Gray","L"="darkred","W"="darkgreen"))+
scale_x_date(date_breaks = "1 week", date_labels = "%Y-%m-%d") +
theme_minimal()+
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
guides(color = guide_legend(ncol = 5))+
theme(legend.position = "top")## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
dfPartidos_CT_mean %>% ggplot(aes(y=TestosteronaZ,x=Fecha))+
geom_point(aes(color=Resultado),alpha=0.5,size=2)+
geom_smooth(se = FALSE)+
scale_color_manual(values=c("D"="Gray","L"="darkred","W"="darkgreen"))+
scale_x_date(date_breaks = "1 week", date_labels = "%Y-%m-%d") +
theme_minimal()+
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
guides(color = guide_legend(ncol = 5))+
theme(legend.position = "top")## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
dfPartidos_CT_mean %>% openxlsx::write.xlsx("partidos_CT.xlsx")##Hipótesis hormonal dual
falta por analizar la hipótesis hormonal dual La Hipotesis Hormonal-Dual (HHD) sugiere que nuestra conducta competitiva está relacionada con alta testosterona y bajo cortisol. Entonces, lo que se suele hacer es hacer tres clusters: -1DT / Mean / + #1DT para Testosterona y lo mismo para cortisol y se analiza si se gana más o juegan más minutos los jugadores cuando tienen alta testosterona (+ 1DT) y bajo cortisol (- 1DT), que con baja Testosterona (-1 DT) y alto cortisol (+ 1 DT).
Para hacer esto se puede tomar como referencia la DT general de cada hormona o la DT individual de cada jugador o el valor promedio de cada hormona en el equipo. Algo que dificulta la interpretación es que aunque cada jugador tiene sus propios valores hormonales, todos pierden o ganan a la vez. Además en diferentes partidos puede haber diferentes jugadores.
Hay muchas formas de abordar esta cuestión, pero a modo exploratorio, inicialmente empezamos por esta: Vemos cual es el nivel hormonal medio de todo el equipo, agregando todos los jugadores de cada partido.
dfPartidos_CT_mean## # A tibble: 27 × 10
## # Groups: Fecha, Resultado, Puntos [27]
## Fecha Resultado Puntos Acumulado Fecha_C Cortisol CortisolZ
## <date> <fct> <dbl> <dbl> <date> <dbl> <dbl>
## 1 2022-08-19 L 0 0 2022-08-18 3.84 -0.650
## 2 2022-09-02 L 0 3 2022-08-30 6.72 0.584
## 3 2022-09-09 L 0 3 2022-09-07 6.96 0.667
## 4 2022-09-16 L 0 3 2022-09-15 6.93 0.650
## 5 2022-09-23 D 1 4 2022-09-18 9.42 1.84
## 6 2022-10-07 D 1 6 2022-10-05 6.72 0.442
## 7 2022-10-12 L 0 6 2022-10-08 6.74 0.505
## 8 2022-10-21 L 0 9 2022-10-18 3.90 -0.856
## 9 2022-10-28 L 0 9 2022-10-26 5.59 0.108
## 10 2022-11-01 L 0 9 2022-10-26 5.59 0.108
## # ℹ 17 more rows
## # ℹ 3 more variables: Fecha_T <date>, Testosterona <dbl>, TestosteronaZ <dbl>pc=0.5
dfPartidos_HHD=dfPartidos_CT_mean %>% ungroup() %>%
mutate(CortisolZ=scale(Cortisol), TestosteronaZ=scale(Testosterona)) %>%
mutate(TcvsCt=case_when(
TestosteronaZ>= pc & CortisolZ <=-pc ~ 1,
TestosteronaZ<= -pc & CortisolZ >=pc ~ 0,
TRUE ~ 0.5
)
)
dfPartidos_HHD %>% count(TcvsCt)## # A tibble: 3 × 2
## TcvsCt n
## <dbl> <int>
## 1 0 3
## 2 0.5 19
## 3 1 5Modelos logísticos a estudiar:
library(caTools)Derrotas
Ahora estudiamos las derrotas
glm(I(Resultado=="L")~ TcvsCt,data=dfPartidos_HHD) %>% broom::tidy()## # A tibble: 2 × 5
## term estimate std.error statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 0.160 0.203 0.790 0.437
## 2 TcvsCt 0.736 0.338 2.18 0.0391El resultado es lo contrario de lo que esperaba… Valores altos de T y bajos de C se asocian a mayor probabilidad de derrota y bajos de T y altos de C a menor probabilidad de derrota.
Eliminemos los casos intermedios y solo nos quedamos con casos extremos:
glm(I(Resultado=="L")~ TcvsCt, data=dfPartidos_HHD %>% filter(TcvsCt==round(TcvsCt,0))) %>% broom::tidy()## # A tibble: 2 × 5
## term estimate std.error statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 3.14e-16 0.211 1.49e-15 1.00
## 2 TcvsCt 8 e- 1 0.267 3 e+ 0 0.0240Aún más consistente con lo anterior
Me quedo solo con T alto +C bajo vs todo lo demás
glm(I(Resultado=="L")~ I(TcvsCt==1),data=dfPartidos_HHD) %>% broom::tidy()## # A tibble: 2 × 5
## term estimate std.error statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 0.50 0.107 4.67 0.0000872
## 2 I(TcvsCt == 1)TRUE 0.3 0.249 1.21 0.239Y ahora Tbajo+CAlto vs todo lo demás:
glm(I(Resultado=="L")~ I(TcvsCt==0),data=dfPartidos_HHD) %>% broom::tidy()## # A tibble: 2 × 5
## term estimate std.error statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 0.625 0.0968 6.45 0.000000927
## 2 I(TcvsCt == 0)TRUE -0.625 0.290 -2.15 0.0413Aquí es Tbajo y Calto (frente a todo lo demás) lo que se asocia a menor probabilidad de derrota.
glm(I(Resultado=="L")~ I(TcvsCt==0),data=dfPartidos_HHD) %>% summary()##
## Call:
## glm(formula = I(Resultado == "L") ~ I(TcvsCt == 0), data = dfPartidos_HHD)
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.62500 0.09682 6.455 9.27e-07 ***
## I(TcvsCt == 0)TRUE -0.62500 0.29047 -2.152 0.0413 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 0.225)
##
## Null deviance: 6.6667 on 26 degrees of freedom
## Residual deviance: 5.6250 on 25 degrees of freedom
## AIC: 40.27
##
## Number of Fisher Scoring iterations: 2Victorias
Estudiemos el efecto en victorias. Hay varias posibles formas de escribirlo. Considerando lo alto de las hormonas 0, 0.5, 1…
glm(I(Resultado=="W")~ TcvsCt,data=dfPartidos_HHD) %>% broom::tidy()## # A tibble: 2 × 5
## term estimate std.error statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 0.236 0.173 1.37 0.184
## 2 TcvsCt -0.0943 0.288 -0.328 0.746Quedandono solo en hormonas altas y bajas, ignorando los casos restantes.
glm(I(Resultado=="W")~ TcvsCt,data=dfPartidos_HHD %>% filter(TcvsCt==round(TcvsCt,0))) %>% broom::tidy()## # A tibble: 2 × 5
## term estimate std.error statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 0.333 0.285 1.17 0.287
## 2 TcvsCt -0.133 0.361 -0.369 0.725Ahora consideremos solo caso de T alto +C bajo frente a todo lo demás:
glm(I(Resultado=="W")~ I(TcvsCt==1),data=dfPartidos_HHD) %>% broom::tidy()## # A tibble: 2 × 5
## term estimate std.error statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 0.182 0.0861 2.11 0.0448
## 2 I(TcvsCt == 1)TRUE 0.0182 0.200 0.0909 0.928Ahora consideremos solo caso de T bajo +C alto frente a todo lo demás:
glm(I(Resultado=="W")~ I(TcvsCt==0),data=dfPartidos_HHD) %>% broom::tidy()## # A tibble: 2 × 5
## term estimate std.error statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 0.167 0.0816 2.04 0.0519
## 2 I(TcvsCt == 0)TRUE 0.167 0.245 0.680 0.502Siguiente pregunta
Los jugadores con una media de temporada con niveles más altos de T y más bajos de C jugaban más que el resto?
Dividir a los jugadores en dos grupos (hay varias posibilidades): 1)
Los de T>media y C<media vs el resto 2) Los de T
Los pacientes son divididos en las tres categorías según los valores de las tres últimas columnas (C/c y T/t representan valores ALTOS/bajos respectivamente)
dfCmedia=dfClong %>% group_by(CODE) %>% summarise(Cortisol=mean(Cortisol,na.rm=T))
dfTmedia=dfTlong %>% group_by(CODE) %>% summarise(Testosterona=mean(Testosterona,na.rm=T))
mediaC=dfCmedia %>% pull() %>% mean()
mediaT=dfTmedia %>% pull() %>% mean()
dfCTMedia=dfPerf %>% select(CODE,PLAYING) %>% inner_join(dfCmedia) %>% inner_join(dfTmedia) %>%
mutate(Tc_vs_Resto=Cortisol<mediaC & Testosterona>mediaT,
tC_vs_Resto=Cortisol>mediaC & Testosterona<mediaT,
Tc_vs_tC=ifelse(!Tc_vs_Resto & ! tC_vs_Resto, 2,as.integer(Tc_vs_Resto))) %>%
mutate(Tc_vs_Resto =Tc_vs_Resto %>% as.factor() %>% fct_recode("T+ c-"="TRUE", "Resto"="FALSE"),
tC_vs_Resto =tC_vs_Resto %>% as.factor() %>% fct_recode("t- C+"="TRUE", "Resto"="FALSE"),
Tc_vs_tC =Tc_vs_tC %>% as.factor() %>% fct_recode("T+ c-"="1", "t- C+"="0","Resto"="2"))## Joining with `by = join_by(CODE)`
## Joining with `by = join_by(CODE)`dfCTMedia## # A tibble: 26 × 7
## CODE PLAYING Cortisol Testosterona Tc_vs_Resto tC_vs_Resto Tc_vs_tC
## <chr> <dbl> <dbl> <dbl> <fct> <fct> <fct>
## 1 COD1 13 4.17 210. Resto Resto Resto
## 2 COD10 42 4.17 357. T+ c- Resto T+ c-
## 3 COD11 20 5.91 328. Resto Resto Resto
## 4 COD12 24 7.34 269. Resto t- C+ t- C+
## 5 COD13 28 6.12 264. Resto t- C+ t- C+
## 6 COD16 20 4.90 326. T+ c- Resto T+ c-
## 7 COD17 17 10.7 213. Resto t- C+ t- C+
## 8 COD18 24 9.67 366. Resto Resto Resto
## 9 COD19 23 6.55 245. Resto t- C+ t- C+
## 10 COD2 9 6.35 287. Resto t- C+ t- C+
## # ℹ 16 more rowsLos Tc son TRUE, el resto, FALSE
dfCTMedia %>% ggplot(aes(x=Tc_vs_Resto,y=PLAYING))+geom_boxplot()+geom_jitter()+
geom_signif(
comparisons = list(c("T+ c-", "Resto")),
map_signif_level = FALSE
)## Warning in wilcox.test.default(c(42, 20, 28, 42, 26, 3, 21), c(13, 20, 24, :
## cannot compute exact p-value with ties
Los tC son TRUE, el resto, FALSE
dfCTMedia %>% ggplot(aes(x=tC_vs_Resto,y=PLAYING))+geom_boxplot()+geom_jitter()+
geom_signif(
comparisons = list(c("t- C+", "Resto")),
map_signif_level = FALSE
)## Warning in wilcox.test.default(c(24, 28, 17, 23, 9, 17), c(13, 42, 20, 20, :
## cannot compute exact p-value with ties
Los tC son TRUE, los tC son FALSE, el resto “NA”
dfCTMedia %>% ggplot(aes(x=Tc_vs_tC,y=PLAYING))+geom_boxplot()+geom_jitter()+
geom_signif(
comparisons = list(c("T+ c-", "t- C+")),
map_signif_level = FALSE
)## Warning in wilcox.test.default(c(42, 20, 28, 42, 26, 3, 21), c(24, 28, 17, :
## cannot compute exact p-value with ties