Kranjc Jaka - Domača Naloga 2, MTRD
2024-01-08
Raziskovalno vprašanje: Ali je opazna razlika pri zapravljeni količini na vinih med strankami, ki so sprejeli ponudbo v zadnji marketinški kampanji in tistimi, ki niso.
Vir: Kaggle.com. (2022). Classification: Customer Personality Analysis. Pridobljeno 7.1.2024 s https://www.kaggle.com/datasets/imakash3011/customer-personality-analysis
Uvozi se podatke (csv file):
cust_pers <- read.table("/Users/jakakranjc/Downloads/marketing_campaign.csv", header=TRUE, sep = "\t", dec = ".")Prikaže se prvih 6 vrstic izbranega dataseta:
head(cust_pers)## ID Year_Birth Education Marital_Status Income Kidhome Teenhome Dt_Customer
## 1 5524 1957 Graduation Single 58138 0 0 04-09-2012
## 2 2174 1954 Graduation Single 46344 1 1 08-03-2014
## 3 4141 1965 Graduation Together 71613 0 0 21-08-2013
## 4 6182 1984 Graduation Together 26646 1 0 10-02-2014
## 5 5324 1981 PhD Married 58293 1 0 19-01-2014
## 6 7446 1967 Master Together 62513 0 1 09-09-2013
## Recency MntWines MntFruits MntMeatProducts MntFishProducts MntSweetProducts
## 1 58 635 88 546 172 88
## 2 38 11 1 6 2 1
## 3 26 426 49 127 111 21
## 4 26 11 4 20 10 3
## 5 94 173 43 118 46 27
## 6 16 520 42 98 0 42
## MntGoldProds NumDealsPurchases NumWebPurchases NumCatalogPurchases
## 1 88 3 8 10
## 2 6 2 1 1
## 3 42 1 8 2
## 4 5 2 2 0
## 5 15 5 5 3
## 6 14 2 6 4
## NumStorePurchases NumWebVisitsMonth AcceptedCmp3 AcceptedCmp4 AcceptedCmp5
## 1 4 7 0 0 0
## 2 2 5 0 0 0
## 3 10 4 0 0 0
## 4 4 6 0 0 0
## 5 6 5 0 0 0
## 6 10 6 0 0 0
## AcceptedCmp1 AcceptedCmp2 Complain Z_CostContact Z_Revenue Response
## 1 0 0 0 3 11 1
## 2 0 0 0 3 11 0
## 3 0 0 0 3 11 0
## 4 0 0 0 3 11 0
## 5 0 0 0 3 11 0
## 6 0 0 0 3 11 0Odstrani se nepotrebne stolpce, tiste, ki ostanejo se preimenuje:
cust_personal <- cust_pers[,-c(2,3,4,5,6,7,8,9,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28)]
colnames(cust_personal) <- c("ID", "Znesek_vino", "Odgovor")
head(cust_personal)## ID Znesek_vino Odgovor
## 1 5524 635 1
## 2 2174 11 0
## 3 4141 426 0
## 4 6182 11 0
## 5 5324 173 0
## 6 7446 520 0Razlaga spremenljivk: ID - ID posamezne stranke Znesek_vino - znesek (v Eur, ki ga je posameznik zapravil na vinu v zadnjih dveh letih) Odgovor - 1 = je sprejel akcijo v zadnji marketinški kampanji / 2 = ni sprejel
ID_posameznika <- cust_personal$`ID`
Povprecen_znesek_zapravljen_na_vinu_zadnje_dve_leti <- cust_personal$`Znesek_vino`
Sodelovanje_v_kampanji <- cust_personal$`Odgovor`Opisna statistika:
summary(cust_personal)## ID Znesek_vino Odgovor
## Min. : 0 Min. : 0.00 Min. :0.0000
## 1st Qu.: 2828 1st Qu.: 23.75 1st Qu.:0.0000
## Median : 5458 Median : 173.50 Median :0.0000
## Mean : 5592 Mean : 303.94 Mean :0.1491
## 3rd Qu.: 8428 3rd Qu.: 504.25 3rd Qu.:0.0000
## Max. :11191 Max. :1493.00 Max. :1.0000Nekaj razlag: min za ID je 0, max za ID je 11191 mean (povprečni znesek) zneska, zapravljenega na vinu je 303.94eur, mediana 173.5. povprečje je večje od mediane -> pozitivna nagnjenost povprečna vrednost je 0.1491 -> 14.91% odgovorov je enakih = 1
Naredi se Welch t-test:
group_1 <- cust_personal$Znesek_vino[cust_personal$Odgovor == 1]
group_2 <- cust_personal$Znesek_vino[cust_personal$Odgovor == 0]
t_test_rezultat <- t.test(group_1, group_2)
print(t_test_rezultat)##
## Welch Two Sample t-test
##
## data: group_1 and group_2
## t = 9.5748, df = 394.67, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 185.6345 281.5639
## sample estimates:
## mean of x mean of y
## 502.7036 269.1044Welchov t-test je bil izveden za primerjavo povprecnih zneskov zapravljenih na vinih med tistimi, ki so sodelovali v zadnji kampanji in tistimi ki niso. P-vrednost je manjša od 0.05, kar pomeni, da lahko ničelno domnevo zavrnemo. Statistično pomembna razlika tako obstaja med povprečnimi zneski, porabljenimi za vino med strankami, ki so sprejele in tistimi strankami, ki niso sprejel zadnje kampanje. Prav tako imamo 95% interval zaupanja, ki še dodatno podpira ‘prednost’ oziroma pozitivno razliko skupine, ki je sprejela kampanjo
Naredi se še neparamtrični test - Wilcoxov test vsote rangov:
group_1_wr <- cust_personal$Znesek_vino[cust_personal$Odgovor == 1]
group_2_wr <- cust_personal$Znesek_vino[cust_personal$Odgovor == 0]
wilcox_rank_vsota <- wilcox.test(group_1_wr, group_2_wr)
print(wilcox_rank_vsota)##
## Wilcoxon rank sum test with continuity correction
##
## data: group_1_wr and group_2_wr
## W = 420994, p-value < 2.2e-16
## alternative hypothesis: true location shift is not equal to 0Wilcoxov test vsote rangov je bil narejen za primerjavo porazdelitve povprečnih zneskov, porabljenih za vino med dvema skupinama (tisti, ki so sprejeli zadnjo kampanjo = 1, in tistimi, ki niso = 0). Rezultat podpira dokaze proti ničelni domnevi, kar nam pove da obstaja pomembna razlika v porazdelitvi zneskov. P-vrednost je manjša od 2.2e-16 in nam pove, da močno podpira zavrnitev ničelne domneve. Razlika v porazdelitvi torej ni enaka 0. To se ujema z prejšnjim t-testom.
Preveri se normalna porazdelitev z shapiro testom:
shapiro.test(cust_personal$Znesek_vino[cust_personal$Odgovor == 1])##
## Shapiro-Wilk normality test
##
## data: cust_personal$Znesek_vino[cust_personal$Odgovor == 1]
## W = 0.91224, p-value = 4.87e-13shapiro.test(cust_personal$Znesek_vino[cust_personal$Odgovor == 0])##
## Shapiro-Wilk normality test
##
## data: cust_personal$Znesek_vino[cust_personal$Odgovor == 0]
## W = 0.82905, p-value < 2.2e-16Shapiro-Wilk test nam pokaže, da je pravilo normalnosti kršeno za povprečni znesek, zapravljen s strani posameznika za vino v zadnjih dveh letih glede na skupino v katero pripada.
Oba testa tako podpirata zavrnitev ničelne domneve, ker pa imamo kršeno pravilo normalnosti se odločimo za ne-parametrični test oziroma wilcoxov test vsote rangov
2. DEL NALOGE Odločil sem se za multiplo linearno regresijo, vir za podatke je ostal isti.
Raziskovalno vprašanje: Kako se znesek zapravljen na vinih navezuje na prihodek in število otrok doma?
summary(cust_pers)## ID Year_Birth Education Marital_Status
## Min. : 0 Min. :1893 Length:2240 Length:2240
## 1st Qu.: 2828 1st Qu.:1959 Class :character Class :character
## Median : 5458 Median :1970 Mode :character Mode :character
## Mean : 5592 Mean :1969
## 3rd Qu.: 8428 3rd Qu.:1977
## Max. :11191 Max. :1996
##
## Income Kidhome Teenhome Dt_Customer
## Min. : 1730 Min. :0.0000 Min. :0.0000 Length:2240
## 1st Qu.: 35303 1st Qu.:0.0000 1st Qu.:0.0000 Class :character
## Median : 51382 Median :0.0000 Median :0.0000 Mode :character
## Mean : 52247 Mean :0.4442 Mean :0.5062
## 3rd Qu.: 68522 3rd Qu.:1.0000 3rd Qu.:1.0000
## Max. :666666 Max. :2.0000 Max. :2.0000
## NA's :24
## Recency MntWines MntFruits MntMeatProducts
## Min. : 0.00 Min. : 0.00 Min. : 0.0 Min. : 0
## 1st Qu.:24.00 1st Qu.: 23.75 1st Qu.: 1.0 1st Qu.: 16
## Median :49.00 Median : 173.50 Median : 8.0 Median : 67
## Mean :49.11 Mean : 303.94 Mean : 26.3 Mean : 167
## 3rd Qu.:74.00 3rd Qu.: 504.25 3rd Qu.: 33.0 3rd Qu.: 232
## Max. :99.00 Max. :1493.00 Max. :199.0 Max. :1725
##
## MntFishProducts MntSweetProducts MntGoldProds NumDealsPurchases
## Min. : 0.00 Min. : 0.00 Min. : 0.00 Min. : 0.000
## 1st Qu.: 3.00 1st Qu.: 1.00 1st Qu.: 9.00 1st Qu.: 1.000
## Median : 12.00 Median : 8.00 Median : 24.00 Median : 2.000
## Mean : 37.53 Mean : 27.06 Mean : 44.02 Mean : 2.325
## 3rd Qu.: 50.00 3rd Qu.: 33.00 3rd Qu.: 56.00 3rd Qu.: 3.000
## Max. :259.00 Max. :263.00 Max. :362.00 Max. :15.000
##
## NumWebPurchases NumCatalogPurchases NumStorePurchases NumWebVisitsMonth
## Min. : 0.000 Min. : 0.000 Min. : 0.00 Min. : 0.000
## 1st Qu.: 2.000 1st Qu.: 0.000 1st Qu.: 3.00 1st Qu.: 3.000
## Median : 4.000 Median : 2.000 Median : 5.00 Median : 6.000
## Mean : 4.085 Mean : 2.662 Mean : 5.79 Mean : 5.317
## 3rd Qu.: 6.000 3rd Qu.: 4.000 3rd Qu.: 8.00 3rd Qu.: 7.000
## Max. :27.000 Max. :28.000 Max. :13.00 Max. :20.000
##
## AcceptedCmp3 AcceptedCmp4 AcceptedCmp5 AcceptedCmp1
## Min. :0.00000 Min. :0.00000 Min. :0.00000 Min. :0.00000
## 1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
## Median :0.00000 Median :0.00000 Median :0.00000 Median :0.00000
## Mean :0.07277 Mean :0.07455 Mean :0.07277 Mean :0.06429
## 3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
## Max. :1.00000 Max. :1.00000 Max. :1.00000 Max. :1.00000
##
## AcceptedCmp2 Complain Z_CostContact Z_Revenue
## Min. :0.00000 Min. :0.000000 Min. :3 Min. :11
## 1st Qu.:0.00000 1st Qu.:0.000000 1st Qu.:3 1st Qu.:11
## Median :0.00000 Median :0.000000 Median :3 Median :11
## Mean :0.01339 Mean :0.009375 Mean :3 Mean :11
## 3rd Qu.:0.00000 3rd Qu.:0.000000 3rd Qu.:3 3rd Qu.:11
## Max. :1.00000 Max. :1.000000 Max. :3 Max. :11
##
## Response
## Min. :0.0000
## 1st Qu.:0.0000
## Median :0.0000
## Mean :0.1491
## 3rd Qu.:0.0000
## Max. :1.0000
## Izbere se samo za nas pomembne stolpce
cust_pers2 <- cust_pers[,-c(1,2,3,4,7,8,9,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29)]
colnames(cust_pers2) <- c("Prihodek", "Otroci_doma", "Znesek_vino")summary(cust_pers2)## Prihodek Otroci_doma Znesek_vino
## Min. : 1730 Min. :0.0000 Min. : 0.00
## 1st Qu.: 35303 1st Qu.:0.0000 1st Qu.: 23.75
## Median : 51382 Median :0.0000 Median : 173.50
## Mean : 52247 Mean :0.4442 Mean : 303.94
## 3rd Qu.: 68522 3rd Qu.:1.0000 3rd Qu.: 504.25
## Max. :666666 Max. :2.0000 Max. :1493.00
## NA's :24Preveri se, ali obstajajo NA vrednosti oziroma koliko praznih vrednosti je v Prihodku:
sum(is.na(cust_pers2))## [1] 24Vsem praznim vrednostim v prihodku se dodeli mediana prihodka
cust_pers2$Prihodek[is.na(cust_pers2$Prihodek)] <- median(cust_pers2$Prihodek, na.rm = TRUE)V kolikor je torej prazna vrednost v stolpcu prihodek, se v celico zapiše mediana prihodka za lažje analiziranje.
Naredi se model za multiplo linearno regeresijo
fit <- lm(Znesek_vino ~ Prihodek + Otroci_doma, data = cust_pers2)summary(fit)##
## Call:
## lm(formula = Znesek_vino ~ Prihodek + Otroci_doma, data = cust_pers2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3877.5 -143.3 -44.9 87.7 1110.2
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.537e+01 1.634e+01 4.612 4.21e-06 ***
## Prihodek 6.004e-03 2.413e-04 24.882 < 2e-16 ***
## Otroci_doma -1.915e+02 1.122e+01 -17.067 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 258.7 on 2237 degrees of freedom
## Multiple R-squared: 0.4097, Adjusted R-squared: 0.4092
## F-statistic: 776.3 on 2 and 2237 DF, p-value: < 2.2e-16P-vrednost je izredno majhna (2.2e-16), kar pove da sta tako prihodek kot število otrok doma statistično pomembna napovedovalca vsote, ki bo zapravljena na vinu. model je statistično pomemben.
library(car)## Loading required package: carDataIzračunamo vif in preverimo multikolinearnost
vif(fit)## Prihodek Otroci_doma
## 1.220856 1.220856Vrednosti sta pod 5 in sta sprejemljivi.
Preveri se povezavo med izbranima spremenljivkama
cor_matrix <- cor(cust_pers2)
print(cor_matrix)## Prihodek Otroci_doma Znesek_vino
## Prihodek 1.0000000 -0.4253265 0.5769031
## Otroci_doma -0.4253265 1.0000000 -0.4962969
## Znesek_vino 0.5769031 -0.4962969 1.0000000Povezava med zneskom, zapravljenim na vinu in prihodkom je 0.57 kar pomeni da je zmerno pozitivno, kar pomeni, da se ob zvišanju prihodka zvišuje vsota zapravljena na vinu. Povezava med zneskom in otroci doma pa je -0.49, kar pomeni da je negativna in se ob višanju števila otrok doma količina zapravljena na vinu manjša.
library(corrplot)## corrplot 0.92 loadedcorrplot(cor_matrix, method = "color")
Naredi se brauch pagan test za predpostavko o homoskedatičnosti
library(olsrr)##
## Attaching package: 'olsrr'## The following object is masked from 'package:datasets':
##
## riversols_test_breusch_pagan(fit)##
## Breusch Pagan Test for Heteroskedasticity
## -----------------------------------------
## Ho: the variance is constant
## Ha: the variance is not constant
##
## Data
## ---------------------------------------
## Response : Znesek_vino
## Variables: fitted values of Znesek_vino
##
## Test Summary
## ----------------------------
## DF = 1
## Chi2 = 6178.5399
## Prob > Chi2 = 0.0000ho hipoteza = variance je konstantna (homoskedastičnost), h1 hipoteza = varianca ni konstantna (heteroskedastičnost) prob nam pove da je p vrednost zelo majhen in manjši od (0.0000), zato lahko h0 zavrnemo. Variabilnost napak ni konstantna, kar namiguje na prisotnost heteroskedastičnosti.
Preveri se ustreznost modela z r2 in prilagojenim r2
summary(fit)$r.squared## [1] 0.4096862summary(fit)$adj.r.squared## [1] 0.4091584približno 41% variabilnosti zneska porabljenega na vinu ob upoštevanju spremenljivk pojasnjuje predstavljen model.