Update of demos

fbertran · Sep 18, 2019 · c1efaf3 · c1efaf3
1 parent 1db57c9
commit c1efaf3
Show file tree

Hide file tree

Showing 9 changed files with 325 additions and 320 deletions.
diff --git a/demo/Chapitre3.R b/demo/Chapitre3.R
diff --git a/demo/Chapitre4.R b/demo/Chapitre4.R
@@ -7,14 +7,14 @@
 
 #Chapitre 4
 
-#page 266
+#page 248
 if(!require("BioStatR")){install.packages("BioStatR")}
 library(BioStatR)
 str(Mesures)
 
 summary(Mesures)
 
-#page 267
+#page 249
 if(!require("ISLR")){install.packages("ISLR")}
 library(ISLR)
 summary(Hitters[,17:20])
@@ -25,7 +25,7 @@ summary(model)
 
 Mes.B$masse
 
-#page 268
+#page 250
 round(fitted(model), 2)
 
 round(residuals(model), 2)
@@ -34,7 +34,7 @@ if(!require("broom")){install.packages("broom")}
 library(broom)
 (model.diag.metrics<-augment(model))
 
-#page 270
+#page 252
 tidy(model)
 
 glance(model)
@@ -49,7 +49,7 @@ with(Mes.B,segments(taille, masse, taille, fitted(model), lty=2,
 legend("topleft",lty=c(1,2,4),legend = c("lm","lowess", 
                                          "smooth.spline"),lwd=2,col=c("red","blue","orange"))
 
-#page 271
+#page 253
 if(!require("ggiraphExtra")){install.packages("ggiraphExtra")}
 library(ggiraphExtra)
 ggPredict(model)
@@ -63,12 +63,12 @@ abline(h=0)
 with(Mes.B,lines(lowess(fitted(model),masse-fitted(model)),col= 
                    "red",lwd=2))
 
-#page 272
+#page 254
 library(MASS)
 model.r <- lqs(masse ~ taille, data=Mes.B)
 summary(model.r)
 
-#page 273
+#page 255
 coefficients(model.r)
 
 model.r$bestone
@@ -77,17 +77,22 @@ coef(lm(masse ~ taille, data=Mes.B[model.r$bestone,]))
 
 with(Mes.B,1-sum(residuals(model.r)^2)/sum((masse-mean(masse))^2))
 
-#page 274
+#page 256
 with(Mes.B,1-sum(residuals(model)^2)/sum((masse-mean(masse))^2))
 
 plot(masse ~ taille, data=Mes.B, xlab="Taille", ylab="Masse")
 abline(model.r, lty=1)
 abline(model, lty=2)
-legend("topleft", legend=c("Robuste","Moindres carr\u00e9s"),lty=1:2)
+with(Mes.B,points(taille[model.r$bestone],masse[model.r$bestone],
+                  pch=19,col="red"))
+abline(lm(masse ~ taille, data=Mes.B[model.r$bestone,]), lty=3)
+legend("topleft", legend=c("R\u00e9sistante : moindres carr\u00e9s tronqu\u00e9s",
+       "Moindres carr\u00e9s ordinaires",
+       "Droite ajust\u00e9e entre les deux observations"), lty=1:3)
 
 shapiro.test(residuals(model.r))
 
-#page 275
+#page 257
 model2<-lm(masse~taille+I(taille^2),data=Mes.B)
 
 summary(model2)
@@ -103,10 +108,10 @@ with(Mes.B,segments(taille,masse,taille,fitted(model2),lty=2,
 legend("topleft",legend=c("Moindres carr\u00e9s ordinaires", 
        "Ajustement local"),lty=c(1,3),lwd=2,col=c("red","blue"))
 
-#page 276
+#page 258
 shapiro.test(residuals(model2))
 
-#page 277
+#page 259
 confint(model2)
 
 anova(model2)
@@ -116,12 +121,12 @@ my.confidence.region(model2, which=1)
 my.confidence.region(model2, which=2)
 my.confidence.region(model2, which=3)
 
-#page 278
+#page 260
 set.seed(314)
 model2.r<-lqs(masse~taille+I(taille^2),data=Mes.B)
 rbind(coefficients(model2),coefficients(model2.r))
 
-#page 279
+#page 261
 shapiro.test(residuals(model2.r))
 
 plot(masse~taille,data=Mes.B,xlab="Taille",ylab="Masse",pch=20)
@@ -135,7 +140,7 @@ with(Mes.B,segments(taille,masse,taille,fitted(model2.r),lty=2,
 legend("topleft",legend=c("R\u00e9sistante : moindres carr\u00e9s trim\u00e9s", 
         "Ajustement local"),lty=c(2,3),lwd=2,col=c("green","blue"))
 
-#page 279-280
+#page 261
 plot(masse~taille,data=Mes.B,xlab="Taille",ylab="Masse",pch=20)
 with(Mes.B,lines(lowess(taille,masse),lty=3,lwd=2,col="blue"))
 with(Mes.B,points(sort(taille),fitted(model2)[order(taille)], 
@@ -150,18 +155,18 @@ legend("topleft",legend=c("Moindres carr\u00e9s ordinaires",
        "R\u00e9sistante : moindres carr\u00e9s trim\u00e9s","Ajustement local"),lty=1:3 
        ,lwd=2,col=c("red","green","blue"))
 
-#page 280
+#page 262
 data("mtcars")
 View(mtcars)
 
 help(mtcars)
 
-#page 281
+#page 263
 head(mtcars,n=10)
 ?mtcars
 str(mtcars)
 
-#page 282
+#page 264
 mtcars2 <- within(mtcars, { 
   vs <- factor(vs, labels = c("V", "S")) 
   am <- factor(am, labels = c("automatic", "manual")) 
@@ -173,7 +178,7 @@ summary(mtcars2)
 
 subsetmtcars<-mtcars[,c(1,3,4,5,6,7)]
 
-#page 283
+#page 265
 library(MVN)
 set.seed(1133)
 result1 = mvn(data = subsetmtcars, 
@@ -186,14 +191,14 @@ result1$multivariateNormality
 
 result1$multivariateOutliers
 
-#page 284
+#page 266
 library(corrplot); set.seed(1133)
 permmtcars <- perm.cor.mtest(subsetmtcars)
 permmtcars$p<.05/choose(ncol(subsetmtcars),2)
 corrplot(permmtcars$cor,p.mat=permmtcars$p,pch.col="white",insig= 
            "label_sig",sig.level=.05/choose(ncol(subsetmtcars),2))
 
-#page 285
+#page 267
 fit.mtcars<-lm(mpg~.,data=subsetmtcars)
 fit.mtcars
 
@@ -207,14 +212,16 @@ shapiro.test(residuals(fit2.mtcars))
 covratio(fit2.mtcars)
 dffits(fit2.mtcars)
 dfbetas(fit2.mtcars)
-car::vif(fit2.mtcars)
-perturb::colldiag(fit2.mtcars)
+library(car)
+vif(fit2.mtcars)
 
-#page 286
+#page 268
+library(perturb)
+colldiag(fit2.mtcars)
 plot(fit2.mtcars)
 influence.measures(fit2.mtcars)
-car::influencePlot(fit2.mtcars)
-car::influenceIndexPlot(fit2.mtcars)
+influencePlot(fit2.mtcars)
+influenceIndexPlot(fit2.mtcars)
 
 summary(fit2.mtcars)
 anova(fit2.mtcars)
@@ -226,7 +233,7 @@ if(!require("mice")){install.packages("mice")}
 library(mice)
 md.pattern(Hitters)
 
-#page 260
+#page 269
 md.pairs(Hitters)
 
 library(dplyr)
@@ -240,7 +247,7 @@ dependent = "Salary"
 Hitters %>% 
   missing_pattern(dependent, explanatory)
 
-#page 288
+#page 270
 if(!require("naniar")){install.packages("naniar")}
 library(naniar);library(ggplot2)
 Hitters %>% 
@@ -249,16 +256,16 @@ Hitters %>%
              fill = Salary_NA)) + 
   geom_density(alpha = 0.5)
 
-#page 289
+#page 271
 gg_miss_var(Hitters)
 try(gg_miss_upset(Hitters))
 
-#page 290
+#page 272
 #Exercice 4.1
 data(anscombe)
 str(anscombe)
 
-#page 291
+#page 273
 #Exercice 4.2
 Hitters = na.omit(Hitters)
 
@@ -276,7 +283,7 @@ points(10, reg.summary$cp[10], pch = 20, col = "red")
 plot(regfit19.full, scale = "Cp")
 coef(regfit19.full, 10)
 
-#page 292
+#page 274
 #q5
 regfit.fwd = regsubsets(Salary ~ ., data = Hitters, nvmax = 19, 
                         method = "forward")
@@ -298,7 +305,7 @@ for (i in 1:length(summary(regfit.fwd)$rss)) {
   val.errors = c(val.errors,mean((Hitters$Salary[-train]-pred)^2))
 }
 
-#page 293
+#page 275
 #q6 (suite)
 mod.ordre=as.numeric(unlist(sapply(table(n.vars), 
                                    function(x){1:x})))
@@ -307,7 +314,7 @@ plot(n.vars,sqrt(val.errors), ylab ="Root MSE",pch =as.character(
 lines(n.vars[mod.ordre==1],sqrt(val.errors)[mod.ordre==1], 
       lwd=2,lty=2)
 
-#page 294
+#page 276
 #q7
 predict.regsubsets = function(object, newdata, id, ...) { 
   form = as.formula(object$call[[2]]) 
@@ -325,56 +332,55 @@ plot(lasso_model_cv)
 n_best_m=which(lasso_model_cv$lambda==lasso_model_cv$lambda.min)
 lasso_model_cv$glmnet.fit$beta[,n_best_m]
 
-#page 295
+#page 277
 #Exercice 4.3
 #q1
 CancerSein <- read.csv("https://tinyurl.com/y3l6sh59")
 
-#page 297
+#page 279
 #Exercice 4.4
 #q1
 SidaChat <- read.csv("https://tinyurl.com/yxe6yxem")
 
-#page 300
+#page 282
 #Exercice 4.5
 #q1
 Vitamines <- read.csv("https://tinyurl.com/y3shxcsd")
 
-#page 301
+#page 283
 #Exercice 4.6
 #q1
 Beton <- read.csv("https://tinyurl.com/y4w2qv9t")
 
-#page 302
+#page 284
 #Exercice 4.7
 #q1
 chal <- read.csv("https://tinyurl.com/yyb3cztf")
 #q2
 cdplot(as.factor(Defaillance)~Temperature, data=chal, 
        ylab="Defaillance")
 
-#page 303
+#page 285
 #q3
 chal.glm <- glm(Defaillance~Temperature,data=chal,
                 family="binomial")
 
 if(!require(hnp)){install.packages("hnp")}
 hnp(chal.glm, sim = 99, conf = 0.95)
 
-#page 304
+#page 286
 #q6
 if(!require(rms)){install.packages("rms")}
 library(rms)
 chal.lrm <- lrm(Defaillance~Temperature, data=chal, x=TRUE, y=TRUE)
 print(chal.lrm)
 residuals(chal.lrm, "gof")
 
-#page 305
 #Exercice 4.8
 #q1
 Cypermethrine <- read.csv("https://tinyurl.com/y4deakfd")
 
-#page 306
+#page 288
 #Exercice 4.9
 #q1
 poly <- read.csv("https://tinyurl.com/yyhhcw37")
@@ -397,7 +403,7 @@ hnp(poly_glm3, sim = 99, conf = 0.95)
 summary(poly_glm3)
 confint(poly_glm3)
 
-#page 307
+#page 289
 with(poly,plot(nombre~age,type="n",ylab="Nombre de polypes", 
                xlab="\u00c2ge"))
 with(poly,points(age[traitement=="placebo"],fitted(poly_glm2)[ 

diff --git a/demo/SolChapitre3.R b/demo/SolChapitre3.R
@@ -7,7 +7,7 @@
 
 #Chapitre 3 : solution des exercices
 
-#page 227
+#Complement en ligne
 #Exercice 3.1
 d_hotels <- read.csv("https://tinyurl.com/y3rxbxoo")
 head(d_hotels)
@@ -23,21 +23,18 @@ head(d_pres2002[,1:3])
 mosaicplot(d_pres2002, type = "pearson", shade = TRUE, las = 2, 
            main = "Associations et r\u00e9sidus du test du chi2")
 
-#page 228
 d_pres2007 <- read.csv("https://tinyurl.com/yyolq665",row.names=1)
 head(d_pres2007[,1:8])
 mosaicplot(d_pres2007, type = "pearson", shade = TRUE, las = 2, 
            main = "Associations et r\u00e9sidus du test du chi2")
 
-#page 229
 #q1
 data(UCBAdmissions)
 str(UCBAdmissions)
 mosaicplot(UCBAdmissions)
 library(vcd)
 assoc(UCBAdmissions)
 
-#page 230
 #q2
 library(FactoMineR) 
 try(MCA(UCBAdmissions))
@@ -50,10 +47,8 @@ head(UCBA.df)
 
 str(UCBA.df)
 
-#page 231
 MCA(UCBA.df, graph=FALSE)
 
-#page 232
 #Exercice 3.4
 d_wow <- read.csv("https://tinyurl.com/y5gffvsb", row.names =1)
 head(d_wow[,1:3])
@@ -62,7 +57,6 @@ wow.cah.ward <- hclust(d.d_wow, method="ward.D2")
 library(ggdendro)
 ggdendrogram(wow.cah.ward, labels = FALSE)
 
-#page 233
 #Exercice 3.5
 d_hotels <- read.csv("https://tinyurl.com/y3rxbxoo", row.names=1)
 head(d_hotels)