From e00ab08ee214ee6428e4f4eee80c0d6d4656cb3a Mon Sep 17 00:00:00 2001 From: Louis Lacoste Date: Sun, 20 Nov 2022 23:32:56 +0100 Subject: [PATCH] Module 2 Exo 5 fini ! --- module2/exo5/exo5_R_fr.org | 144 ++++++++++++++++++++++++++++++------- 1 file changed, 118 insertions(+), 26 deletions(-) diff --git a/module2/exo5/exo5_R_fr.org b/module2/exo5/exo5_R_fr.org index 336a9f7..e162de4 100644 --- a/module2/exo5/exo5_R_fr.org +++ b/module2/exo5/exo5_R_fr.org @@ -42,30 +42,31 @@ data #+RESULTS: #+begin_example - Date Count Temperature Pressure Malfunction -1 4/12/81 6 66 50 0 -2 11/12/81 6 70 50 1 -3 3/22/82 6 69 50 0 -4 11/11/82 6 68 50 0 -5 4/04/83 6 67 50 0 -6 6/18/82 6 72 50 0 -7 8/30/83 6 73 100 0 -8 11/28/83 6 70 100 0 -9 2/03/84 6 57 200 1 -10 4/06/84 6 63 200 1 -11 8/30/84 6 70 200 1 -12 10/05/84 6 78 200 0 -13 11/08/84 6 67 200 0 -14 1/24/85 6 53 200 2 -15 4/12/85 6 67 200 0 -16 4/29/85 6 75 200 0 -17 6/17/85 6 70 200 0 -18 7/29/85 6 81 200 0 -19 8/27/85 6 76 200 0 -20 10/03/85 6 79 200 0 -21 10/30/85 6 75 200 2 -22 11/26/85 6 76 200 0 -23 1/12/86 6 58 200 1 + + Date Count Temperature Pressure Malfunction +1 4/12/81 6 66 50 0 +2 11/12/81 6 70 50 1 +3 3/22/82 6 69 50 0 +4 11/11/82 6 68 50 0 +5 4/04/83 6 67 50 0 +6 6/18/82 6 72 50 0 +7 8/30/83 6 73 100 0 +8 11/28/83 6 70 100 0 +9 2/03/84 6 57 200 1 +10 4/06/84 6 63 200 1 +11 8/30/84 6 70 200 1 +12 10/05/84 6 78 200 0 +13 11/08/84 6 67 200 0 +14 1/24/85 6 53 200 2 +15 4/12/85 6 67 200 0 +16 4/29/85 6 75 200 0 +17 6/17/85 6 70 200 0 +18 7/29/85 6 81 200 0 +19 8/27/85 6 76 200 0 +20 10/03/85 6 79 200 0 +21 10/30/85 6 75 200 2 +22 11/26/85 6 76 200 0 +23 1/12/86 6 58 200 1 #+end_example Le jeu de données nous indique la date de l'essai, le nombre de joints @@ -85,6 +86,7 @@ data #+end_src #+RESULTS: +: : Date Count Temperature Pressure Malfunction : 2 11/12/81 6 70 50 1 : 9 2/03/84 6 57 200 1 @@ -99,7 +101,7 @@ la pression est quasiment toujours égale à 200, ce qui devrait simplifier l'analyse. Comment la fréquence d'échecs varie-t-elle avec la température ? -#+begin_src R :results output graphics :file "freq_temp.png" :exports both :width 600 :height 400 :session *R* +#+begin_src R :results output graphics file :file "freq_temp.png" :exports both :width 600 :height 400 :session *R* plot(data=data, Malfunction/Count ~ Temperature, ylim=c(0,1)) #+end_src @@ -161,7 +163,7 @@ La température prévue le jour du décollage est de 31°F. Essayons d'estimer la probabilité de dysfonctionnement des joints toriques à cette température à partir du modèle que nous venons de construire: -#+begin_src R :results output graphics :file "proba_estimate.png" :exports both :width 600 :height 400 :session *R* +#+begin_src R :results output graphics file :file "proba_estimate.png" :exports both :width 600 :height 400 :session *R* # shuttle=shuttle[shuttle$r!=0,] tempv = seq(from=30, to=90, by = .5) rmv <- predict(logistic_reg,list(Temperature=tempv),type="response") @@ -185,6 +187,7 @@ sum(data_full$Malfunction)/sum(data_full$Count) #+end_src #+RESULTS: +: : [1] 0.06521739 Cette probabilité est donc d'environ $p=0.065$, sachant qu'il existe @@ -205,3 +208,92 @@ problème... Saurez-vous le trouver ? Vous êtes libre de modifier cette analyse et de regarder ce jeu de données sous tous les angles afin d'expliquer ce qui ne va pas. +* Entrainement du modèle sur toutes les données + +On recalcule le modèle en prenant en compte toutes les données + +#+begin_src R :results output :session *R* :exports both +logistic_reg_full = glm(data=data_full, Malfunction/Count ~ Temperature, weights=Count, + family=binomial(link='logit')) +summary(logistic_reg_full) +#+end_src + +On peut voir dans les résultats que l'on trouve un impact de la +température significatif au seuil $5%$ : + +#+RESULTS: +#+begin_example + +Call: +glm(formula = Malfunction/Count ~ Temperature, family = binomial(link = "logit"), + data = data_full, weights = Count) + +Deviance Residuals: + Min 1Q Median 3Q Max +-0.95227 -0.78299 -0.54117 -0.04379 2.65152 + +Coefficients: + Estimate Std. Error z value Pr(>|z|) +(Intercept) 5.08498 3.05247 1.666 0.0957 . +Temperature -0.11560 0.04702 -2.458 0.0140 * +--- +codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 + +(Dispersion parameter for binomial family taken to be 1) + + Null deviance: 24.230 on 22 degrees of freedom +Residual deviance: 18.086 on 21 degrees of freedom +AIC: 35.647 + +Number of Fisher Scoring iterations: 5 +#+end_example + +** Prédictions : + +#+begin_src R :results output graphics file :file "proba_estimate.png" :exports both :width 600 :height 400 :session *R* +# shuttle=shuttle[shuttle$r!=0,] +tempv = seq(from=30, to=90, by = .5) +rmv <- predict(logistic_reg_full,list(Temperature=tempv),type="response") +plot(tempv,rmv,type="l",ylim=c(0,1)) +points(data=data, Malfunction/Count ~ Temperature) +#+end_src + +#+RESULTS: +[[file:proba_estimate.png]] +Bien que l'on ait un faible jeu de données le graphique semble nous +indiquer que dans le domaine proche de 30°F le risque de +dysfonctionnement se rapproche de 1. + +#+begin_src R :results output :session *R* :exports both +prediction_31F <- predict(logistic_reg_full, newdata = list(Temperature=31), type="response") +prediction_31F +prediction_31F**2 +#+end_src + +#+RESULTS: +: +: 1 +: 0.8177744 +: +: 1 +: 0.668755 + +En définissant le modèle sur l'ensemble du jeu de données, le risque +de panne d'un joint est donc estimé à $p=0.817774$ soit environ $82%$ +de risque de problème avec un joint. +En supposant l'indépendance des pannes des joints, on trouve un risque +de panne des 2 joints primaires et secondaires de $p²=0.668755$. + +#+begin_src R :results output :session *R* :exports both +1 - (1 - prediction_31F**2)**3 +#+end_src + +#+RESULTS: +: 1 +: 0.9636547 + +Ce qui donne donc une probabilité de défaillance du lanceur $1-(1-p²)³ += 0.9636547$. + +** Conclusion +*Il ne faut surtout pas lancer la fusée* -- 2.18.1