Skip to content

M
mooc-rr
Commit e00ab08e authored by Louis Lacoste's avatar Louis Lacoste
Browse files
Options

Module 2 Exo 5 fini !

parent 20049083
Hide whitespace changes
Inline Side-by-side
Showing with 118 additions and 26 deletions
module2/exo5/exo5_R_fr.org
View file @ e00ab08e
......@@ -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*
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment