Analyse des 4 dataset Candies,Human Serum, CHOO et UCH avec les fonctions limpca updates
Visschers Antoine
21/11/2023
1 Importation des données
Importation des quatres RData qui contiennent :
- design : le plan d’expérience
- outcomes : la matrice réponses
- formula : la formule du modèle
- model : l’acronyme du type de modèle (“lmm” = linear mixed model ou “lm” = linear model). Cet élément est optionnel et n’est pas dans les RData importés.
1.1 lmpDataList :
l’objet lmpDataList de l’ensemble Candies est :
str(Candies)## List of 3
## $ design :'data.frame': 165 obs. of 2 variables:
## ..$ Judges : Factor w/ 11 levels "01","02","03",..: 1 1 1 10 10 10 11 11 11 2 ...
## ..$ Candies: Factor w/ 5 levels "1","2","3","4",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ outcomes: num [1:165, 1:9] 4.8 2.7 2.85 3.15 3.75 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:165] "0111" "0112" "0113" "1011" ...
## .. ..$ : chr [1:9] "Transp" "Acid" "Sweet" "Raspb" ...
## $ formula : chr "~ Candies + (1 | Judges) + (1 | Candies:Judges)"l’objet lmpDataList de l’ensemble Serum est :
str(Serum)## List of 3
## $ design :'data.frame': 140 obs. of 2 variables:
## ..$ Volunteer: Factor w/ 12 levels "01","02","03",..: 10 10 10 10 10 10 10 10 10 10 ...
## ..$ Sampling : Factor w/ 3 levels "1","2","3": 1 1 1 1 2 2 2 2 3 3 ...
## $ outcomes: num [1:140, 1:750] 0.0437 0.031 0.0471 0.0332 0.0251 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:140] "10111" "10112" "10121" "10122" ...
## .. ..$ : chr [1:750] "9.993675" "9.98060893124165" "9.96754286248331" "9.95447679372497" ...
## $ formula : chr "~ (1|Volunteer) + (1|Volunteer:Sampling)"l’objet lmpDataList de l’ensemble CHOO est :
str(CHOO)## List of 3
## $ design :'data.frame': 46 obs. of 4 variables:
## ..$ time : Factor w/ 3 levels "1","2","3": 1 2 3 1 2 3 1 2 3 1 ...
## ..$ treatment : Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ volunteer : Factor w/ 16 levels "G1R1","G1R2",..: 1 1 1 2 2 2 3 3 3 4 ...
## ..$ traitement: Factor w/ 2 levels "Control","Antibiotic": 1 1 1 1 1 1 1 1 1 1 ...
## $ outcomes: num [1:46, 1:1452] 0.1937 0.0905 0.2296 0.1845 0.0815 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:46] "T1_G1R1" "T2_G1R1" "T3_G1R1" "T1_G1R2" ...
## .. ..$ : chr [1:1452] "X8.49697559801906" "X8.49146625544723" "X8.48595691287539" "X8.48044757030356" ...
## $ formula : chr "~ treatment*time + (1|volunteer)"l’objet lmpDataList de l’ensemble UCH est :
str(UCH)## List of 3
## $ design :'data.frame': 34 obs. of 5 variables:
## ..$ Hippurate: Factor w/ 3 levels "0","1","2": 1 1 1 1 1 1 2 2 2 2 ...
## ..$ Citrate : Factor w/ 3 levels "0","2","4": 1 1 2 2 3 3 1 1 2 2 ...
## ..$ Dilution : Factor w/ 1 level "diluted": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Day : Factor w/ 2 levels "2","3": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ Time : Factor w/ 2 levels "1","2": 1 2 1 2 1 2 1 2 1 2 ...
## $ outcomes: num [1:34, 1:600] 0.0312 0.0581 0.027 0.0341 0.0406 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:34] "M2C00D2R1" "M2C00D2R2" "M2C02D2R1" "M2C02D2R2" ...
## .. ..$ X1: chr [1:600] "9.9917004" "9.9753204" "9.9590624" "9.9427436" ...
## $ formula : chr "outcomes ~ Hippurate + Citrate + Time + Hippurate:Citrate + Time:Hippurate + Time:Citrate + Hippurate:Citrate:Time"2 Exploration des données
2.1 Partie Candies
2.1.1 Visualisation du plan d’expérience
plotDesign(design = Candies$design, x = "Judges",
y = "Candies",
title = "Plan de l'ensemble Candies")
#exporter le plan
ggsave(plot = last_plot(), device = NULL, filename = file.path(output_Candies,"design_Candies.jpeg"),
scale = 0.6, width = 15, height = 7, units = "cm",dpi = 1000)Les données sont bien balancées.
2.1.2 Visualisation de la matrice des réponses:
Structure de la matrice des réponses :
str(Candies$outcomes)## num [1:165, 1:9] 4.8 2.7 2.85 3.15 3.75 ...
## - attr(*, "dimnames")=List of 2
## ..$ : chr [1:165] "0111" "0112" "0113" "1011" ...
## ..$ : chr [1:9] "Transp" "Acid" "Sweet" "Raspb" ...p1 <- plotLine(Y = Candies$outcomes,
title = "plotLine de trois observations sur Candies",
rows = c(4,50,12),
xlab = "Critères",
ylab = "Notes",
xaxis_type = "character",
type = "s")
ggsave(file = file.path(output_Candies,"plotLine_Candies.jpeg"),p1)## Saving 6 x 5 in imagep1
plotScatterM(Y = Candies$outcomes, cols = c(1:3),
design = Candies$design,varname.colorup = "Candies",varname.colordown = "Candies", varname.pchup = "Judges", varname.pchdown = "Judges", title = "plotScatterM de trois des réponses")
jpeg(file = file.path(output_Candies,"plotScatterM_Candies.jpeg"))
plotScatterM(Y = Candies$outcomes, cols = c(1:3),
design = Candies$design,varname.colorup = "Candies",varname.colordown = "Candies", varname.pchup = "Judges", varname.pchdown = "Judges", title = "plotScatterM de trois des réponses")
dev.off()## png
## 2plotScatter(Y = Candies$outcomes,
xy = c("Hard","Acid"),
design = Candies$design,
color = "Judges",
shape = "Candies",
title = "plotScatter entre les notes Hard et les notes Acid")
plotMeans(Y = Candies$outcomes,
design = Candies$design,
cols = c("Hard"),
x = c("Candies"),
z = c("Judges"),
ylab = "Notes",
title=c("Moyennes des notes du critère Hard"))## $Hard## Warning: The shape palette can deal with a maximum of 6 discrete values because
## more than 6 becomes difficult to discriminate; you have 11. Consider
## specifying shapes manually if you must have them.## Warning: Removed 25 rows containing missing values (geom_point).
# Exportation
jpeg(file = file.path(output_Candies,"plotScatter_Candies.jpeg"))
plotScatter(Y = Candies$outcomes,
xy = c("Hard","Acid"),
design = Candies$design,
color = "Judges",
shape = "Candies",
title = "plotScatter entre les notes Hard et les notes Acid")
dev.off()2.2 Partie Serum
2.2.1 Visualisation du plan d’expérience
plotDesign(design = Serum$design, x = "Volunteer",
y = "Sampling",
title = "Plan de l'ensemble Serum")
# exporter le plan
ggsave(plot = last_plot(), device = NULL, filename = file.path(output_Serum,"design_Serum.jpeg"),
scale = 0.6, width = 15, height = 7, units = "cm",dpi = 1000)Les données ne sont pas balancées, il manque un résultat pour le deuxième échantillon du quatrième et huitième volontaire et 2 résultats pour le premier échantillon du onzième volontaire.
2.2.2 Visualisation de la matrice des réponses:
Structure de la matrice des réponses :
str(Serum$outcomes)## num [1:140, 1:750] 0.0437 0.031 0.0471 0.0332 0.0251 ...
## - attr(*, "dimnames")=List of 2
## ..$ : chr [1:140] "10111" "10112" "10121" "10122" ...
## ..$ : chr [1:750] "9.993675" "9.98060893124165" "9.96754286248331" "9.95447679372497" ...p2 <- plotLine(Y = Serum$outcomes,
title = "plotLine de trois observations sur Serum",
rows = c(3,17,12),
xlab = "ppm",
xaxis_type = "numeric",
type = "s")
ggsave(file = file.path(output_Serum,"plotLine_Serum.jpeg"),p2)## Saving 6 x 5 in imagep2
plotScatterM(Y = Serum$outcomes, cols = c(1:3),
design = Serum$design,varname.colorup = "Volunteer",varname.colordown = "Volunteer", varname.pchup = "Sampling", varname.pchdown = "Sampling", title = "plotScatterM de trois des réponses")
jpeg(file = file.path(output_Serum,"plotScatterM_Serum.jpeg"))
plotScatterM(Y = Serum$outcomes, cols = c(1:3),
design = Serum$design,varname.colorup = "Volunteer",varname.colordown = "Volunteer", varname.pchup = "Sampling", varname.pchdown = "Sampling", title = "plotScatterM de trois des réponses")
dev.off()## png
## 2plotScatter(Y = Serum$outcomes,
xy = c(3,142),
design = Serum$design,
color = "Volunteer",
shape = "Sampling",
title = "plotScatter entre 2 réponses de Serum")
plotMeans(Y = Serum$outcomes,
design = Serum$design,
cols = c(15),
x = c("Sampling"),
z = c("Volunteer"),
ylab = "Intensité",
title=c("Moyennes des intensités de la réponse 15"))## $`9.81075003738318`## Warning: The shape palette can deal with a maximum of 6 discrete values because
## more than 6 becomes difficult to discriminate; you have 12. Consider
## specifying shapes manually if you must have them.## Warning: Removed 18 rows containing missing values (geom_point).
# Exportation
jpeg(file = file.path(output_Serum,"plotScatter_Serum.jpeg"))
plotMeans(Y = Serum$outcomes,
design = Serum$design,
cols = c(15),
x = c("Sampling"),
z = c("Volunteer"),
ylab = "Intensité",
title=c("Moyennes des notes de la réponse 15"))
dev.off()2.3 Partie CHOO
2.3.1 Visualisation du plan d’expérience
plotDesign(design = CHOO$design[CHOO$design[,"traitement"]=="Control",], x = "volunteer",
y = "time", cols = "traitement",
title = "Plan du traitement Control de CHOO")
# exporter le plan
ggsave(plot = last_plot(), device = NULL, filename = file.path(output_CHOO,"design_CHOO_Control.jpeg"),
scale = 0.6, width = 15, height = 7, units = "cm",dpi = 1000)
plotDesign(design = CHOO$design[CHOO$design[,"traitement"]=="Antibiotic",], x = "volunteer",
y = "time", cols = "traitement",
title = "Plan du traitement Antibiotic de CHOO")
# exporter le plan
ggsave(plot = last_plot(), device = NULL, filename = file.path(output_CHOO,"design_CHOO_Antibiotic.jpeg"),
scale = 0.6, width = 15, height = 7, units = "cm",dpi = 1000)On peut voir que les données ne sont pas balancées. Il manque le 3ème résultat du sujet 6 dans le groupe Antibiotic et le 2ème résultat du sujet 1 dans le groupe Antibiotic.
2.3.2 Visualisation de la matrice des réponses:
Structure de la matrice des réponses :
str(CHOO$outcomes)## num [1:46, 1:1452] 0.1937 0.0905 0.2296 0.1845 0.0815 ...
## - attr(*, "dimnames")=List of 2
## ..$ : chr [1:46] "T1_G1R1" "T2_G1R1" "T3_G1R1" "T1_G1R2" ...
## ..$ : chr [1:1452] "X8.49697559801906" "X8.49146625544723" "X8.48595691287539" "X8.48044757030356" ...p3 <- plotLine(Y = CHOO$outcomes,
title = "plotLine de trois observations sur CHOO",
rows = c(3,17,12),
xlab = "ppm",
xaxis_type = "character",
type = "s")
ggsave(file = file.path(output_CHOO,"plotLine_CHOO.jpeg"),p3)## Saving 6 x 5 in imagep3
plotScatterM(Y = CHOO$outcomes, cols = c(1:3),
design = CHOO$design,varname.colorup = "time",varname.colordown = "time", varname.pchup = "treatment", varname.pchdown = "treatment", title = "plotScatterM de trois des réponses")
jpeg(file = file.path(output_CHOO,"plotScatterM_CHOO.jpeg"))
plotScatterM(Y = CHOO$outcomes, cols = c(1:3),
design = CHOO$design,varname.colorup = "time",varname.colordown = "time", varname.pchup = "treatment", varname.pchdown = "treatment", title = "plotScatterM de trois des réponses")
dev.off()## png
## 2plotScatter(Y = CHOO$outcomes,
xy = c(3,142),
design = CHOO$design,
color = "time",
shape = "treatment",
title = "plotScatter entre 2 réponses de CHOO")
plotMeans(Y = CHOO$outcomes,
design = CHOO$design,
cols = c(15),
x = c("time"),
z = c("treatment"),
ylab = "Intensité",
title=c("Moyennes des intensités de la réponse 15"))## $X8.41984480201337
# Exportation
jpeg(file = file.path(output_CHOO,"plotScatter_CHOO.jpeg"))
plotMeans(Y = CHOO$outcomes,
design = CHOO$design,
cols = c(15),
x = c("time"),
z = c("treatment"),
ylab = "Intensité",
title=c("Moyennes des notes de la réponse 15"))
dev.off()2.4 Partie UCH
Utilisation limitée aux variables Citrate, Hippurate et Time
2.4.1 Visualisation du plan d’expérience
plotDesign(design = UCH$design, x = "Hippurate",
y = "Citrate", rows = "Time",
title = "Design of the UCH dataset")
Le modèle n’est pas balancé, il manque une observation lorsque le Citrate = 2, l’Hippurate = 0 et le temps = 1 et une observation lorsque le Citrate = 4, l’Hippurate = 0 et le temps = 1.
2.4.2 Visualisation de la matrice des réponses:
Structure de la matrice des réponses :
str(UCH$outcomes)## num [1:34, 1:600] 0.0312 0.0581 0.027 0.0341 0.0406 ...
## - attr(*, "dimnames")=List of 2
## ..$ : chr [1:34] "M2C00D2R1" "M2C00D2R2" "M2C02D2R1" "M2C02D2R2" ...
## ..$ X1: chr [1:600] "9.9917004" "9.9753204" "9.9590624" "9.9427436" ...p4 <- plotLine(Y = UCH$outcomes,
title = "H-NMR spectrum",
rows = c(3),
xlab = "ppm",
ylab = "Intensité")
ggsave(file = file.path(output_UCH,"plotLine_UCH.jpeg"),p4)## Saving 6 x 5 in imagep4
plotScatterM(Y = UCH$outcomes, cols = c(133, 145, 150, 369, 453),
design = UCH$design,varname.colorup = "Hippurate",
varname.colordown = "Citrate")
jpeg(file = file.path(output_UCH,"plotScatterM_UCH.jpeg"))
plotScatterM(Y = UCH$outcomes, cols = c(133, 145, 150, 369, 453),
design = UCH$design,varname.colorup = "Hippurate",
varname.colordown = "Citrate")
dev.off()## png
## 2plotScatter(Y = UCH$outcomes,
xy = c("2.6092056","3.9811536"),
design = UCH$design,
color = "Hippurate",
shape = "Citrate")
plotMeans(Y = UCH$outcomes,
design = UCH$design,
cols = c(453),
x = c("Citrate"),
w = c("Hippurate"),
z = c("Time"),
ylab = "Intensity",
title=c("Moyennes de l'intensité de la réponse 453"))## $`2.6092056`
# Exportation
jpeg(file = file.path(output_UCH,"plotScatter_UCH.jpeg"))
plotMeans(Y = UCH$outcomes,
design = UCH$design,
cols = c(453),
x = c("Citrate"),
w = c("Hippurate"),
z = c("Time"),
ylab = "Intensity",
title=c("Moyennes de l'intensité de la réponse 453"))
dev.off()3 PCA sur les outcomes
Remplacer les outcomes par les scores des PCA pour diminuer le nombre de variables et donc de paramètres à estimer. Cette étape n’a pas été faite pour le modèle linéaire UCH.
3.1 Partie Candies
resPCA_Candies <- lmpOutcomesReduct(Candies)
lmpDataList_Candies <- resPCA_Candies$lmpDataList
nPC_Candies <- resPCA_Candies$nPC
resPCA_Candies <- resPCA_Candies$resPCA
pcaScreePlot(resPCA_Candies, nPC = nPC_Candies, title = "PCA sur les outcomes")
#exporter
jpeg(file.path(output_Candies,"res_PCA_scree_plot_outcomes.jpeg"))
pcaScreePlot(resPCA_Candies, nPC = nPC_Candies, title = "PCA sur les outcomes")
dev.off()## png
## 2pcaScorePlot(resPcaBySvd = resPCA_Candies, axes = c(1,2),
title = "Score plot Judges",
design = Candies$design, color="Judges", drawShapes = "segment",
points_labs_rn = FALSE)
#exporter
jpeg(file.path(output_Candies,"res_PCA_score_plot_Judges.jpeg"))
pcaScorePlot(resPcaBySvd = resPCA_Candies, axes = c(1,2),
title = "Score plot Judges",
design = Candies$design, color="Judges", drawShapes = "segment",
points_labs_rn = FALSE)
dev.off()## png
## 2pcaScorePlot(resPcaBySvd = resPCA_Candies, axes = c(1,2),
title = "Score plot Candies",
design = Candies$design, color="Candies", drawShapes = "polygon",
points_labs_rn = FALSE)
#exporter
jpeg(file.path(output_Candies,"res_PCA_score_plot_Candies.jpeg"))
pcaScorePlot(resPcaBySvd = resPCA_Candies, axes = c(1,2),
title = "Score plot Candies",
design = Candies$design, color="Candies", drawShapes = "polygon",
points_labs_rn = FALSE)
dev.off()## png
## 2pcaLoading2dPlot(resPcaBySvd = resPCA_Candies, axes = c(1,2), title = "PCA loadings plot candies",pl_n = 9, addRownames = TRUE)
#exporter
jpeg(file.path(output_Candies,"res_PCA_loadings_plot.jpeg"))
pcaLoading2dPlot(resPcaBySvd = resPCA_Candies, axes = c(1,2), title = "PCA loadings plot candies",pl_n = 9, addRownames = TRUE)
dev.off()## png
## 2#research columns
spectra_PCA_scores <- resPCA_Candies$scores
spectra_PCA_loadings_Candies <- resPCA_Candies$loadings
# outcomes = PCA score
outcomes_Candies <- spectra_PCA_scores
rownames(outcomes_Candies) <- rownames(Candies$design)3.2 Partie Serum
n <- nrow(Serum$outcomes)
resPCA_Serum <- lmpOutcomesReduct(Serum)
lmpDataList_Serum <- resPCA_Serum$lmpDataList
nPC_Serum <- resPCA_Serum$nPC
resPCA_Serum <- resPCA_Serum$resPCA
pcaScreePlot(resPCA_Serum, nPC_Serum, title = "PCA sur les outcomes")
#exporter
jpeg(file.path(output_Serum,"res_PCA_scree_plot_outcomes.jpeg"))
pcaScreePlot(resPCA_Serum, nPC_Serum, title = "PCA sur les outcomes")
dev.off()## png
## 2pcaScorePlot(resPcaBySvd = resPCA_Serum, axes = c(1,2),
title = "Score plot Sampling",
design = Serum$design, color="Sampling", drawShapes = "segment",
points_labs_rn = FALSE)
#exporter
jpeg(file.path(output_Serum,"res_PCA_score_plot_Sampling.jpeg"))
pcaScorePlot(resPcaBySvd = resPCA_Serum, axes = c(1,2),
title = "Score plot Sampling",
design = Serum$design, color="Sampling", drawShapes = "segment",
points_labs_rn = FALSE)
dev.off()## png
## 2pcaScorePlot(resPcaBySvd = resPCA_Serum, axes = c(1,2),
title = "Score plot Volunteer",
design = Serum$design, color="Volunteer", drawShapes = "polygon",
points_labs_rn = FALSE)
#exporter
jpeg(file.path(output_Serum,"res_PCA_score_plot_Volunteer.jpeg"))
pcaScorePlot(resPcaBySvd = resPCA_Serum, axes = c(1,2),
title = "Score plot Volunteer",
design = Serum$design, color="Volunteer", drawShapes = "polygon",
points_labs_rn = FALSE)
dev.off()## png
## 2# pcaScorePlot(resPcaBySvd = resPCA_Serum, axes = c(1,2),
# title = "Score plot interaction Volunteer and Sampling",
# design = Serum$design, color="interVolSamp", drawShapes = "segment",
# points_labs_rn = FALSE)
# #exporter
# jpeg(file.path(output_Serum,"res_PCA_score_plot_inter_Vol_Samp.jpeg"))
# pcaScorePlot(resPcaBySvd = resPCA_Serum, axes = c(1,2),
# title = "Score plot interaction Volunteer and Sampling",
# design = Serum$design, color="interVolSamp", drawShapes = "segment",
# points_labs_rn = FALSE)
# dev.off()
pcaLoading2dPlot(resPcaBySvd = resPCA_Serum, axes = c(1,2), title = "PCA loadings plot Serum", addRownames = TRUE)
#exporter
jpeg(file.path(output_Serum,"res_PCA_loadings_plot.jpeg"))
pcaLoading2dPlot(resPcaBySvd = resPCA_Serum, axes = c(1,2), title = "PCA loadings plot Serum", addRownames = TRUE)
dev.off()## png
## 2#research columns
spectra_PCA_scores <- resPCA_Serum$scores
spectra_PCA_loadings_Serum <- resPCA_Serum$loadings
# outcomes = PCA score
outcomes_Serum <- spectra_PCA_scores
rownames(outcomes_Serum) <- rownames(Serum$design)3.3 Partie CHOO
n <- nrow(CHOO$outcomes)
resPCA_CHOO <- lmpOutcomesReduct(CHOO)
lmpDataList_CHOO <- resPCA_CHOO$lmpDataList
nPC_CHOO <- resPCA_CHOO$nPC
resPCA_CHOO <- resPCA_CHOO$resPCA
pcaScreePlot(resPCA_CHOO, nPC = nPC_CHOO, title = "PCA sur les outcomes")
#exporter
jpeg(file.path(output_CHOO,"res_PCA_scree_plot_outcomes.jpeg"))
pcaScreePlot(resPCA_CHOO, nPC = nPC_CHOO, title = "PCA sur les outcomes")
dev.off()## png
## 2pcaScorePlot(resPcaBySvd = resPCA_CHOO, axes = c(1,2),
title = "Score plot Traitement",
design = CHOO$design, color="traitement", drawShapes = "segment",
points_labs_rn = FALSE)
#exporter
jpeg(file.path(output_CHOO,"res_PCA_score_plot_Traitement.jpeg"))
pcaScorePlot(resPcaBySvd = resPCA_CHOO, axes = c(1,2),
title = "Score plot Traitement",
design = CHOO$design, color="traitement", drawShapes = "segment",
points_labs_rn = FALSE)
dev.off()## png
## 2pcaScorePlot(resPcaBySvd = resPCA_CHOO, axes = c(1,2),
title = "Score plot Time",
design = CHOO$design, color="time", drawShapes = "segment",
points_labs_rn = FALSE)
#exporter
jpeg(file.path(output_CHOO,"res_PCA_score_plot_Time.jpeg"))
pcaScorePlot(resPcaBySvd = resPCA_CHOO, axes = c(1,2),
title = "Score plot Time",
design = CHOO$design, color="time", drawShapes = "segment",
points_labs_rn = FALSE)
dev.off()## png
## 2# pcaScorePlot(resPcaBySvd = resPCA_CHOO, axes = c(1,2),
# title = "Score plot Time:Treatment",
# design = CHOO$design, color="timetreatment", drawShapes = "segment",
# points_labs_rn = FALSE)
#
# #exporter
# jpeg(file.path(output_CHOO,"res_PCA_score_plot_Time_Treatment.jpeg"))
# pcaScorePlot(resPcaBySvd = resPCA_CHOO, axes = c(1,2),
# title = "Score plot Time",
# design = CHOO$design, color="timetreatment", drawShapes = "segment",
# points_labs_rn = FALSE)
# dev.off()
pcaScorePlot(resPcaBySvd = resPCA_CHOO, axes = c(1,2),
title = "Score plot Volunteer",
design = CHOO$design, color="volunteer", drawShapes = "polygon",
points_labs_rn = FALSE)
#exporter
jpeg(file.path(output_CHOO,"res_PCA_score_plot_Volunteer.jpeg"))
pcaScorePlot(resPcaBySvd = resPCA_CHOO, axes = c(1,2),
title = "Score plot Volunteer",
design = CHOO$design, color="volunteer", drawShapes = "polygon",
points_labs_rn = FALSE)
dev.off()## png
## 2pcaLoading2dPlot(resPcaBySvd = resPCA_CHOO, axes = c(1,2), title = "PCA loadings plot Serum", addRownames = TRUE)## Warning: ggrepel: 4 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps
#exporter
jpeg(file.path(output_CHOO,"res_PCA_loadings_plot.jpeg"))
pcaLoading2dPlot(resPcaBySvd = resPCA_CHOO, axes = c(1,2), title = "PCA loadings plot Serum", addRownames = TRUE)## Warning: ggrepel: 4 unlabeled data points (too many overlaps). Consider
## increasing max.overlapsdev.off()## png
## 2#research columns
spectra_PCA_scores <- resPCA_CHOO$scores
spectra_PCA_loadings_CHOO <- resPCA_CHOO
# outcomes = PCA score
outcomes_CHOO <- spectra_PCA_scores
rownames(outcomes_CHOO) <- rownames(CHOO$design)3.4 lmpDataList :
3.4.1 Partie Candies
str(lmpDataList_Candies)## List of 6
## $ design :'data.frame': 165 obs. of 2 variables:
## ..$ Judges : Factor w/ 11 levels "01","02","03",..: 1 1 1 10 10 10 11 11 11 2 ...
## ..$ Candies: Factor w/ 5 levels "1","2","3","4",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ outcomes : num [1:165, 1:8] -13.1 -16.9 -12 -14.1 -17.1 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : NULL
## .. ..$ : chr [1:8] "PC1" "PC2" "PC3" "PC4" ...
## $ formula : chr "~ Candies + (1 | Judges) + (1 | Candies:Judges)"
## $ isReduct : logi TRUE
## $ outcomesRaw: num [1:165, 1:9] 4.8 2.7 2.85 3.15 3.75 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:165] "0111" "0112" "0113" "1011" ...
## .. ..$ : chr [1:9] "Transp" "Acid" "Sweet" "Raspb" ...
## $ loadingsPCA: num [1:9, 1:8] 0.394 -0.169 -0.237 -0.24 -0.413 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:9] "Transp" "Acid" "Sweet" "Raspb" ...
## .. ..$ : chr [1:8] "PC1" "PC2" "PC3" "PC4" ...3.4.2 Partie Serum
str(lmpDataList_Serum)## List of 6
## $ design :'data.frame': 140 obs. of 2 variables:
## ..$ Volunteer: Factor w/ 12 levels "01","02","03",..: 10 10 10 10 10 10 10 10 10 10 ...
## ..$ Sampling : Factor w/ 3 levels "1","2","3": 1 1 1 1 2 2 2 2 3 3 ...
## $ outcomes : num [1:140, 1:15] -21.9 -22.5 -21.3 -22.4 -17.7 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : NULL
## .. ..$ : chr [1:15] "PC1" "PC2" "PC3" "PC4" ...
## $ formula : chr "~ (1|Volunteer) + (1|Volunteer:Sampling)"
## $ isReduct : logi TRUE
## $ outcomesRaw: num [1:140, 1:750] 0.0437 0.031 0.0471 0.0332 0.0251 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:140] "10111" "10112" "10121" "10122" ...
## .. ..$ : chr [1:750] "9.993675" "9.98060893124165" "9.96754286248331" "9.95447679372497" ...
## $ loadingsPCA: num [1:750, 1:15] -0.000203 -0.000194 -0.000179 -0.000153 -0.000189 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:750] "9.993675" "9.98060893124165" "9.96754286248331" "9.95447679372497" ...
## .. ..$ : chr [1:15] "PC1" "PC2" "PC3" "PC4" ...3.4.3 Partie CHOO
str(lmpDataList_CHOO)## List of 6
## $ design :'data.frame': 46 obs. of 4 variables:
## ..$ time : Factor w/ 3 levels "1","2","3": 1 2 3 1 2 3 1 2 3 1 ...
## ..$ treatment : Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 1 1 1 ...
## ..$ volunteer : Factor w/ 16 levels "G1R1","G1R2",..: 1 1 1 2 2 2 3 3 3 4 ...
## ..$ traitement: Factor w/ 2 levels "Control","Antibiotic": 1 1 1 1 1 1 1 1 1 1 ...
## $ outcomes : num [1:46, 1:14] -58.6 48.4 33.6 50.8 -49.8 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : NULL
## .. ..$ : chr [1:14] "PC1" "PC2" "PC3" "PC4" ...
## $ formula : chr "~ treatment*time + (1|volunteer)"
## $ isReduct : logi TRUE
## $ outcomesRaw: num [1:46, 1:1452] 0.1937 0.0905 0.2296 0.1845 0.0815 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:46] "T1_G1R1" "T2_G1R1" "T3_G1R1" "T1_G1R2" ...
## .. ..$ : chr [1:1452] "X8.49697559801906" "X8.49146625544723" "X8.48595691287539" "X8.48044757030356" ...
## $ loadingsPCA: num [1:1452, 1:14] -0.000371 -0.000376 -0.000505 -0.000319 -0.000302 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:1452] "X8.49697559801906" "X8.49146625544723" "X8.48595691287539" "X8.48044757030356" ...
## .. ..$ : chr [1:14] "PC1" "PC2" "PC3" "PC4" ...4 Estimation du modèle et décomposition de la matrice d’effets
4.1 Estimation des matrices de modèles
4.1.1 Partie Candies
resLmpModelMatrix_Candies <- UPDATE_lmpModelMatrix(lmpDataList_Candies)## Warning in UPDATE_lmpModelMatrix(lmpDataList_Candies): The random model matrix
## is provided for indicative purposes only.4.1.2 Partie Serum
resLmpModelMatrix_Serum <- UPDATE_lmpModelMatrix(lmpDataList_Serum)## Warning in UPDATE_lmpModelMatrix(lmpDataList_Serum): The random model matrix is
## provided for indicative purposes only.4.1.3 Partie CHOO
resLmpModelMatrix_CHOO <- UPDATE_lmpModelMatrix(lmpDataList_CHOO)## Warning in UPDATE_lmpModelMatrix(lmpDataList_CHOO): The random model matrix is
## provided for indicative purposes only.4.1.4 Partie UCH
resLmpModelMatrix_UCH <- UPDATE_lmpModelMatrix(UCH)4.2 Estimations des modèles mixtes
4.2.1 Partie Candies
4.2.1.1 Estimation avec la variance des effets fixes calculée avec la variance des matrices d’effets fixes (resLmpEffectMatrices_Candies_test).
resLmpEffectMatrices_Candies_test <- UPDATE_lmpEffectMatrices(resLmpModelMatrix_Candies)## Warning in UPDATE_lmpEffectMatrices(resLmpModelMatrix_Candies): boundary (singular) fit: see help('isSingular')
## for the response(s) : PC5, PC6, PC84.2.1.2 Estimation avec la variance des effets fixes calculée avec la formule du type 3 SS de limpca (resLmpEffectMatrices_Candies).
resLmpEffectMatrices_Candies <- UPDATE_lmpEffectMatrices_2(resLmpModelMatrix_Candies)## Warning in UPDATE_lmpEffectMatrices_2(resLmpModelMatrix_Candies): boundary (singular) fit: see help('isSingular')
## For the response(s) : PC5, PC6, PC84.2.1.3 Résultat du modèles pour certaines réponses
4.2.1.3.1 Résultat du modèle pour la PC1
resLmpEffectMatrices_Candies$MM_full$PC1## Linear mixed model fit by REML ['lmerMod']
## Formula: PC1 ~ Candies + (1 | Judges) + (1 | Candies:Judges)
## Data: data_full
## REML criterion at convergence: 875.029
## Random effects:
## Groups Name Std.Dev.
## Candies:Judges (Intercept) 1.5925
## Judges (Intercept) 0.5656
## Residual 3.1756
## Number of obs: 165, groups: Candies:Judges, 55; Judges, 11
## Fixed Effects:
## (Intercept) Candies1 Candies2 Candies3 Candies4
## 5.121e-15 -1.684e+01 1.167e+01 1.036e+01 1.177e+014.2.1.3.2 Résultat du modèle pour la PC5
resLmpEffectMatrices_Candies$MM_full$PC5## Linear mixed model fit by REML ['lmerMod']
## Formula: PC5 ~ Candies + (1 | Judges) + (1 | Candies:Judges)
## Data: data_full
## REML criterion at convergence: 743.1506
## Random effects:
## Groups Name Std.Dev.
## Candies:Judges (Intercept) 0.9107
## Judges (Intercept) 0.0000
## Residual 2.1644
## Number of obs: 165, groups: Candies:Judges, 55; Judges, 11
## Fixed Effects:
## (Intercept) Candies1 Candies2 Candies3 Candies4
## -5.357e-17 -2.922e-01 1.618e-01 -2.831e-01 4.554e-01
## optimizer (bobyqa) convergence code: 0 (OK) ; 0 optimizer warnings; 1 lme4 warnings4.2.1.3.3 Résultat du modèle pour la PC6
resLmpEffectMatrices_Candies$MM_full$PC6## Linear mixed model fit by REML ['lmerMod']
## Formula: PC6 ~ Candies + (1 | Judges) + (1 | Candies:Judges)
## Data: data_full
## REML criterion at convergence: 732.1019
## Random effects:
## Groups Name Std.Dev.
## Candies:Judges (Intercept) 0.0000
## Judges (Intercept) 0.7585
## Residual 2.1631
## Number of obs: 165, groups: Candies:Judges, 55; Judges, 11
## Fixed Effects:
## (Intercept) Candies1 Candies2 Candies3 Candies4
## 1.721e-16 7.931e-03 -3.737e-01 4.256e-01 4.194e-02
## optimizer (bobyqa) convergence code: 0 (OK) ; 0 optimizer warnings; 1 lme4 warnings4.2.1.3.4 Résultat du modèle pour la PC8
resLmpEffectMatrices_Candies$MM_full$PC8## Linear mixed model fit by REML ['lmerMod']
## Formula: PC8 ~ Candies + (1 | Judges) + (1 | Candies:Judges)
## Data: data_full
## REML criterion at convergence: 651.1044
## Random effects:
## Groups Name Std.Dev.
## Candies:Judges (Intercept) 0.4113
## Judges (Intercept) 0.0000
## Residual 1.6914
## Number of obs: 165, groups: Candies:Judges, 55; Judges, 11
## Fixed Effects:
## (Intercept) Candies1 Candies2 Candies3 Candies4
## -3.866e-16 3.136e-02 1.578e-01 -2.212e-01 -1.136e-01
## optimizer (bobyqa) convergence code: 0 (OK) ; 0 optimizer warnings; 1 lme4 warnings4.2.2 Partie Serum
4.2.2.1 Estimation avec la variance des effets fixes calculée avec la variance des matrices d’effets fixes (resLmpEffectMatrices_Serum_test).
### parallel LMM
#######################
resLmpEffectMatrices_Serum_test <- UPDATE_lmpEffectMatrices(resLmpModelMatrix_Serum)## Warning in UPDATE_lmpEffectMatrices(resLmpModelMatrix_Serum): boundary (singular) fit: see help('isSingular')
## for the response(s) : PC134.2.2.2 Estimation avec la variance des effets fixes calculée avec la formule du type 3 SS de limpca (resLmpEffectMatrices_Serum).
resLmpEffectMatrices_Serum <- UPDATE_lmpEffectMatrices_2(resLmpModelMatrix_Serum)## Warning in UPDATE_lmpEffectMatrices_2(resLmpModelMatrix_Serum): boundary (singular) fit: see help('isSingular')
## For the response(s) : PC134.2.2.3 Résultat du modèles pour certaines réponses
4.2.2.3.1 PC8 avec l’optimisation bobyqa
summary(resLmpEffectMatrices_Serum$MM_full$PC8)## Linear mixed model fit by REML ['lmerMod']
## Formula: PC8 ~ (1 | Volunteer) + (1 | Volunteer:Sampling)
## Data: data_full
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 375.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.4307 -0.2230 -0.0270 0.2297 4.2478
##
## Random effects:
## Groups Name Variance Std.Dev.
## Volunteer:Sampling (Intercept) 2.42793 1.5582
## Volunteer (Intercept) 0.04539 0.2131
## Residual 0.36804 0.6067
## Number of obs: 140, groups: Volunteer:Sampling, 36; Volunteer, 12
##
## Fixed effects:
## Estimate Std. Error t value
## (Intercept) -0.01796 0.27184 -0.0664.2.2.3.2 PC8 avec l’optimisation Nelder-Mead
summary(lmer(formula = formula(paste0("PC8",lmpDataList_Serum$formula)),data = cbind(lmpDataList_Serum$design,lmpDataList_Serum$outcomes)))## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## unable to evaluate scaled gradient## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues## Linear mixed model fit by REML ['lmerMod']
## Formula: PC8 ~ (1 | Volunteer) + (1 | Volunteer:Sampling)
## Data: cbind(lmpDataList_Serum$design, lmpDataList_Serum$outcomes)
##
## REML criterion at convergence: 375.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.4334 -0.2181 -0.0256 0.2275 4.2442
##
## Random effects:
## Groups Name Variance Std.Dev.
## Volunteer:Sampling (Intercept) 2.469e+00 1.571401
## Volunteer (Intercept) 3.953e-05 0.006288
## Residual 3.681e-01 0.606718
## Number of obs: 140, groups: Volunteer:Sampling, 36; Volunteer, 12
##
## Fixed effects:
## Estimate Std. Error t value
## (Intercept) -0.01795 0.26696 -0.067
## optimizer (nloptwrap) convergence code: 0 (OK)
## unable to evaluate scaled gradient
## Model failed to converge: degenerate Hessian with 1 negative eigenvalues4.2.3 Partie CHOO
4.2.3.1 Estimation avec la variance des effets fixes calculée avec la variance des matrices d’effets fixes (resLmpEffectMatrices_CHOO_test).
### parallel LMM
#######################
resLmpEffectMatrices_CHOO_test <- UPDATE_lmpEffectMatrices(resLmpModelMatrix_CHOO)## Warning in UPDATE_lmpEffectMatrices(resLmpModelMatrix_CHOO): boundary (singular) fit: see help('isSingular')
## for the response(s) : PC8, PC10, PC11, PC12, PC144.2.3.2 Estimation avec la variance des effets fixes calculée avec la formule du type 3 SS de limpca (resLmpEffectMatrices_CHOO).
### parallel LMM
#######################
resLmpEffectMatrices_CHOO <- UPDATE_lmpEffectMatrices_2(resLmpModelMatrix_CHOO)## Warning in UPDATE_lmpEffectMatrices_2(resLmpModelMatrix_CHOO): boundary (singular) fit: see help('isSingular')
## For the response(s) : PC8, PC10, PC11, PC12, PC144.2.4 Partie UCH
resLmpEffectMatrices_UCH <- UPDATE_lmpEffectMatrices_2(resLmpModelMatrix_UCH)5 Pourcentage de variance expliqué par effet :
5.1 Partie Candies
5.1.1 sur resLmpEffectMatrices_Candies_test
pander::pander(resLmpEffectMatrices_Candies_test$variationPercentages)| Candies | Candies:Judges | Judges | Residuals |
|---|---|---|---|
| 73.84 | 3.845 | 2.684 | 19.63 |
resLmpEffectMatrices_Candies_test$varPercentagesPlot
ggsave(file.path(output_Candies,"res_test_varPercentagesPlot.jpeg"),resLmpEffectMatrices_Candies$varPercentagesPlot)## Saving 6 x 5 in image5.1.1.1 sur resLmpEffectMatrices_Candies
pander::pander(resLmpEffectMatrices_Candies$variationPercentages)| Candies | Candies:Judges | Judges | Residuals |
|---|---|---|---|
| 73.84 | 3.845 | 2.684 | 19.63 |
resLmpEffectMatrices_Candies$varPercentagesPlot
ggsave(file.path(output_Candies,"res_varPercentagesPlot_test.jpeg"),resLmpEffectMatrices_Candies$varPercentagesPlot)## Saving 6 x 5 in image5.2 Partie Serum
5.2.1 sur resLmpEffectMatrices_Serum_test
pander::pander(resLmpEffectMatrices_Serum_test$variationPercentages)| Volunteer:Sampling | Volunteer | Residuals |
|---|---|---|
| 27.68 | 70.8 | 1.525 |
resLmpEffectMatrices_Serum_test$varPercentagesPlot
ggsave(file.path(output_Serum,"res_test_varPercentagesPlot.jpeg"),resLmpEffectMatrices_Serum$varPercentagesPlot)## Saving 6 x 5 in image5.2.2 sur resLmpEffectMatrices_Serum
pander::pander(resLmpEffectMatrices_Serum$variationPercentages)| Volunteer:Sampling | Volunteer | Residuals |
|---|---|---|
| 27.68 | 70.8 | 1.525 |
resLmpEffectMatrices_Serum$varPercentagesPlot
ggsave(file.path(output_Serum,"res_varPercentagesPlot.jpeg"),resLmpEffectMatrices_Serum$varPercentagesPlot)## Saving 6 x 5 in image5.3 Partie CHOO
5.3.1 sur resLmpEffectMatrices_CHOO_test
pander::pander(resLmpEffectMatrices_CHOO_test$variationPercentages)| treatment | time | treatment:time | volunteer | Residuals |
|---|---|---|---|---|
| 10.11 | 0.75 | 2.858 | 29.33 | 56.94 |
resLmpEffectMatrices_CHOO_test$varPercentagesPlot
ggsave(file.path(output_CHOO,"res_test_varPercentagesPlot.jpeg"),resLmpEffectMatrices_CHOO$varPercentagesPlot)## Saving 6 x 5 in image5.3.2 sur resLmpEffectMatrices_CHOO
pander::pander(resLmpEffectMatrices_CHOO$variationPercentages)| treatment | time | treatment:time | volunteer | Residuals |
|---|---|---|---|---|
| 10.1 | 0.7482 | 2.85 | 29.34 | 56.96 |
ggsave(file.path(output_CHOO,"res_varPercentagesPlot.jpeg"),resLmpEffectMatrices_CHOO$varPercentagesPlot)## Saving 6 x 5 in imageresLmpEffectMatrices_CHOO$varPercentagesPlot
5.4 Partie UCH
output_UCH <- paste0(fig_path,"/UCH")
pander::pander(resLmpEffectMatrices_UCH$variationPercentages)| Hippurate | Citrate | Time | Hippurate:Citrate | Hippurate:Time |
|---|---|---|---|---|
| 39.31 | 29.91 | 16.24 | 1.543 | 6.229 |
| Citrate:Time | Hippurate:Citrate:Time | Residuals |
|---|---|---|
| 0.5387 | 1.684 | 4.298 |
resLmpEffectMatrices_UCH$varPercentagesPlot
ggsave(file.path(output_UCH,"res_varPercentagesPlot.jpeg"),resLmpEffectMatrices_UCH$varPercentagesPlot)## Saving 6 x 5 in image6 Tests Bootstrap
6.1 Partie Candies
resLmpBootstrapTests_Candies <- UPDATE_lmpBootstrapTests(resLmpEffectMatrices_Candies, nboot = 200, verbose = TRUE)
save(resLmpBootstrapTests_Candies, file = "./outputs_lmer/Candies/resBootstrap")6.1.1 Significativité des effets
load(file = "./outputs_lmer/Candies/resBootstrap")
pander::pander(t(resLmpBootstrapTests_Candies$resultsTable))| Candies | Candies:Judges | Judges | Residuals | |
|---|---|---|---|---|
| % of variance | 73.84 | 3.85 | 2.68 | 19.63 |
| Bootstrap p-values | < 0.005 | < 0.005 | < 0.005 | - |
6.1.2 Distribution bootstrap par effet
for(name in names(resLmpBootstrapTests_Candies$f.obs)){
m=hist(resLmpBootstrapTests_Candies$f.boot[[name]], freq=F, breaks=100,
xlab="Global Likelihood Ratio Statistic",
xlim=range(resLmpBootstrapTests_Candies$f.obs[name], resLmpBootstrapTests_Candies$f.boot[[name]]),
ylim = c(0,0.08),
col = "gray75",border = "gray75",
main = paste( name , "effect"), cex.main = 2.2)
points(resLmpBootstrapTests_Candies$f.obs[name], 0, col="red", pch=19, lwd=6)
legend("topright",
legend = c(paste0("True GLRT: ", round(resLmpBootstrapTests_Candies$f.obs[name],2))),
col = c("red"),pch=19, inset=c(-0.1,0),box.lty=0, cex = 1.4, y.intersp = 0.8)
m
# Exporter graph
name_bis <- str_replace(name,":","")
jpeg(file.path(output_Candies,paste0("HSD_hist_",name_bis,".jpeg")))
m=hist(resLmpBootstrapTests_Candies$f.boot[[name]], freq=F, breaks=100,
xlab="Global Likelihood Ratio Statistic",
xlim=range(resLmpBootstrapTests_Candies$f.obs[name], resLmpBootstrapTests_Candies$f.boot[[name]]),
ylim = c(0,0.08),
col = "gray75",border = "gray75",
main = paste( name , "effect"), cex.main = 2.2)
points(resLmpBootstrapTests_Candies$f.obs[name], 0, col="red", pch=19, lwd=6)
legend("topright",
legend = c(paste0("True GLRT: ", round(resLmpBootstrapTests_Candies$f.obs[name],2))),
col = c("red"),pch=19, inset=c(-0.1,0),box.lty=0, cex = 1.4, y.intersp = 0.8)
dev.off()
}
6.2 Partie Serum
resLmpBootstrapTests_Serum <- UPDATE_lmpBootstrapTests(resLmpEffectMatrices_Serum, nboot = 200, verbose = TRUE)
save(resLmpBootstrapTests_Serum, file = "./outputs_lmer/Serum/resBootstrap")6.2.1 Significativité des effets
load(file = "./outputs_lmer/Serum/resBootstrap")
pander::pander(t(resLmpBootstrapTests_Serum$resultsTable))| Volunteer:Sampling | Volunteer | Residuals | |
|---|---|---|---|
| % of variance | 27.68 | 70.80 | 1.52 |
| Bootstrap p-values | < 0.005 | < 0.005 | - |
6.2.2 Distribution bootstrap par effet
for(name in names(resLmpBootstrapTests_Serum$f.obs)){
m=hist(resLmpBootstrapTests_Serum$f.boot[[name]], freq=F, breaks=100,
xlab="Global Likelihood Ratio Statistic",
xlim=range(resLmpBootstrapTests_Serum$f.obs[name], resLmpBootstrapTests_Serum$f.boot[[name]]),
ylim = c(0,0.08),
col = "gray75",border = "gray75",
main = paste( name , "effect"), cex.main = 2.2)
points(resLmpBootstrapTests_Serum$f.obs[name], 0, col="red", pch=19, lwd=6)
legend("topright",
legend = c(paste0("True GLRT: ", round(resLmpBootstrapTests_Serum$f.obs[name],2))),
col = c("red"),pch=19, inset=c(-0.1,0),box.lty=0, cex = 1.4, y.intersp = 0.8)
m
# Exporter graph
name_bis <- str_replace(name,":","")
jpeg(file.path(output_Serum,paste0("HSD_hist_",name_bis,".jpeg")))
m=hist(resLmpBootstrapTests_Serum$f.boot[[name]], freq=F, breaks=100,
xlab="Global Likelihood Ratio Statistic",
xlim=range(resLmpBootstrapTests_Serum$f.obs[name], resLmpBootstrapTests_Serum$f.boot[[name]]),
ylim = c(0,0.08),
col = "gray75",border = "gray75",
main = paste( name , "effect"), cex.main = 2.2)
points(resLmpBootstrapTests_Serum$f.obs[name], 0, col="red", pch=19, lwd=6)
legend("topright",
legend = c(paste0("True GLRT: ", round(resLmpBootstrapTests_Serum$f.obs[name],2))),
col = c("red"),pch=19, inset=c(-0.1,0),box.lty=0, cex = 1.4, y.intersp = 0.8)
dev.off()
}
6.3 Partie CHOO
resLmpBootstrapTests_CHOO <- UPDATE_lmpBootstrapTests(resLmpEffectMatrices_CHOO, nboot = 200, verbose = TRUE)
save(resLmpBootstrapTests_CHOO, file = "./outputs_lmer/CHOO/resBootstrap")6.3.1 Significativité des effets
load(file = "./outputs_lmer/CHOO/resBootstrap")
pander::pander(t(resLmpBootstrapTests_CHOO$resultsTable))| treatment | time | treatment:time | volunteer | Residuals | |
|---|---|---|---|---|---|
| % of variance | 10.10 | 0.75 | 2.85 | 29.34 | 56.96 |
| Bootstrap p-values | 0.12 | 0.6 | 0.82 | < 0.005 | - |
6.3.2 Distribution bootstrap par effet
for(name in names(resLmpBootstrapTests_CHOO$f.obs)){
m=hist(resLmpBootstrapTests_CHOO$f.boot[[name]], freq=F, breaks=100,
xlab="Global Likelihood Ratio Statistic",
xlim=range(resLmpBootstrapTests_CHOO$f.obs[name], resLmpBootstrapTests_CHOO$f.boot[[name]]),
ylim = c(0,0.08),
col = "gray75",border = "gray75",
main = paste( name , "effect"), cex.main = 2.2)
points(resLmpBootstrapTests_CHOO$f.obs[name], 0, col="red", pch=19, lwd=6)
legend("topright",
legend = c(paste0("True GLRT: ", round(resLmpBootstrapTests_CHOO$f.obs[name],2))),
col = c("red"),pch=19, inset=c(-0.1,0),box.lty=0, cex = 1.4, y.intersp = 0.8)
m
# Exporter graph
name_bis <- str_replace(name,":","")
jpeg(file.path(output_CHOO,paste0("HSD_hist_",name_bis,".jpeg")))
m=hist(resLmpBootstrapTests_CHOO$f.boot[[name]], freq=F, breaks=100,
xlab="Global Likelihood Ratio Statistic",
xlim=range(resLmpBootstrapTests_CHOO$f.obs[name], resLmpBootstrapTests_CHOO$f.boot[[name]]),
ylim = c(0,0.08),
col = "gray75",border = "gray75",
main = paste( name , "effect"), cex.main = 2.2)
points(resLmpBootstrapTests_CHOO$f.obs[name], 0, col="red", pch=19, lwd=6)
legend("topright",
legend = c(paste0("True GLRT: ", round(resLmpBootstrapTests_CHOO$f.obs[name],2))),
col = c("red"),pch=19, inset=c(-0.1,0),box.lty=0, cex = 1.4, y.intersp = 0.8)
dev.off()
}
6.4 Partie UCH
resLmpBootstrapTests_UCH <- UPDATE_lmpBootstrapTests(resLmpEffectMatrices_UCH, nboot = 200, verbose = TRUE)
save(resLmpBootstrapTests_UCH, file = "./outputs_lmer/UCH/resBootstrap")6.4.1 Significativité des effets
load(file = "./outputs_lmer/UCH/resBootstrap")
pander::pander(t(resLmpBootstrapTests_UCH$resultsTable))| Hippurate | Citrate | Time | Hippurate:Citrate | |
|---|---|---|---|---|
| % of variance (T III) | 39.31 | 29.91 | 16.24 | 1.54 |
| Bootstrap p-values | < 0.005 | < 0.005 | < 0.005 | 0.16 |
| Hippurate:Time | Citrate:Time | |
|---|---|---|
| % of variance (T III) | 6.23 | 0.54 |
| Bootstrap p-values | < 0.005 | 0.4 |
| Hippurate:Citrate:Time | Residuals | |
|---|---|---|
| % of variance (T III) | 1.68 | 4.30 |
| Bootstrap p-values | 0.11 | - |
6.4.2 Distribution bootstrap par effet
for(name in names(resLmpBootstrapTests_UCH$f.obs)){
m=hist(resLmpBootstrapTests_UCH$f.boot[,name], freq=F, breaks=100,
xlab="Global Likelihood Ratio Statistic",
xlim=range(resLmpBootstrapTests_UCH$f.obs[name], resLmpBootstrapTests_UCH$f.boot[,name]),
ylim = c(0,0.08),
col = "gray75",border = "gray75",
main = paste( name , "effect"), cex.main = 2.2)
points(resLmpBootstrapTests_UCH$f.obs[name], 0, col="red", pch=19, lwd=6)
legend("topright",
legend = c(paste0("True GLRT: ", round(resLmpBootstrapTests_UCH$f.obs[name],2))),
col = c("red"),pch=19, inset=c(-0.1,0),box.lty=0, cex = 1.4, y.intersp = 0.8)
m
# Exporter graph
name_bis <- str_replace_all(name,":","")
jpeg(file.path(output_UCH,paste0("HSD_hist_",name_bis,".jpeg")))
m=hist(resLmpBootstrapTests_UCH$f.boot[,name], freq=F, breaks=100,
xlab="Global Likelihood Ratio Statistic",
xlim=range(resLmpBootstrapTests_UCH$f.obs[name], resLmpBootstrapTests_UCH$f.boot[,name]),
ylim = c(0,0.08),
col = "gray75",border = "gray75",
main = paste( name , "effect"), cex.main = 2.2)
points(resLmpBootstrapTests_UCH$f.obs[name], 0, col="red", pch=19, lwd=6)
legend("topright",
legend = c(paste0("True GLRT: ", round(resLmpBootstrapTests_UCH$f.obs[name],2))),
col = c("red"),pch=19, inset=c(-0.1,0),box.lty=0, cex = 1.4, y.intersp = 0.8)
dev.off()
}
7 Calcule des dimensions effectives (ED) et facteurs de corrections
# calcule du facteur de correction
fact_corretion <- function(df1, df2, min_df2 = 4){
if (any(df2 < min_df2)) {
warning("The degree of freedom df2 is too small. Using df2 = ", min_df2,"\n")
df2[df2 < min_df2] <- min_df2
}
Fstat <- qf(.95, df1=df1 ,df2= df2)
coef <- sqrt((Fstat*df1)/df2)
return(coef)
}7.1 Partie Candies
7.1.1 ED
res_ED_Candies <- computeED(resLmpEffectMatrices_Candies)## Warning in computeED(resLmpEffectMatrices_Candies): The variance of the random Judges variable for response PC5 is 0.## Warning in computeED(resLmpEffectMatrices_Candies): The variance of the random Candies:Judges variable for response PC6 is 0.## Warning in computeED(resLmpEffectMatrices_Candies): The variance of the random Judges variable for response PC8 is 0.pander::pander(round(res_ED_Candies,1))| PC1 | PC2 | PC3 | PC4 | PC5 | PC6 | PC7 | PC8 | |
|---|---|---|---|---|---|---|---|---|
| Candies:Judges | 20.6 | 27.2 | 7 | 8.8 | 17.3 | 0 | 25 | 7.5 |
| Judges | 2.1 | 0.5 | 8.8 | 1.7 | 0 | 6.5 | 4.9 | 0 |
| Candies | 4 | 4 | 4 | 4 | 4 | 4 | 4 | 4 |
| Residuals | 138.3 | 133.3 | 145.2 | 150.5 | 143.7 | 154.5 | 131.1 | 153.5 |
7.1.2 Facteurs de corrections
fact_corretion_Candies <- fact_corretion(res_ED_Candies["Candies",], res_ED_Candies["Candies:Judges",])## Warning in fact_corretion(res_ED_Candies["Candies", ], res_ED_Candies["Candies:Judges", : The degree of freedom df2 is too small. Using df2 = 4fact_corretion_Judges <- fact_corretion(res_ED_Candies["Judges",], res_ED_Candies["Residuals",])## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.048076 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.045916 is not accuratefact_corretion_CJ <- fact_corretion(res_ED_Candies["Candies:Judges",], res_ED_Candies["Residuals",])## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.047908 is not accuratefacts_corretions_Candies <- rbind(Candies = fact_corretion_Candies, Judges = fact_corretion_Judges, `Candies:Judges` = fact_corretion_CJ)
pander::pander(round(facts_corretions_Candies, 1))| PC1 | PC2 | PC3 | PC4 | PC5 | PC6 | PC7 | PC8 | |
|---|---|---|---|---|---|---|---|---|
| Candies | 0.7 | 0.6 | 1.5 | 1.3 | 0.8 | 2.5 | 0.7 | 1.4 |
| Judges | 0.2 | 0.1 | 0.3 | 0.2 | 0 | 0.3 | 0.3 | 0 |
| Candies:Judges | 0.5 | 0.6 | 0.3 | 0.3 | 0.5 | 0 | 0.6 | 0.3 |
# fact correction manon martin
# fact_correction_Candies_m = fact_corretion(c(4,4,4,4,4,4,4,4),c(13.3, 18.9, 9.8, 8.6, 12.4, 2.6, 19.1, 9.7), min_df2 = 0)
# round(fact_correction_Candies_m,1)
#
# fact_correction_Judges_m = fact_corretion(c(5.3, 5.8, 9.1, 3.4, 2.5, 6.6, 7.7, 1.7),c(141.3, 135.3, 141.1, 148, 145.1, 150.8, 133.2, 148.6), min_df2 = 0)
# round(fact_correction_Judges_m,1)
#
# fact_correction_CJ_m = fact_corretion(c(13.3, 18.9, 9.8, 8.6, 12.4, 2.6, 19.1, 9.7),c(141.3, 135.3, 141.1, 148, 145.1, 150.8, 133.2, 148.6), min_df2 = 0)
# round(fact_correction_CJ_m,1)7.2 Partie Serum
7.2.1 ED
res_ED_Serum <- computeED(resLmpEffectMatrices_Serum)## Warning in computeED(resLmpEffectMatrices_Serum): The variance of the random Volunteer variable for response PC13 is 0.pander::pander(round(res_ED_Serum,1))| PC1 | PC2 | PC3 | PC4 | PC5 | PC6 | PC7 | |
|---|---|---|---|---|---|---|---|
| Volunteer:Sampling | 24.8 | 24.9 | 30.3 | 28.7 | 27 | 28.2 | 25.5 |
| Volunteer | 10.1 | 9.9 | 4.5 | 5.3 | 7.5 | 4.4 | 8.3 |
| Residuals | 105.1 | 105.2 | 105.2 | 106 | 105.5 | 107.3 | 106.1 |
| PC8 | PC9 | PC10 | PC11 | PC12 | PC13 | PC14 | PC15 | |
|---|---|---|---|---|---|---|---|---|
| Volunteer:Sampling | 33.1 | 22.3 | 27.5 | 19.2 | 28.4 | 31 | 30.3 | 7.7 |
| Volunteer | 0.6 | 8.6 | 4.4 | 8.6 | 5.6 | 0 | 2.8 | 6.1 |
| Residuals | 106.3 | 109.1 | 108.1 | 112.1 | 106 | 109 | 106.9 | 126.1 |
7.2.2 Facteurs de corrections
fact_corretion_VS <- fact_corretion(res_ED_Serum["Volunteer:Sampling",], res_ED_Serum["Residuals",])
fact_corretion_Volunteer <- fact_corretion(res_ED_Serum["Volunteer",], res_ED_Serum["Volunteer:Sampling",])## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.046017 is not accuratefacts_corretions_Serum <- rbind(`Volunteer:Sampling` = fact_corretion_VS, Volunteer = fact_corretion_Volunteer)
pander::pander(round(facts_corretions_Serum, 1))| PC1 | PC2 | PC3 | PC4 | PC5 | PC6 | PC7 | PC8 | PC9 | |
|---|---|---|---|---|---|---|---|---|---|
| Volunteer:Sampling | 0.6 | 0.6 | 0.7 | 0.7 | 0.6 | 0.6 | 0.6 | 0.7 | 0.6 |
| Volunteer | 1 | 0.9 | 0.6 | 0.7 | 0.8 | 0.6 | 0.9 | 0.3 | 1 |
| PC10 | PC11 | PC12 | PC13 | PC14 | PC15 | |
|---|---|---|---|---|---|---|
| Volunteer:Sampling | 0.6 | 0.5 | 0.7 | 0.7 | 0.7 | 0.4 |
| Volunteer | 0.6 | 1 | 0.7 | 0 | 0.5 | 1.7 |
7.3 Partie CHOO
7.3.1 ED
res_ED_CHOO <- computeED(resLmpEffectMatrices_CHOO)## Warning in computeED(resLmpEffectMatrices_CHOO): The variance of the random volunteer variable for response PC8 is 0.## Warning in computeED(resLmpEffectMatrices_CHOO): The variance of the random volunteer variable for response PC11 is 0.## Warning in computeED(resLmpEffectMatrices_CHOO): The variance of the random volunteer variable for response PC12 is 0.## Warning in computeED(resLmpEffectMatrices_CHOO): The variance of the random volunteer variable for response PC14 is 0.pander::pander(round(res_ED_CHOO,1))| PC1 | PC2 | PC3 | PC4 | PC5 | PC6 | PC7 | PC8 | PC9 | |
|---|---|---|---|---|---|---|---|---|---|
| volunteer | 8 | 12.6 | 12 | 6.3 | 0.6 | 1.8 | 4.4 | 0 | 4.3 |
| treatment | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 |
| time | 2 | 2 | 2 | 2 | 2 | 2 | 2 | 2 | 2 |
| treatment:time | 2 | 2 | 2 | 2 | 2 | 2 | 2 | 2 | 2 |
| Residuals | 33 | 28.4 | 29 | 34.7 | 40.4 | 39.2 | 36.6 | 41 | 36.7 |
| PC10 | PC11 | PC12 | PC13 | PC14 | |
|---|---|---|---|---|---|
| volunteer | 0 | 0 | 0 | 5.5 | 0 |
| treatment | 1 | 1 | 1 | 1 | 1 |
| time | 2 | 2 | 2 | 2 | 2 |
| treatment:time | 2 | 2 | 2 | 2 | 2 |
| Residuals | 41 | 41 | 41 | 35.5 | 41 |
7.3.2 Facteurs de corrections
fact_corretion_volunteer <- fact_corretion(res_ED_CHOO["volunteer",], res_ED_CHOO["Residuals",])## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.049954 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.05 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.049903 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.04986 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.049774 is not accuratefact_corretion_treatment <- fact_corretion(res_ED_CHOO["treatment",], res_ED_CHOO["volunteer",])## Warning in fact_corretion(res_ED_CHOO["treatment", ], res_ED_CHOO["volunteer", : The degree of freedom df2 is too small. Using df2 = 4fact_corretion_time <- fact_corretion(res_ED_CHOO["time",], res_ED_CHOO["Residuals",])
fact_corretion_TrTi <- fact_corretion(res_ED_CHOO["treatment:time",], res_ED_CHOO["Residuals",])
facts_corretions_CHOO <- rbind(volunteer = fact_corretion_volunteer,treatment = fact_corretion_treatment, time = fact_corretion_time, `treatment:time` = fact_corretion_TrTi)
pander::pander(round(facts_corretions_CHOO, 1))| PC1 | PC2 | PC3 | PC4 | PC5 | PC6 | PC7 | PC8 | PC9 | |
|---|---|---|---|---|---|---|---|---|---|
| volunteer | 0.7 | 1 | 0.9 | 0.7 | 0.3 | 0.4 | 0.6 | 0 | 0.5 |
| treatment | 0.8 | 0.6 | 0.6 | 1 | 1.4 | 1.4 | 1.3 | 1.4 | 1.3 |
| time | 0.4 | 0.5 | 0.5 | 0.4 | 0.4 | 0.4 | 0.4 | 0.4 | 0.4 |
| treatment:time | 0.4 | 0.5 | 0.5 | 0.4 | 0.4 | 0.4 | 0.4 | 0.4 | 0.4 |
| PC10 | PC11 | PC12 | PC13 | PC14 | |
|---|---|---|---|---|---|
| volunteer | 0 | 0 | 0 | 0.6 | 0 |
| treatment | 1.4 | 1.4 | 1.4 | 1.1 | 1.4 |
| time | 0.4 | 0.4 | 0.4 | 0.4 | 0.4 |
| treatment:time | 0.4 | 0.4 | 0.4 | 0.4 | 0.4 |
8 ACP sur les matrices d’effets
8.1 ASCA
8.1.1 Partie Candies
# with ED
resLmpPcaEffectsASCA_Candies <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_Candies, method="ASCA",verbose = TRUE,backtransform = TRUE, correctedMatrixAdd = FALSE)## [1] "ASCA method used : PCA on the pure effect matrices"
## Time difference of 0.004616022 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsASCA_Candies,varname.colorup = "Candies",varname.colordown = "Candies", varname.pchup = "Judges", varname.pchdown = "Judges",)
# Construction des graphiques
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsASCA_Candies$Candies$var)
screeplotCandies <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsASCA_Candies$Judges$var)
screeplotJudges <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsASCA_Candies$`Candies:Judges`$var)
screeplotCandiesJudges <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsASCA_Candies$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
Candies_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_Candies,effectNames = c("Candies"),color = "Candies",shape = "Candies") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) +
coord_cartesian(xlim = c(-20, 15), ylim = c(-10, 8))
Judges_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_Candies,effectNames = c("Judges"),color = "Judges") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
# Inverser les scores et les loadings pour Candies:Judges
resLmpPcaEffectsASCA_Candies_bis <- resLmpPcaEffectsASCA_Candies
resLmpPcaEffectsASCA_Candies_bis$`Candies:Judges`$scores <- - resLmpPcaEffectsASCA_Candies$`Candies:Judges`$scores
resLmpPcaEffectsASCA_Candies_bis$`Candies:Judges`$loadings <- - resLmpPcaEffectsASCA_Candies$`Candies:Judges`$loadings
CA_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_Candies_bis,effectNames = c("Candies:Judges"), color = "Judges",shape = "Candies", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) ## `summarise()` has grouped output by 'Judges'. You can override using the
## `.groups` argument.# 2 points outliers
index <- c(10, 27)
Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_Candies,effectNames = c("Residuals"), shape = "Candies", color = "Judges") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
annotate("text", y = (resLmpPcaEffectsASCA_Candies$Residuals$scores[index,2] +
1.7*c(-1 , -1)),
x = resLmpPcaEffectsASCA_Candies$Residuals$scores[index,1],
label = rownames(resLmpPcaEffectsASCA_Candies$Residuals$scores[index,1:2]))## mapping: x = ~x, y = ~y
## geom_text: na.rm = FALSE
## stat_identity: na.rm = FALSE
## position_identityloadCandies <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_Candies, effectNames = c("Candies"), addRownames = TRUE)
loadJudges <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_Candies, effectNames = c("Judges"), addRownames = TRUE)
loadCandiesJudges <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_Candies_bis, effectNames = c("Candies:Judges"), addRownames = TRUE)
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_Candies, effectNames = c("Residuals"), addRownames = TRUE)
a <- grid.arrange(screeplotCandies, Candies_scores,
loadCandies, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Candy effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_ASCA_Candy.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplotJudges, Judges_scores,
loadJudges, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Judge effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_ASCA_Judges.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplotCandiesJudges, CA_scores,
loadCandiesJudges, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("C*J effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_ASCA_CJ.jpeg"),c, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)d <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_ASCA_Residuals.jpeg"),d, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)UPDATE_lmpEffectPlot(resLmpPcaEffectsASCA_Candies, effectName = "Candies:Judges", x = "Candies", z = "Judges")## Warning: The shape palette can deal with a maximum of 6 discrete values because
## more than 6 becomes difficult to discriminate; you have 11. Consider
## specifying shapes manually if you must have them.## Warning: Removed 25 rows containing missing values (geom_point).
8.1.1.1 Combiner Candies, Judges et Candies:Judges
resLmpPcaEffectsASCA_Comb_Candies <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_Candies, method="ASCA",verbose = TRUE, correctedMatrixAdd = FALSE, backtransform = TRUE,combineEffects = list(c("Candies","Judges", "Candies:Judges")))## [1] "ASCA method used : PCA on the pure effect matrices"
## Time difference of 0 secs# Construction des graphiques
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsASCA_Comb_Candies$`Candies+Judges+Candies:Judges`$var)
screeplotCombCandies <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
combCandies_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_Comb_Candies,effectNames = c("Candies+Judges+Candies:Judges"),color = "Candies",shape = "Candies", drawShapes = "polygon") + theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
loadCombCandies <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_Comb_Candies, effectNames = c("Candies+Judges+Candies:Judges"), addRownames = TRUE)
a <- grid.arrange(screeplotCombCandies, combCandies_scores,
loadCombCandies, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Candies+Judges+Candies:Judges effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_ASCA_Comb.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)# exporter
UPDATE_lmpEffectPlot(resLmpPcaEffectsASCA_Comb_Candies,effectName = c("Candies+Judges+Candies:Judges"), x = c("Candies"), z = c("Judges"),axes = c(1))## Warning: The shape palette can deal with a maximum of 6 discrete values because
## more than 6 becomes difficult to discriminate; you have 11. Consider
## specifying shapes manually if you must have them.## Warning: Removed 25 rows containing missing values (geom_point).
ggsave(plot = last_plot(), device = NULL, filename = file.path(output_Candies,"plotEffect_Candies_PC1.jpeg"),
scale = 1,dpi = 1000)## Saving 6 x 5 in image## Warning: The shape palette can deal with a maximum of 6 discrete values because
## more than 6 becomes difficult to discriminate; you have 11. Consider
## specifying shapes manually if you must have them.
## Warning: Removed 25 rows containing missing values (geom_point).UPDATE_lmpEffectPlot(resLmpPcaEffectsASCA_Comb_Candies,effectName = c("Candies+Judges+Candies:Judges"), x = c("Candies"), z = c("Judges"),axes = c(2))## Warning: The shape palette can deal with a maximum of 6 discrete values because
## more than 6 becomes difficult to discriminate; you have 11. Consider
## specifying shapes manually if you must have them.
## Warning: Removed 25 rows containing missing values (geom_point).
ggsave(plot = last_plot(), device = NULL, filename = file.path(output_Candies,"plotEffect_Candies_PC2.jpeg"),
scale = 1,dpi = 1000)## Saving 6 x 5 in image## Warning: The shape palette can deal with a maximum of 6 discrete values because
## more than 6 becomes difficult to discriminate; you have 11. Consider
## specifying shapes manually if you must have them.
## Warning: Removed 25 rows containing missing values (geom_point).8.1.2 Partie Serum
resLmpPcaEffectsASCA_Serum <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_Serum, method="ASCA",verbose = TRUE,backtransform = TRUE, correctedMatrixAdd = FALSE)## [1] "ASCA method used : PCA on the pure effect matrices"
## Time difference of 0.003986835 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsASCA_Serum,varname.colorup = "Volunteer",varname.colordown = "Volunteer", varname.pchup = "Sampling", varname.pchdown = "Sampling")
# Construction des graphiques
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsASCA_Serum$Volunteer$var)
screeplotVolunteer <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsASCA_Serum$`Volunteer:Sampling`$var)
screeplotVS <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsASCA_Serum$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
Volunteer_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_Serum,effectNames = c("Volunteer"),color = "Volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
VS_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_Serum,effectNames = c("Volunteer:Sampling"), color = "Volunteer",shape = "Sampling", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) ## `summarise()` has grouped output by 'Volunteer'. You can override using the
## `.groups` argument.Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_Serum,effectNames = c("Residuals"), shape = "Sampling", color = "Volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
loadVolunteer <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_Serum, effectNames = c("Volunteer"))
loadVolunteerSampling <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_Serum, effectNames = c("Volunteer:Sampling"))
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_Serum, effectNames = c("Residuals"))
a <- grid.arrange(screeplotVolunteer, Volunteer_scores,
loadVolunteer, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Volunteer effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_ASCA_Volunteer.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplotVS, VS_scores,
loadVolunteerSampling, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Volunteer:Sampling effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_ASCA_VS.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_ASCA_Residuals.jpeg"),c, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)UPDATE_lmpEffectPlot(resLmpPcaEffectsASCA_Serum, effectName = "Volunteer:Sampling", x = "Sampling", z = "Volunteer")## Warning: The shape palette can deal with a maximum of 6 discrete values because
## more than 6 becomes difficult to discriminate; you have 12. Consider
## specifying shapes manually if you must have them.## Warning: Removed 18 rows containing missing values (geom_point).
8.1.3 Partie CHOO
resLmpPcaEffectsASCA_CHOO <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_CHOO, method="ASCA",verbose = TRUE, correctedMatrixAdd = FALSE)## [1] "ASCA method used : PCA on the pure effect matrices"
## Time difference of 0.002992153 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsASCA_CHOO,varname.colorup = "time",varname.colordown = "time", varname.pchup = "treatment", varname.pchdown = "treatment")
# Construction des graphiques
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCA_CHOO$volunteer$var)
screeplotvolunteer <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCA_CHOO$treatment$var)
screeplottreatment <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCA_CHOO$time$var)
screeplottime <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCA_CHOO$`treatment:time`$var)
screeplottrti <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCA_CHOO$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
volunteer_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_CHOO,effectNames = c("volunteer"),color = "volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
treatment_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_CHOO,effectNames = c("treatment"), color = "treatment",shape = "treatment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) ## Warning in FUN(X[[i]], ...): The variance of PC2 is inferior to 1%. Graph scaledtime_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_CHOO,effectNames = c("time"), color = "time",shape = "time") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
treatmenttime_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_CHOO,effectNames = c("treatment:time"), color = "treatment",shape = "time", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))## `summarise()` has grouped output by 'treatment'. You can override using the
## `.groups` argument.Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_CHOO,effectNames = c("Residuals"), shape = "treatment", color = "time") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
loadvolunteer <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_CHOO, effectNames = c("volunteer"))
loadtreatment <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_CHOO, effectNames = c("treatment"))## Warning in FUN(X[[i]], ...): The variance of PC2 is inferior to 1%. Graph scaledloadtime <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_CHOO, effectNames = c("time"))
loadtreatmenttime <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_CHOO, effectNames = c("treatment:time"))
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_CHOO, effectNames = c("Residuals"))
a <- grid.arrange(screeplotvolunteer, volunteer_scores,
loadvolunteer, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("volunteer effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCA_volunteer.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplottreatment, treatment_scores,
loadtreatment, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("treatment effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCA_treatment.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplottime, time_scores,
loadtime, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("time effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCA_time.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)d <- grid.arrange(screeplottrti, treatmenttime_scores,
loadtreatmenttime, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("treatment:time effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCA_treatmenttime.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)e <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCA_Residuals.jpeg"),d, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)UPDATE_lmpEffectPlot(resLmpPcaEffectsASCA_CHOO, effectName = "treatment:time", x = "time", z = "treatment")
UPDATE_lmpEffectPlot(resLmpPcaEffectsASCA_CHOO, effectName = "treatment:time", x = "treatment", z = "time")
8.1.3.1 ASCA avec combinaisons
Il y a 2 combinaisons d’effets : - treatment et time - treatment, time et volunteer
resLmpPcaEffectsASCA_Comb_CHOO <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_CHOO, method="ASCA",verbose = TRUE, combineEffects = list(c("treatment","time"), c("treatment","time","volunteer")),correctedMatrixAdd = FALSE)## [1] "ASCA method used : PCA on the pure effect matrices"
## Time difference of 0.004998922 secs# Construction des graphiques
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCA_Comb_CHOO$`treatment+time`$var)
screeplotComb <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCA_Comb_CHOO$`treatment+time+volunteer`$var)
screeplotComb2 <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
comb_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_Comb_CHOO,effectNames = c("treatment+time"), color = "treatment",shape = "time") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
comb2_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_Comb_CHOO,effectNames = c("treatment+time+volunteer"), color = "treatment",shape = "time") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
loadComb <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_Comb_CHOO, effectNames = c("treatment+time"))
loadComb2 <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCA_Comb_CHOO, effectNames = c("treatment+time+volunteer"))
a <- grid.arrange(screeplotComb, comb_scores,
loadComb, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("treatment+time effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCA_comb.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplotComb2, comb2_scores,
loadComb2, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("treatment+time+volunteer effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCA_comb2.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)8.1.4 Partie UCH
resLmpPcaEffectsASCA_UCH <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_UCH, method="ASCA",verbose = TRUE, correctedMatrixAdd = FALSE)## [1] "ASCA method used : PCA on the pure effect matrices"
## Time difference of 0.09958196 secsall_loadings_pl <- UPDATE_lmpLoading1dPlot(resLmpPcaEffectsASCA_UCH,
effectNames = c("Hippurate", "Citrate","Time",
"Hippurate:Time",
"Residuals"),
axes = 1, xlab = "ppm")UPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsASCA_UCH,PCdim=c(1,1,1,1,1,1,1,2),
modelAbbrev = TRUE,
varname.colorup = "Citrate",
varname.colordown = "Time",
varname.pchup="Hippurate",
varname.pchdown="Time",
title = "ASCA scores scatterplot matrix")
# Hippurate
hip_scores_pl <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_UCH, effectNames = "Hippurate",
color = "Hippurate", shape = "Hippurate")
hip_loadings_pl <- all_loadings_pl$Hippurate
grid.arrange(hip_scores_pl,hip_loadings_pl, ncol=2)
# Citrate
cit_scores_pl <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_UCH, effectNames = "Citrate",
color = "Citrate", shape = "Citrate")
cit_loadings_pl <- all_loadings_pl$Citrate
grid.arrange(cit_scores_pl,cit_loadings_pl, ncol=2)
# Time
tim_scores_pl <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_UCH, effectNames = "Time", color = "Time",
shape = "Time")## Warning in FUN(X[[i]], ...): The variance of PC2 is inferior to 1%. Graph scaledtim_loadings_pl <- all_loadings_pl$Time
grid.arrange(tim_scores_pl,tim_loadings_pl, ncol=2)
# Hippurate:Time
hiptim_scores_pl <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCA_UCH, effectNames = "Hippurate:Time",
color = "Hippurate", shape = "Time")
hiptim_loadings_pl <- all_loadings_pl$`Hippurate:Time`
grid.arrange(hiptim_scores_pl,hiptim_loadings_pl, ncol=2)
resid_scores_pl <- lmpScorePlot(resLmpPcaEffectsASCA_UCH, effectNames = "Residuals",
color = "Day", shape = "Day",
drawShapes = "segment")
resid_loadings_pl <- all_loadings_pl$Residuals
grid.arrange(resid_scores_pl,resid_loadings_pl, ncol=2)
UPDATE_lmpEffectPlot(resLmpPcaEffectsASCA_UCH, effectName = "Hippurate:Time", x = "Hippurate", z = "Time")
#### ASCA avec combinaisons d’effets
Il y a 2 combinaisons d’effets : - Hippurate, Time et Hippurate:Time - Hippurate et Times
resLmpPcaEffectsASCA_Comb_UCH <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_UCH, method="ASCA",verbose = TRUE, combineEffects = list(c("Hippurate", "Time", "Hippurate:Time"),c("Hippurate", "Time")))## [1] "ASCA method used : PCA on the pure effect matrices"
## Time difference of 0.150614 secscomb_loadings_pl <- lmpLoading1dPlot(resLmpPcaEffectsASCA_Comb_UCH,
effectNames = c("Hippurate+Time+Hippurate:Time"),
axes = 1, xlab = "ppm")# Hippurate+Time+Hippurate:Time
hiptimInter_scores_pl <- lmpScorePlot(resLmpPcaEffectsASCA_Comb_UCH,
effectNames = "Hippurate+Time+Hippurate:Time",
color = "Hippurate", shape = "Time")
hiptimInter_loadings_pl <- all_loadings_pl$`Hippurate:Time`
grid.arrange(hiptimInter_scores_pl,hiptimInter_loadings_pl, ncol=2)
8.2 APCA
8.2.1 Partie Candies
8.2.1.1 APCA sans correction de la matrice augmentée
resLmpPcaEffectsAPCA_Candies <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_Candies, method="APCA",verbose = TRUE,backtransform = TRUE, correctedMatrixAdd = FALSE)## [1] "The model is a mixed ANOVA 2 with interaction."
## [1] "APCA method used : PCA on the augmented effect matrices"
## Time difference of 0.03622818 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsAPCA_Candies,varname.colorup = "Candies",varname.colordown = "Candies", varname.pchup = "Judges", varname.pchdown = "Judges",)
# Construction des graphiques
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsAPCA_Candies$Candies$var)
screeplotCandies <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsAPCA_Candies$Judges$var)
screeplotJudges <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsAPCA_Candies$`Candies:Judges`$var)
screeplotCandiesJudges <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsAPCA_Candies$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
Candies_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Candies,effectNames = c("Candies"),color = "Candies",shape = "Candies", drawShapes = "ellipse") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
Judges_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Candies,effectNames = c("Judges"),color = "Judges", drawShapes = "ellipse") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
# Inverser les scores et les loadings pour Candies:Judges
resLmpPcaEffectsAPCA_Candies_bis <- resLmpPcaEffectsAPCA_Candies
resLmpPcaEffectsAPCA_Candies_bis$`Candies:Judges`$scores <- - resLmpPcaEffectsAPCA_Candies$`Candies:Judges`$scores
resLmpPcaEffectsAPCA_Candies_bis$`Candies:Judges`$loadings <- - resLmpPcaEffectsAPCA_Candies$`Candies:Judges`$loadings
CA_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Candies_bis,effectNames = c("Candies:Judges"), color = "Judges",shape = "Candies", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))## `summarise()` has grouped output by 'Judges'. You can override using the
## `.groups` argument.# 2 points outliers
index <- c(10, 27)
Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Candies,effectNames = c("Residuals"), shape = "Candies", color = "Judges") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) +
coord_cartesian(xlim = c(-20, 20), ylim = c(-20, 20)) +
annotate("text", y = (resLmpPcaEffectsAPCA_Candies$Residuals$scores[index,2] +
1.7*c(-1 , -1)),
x = resLmpPcaEffectsAPCA_Candies$Residuals$scores[index,1],
label = rownames(resLmpPcaEffectsAPCA_Candies$Residuals$scores[index,1:2]))
loadCandies <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Candies, effectNames = c("Candies"), addRownames = TRUE)
loadJudges <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Candies, effectNames = c("Judges"), addRownames = TRUE)
loadCandiesJudges <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Candies_bis, effectNames = c("Candies:Judges"), addRownames = TRUE)
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Candies, effectNames = c("Residuals"), addRownames = TRUE)
a <- grid.arrange(screeplotCandies, Candies_scores,
loadCandies, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Candy effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_APCA_Candy.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplotJudges, Judges_scores,
loadJudges, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Judge effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_APCA_Judges.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplotCandiesJudges, CA_scores,
loadCandiesJudges, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("C*J effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_APCA_CJ.jpeg"),c, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)d <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_APCA_Residuals.jpeg"),d, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)8.2.1.2 APCA avec correction de la matrice augmentée
resLmpPcaEffectsAPCA_Candies_corr <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_Candies, method="APCA",verbose = TRUE, backtransform = TRUE, correctedMatrixAdd = TRUE)## [1] "The model is a mixed ANOVA 2 with interaction."
## [1] "APCA method used : PCA on the augmented effect matrices"## Warning in computeED(resLmpEffectMatrices): The variance of the random Judges variable for response PC5 is 0.## Warning in computeED(resLmpEffectMatrices): The variance of the random Candies:Judges variable for response PC6 is 0.## Warning in computeED(resLmpEffectMatrices): The variance of the random Judges variable for response PC8 is 0.## Warning in computeAugmentedScoresAPCA(EffectMatGLM[[x]], resLmpEffectMatrices$effectMatricesR[[nameMadd]], : The degree of freedom df2 is too small. Using df2 = 4## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.047908 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.048076 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.045916 is not accurate## Time difference of 0.07818198 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsAPCA_Candies_corr,varname.colorup = "Candies",varname.colordown = "Candies", varname.pchup = "Judges", varname.pchdown = "Judges",)
# Construction des graphiques
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsAPCA_Candies_corr$Candies$var)
screeplotCandies <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsAPCA_Candies_corr$Judges$var)
screeplotJudges <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsAPCA_Candies_corr$`Candies:Judges`$var)
screeplotCandiesJudges <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsAPCA_Candies_corr$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
Candies_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Candies_corr,effectNames = c("Candies"),color = "Candies",shape = "Candies", drawShapes = "ellipse") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
Judges_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Candies_corr,effectNames = c("Judges"),color = "Judges", drawShapes = "ellipse") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
# Inverser les scores et les loadings pour Candies:Judges
resLmpPcaEffectsAPCA_Candies_corr_bis <- resLmpPcaEffectsAPCA_Candies_corr
resLmpPcaEffectsAPCA_Candies_corr_bis$`Candies:Judges`$scores <- - resLmpPcaEffectsAPCA_Candies_corr$`Candies:Judges`$scores
resLmpPcaEffectsAPCA_Candies_corr_bis$`Candies:Judges`$loadings <- - resLmpPcaEffectsAPCA_Candies_corr$`Candies:Judges`$loadings
CA_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Candies_corr_bis,effectNames = c("Candies:Judges"), color = "Judges",shape = "Candies", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))## `summarise()` has grouped output by 'Judges'. You can override using the
## `.groups` argument.# 2 points outliers
index <- c(10, 27)
Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Candies_corr,effectNames = c("Residuals"), shape = "Candies", color = "Judges") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) +
coord_cartesian(xlim = c(-20, 20), ylim = c(-20, 20)) +
annotate("text", y = (resLmpPcaEffectsAPCA_Candies_corr$Residuals$scores[index,2] +
1.7*c(-1 , -1)),
x = resLmpPcaEffectsAPCA_Candies_corr$Residuals$scores[index,1],
label = rownames(resLmpPcaEffectsAPCA_Candies_corr$Residuals$scores[index,1:2]))
loadCandies <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Candies_corr, effectNames = c("Candies"), addRownames = TRUE)
loadJudges <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Candies_corr, effectNames = c("Judges"), addRownames = TRUE)
loadCandiesJudges <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Candies_corr_bis, effectNames = c("Candies:Judges"), addRownames = TRUE)
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Candies_corr, effectNames = c("Residuals"), addRownames = TRUE)
a <- grid.arrange(screeplotCandies, Candies_scores,
loadCandies, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Candy effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_APCA_Candy_corr.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplotJudges, Judges_scores,
loadJudges, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Judge effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_APCA_Judges_corr.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplotCandiesJudges, CA_scores,
loadCandiesJudges, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("C*J effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_APCA_CJ_corr.jpeg"),c, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)d <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_APCA_Residuals_corr.jpeg"),d, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)8.2.2 Partie Serum
8.2.2.1 APCA sans correction de la matrice augmentée
resLmpPcaEffectsAPCA_Serum <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_Serum, method="APCA",verbose = TRUE, backtransform = TRUE, correctedMatrixAdd = FALSE)## [1] "The model is a nested mixed ANOVA 2."
## [1] "APCA method used : PCA on the augmented effect matrices"
## Time difference of 0.005002022 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsAPCA_Serum,varname.colorup = "Volunteer",varname.colordown = "Volunteer", varname.pchup = "Sampling", varname.pchdown = "Sampling")
# Construction des graphiques
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsAPCA_Serum$Volunteer$var)
screeplotVolunteer <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsAPCA_Serum$`Volunteer:Sampling`$var)
screeplotVS <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsAPCA_Serum$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
Volunteer_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Serum,effectNames = c("Volunteer"),color = "Volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
VS_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Serum,effectNames = c("Volunteer:Sampling"), color = "Volunteer",shape = "Sampling", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) ## `summarise()` has grouped output by 'Volunteer'. You can override using the
## `.groups` argument.Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Serum,effectNames = c("Residuals"), shape = "Sampling", color = "Volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
loadVolunteer <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Serum, effectNames = c("Volunteer"))
loadVolunteerSampling <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Serum, effectNames = c("Volunteer:Sampling"))
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Serum, effectNames = c("Residuals"))
a <- grid.arrange(screeplotVolunteer, Volunteer_scores,
loadVolunteer, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Volunteer effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_APCA_Volunteer.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplotVS, VS_scores,
loadVolunteerSampling, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Volunteer:Sampling effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_APCA_VS.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_APCA_Residuals.jpeg"),c, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)8.2.2.2 APCA avec correction de la matrice augmentée
resLmpPcaEffectsAPCA_Serum_corr <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_Serum, method="APCA",verbose = TRUE, backtransform = TRUE, correctedMatrixAdd = TRUE)## [1] "The model is a nested mixed ANOVA 2."
## [1] "APCA method used : PCA on the augmented effect matrices"## Warning in computeED(resLmpEffectMatrices): The variance of the random Volunteer variable for response PC13 is 0.## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.046017 is not accurate## Time difference of 0.08585596 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsAPCA_Serum_corr,varname.colorup = "Volunteer",varname.colordown = "Volunteer", varname.pchup = "Sampling", varname.pchdown = "Sampling")
# Construction des graphiques
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsAPCA_Serum_corr$Volunteer$var)
screeplotVolunteer <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsAPCA_Serum_corr$`Volunteer:Sampling`$var)
screeplotVS <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsAPCA_Serum_corr$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
Volunteer_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Serum_corr,effectNames = c("Volunteer"),color = "Volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
VS_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Serum_corr,effectNames = c("Volunteer:Sampling"), color = "Volunteer",shape = "Sampling", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) ## `summarise()` has grouped output by 'Volunteer'. You can override using the
## `.groups` argument.Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_Serum_corr,effectNames = c("Residuals"), shape = "Sampling", color = "Volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
loadVolunteer <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Serum_corr, effectNames = c("Volunteer"))
loadVolunteerSampling <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Serum_corr, effectNames = c("Volunteer:Sampling"))
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_Serum_corr, effectNames = c("Residuals"))
a <- grid.arrange(screeplotVolunteer, Volunteer_scores,
loadVolunteer, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Volunteer effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_APCA_Volunteer_corr.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplotVS, VS_scores,
loadVolunteerSampling, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Volunteer:Sampling effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_APCA_VS_corr.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_APCA_Residuals_corr.jpeg"),c, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)8.2.3 Partie CHOO
8.2.3.1 APCA sans correction de la matrice augmentée
resLmpPcaEffectsAPCA_CHOO <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_CHOO, method="APCA",verbose = TRUE, backtransform = TRUE, correctedMatrixAdd = FALSE)## [1] "The model is a longitudinal 2 factor"
## [1] "APCA method used : PCA on the augmented effect matrices"
## Time difference of 0.006998062 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsAPCA_CHOO,varname.colorup = "time",varname.colordown = "time", varname.pchup = "treatment", varname.pchdown = "treatment")
# Construction des graphiques
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsAPCA_CHOO$volunteer$var)
screeplotvolunteer <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsAPCA_CHOO$treatment$var)
screeplottreatment <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsAPCA_CHOO$time$var)
screeplottime <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsAPCA_CHOO$`treatment:time`$var)
screeplottrti <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsAPCA_CHOO$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
volunteer_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_CHOO,effectNames = c("volunteer"),color = "volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
treatment_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_CHOO,effectNames = c("treatment"), color = "treatment",shape = "treatment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
time_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_CHOO,effectNames = c("time"), color = "time",shape = "time") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
treatmenttime_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_CHOO,effectNames = c("treatment:time"), color = "treatment",shape = "time", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))## `summarise()` has grouped output by 'treatment'. You can override using the
## `.groups` argument.Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_CHOO,effectNames = c("Residuals"), shape = "treatment", color = "time") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
loadvolunteer <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_CHOO, effectNames = c("volunteer"))
loadtreatment <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_CHOO, effectNames = c("treatment"))
loadtime <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_CHOO, effectNames = c("time"))
loadtreatmenttime <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_CHOO, effectNames = c("treatment:time"))
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_CHOO, effectNames = c("Residuals"))
a <- grid.arrange(screeplotvolunteer, volunteer_scores,
loadvolunteer, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("volunteer effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_APCA_volunteer.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplottreatment, treatment_scores,
loadtreatment, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("treatment effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_APCA_treatment.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplottime, time_scores,
loadtime, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("time effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_APCA_time.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)d <- grid.arrange(screeplottrti, treatmenttime_scores,
loadtreatmenttime, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("treatment:time effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_APCA_treatmenttime.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)e <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_APCA_Residuals.jpeg"),d, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)8.2.3.2 APCA avec correction de la matrice augmentée
resLmpPcaEffectsAPCA_CHOO_corr <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_CHOO, method="APCA",verbose = TRUE, backtransform = TRUE, correctedMatrixAdd = TRUE)## [1] "The model is a longitudinal 2 factor"
## [1] "APCA method used : PCA on the augmented effect matrices"## Warning in computeED(resLmpEffectMatrices): The variance of the random volunteer variable for response PC8 is 0.## Warning in computeED(resLmpEffectMatrices): The variance of the random volunteer variable for response PC11 is 0.## Warning in computeED(resLmpEffectMatrices): The variance of the random volunteer variable for response PC12 is 0.## Warning in computeED(resLmpEffectMatrices): The variance of the random volunteer variable for response PC14 is 0.## Warning in computeAugmentedScoresAPCA(EffectMatGLM[[x]], resLmpEffectMatrices$effectMatricesR[[nameMadd]], : The degree of freedom df2 is too small. Using df2 = 4## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.049954 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.05 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.049903 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.04986 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.049774 is not accurate## Time difference of 0.02083802 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsAPCA_CHOO_corr,varname.colorup = "time",varname.colordown = "time", varname.pchup = "treatment", varname.pchdown = "treatment")
# Construction des graphiques
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsAPCA_CHOO_corr$volunteer$var)
screeplotvolunteer <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsAPCA_CHOO_corr$treatment$var)
screeplottreatment <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsAPCA_CHOO_corr$time$var)
screeplottime <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsAPCA_CHOO_corr$`treatment:time`$var)
screeplottrti <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsAPCA_CHOO_corr$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
volunteer_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_CHOO_corr,effectNames = c("volunteer"),color = "volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
treatment_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_CHOO_corr,effectNames = c("treatment"), color = "treatment",shape = "treatment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
time_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_CHOO_corr,effectNames = c("time"), color = "time",shape = "time") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
treatmenttime_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_CHOO_corr,effectNames = c("treatment:time"), color = "treatment",shape = "time", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))## `summarise()` has grouped output by 'treatment'. You can override using the
## `.groups` argument.Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_CHOO_corr,effectNames = c("Residuals"), shape = "treatment", color = "time") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
loadvolunteer <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_CHOO_corr, effectNames = c("volunteer"))
loadtreatment <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_CHOO_corr, effectNames = c("treatment"))
loadtime <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_CHOO_corr, effectNames = c("time"))
loadtreatmenttime <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_CHOO_corr, effectNames = c("treatment:time"))
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsAPCA_CHOO_corr, effectNames = c("Residuals"))
a <- grid.arrange(screeplotvolunteer, volunteer_scores,
loadvolunteer, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("volunteer effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_APCA_volunteer_corr.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplottreatment, treatment_scores,
loadtreatment, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("treatment effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_APCA_treatment.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplottime, time_scores,
loadtime, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("time effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_APCA_time_corr.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)d <- grid.arrange(screeplottrti, treatmenttime_scores,
loadtreatmenttime, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("treatment:time effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_APCA_treatmenttime_corr.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)e <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_APCA_Residuals_corr.jpeg"),d, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)8.2.4 Partie UCH
resLmpPcaEffectsAPCA_UCH <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_UCH, method="APCA",verbose = TRUE, correctedMatrixAdd = FALSE)## [1] "APCA method used : PCA on the augmented effect matrices"
## Time difference of 0.155261 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsAPCA_UCH,
effectNames = c("Hippurate", "Citrate", "Time",
"Hippurate:Time"),
modelAbbrev = TRUE,
varname.colorup = "Citrate",
varname.colordown = "Time",
varname.pchup="Hippurate",
varname.pchdown="Time",
title = "APCA scores scatterplot matrix")
# Hippurate main effect
UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_UCH, effectNames = "Hippurate",
color = "Hippurate", shape = "Hippurate", drawShapes = "ellipse")
# Citrate main effect
UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_UCH, effectNames = "Citrate",
color = "Citrate", shape = "Citrate", drawShapes = "ellipse")
# Time main effect
UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_UCH, effectNames = "Time",
color = "Time", shape = "Time", drawShapes = "ellipse")
# Interaction term
UPDATE_lmpScorePlot(resLmpPcaEffectsAPCA_UCH, effectNames = "Hippurate:Time",
color = "Hippurate", shape = "Time", drawShapes = "segment")## `summarise()` has grouped output by 'Hippurate'. You can override using the
## `.groups` argument.
UPDATE_lmpLoading1dPlot(resLmpPcaEffectsAPCA_UCH, effectNames = c("Hippurate", "Citrate",
"Time", "Hippurate:Time"), axes = 1)## $Hippurate
##
## $Citrate
##
## $Time
##
## $`Hippurate:Time`
8.3 ASCA-E
8.3.1 Partie Candies
8.3.1.1 ASCA-E sans correction de la matrice augmentée
resLmpPcaEffectsASCAE_Candies <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_Candies, method="ASCA-E",verbose = TRUE, backtransform = TRUE, correctedMatrixAdd = FALSE)## [1] "The model is a mixed ANOVA 2 with interaction."
## [1] "ASCA-E method used : PCA on the pure effect matrices\n but scores are updated"
## Time difference of 0.06062007 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsASCAE_Candies,varname.colorup = "Candies",varname.colordown = "Candies", varname.pchup = "Judges", varname.pchdown = "Judges",)
# Construction des graphiques
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsASCAE_Candies$Candies$var)
screeplotCandies <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsASCAE_Candies$Judges$var)
screeplotJudges <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsASCAE_Candies$`Candies:Judges`$var)
screeplotCandiesJudges <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsASCAE_Candies$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
Candies_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Candies,effectNames = c("Candies"),color = "Candies",shape = "Candies", drawShapes = "ellipse") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
Judges_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Candies,effectNames = c("Judges"),color = "Judges", drawShapes = "ellipse") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
# Inverser les scores et les loadings pour Candies:Judges
resLmpPcaEffectsASCAE_Candies_bis <- resLmpPcaEffectsASCAE_Candies
resLmpPcaEffectsASCAE_Candies_bis$`Candies:Judges`$scores <- - resLmpPcaEffectsASCAE_Candies$`Candies:Judges`$scores
resLmpPcaEffectsASCAE_Candies_bis$`Candies:Judges`$loadings <- - resLmpPcaEffectsASCAE_Candies$`Candies:Judges`$loadings
CA_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Candies_bis,effectNames = c("Candies:Judges"), color = "Judges",shape = "Candies", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))## `summarise()` has grouped output by 'Judges'. You can override using the
## `.groups` argument.# 2 points outliers
index <- c(10, 27)
Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Candies,effectNames = c("Residuals"), shape = "Candies", color = "Judges") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) +
coord_cartesian(xlim = c(-20, 20), ylim = c(-20, 20)) +
annotate("text", y = (resLmpPcaEffectsASCAE_Candies$Residuals$scores[index,2] +
1.7*c(-1 , -1)),
x = resLmpPcaEffectsASCAE_Candies$Residuals$scores[index,1],
label = rownames(resLmpPcaEffectsASCAE_Candies$Residuals$scores[index,1:2]))
loadCandies <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Candies, effectNames = c("Candies"), addRownames = TRUE)
loadJudges <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Candies, effectNames = c("Judges"), addRownames = TRUE)
loadCandiesJudges <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Candies_bis, effectNames = c("Candies:Judges"), addRownames = TRUE)
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Candies, effectNames = c("Residuals"), addRownames = TRUE)
a <- grid.arrange(screeplotCandies, Candies_scores,
loadCandies, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Candy effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_ASCAE_Candy.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplotJudges, Judges_scores,
loadJudges, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Judge effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_ASCAE_Judges.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplotCandiesJudges, CA_scores,
loadCandiesJudges, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("C*J effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_ASCAE_CJ.jpeg"),c, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)d <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_ASCAE_Residuals.jpeg"),d, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)8.3.1.2 ASCA-E avec correction de la matrice augmentée
resLmpPcaEffectsASCAE_Candies_corr <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_Candies, method="ASCA-E",verbose = TRUE, backtransform = TRUE, correctedMatrixAdd = TRUE)## [1] "The model is a mixed ANOVA 2 with interaction."
## [1] "ASCA-E method used : PCA on the pure effect matrices\n but scores are updated"## Warning in computeED(resLmpEffectMatrices): The variance of the random Judges variable for response PC5 is 0.## Warning in computeED(resLmpEffectMatrices): The variance of the random Candies:Judges variable for response PC6 is 0.## Warning in computeED(resLmpEffectMatrices): The variance of the random Judges variable for response PC8 is 0.## Warning in computeAugmentedScoresASCAE(EffectMatGLM[[x]], resLmpEffectMatrices$effectMatricesR[[nameMadd]], : The degree of freedom df2 is too small. Using df2 = 4## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.047908 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.048076 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.045916 is not accurate## Time difference of 0.1026289 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsASCAE_Candies_corr,varname.colorup = "Candies",varname.colordown = "Candies", varname.pchup = "Judges", varname.pchdown = "Judges",)
# Construction des graphiques
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsASCAE_Candies_corr$Candies$var)
screeplotCandies <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsASCAE_Candies_corr$Judges$var)
screeplotJudges <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsASCAE_Candies_corr$`Candies:Judges`$var)
screeplotCandiesJudges <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:8), var = resLmpPcaEffectsASCAE_Candies_corr$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
Candies_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Candies_corr,effectNames = c("Candies"),color = "Candies",shape = "Candies", drawShapes = "ellipse") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) +
coord_cartesian(xlim = c(-20, 15), ylim = c(-10, 8))
Judges_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Candies_corr,effectNames = c("Judges"),color = "Judges", drawShapes = "ellipse") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) +
coord_cartesian(xlim = c(-7, 9), ylim = c(-5, 3))
# Inverser les scores et les loadings pour Candies:Judges
resLmpPcaEffectsASCAE_Candies_corr_bis <- resLmpPcaEffectsASCAE_Candies_corr
resLmpPcaEffectsASCAE_Candies_corr_bis$`Candies:Judges`$scores <- - resLmpPcaEffectsASCAE_Candies_corr$`Candies:Judges`$scores
resLmpPcaEffectsASCAE_Candies_corr_bis$`Candies:Judges`$loadings <- - resLmpPcaEffectsASCAE_Candies_corr$`Candies:Judges`$loadings
CA_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Candies_corr_bis,effectNames = c("Candies:Judges"), color = "Judges",shape = "Candies", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) +
coord_cartesian(xlim = c(-11, 9), ylim = c(-8, 11))## `summarise()` has grouped output by 'Judges'. You can override using the
## `.groups` argument.# 2 points outliers
index <- c(10, 27)
Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Candies_corr,effectNames = c("Residuals"), shape = "Candies", color = "Judges") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) +
coord_cartesian(xlim = c(-20, 20), ylim = c(-20, 20)) +
annotate("text", y = (resLmpPcaEffectsASCAE_Candies_corr$Residuals$scores[index,2] +
1.7*c(-1 , -1)),
x = resLmpPcaEffectsASCAE_Candies_corr$Residuals$scores[index,1],
label = rownames(resLmpPcaEffectsASCAE_Candies_corr$Residuals$scores[index,1:2]))
loadCandies <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Candies_corr, effectNames = c("Candies"), addRownames = TRUE) +
coord_cartesian(xlim = c(-0.5, 0.5), ylim = c(-1, 1))
loadJudges <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Candies_corr, effectNames = c("Judges"), addRownames = TRUE) +
coord_cartesian(xlim = c(-0.8, 0.8), ylim = c(-0.6, 0.6))
loadCandiesJudges <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Candies_corr_bis, effectNames = c("Candies:Judges"), addRownames = TRUE) +
coord_cartesian(xlim = c(-0.8, 0.8), ylim = c(-0.6, 0.6))
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Candies_corr, effectNames = c("Residuals"), addRownames = TRUE) +
coord_cartesian(xlim = c(-0.8, 0.8), ylim = c(-0.5, 0.5))
a <- grid.arrange(screeplotCandies, Candies_scores,
loadCandies, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Candy effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_ASCAE_Candy_corr.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplotJudges, Judges_scores,
loadJudges, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Judge effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_ASCAE_Judges_corr.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplotCandiesJudges, CA_scores,
loadCandiesJudges, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("C*J effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_ASCAE_CJ_corr.jpeg"),c, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)d <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Candies,"Candies_ASCAE_Residuals_corr.jpeg"),d, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)8.3.2 Partie Serum
8.3.2.1 ASCA-E sans correction de la matrice augmentée
resLmpPcaEffectsASCAE_Serum <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_Serum, method="ASCA-E",verbose = TRUE, backtransform = TRUE, correctedMatrixAdd = FALSE)## [1] "The model is a nested mixed ANOVA 2."
## [1] "ASCA-E method used : PCA on the pure effect matrices\n but scores are updated"
## Time difference of 0.005999088 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsASCAE_Serum,varname.colorup = "Volunteer",varname.colordown = "Volunteer", varname.pchup = "Sampling", varname.pchdown = "Sampling")
# Construction des graphiques
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsASCAE_Serum$Volunteer$var)
screeplotVolunteer <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsASCAE_Serum$`Volunteer:Sampling`$var)
screeplotVS <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsASCAE_Serum$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
Volunteer_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Serum,effectNames = c("Volunteer"),color = "Volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
VS_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Serum,effectNames = c("Volunteer:Sampling"), color = "Volunteer",shape = "Sampling", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) ## `summarise()` has grouped output by 'Volunteer'. You can override using the
## `.groups` argument.Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Serum,effectNames = c("Residuals"), shape = "Sampling", color = "Volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
loadVolunteer <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Serum, effectNames = c("Volunteer"))
loadVolunteerSampling <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Serum, effectNames = c("Volunteer:Sampling"))
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Serum, effectNames = c("Residuals"))
a <- grid.arrange(screeplotVolunteer, Volunteer_scores,
loadVolunteer, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Volunteer effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_ASCAE_Volunteer.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplotVS, VS_scores,
loadVolunteerSampling, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Volunteer:Sampling effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_ASCAE_VS.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_ASCAE_Residuals.jpeg"),c, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)8.3.2.2 ASCA-E avec correction de la matrice augmentée
resLmpPcaEffectsASCAE_Serum_corr <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_Serum, method="ASCA-E",verbose = TRUE, backtransform = TRUE ,correctedMatrixAdd = TRUE)## [1] "The model is a nested mixed ANOVA 2."
## [1] "ASCA-E method used : PCA on the pure effect matrices\n but scores are updated"## Warning in computeED(resLmpEffectMatrices): The variance of the random Volunteer variable for response PC13 is 0.## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.046017 is not accurate## Time difference of 0.078233 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsASCAE_Serum_corr,varname.colorup = "Volunteer",varname.colordown = "Volunteer", varname.pchup = "Sampling", varname.pchdown = "Sampling")
# Construction des graphiques
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsASCAE_Serum_corr$Volunteer$var)
screeplotVolunteer <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsASCAE_Serum_corr$`Volunteer:Sampling`$var)
screeplotVS <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:15), var = resLmpPcaEffectsASCAE_Serum_corr$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
Volunteer_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Serum_corr,effectNames = c("Volunteer"),color = "Volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
VS_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Serum_corr,effectNames = c("Volunteer:Sampling"), color = "Volunteer",shape = "Sampling", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) ## `summarise()` has grouped output by 'Volunteer'. You can override using the
## `.groups` argument.Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_Serum_corr,effectNames = c("Residuals"), shape = "Sampling", color = "Volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
loadVolunteer <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Serum_corr, effectNames = c("Volunteer"))
loadVolunteerSampling <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Serum_corr, effectNames = c("Volunteer:Sampling"))
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_Serum_corr, effectNames = c("Residuals"))
a <- grid.arrange(screeplotVolunteer, Volunteer_scores,
loadVolunteer, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Volunteer effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_ASCAE_Volunteer_corr.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplotVS, VS_scores,
loadVolunteerSampling, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Volunteer:Sampling effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_ASCAE_VS_corr.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_Serum,"Serum_ASCAE_Residuals_corr.jpeg"),c, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)8.3.3 Partie CHOO
8.3.3.1 ASCA-E sans correction de la matrice augmentée
resLmpPcaEffectsASCAE_CHOO <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_CHOO, method="ASCA-E",verbose = TRUE, backtransform = TRUE, correctedMatrixAdd = FALSE)## [1] "The model is a longitudinal 2 factor"
## [1] "ASCA-E method used : PCA on the pure effect matrices\n but scores are updated"
## Time difference of 0.009774208 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsASCAE_CHOO,varname.colorup = "time",varname.colordown = "time", varname.pchup = "treatment", varname.pchdown = "treatment")
# Construction des graphiques
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCAE_CHOO$volunteer$var)
screeplotvolunteer <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCAE_CHOO$treatment$var)
screeplottreatment <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCAE_CHOO$time$var)
screeplottime <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCAE_CHOO$`treatment:time`$var)
screeplottrti <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCAE_CHOO$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
volunteer_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_CHOO,effectNames = c("volunteer"),color = "volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
treatment_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_CHOO,effectNames = c("treatment"), color = "treatment",shape = "treatment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) ## Warning in FUN(X[[i]], ...): The variance of PC2 is inferior to 1%. Graph scaledtime_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_CHOO,effectNames = c("time"), color = "time",shape = "time") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
treatmenttime_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_CHOO,effectNames = c("treatment:time"), color = "treatment",shape = "time", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))## `summarise()` has grouped output by 'treatment'. You can override using the
## `.groups` argument.Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_CHOO,effectNames = c("Residuals"), shape = "treatment", color = "time") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
loadvolunteer <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_CHOO, effectNames = c("volunteer"))
loadtreatment <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_CHOO, effectNames = c("treatment"))## Warning in FUN(X[[i]], ...): The variance of PC2 is inferior to 1%. Graph scaledloadtime <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_CHOO, effectNames = c("time"))
loadtreatmenttime <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_CHOO, effectNames = c("treatment:time"))
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_CHOO, effectNames = c("Residuals"))
a <- grid.arrange(screeplotvolunteer, volunteer_scores,
loadvolunteer, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("volunteer effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCAE_volunteer.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplottreatment, treatment_scores,
loadtreatment, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("treatment effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCAE_treatment.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplottime, time_scores,
loadtime, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("time effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCAE_time.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)d <- grid.arrange(screeplottrti, treatmenttime_scores,
loadtreatmenttime, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("treatment:time effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCAE_treatmenttime.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)e <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCAE_Residuals.jpeg"),d, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)8.3.3.2 ASCA-E avec correction de la matrice augmentée
resLmpPcaEffectsASCAE_CHOO_corr <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_CHOO, method="ASCA-E",verbose = TRUE, backtransform = TRUE, correctedMatrixAdd = TRUE)## [1] "The model is a longitudinal 2 factor"
## [1] "ASCA-E method used : PCA on the pure effect matrices\n but scores are updated"## Warning in computeED(resLmpEffectMatrices): The variance of the random volunteer variable for response PC8 is 0.## Warning in computeED(resLmpEffectMatrices): The variance of the random volunteer variable for response PC11 is 0.## Warning in computeED(resLmpEffectMatrices): The variance of the random volunteer variable for response PC12 is 0.## Warning in computeED(resLmpEffectMatrices): The variance of the random volunteer variable for response PC14 is 0.## Warning in computeAugmentedScoresASCAE(EffectMatGLM[[x]], resLmpEffectMatrices$effectMatricesR[[nameMadd]], : The degree of freedom df2 is too small. Using df2 = 4## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.049954 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.05 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.049903 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.04986 is not accurate## Warning in qf(0.95, df1 = df1, df2 = df2): qbeta(a, *) =: x0 with |pbeta(x0,*) -
## alpha| = 0.049774 is not accurate## Time difference of 0.03443909 secsUPDATE_lmpScoreScatterPlotM(resLmpPcaEffectsASCAE_CHOO_corr,varname.colorup = "time",varname.colordown = "time", varname.pchup = "treatment", varname.pchdown = "treatment")
# Construction des graphiques
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCAE_CHOO_corr$volunteer$var)
screeplotvolunteer <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCAE_CHOO_corr$treatment$var)
screeplottreatment <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCAE_CHOO_corr$time$var)
screeplottime <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCAE_CHOO_corr$`treatment:time`$var)
screeplottrti <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
df <- data.frame(PC = as.character(1:14), var = resLmpPcaEffectsASCAE_CHOO_corr$Residuals$var)
screeplotResiduals <- ggplot(df, aes(y=0,yend=var,x = PC,
xend=PC))+ geom_segment() +
labs(title= "Scree plot",
x = "PC", y="% var") + theme_classic()
volunteer_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_CHOO_corr,effectNames = c("volunteer"),color = "volunteer") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
treatment_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_CHOO_corr,effectNames = c("treatment"), color = "treatment",shape = "treatment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line")) ## Warning in FUN(X[[i]], ...): The variance of PC2 is inferior to 1%. Graph scaledtime_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_CHOO_corr,effectNames = c("time"), color = "time",shape = "time") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
treatmenttime_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_CHOO_corr,effectNames = c("treatment:time"), color = "treatment",shape = "time", drawShapes = "segment") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))## `summarise()` has grouped output by 'treatment'. You can override using the
## `.groups` argument.Residuals_scores <- UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_CHOO_corr,effectNames = c("Residuals"), shape = "treatment", color = "time") +
theme(legend.text=element_text(size=10),
legend.key.height=unit(0.7,"line"))
loadvolunteer <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_CHOO_corr, effectNames = c("volunteer"))
loadtreatment <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_CHOO_corr, effectNames = c("treatment"))## Warning in FUN(X[[i]], ...): The variance of PC2 is inferior to 1%. Graph scaledloadtime <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_CHOO_corr, effectNames = c("time"))
loadtreatmenttime <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_CHOO_corr, effectNames = c("treatment:time"))
loadResiduals <- UPDATE_lmpLoading2dPlot(resLmpPcaEffectsASCAE_CHOO_corr, effectNames = c("Residuals"))
a <- grid.arrange(screeplotvolunteer, volunteer_scores,
loadvolunteer, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("volunteer effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCAE_volunteer_corr.jpeg"),a, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)b <- grid.arrange(screeplottreatment, treatment_scores,
loadtreatment, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("treatment effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCAE_treatment_corr.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)c <- grid.arrange(screeplottime, time_scores,
loadtime, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("time effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCAE_time_corr.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)d <- grid.arrange(screeplottrti, treatmenttime_scores,
loadtreatmenttime, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("treatment:time effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCAE_treatmenttime_corr.jpeg"),b, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)e <- grid.arrange(screeplotResiduals, Residuals_scores,
loadResiduals, nrow=1,widths=c(0.3, 1, 0.85),
top=textGrob("Residuals effect matrix",
gp=gpar(fontsize=20,font=2)))
ggsave(file = file.path(output_CHOO,"CHOO_ASCAE_Residuals_corr.jpeg"),d, width = 30, height = 13, units = "cm",dpi = 1000, scale = 0.8)8.3.4 Partie UCH
resLmpPcaEffectsASCAE_UCH <- UPDATE_lmpPcaEffects_3(resLmpEffectMatrices_UCH, method="ASCA-E",verbose = TRUE, correctedMatrixAdd = FALSE)## [1] "ASCA-E method used : PCA on the pure effect matrices\n but scores are updated"
## Time difference of 0.1536119 secslmpScoreScatterPlotM(resLmpPcaEffectsASCAE_UCH,
effectNames = c("Hippurate", "Citrate", "Time",
"Hippurate:Time"),
modelAbbrev = TRUE,
varname.colorup = "Citrate",
varname.colordown = "Time",
varname.pchup="Hippurate",
varname.pchdown="Time",
title = "ASCA-E scores scatterplot matrix")
UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_UCH, effectNames = "Hippurate",
color = "Hippurate", shape = "Hippurate")
UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_UCH, effectNames = "Citrate",
color = "Citrate", shape = "Citrate")
UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_UCH, effectNames = "Time",
color = "Time", shape = "Time")## Warning in FUN(X[[i]], ...): The variance of PC2 is inferior to 1%. Graph scaled
UPDATE_lmpScorePlot(resLmpPcaEffectsASCAE_UCH, effectNames = "Hippurate:Time",
color = "Hippurate", shape = "Time")
9 Contributions des effets ASCA
9.0.1 Candies
resContribution_Candies <- UPDATE_lmpContributions(resLmpPcaEffectsASCA_Candies)9.0.1.1 Pourcentage de variance expliqué des réponses pour chaque effet
pander::pander(resContribution_Candies$effectTable)| PC1 | PC2 | PC3 | PC4 | PC5 | Sum | |
|---|---|---|---|---|---|---|
| Candies | 94.24 | 5.09 | 0.58 | 0.1 | 0 | 100 |
| Candies:Judges | 57.82 | 22.5 | 9.89 | 5.44 | 2.17 | 97.82 |
| Judges | 89.52 | 6.67 | 3.12 | 0.36 | 0.28 | 99.95 |
| Residuals | 27.53 | 18.03 | 15.92 | 12.95 | 9.39 | 83.82 |
lmpScreePlot(resContribution_Candies)## $Candies
##
## $`Candies:Judges`
##
## $Judges
##
## $Residuals
9.0.1.2 Contributions des réponses pour chaque effet
pander::pander(resContribution_Candies$contribTable)| PC1 | PC2 | PC3 | PC4 | PC5 | Contrib | |
|---|---|---|---|---|---|---|
| Candies | 69.58 | 3.76 | 0.43 | 0.07 | 0 | 73.84 |
| Candies:Judges | 2.22 | 0.87 | 0.38 | 0.21 | 0.08 | 3.85 |
| Judges | 2.4 | 0.18 | 0.08 | 0.01 | 0.01 | 2.68 |
| Residuals | 5.41 | 3.54 | 3.13 | 2.54 | 1.84 | 19.63 |
9.0.1.3 Les plus grandes contributions des réponses pour chaque effet
resContribution_Candies$plotContrib
# exporter le graphique
ggsave(file = file.path(output_Candies,"Candies_plotContrib.jpeg"),resContribution_Candies$plotContrib)## Saving 6 x 5 in image9.0.2 Serum
resContribution_Serum <- UPDATE_lmpContributions(resLmpPcaEffectsASCA_Serum)9.0.2.1 Pourcentage de variance expliquée des réponses pour chaque effet
pander::pander(resContribution_Serum$effectTable)| PC1 | PC2 | PC3 | PC4 | PC5 | Sum | |
|---|---|---|---|---|---|---|
| Volunteer:Sampling | 63.53 | 16.94 | 6.3 | 3.53 | 2.54 | 92.84 |
| Volunteer | 88.43 | 9.14 | 0.79 | 0.52 | 0.44 | 99.32 |
| Residuals | 27.62 | 20.74 | 16.9 | 12.22 | 7.71 | 85.19 |
lmpScreePlot(resContribution_Serum)## $`Volunteer:Sampling`
##
## $Volunteer
##
## $Residuals
9.0.2.2 Contributions des réponses pour chaque effet
pander::pander(resContribution_Serum$contribTable)| PC1 | PC2 | PC3 | PC4 | PC5 | Contrib | |
|---|---|---|---|---|---|---|
| Volunteer:Sampling | 17.58 | 4.69 | 1.74 | 0.98 | 0.7 | 27.68 |
| Volunteer | 62.61 | 6.47 | 0.56 | 0.37 | 0.31 | 70.8 |
| Residuals | 0.42 | 0.32 | 0.26 | 0.19 | 0.12 | 1.52 |
9.0.2.3 Les plus grandes contributions des réponses pour chaque effet
resContribution_Serum$plotContrib
# exporter le graphique
ggsave(file = file.path(output_Serum,"Serum_plotContrib.jpeg"),resContribution_Serum$plotContrib)## Saving 6 x 5 in image9.0.3 CHOO
resContribution_CHOO <- UPDATE_lmpContributions(resLmpPcaEffectsASCA_CHOO)9.0.3.1 Pourcentage de variance expliquée des réponses pour chaque effet
pander::pander(resContribution_CHOO$effectTable)| PC1 | PC2 | PC3 | PC4 | PC5 | Sum | |
|---|---|---|---|---|---|---|
| treatment | 100 | 0 | 0 | 0 | 0 | 100 |
| time | 68.92 | 31.08 | 0 | 0 | 0 | 100 |
| treatment:time | 91.14 | 8.86 | 0 | 0 | 0 | 100 |
| volunteer | 64 | 25.42 | 8.03 | 2.17 | 0.23 | 99.85 |
| Residuals | 75.64 | 6.44 | 5.43 | 3.08 | 1.9 | 92.49 |
lmpScreePlot(resContribution_CHOO)## $treatment
##
## $time
##
## $`treatment:time`
##
## $volunteer
##
## $Residuals
9.0.3.2 Contributions des réponses pour chaque effet
pander::pander(resContribution_CHOO$contribTable)| PC1 | PC2 | PC3 | PC4 | PC5 | Contrib | |
|---|---|---|---|---|---|---|
| treatment | 10.1 | 0 | 0 | 0 | 0 | 10.1 |
| time | 0.52 | 0.23 | 0 | 0 | 0 | 0.75 |
| treatment:time | 2.6 | 0.25 | 0 | 0 | 0 | 2.85 |
| volunteer | 18.78 | 7.46 | 2.36 | 0.64 | 0.07 | 29.34 |
| Residuals | 43.09 | 3.67 | 3.09 | 1.75 | 1.08 | 56.96 |
9.0.3.3 Les plus grandes contributions des réponses pour chaque effet
resContribution_CHOO$plotContrib
# exporter le graphique
ggsave(file = file.path(output_CHOO,"CHOO_plotContrib.jpeg"),resContribution_CHOO$plotContrib)## Saving 6 x 5 in image9.0.4 UCH
resContribution_UCH <- UPDATE_lmpContributions(resLmpPcaEffectsASCA_UCH)9.0.4.1 Pourcentage de variance expliquée des réponses pour chaque effet
pander::pander(resContribution_UCH$effectTable)| PC1 | PC2 | PC3 | PC4 | PC5 | Sum | |
|---|---|---|---|---|---|---|
| Hippurate | 97.71 | 2.29 | 0 | 0 | 0 | 100 |
| Citrate | 98.22 | 1.78 | 0 | 0 | 0 | 100 |
| Time | 100 | 0 | 0 | 0 | 0 | 100 |
| Hippurate:Citrate | 44.01 | 38.51 | 15.13 | 2.34 | 0 | 99.99 |
| Hippurate:Time | 93.92 | 6.08 | 0 | 0 | 0 | 100 |
| Citrate:Time | 90.76 | 9.24 | 0 | 0 | 0 | 100 |
| Hippurate:Citrate:Time | 47.23 | 27.49 | 22.6 | 2.68 | 0 | 100 |
| Residuals | 48.54 | 16.9 | 10.28 | 5.93 | 4.32 | 85.97 |
lmpScreePlot(resContribution_UCH)## $Hippurate
##
## $Citrate
##
## $Time
##
## $`Hippurate:Citrate`
##
## $`Hippurate:Time`
##
## $`Citrate:Time`
##
## $`Hippurate:Citrate:Time`
##
## $Residuals
9.0.4.2 Contributions des réponses pour chaque effet
pander::pander(resContribution_UCH$contribTable)| PC1 | PC2 | PC3 | PC4 | PC5 | Contrib | |
|---|---|---|---|---|---|---|
| Hippurate | 38.41 | 0.9 | 0 | 0 | 0 | 39.31 |
| Citrate | 29.37 | 0.53 | 0 | 0 | 0 | 29.91 |
| Time | 16.24 | 0 | 0 | 0 | 0 | 16.24 |
| Hippurate:Citrate | 0.68 | 0.59 | 0.23 | 0.04 | 0 | 1.54 |
| Hippurate:Time | 5.85 | 0.38 | 0 | 0 | 0 | 6.23 |
| Citrate:Time | 0.49 | 0.05 | 0 | 0 | 0 | 0.54 |
| Hippurate:Citrate:Time | 0.8 | 0.46 | 0.38 | 0.05 | 0 | 1.68 |
| Residuals | 2.09 | 0.73 | 0.44 | 0.25 | 0.19 | 4.3 |
9.0.4.3 Les plus grandes contributions des réponses pour chaque effet
resContribution_UCH$plotContrib
# exporter le graphique
ggsave(file = file.path(output_UCH,"UCH_plotContrib.jpeg"),resContribution_UCH$plotContrib)## Saving 6 x 5 in image10 Info de la Session
sessionInfo()## R version 4.1.1 (2021-08-10)
## Platform: i386-w64-mingw32/i386 (32-bit)
## Running under: Windows 10 x64 (build 19045)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=French_Belgium.1252 LC_CTYPE=French_Belgium.1252
## [3] LC_MONETARY=French_Belgium.1252 LC_NUMERIC=C
## [5] LC_TIME=French_Belgium.1252
##
## attached base packages:
## [1] grid stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] kableExtra_1.3.4 limpca_0.0.99 metafolio_0.1.1
## [4] dplyr_1.1.1 car_3.0-11 carData_3.0-5
## [7] mdatools_0.13.1 tidyr_1.2.1 ggpubr_0.4.0
## [10] emdbook_1.3.12 spatstat_3.0-2 spatstat.linnet_3.0-3
## [13] spatstat.model_3.0-2 rpart_4.1-15 spatstat.explore_3.0-5
## [16] nlme_3.1-153 spatstat.random_3.0-1 spatstat.geom_3.0-3
## [19] spatstat.data_3.0-0 reshape2_1.4.4 cowplot_1.1.1
## [22] ggplot2_3.3.6 gridExtra_2.3 stringr_1.4.1
## [25] pander_0.6.5 plyr_1.8.8 lme4_1.1-30
## [28] Matrix_1.5-1 MBXUCL_0.1
##
## loaded via a namespace (and not attached):
## [1] utf8_1.2.2 plsVarSel_0.9.9 tidyselect_1.2.0
## [4] htmlwidgets_1.5.4 pROC_1.18.0 munsell_0.5.0
## [7] ragg_1.2.2 codetools_0.2-18 future_1.33.0
## [10] withr_2.5.0 colorspace_2.0-3 Biobase_2.54.0
## [13] highr_0.9 knitr_1.41 rstudioapi_0.14
## [16] stats4_4.1.1 ggsignif_0.6.4 tensor_1.5
## [19] listenv_0.8.0 labeling_0.4.2 bbmle_1.0.25
## [22] MSQC_1.1.0 polyclip_1.10-4 farver_2.1.1
## [25] coda_0.19-4 parallelly_1.36.0 vctrs_0.6.1
## [28] generics_0.1.3 ipred_0.9-13 xfun_0.35
## [31] timechange_0.1.1 R6_2.5.1 doParallel_1.0.17
## [34] spatstat.utils_3.0-1 cachem_1.0.6 assertthat_0.2.1
## [37] scales_1.2.1 nnet_7.3-16 googlesheets4_1.0.1
## [40] gtable_0.3.1 clValid_0.7 globals_0.16.1
## [43] goftest_1.2-3 timeDate_4021.106 rlang_1.1.0
## [46] systemfonts_1.0.4 splines_4.1.1 rstatix_0.7.0
## [49] ModelMetrics_1.2.2.2 ropls_1.26.4 gargle_1.2.1
## [52] broom_1.0.1 rgl_0.110.2 yaml_2.3.5
## [55] abind_1.4-5 modelr_0.1.10 backports_1.4.1
## [58] caret_6.0-93 tools_4.1.1 lava_1.7.0
## [61] spls_2.2-3 ellipsis_0.3.2 jquerylib_0.1.4
## [64] proxy_0.4-27 BiocGenerics_0.40.0 phyclust_0.1-32
## [67] Rcpp_1.0.9 base64enc_0.1-3 progress_1.2.2
## [70] purrr_0.3.5 prettyunits_1.1.1 deldir_1.0-6
## [73] haven_2.5.1 ggrepel_0.9.2 cluster_2.1.2
## [76] fs_1.5.2 magrittr_2.0.3 data.table_1.14.4
## [79] openxlsx_4.2.4 reprex_2.0.2 googledrive_2.0.0
## [82] mvtnorm_1.1-3 hms_1.1.2 praznik_11.0.0
## [85] evaluate_0.18 rio_0.5.29 readxl_1.4.1
## [88] genalg_0.2.1 compiler_4.1.1 bdsmatrix_1.3-6
## [91] tibble_3.2.1 crayon_1.5.2 minqa_1.2.4
## [94] htmltools_0.5.3 mgcv_1.8-38 tzdb_0.3.0
## [97] lubridate_1.9.0 DBI_1.1.3 dbplyr_2.2.1
## [100] MASS_7.3-54 boot_1.3-28 readr_2.1.3
## [103] cli_3.3.0 parallel_4.1.1 gower_1.0.0
## [106] forcats_0.5.2 pkgconfig_2.0.3 numDeriv_2016.8-1.1
## [109] foreign_0.8-81 spatstat.sparse_3.0-0 recipes_0.1.17
## [112] xml2_1.3.3 foreach_1.5.2 svglite_2.1.0
## [115] bslib_0.4.1 webshot_0.5.4 prodlim_2019.11.13
## [118] rvest_1.0.3 digest_0.6.29 pls_2.8-1
## [121] rmarkdown_2.18 cellranger_1.1.0 curl_4.3.2
## [124] nloptr_2.0.3 lifecycle_1.0.3 jsonlite_1.8.3
## [127] viridisLite_0.4.1 fansi_1.0.3 pillar_1.8.1
## [130] ggsci_2.9 lattice_0.20-45 fastmap_1.1.0
## [133] httr_1.4.4 survival_3.4-0 glue_1.6.2
## [136] zip_2.2.0 iterators_1.0.14 class_7.3-19
## [139] stringi_1.7.6 sass_0.4.3 textshaping_0.3.6
## [142] tidyverse_1.3.2 future.apply_1.9.1 ape_5.6-2