Student
M.NEKUI TIEFANG BIEDIANT
2023-04-03
#charger les données
clients=read.csv("http://goo.gl/qw303p")##inspecter les donneés
head(clients)## age gender income kids ownHome subscribe Segment
## 1 47.31613 Male 49482.81 2 ownNo subNo Suburb mix
## 2 31.38684 Male 35546.29 1 ownYes subNo Suburb mix
## 3 43.20034 Male 44169.19 0 ownYes subNo Suburb mix
## 4 37.31700 Female 81041.99 1 ownNo subNo Suburb mix
## 5 40.95439 Female 79353.01 3 ownYes subNo Suburb mix
## 6 43.03387 Male 58143.36 4 ownYes subNo Suburb mixsummary(clients)## age gender income kids
## Min. :19.26 Length:300 Min. : -5183 Min. :0.00
## 1st Qu.:33.01 Class :character 1st Qu.: 39656 1st Qu.:0.00
## Median :39.49 Mode :character Median : 52014 Median :1.00
## Mean :41.20 Mean : 50937 Mean :1.27
## 3rd Qu.:47.90 3rd Qu.: 61403 3rd Qu.:2.00
## Max. :80.49 Max. :114278 Max. :7.00
## ownHome subscribe Segment
## Length:300 Length:300 Length:300
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
## str(clients)## 'data.frame': 300 obs. of 7 variables:
## $ age : num 47.3 31.4 43.2 37.3 41 ...
## $ gender : chr "Male" "Male" "Male" "Female" ...
## $ income : num 49483 35546 44169 81042 79353 ...
## $ kids : int 2 1 0 1 3 4 3 0 1 0 ...
## $ ownHome : chr "ownNo" "ownYes" "ownYes" "ownNo" ...
## $ subscribe: chr "subNo" "subNo" "subNo" "subNo" ...
## $ Segment : chr "Suburb mix" "Suburb mix" "Suburb mix" "Suburb mix" ...#changer de nom des variables et rendre les var quali en facteur
names(clients)=c("age","sexe","revenu","enfants","proprio","abonné","segments")
clients$sexe=as.factor(clients$sexe)
clients$proprio=as.factor(clients$proprio)
clients$abonné=as.factor(clients$abonné)
clients$segments=as.factor(clients$segments)
str(clients)## 'data.frame': 300 obs. of 7 variables:
## $ age : num 47.3 31.4 43.2 37.3 41 ...
## $ sexe : Factor w/ 2 levels "Female","Male": 2 2 2 1 1 2 2 2 1 1 ...
## $ revenu : num 49483 35546 44169 81042 79353 ...
## $ enfants : int 2 1 0 1 3 4 3 0 1 0 ...
## $ proprio : Factor w/ 2 levels "ownNo","ownYes": 1 2 2 1 2 2 1 1 1 2 ...
## $ abonné : Factor w/ 2 levels "subNo","subYes": 1 1 1 1 1 1 1 1 1 1 ...
## $ segments: Factor w/ 4 levels "Moving up","Suburb mix",..: 2 2 2 2 2 2 2 2 2 2 ...#les fonctions by agregate et with
*by
by(clients$revenu,clients$segments,mean)#moyenne des revenu en fonction des segments## clients$segments: Moving up
## [1] 53090.97
## ------------------------------------------------------------
## clients$segments: Suburb mix
## [1] 55033.82
## ------------------------------------------------------------
## clients$segments: Travelers
## [1] 62213.94
## ------------------------------------------------------------
## clients$segments: Urban hip
## [1] 21681.93by(clients$revenu,list(clients$segments,clients$proprio),mean)#moyenne des revenu en fonction de segments et proprio## : Moving up
## : ownNo
## [1] 54497.68
## ------------------------------------------------------------
## : Suburb mix
## : ownNo
## [1] 54932.83
## ------------------------------------------------------------
## : Travelers
## : ownNo
## [1] 63188.42
## ------------------------------------------------------------
## : Urban hip
## : ownNo
## [1] 21337.59
## ------------------------------------------------------------
## : Moving up
## : ownYes
## [1] 50216.37
## ------------------------------------------------------------
## : Suburb mix
## : ownYes
## [1] 55143.21
## ------------------------------------------------------------
## : Travelers
## : ownYes
## [1] 61889.12
## ------------------------------------------------------------
## : Urban hip
## : ownYes
## [1] 23059.27aggregate même role que by* mais rendus sous forme de tableau
tableau=aggregate(revenu~segments,mean,data = clients)
tableau## segments revenu
## 1 Moving up 53090.97
## 2 Suburb mix 55033.82
## 3 Travelers 62213.94
## 4 Urban hip 21681.93tableau2=aggregate(revenu~segments+proprio,mean,data = clients)
tableau2## segments proprio revenu
## 1 Moving up ownNo 54497.68
## 2 Suburb mix ownNo 54932.83
## 3 Travelers ownNo 63188.42
## 4 Urban hip ownNo 21337.59
## 5 Moving up ownYes 50216.37
## 6 Suburb mix ownYes 55143.21
## 7 Travelers ownYes 61889.12
## 8 Urban hip ownYes 23059.27*with
with(clients, table(segments,proprio)) #tableau de frequence pour var quali## proprio
## segments ownNo ownYes
## Moving up 47 23
## Suburb mix 52 48
## Travelers 20 60
## Urban hip 40 10with(clients, prop.table(table(segments,proprio),margin=1))## proprio
## segments ownNo ownYes
## Moving up 0.6714286 0.3285714
## Suburb mix 0.5200000 0.4800000
## Travelers 0.2500000 0.7500000
## Urban hip 0.8000000 0.2000000with(clients, prop.table(table(segments,proprio),margin=2)) #tableau de frequence pour var quali## proprio
## segments ownNo ownYes
## Moving up 0.29559748 0.16312057
## Suburb mix 0.32704403 0.34042553
## Travelers 0.12578616 0.42553191
## Urban hip 0.25157233 0.07092199#margin=1 par ligne margin=2 par colonne#representation des données
library(lattice)
histogram(~abonné | segments , data = clients)
histogram(~sexe | segments , data = clients)
histogram(~abonné|segments, data = clients, type = "count", layout=c(4,1),col=c("red","blue"))
histogram(~abonné | segments+proprio , data = clients)
prop.table(table(clients$abonné,clients$segments),margin = 2)##
## Moving up Suburb mix Travelers Urban hip
## subNo 0.800 0.940 0.875 0.800
## subYes 0.200 0.060 0.125 0.200#histogram(~abonné | segments+revenu.fac , data = clients)
barchart(prop.table(table(clients$abonné,clients$segments),margin = 2)[2,],xlab = "titre",col="red")
essayons de realiser un test de comparaison des moyennes
##student dans notre bd
by(clients$revenu,clients$proprio, var)## clients$proprio: ownNo
## [1] 358692875
## ------------------------------------------------------------
## clients$proprio: ownYes
## [1] 430890091boxplot(clients$revenu~clients$proprio)
visiblement les mean sont différente
Vérification den la normalité
hist(clients$revenu)
shapiro.test(clients$revenu)##
## Shapiro-Wilk normality test
##
## data: clients$revenu
## W = 0.97765, p-value = 0.0001244normalité rejeté !!
pour visualiser la distribution d’une variable avec une seule modalite il faut:
par(mfrow=c(1,2))
with(clients,hist(revenu[proprio=="ownYes"]))
with(clients,hist(revenu[proprio=="ownNo"]))
#t.test(clients$revenu~clients$proprio, var.equal=FALSE)
#lorsque les deux echantillon sont depezndant et numerique la syntaxe adequat est la suivante
#t.test(echan1,echan2, var.equal=T, paired=T)
#non paramétrique
by(clients$revenu,clients$proprio, median)## clients$proprio: ownNo
## [1] 51412.56
## ------------------------------------------------------------
## clients$proprio: ownYes
## [1] 52953.41wilcox.test(clients$revenu~clients$proprio,correct = F)##
## Wilcoxon rank sum test
##
## data: clients$revenu by clients$proprio
## W = 9325, p-value = 0.01197
## alternative hypothesis: true location shift is not equal to 0rejet de H0
test de conformité
median(clients$revenu)## [1] 52014.35wilcox.test(clients$revenu, mu=52050)##
## Wilcoxon signed rank test with continuity correction
##
## data: clients$revenu
## V = 21579, p-value = 0.508
## alternative hypothesis: true location is not equal to 52050H0 accepté: oui le revenu moyen peut être assimilable/conforme a 52050
library(pastecs)
by(clients$revenu,clients$proprio,stat.desc)## clients$proprio: ownNo
## nbr.val nbr.null nbr.na min max range
## 1.590000e+02 0.000000e+00 0.000000e+00 1.198525e+04 1.134568e+05 1.014715e+05
## sum median mean SE.mean CI.mean.0.95 var
## 7.535171e+06 5.141256e+04 4.739101e+04 1.501975e+03 2.966540e+03 3.586929e+08
## std.dev coef.var
## 1.893919e+04 3.996367e-01
## ------------------------------------------------------------
## clients$proprio: ownYes
## nbr.val nbr.null nbr.na min max
## 1.410000e+02 0.000000e+00 0.000000e+00 -5.183354e+03 1.142783e+05
## range sum median mean SE.mean
## 1.194616e+05 7.745790e+06 5.295341e+04 5.493468e+04 1.748130e+03
## CI.mean.0.95 var std.dev coef.var
## 3.456147e+03 4.308901e+08 2.075789e+04 3.778650e-01##test du khi-deux lien entre deux var quali
#tableau de frequence
t=table(clients$abonné,clients$proprio)
t##
## ownNo ownYes
## subNo 137 123
## subYes 22 18HO: pas de lien H1: existance de lien Notons ici que le risque represente une ERREUR D’INFERENCE( donc en general c’est sur 100 echantillon je peux me tromper sur 5 echantillons)
chisq.test(t,correct =F )##
## Pearson's Chi-squared test
##
## data: t
## X-squared = 0.074113, df = 1, p-value = 0.7854pas de lien !!!!
passons au test binomiale sorti binaire
H0: Pval inf 0.5 H1:Pval sup/=0.5
#binom.test(x,n,p,alternative = "greater")
#?binom.test
# Supposons que nous avons 30 tirages de pièces de monnaie et que nous voulons tester si la probabilité de succès est de 0.5
nombre_de_succes <- 18
taille_de_l_echantillon <- 30
probabilite_theorique <- 0.5
# Effectuer le test binomial
resultat_test <- binom.test(nombre_de_succes, taille_de_l_echantillon, p = probabilite_theorique, alternative = "two.sided")
# Afficher les résultats
print(resultat_test)##
## Exact binomial test
##
## data: nombre_de_succes and taille_de_l_echantillon
## number of successes = 18, number of trials = 30, p-value = 0.3616
## alternative hypothesis: true probability of success is not equal to 0.5
## 95 percent confidence interval:
## 0.4060349 0.7734424
## sample estimates:
## probability of success
## 0.6x:nbre observé qui repondent aux succeès , n:total , p=0.5(generalement), H1 (alternative)=superieure pour conclure on compare la prob de succes a 0.5
ANOVA (analysis of variance)
il complète le test de stutend qui se limite a un facteur et 2 modalités exclusivement
*passons à la visualisation tout d’abord
library(ggplot2)
visua=ggplot(clients,aes(segments,revenu))+geom_boxplot()
visua
*passons a anova proprement dit ( un facteur plus de deux modalités)
segmentanova=aov(revenu~segments,data = clients)
anova(segmentanova)## Analysis of Variance Table
##
## Response: revenu
## Df Sum Sq Mean Sq F value Pr(>F)
## segments 3 5.4970e+10 1.8323e+10 81.828 < 2.2e-16 ***
## Residuals 296 6.6281e+10 2.2392e+08
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1F value est le quotient de la moyenne de la somme des carrées du model sur la moyenne de la somme des carrées par groupe
il est bien significatif donc on peut conclur que les types de segment ont un impact sur la moyenne des revenu
- anova deux facteurs now
model2=aov(revenu~segments+proprio,data = clients)
anova(model2) #proprio pas significatif supsons de multicolinearité!!!!## Analysis of Variance Table
##
## Response: revenu
## Df Sum Sq Mean Sq F value Pr(>F)
## segments 3 5.4970e+10 1.8323e+10 81.6381 <2e-16 ***
## proprio 1 6.9918e+07 6.9918e+07 0.3115 0.5772
## Residuals 295 6.6211e+10 2.2444e+08
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1model3=lm(revenu~segments+proprio,data = clients)
summary(model3)##
## Call:
## lm(formula = revenu ~ segments + proprio, data = clients)
##
## Residuals:
## Min 1Q Median 3Q Max
## -67135 -6931 -270 6259 52327
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 53436 1894 28.208 < 2e-16 ***
## segmentsSuburb mix 2102 2352 0.894 0.372240
## segmentsTravelers 9566 2577 3.712 0.000246 ***
## segmentsUrban hip -31544 2785 -11.328 < 2e-16 ***
## proprioownYes -1050 1882 -0.558 0.577175
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 14980 on 295 degrees of freedom
## Multiple R-squared: 0.4539, Adjusted R-squared: 0.4465
## F-statistic: 61.31 on 4 and 295 DF, p-value: < 2.2e-16*comparaison des modèles anova
anova(segmentanova, model2)## Analysis of Variance Table
##
## Model 1: revenu ~ segments
## Model 2: revenu ~ segments + proprio
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 296 6.6281e+10
## 2 295 6.6211e+10 1 69918004 0.3115 0.5772Pr(F)= 0.5772 donc H0 accepté (pas d’amelioration dans le model ) model1 mieux que model2