#Na poczatku wczytujemy zbior danych
rowery<-read_excel("sklep_rowerowy.xlsx")
rowery ## # A tibble: 1,000 × 13
## ID `Marital Status` Gender Income Children Education Occupation
## <dbl> <chr> <chr> <dbl> <dbl> <chr> <chr>
## 1 12496 Married Female 40000 1 Bachelors Skilled Ma…
## 2 24107 Married Male 30000 3 Partial College Clerical
## 3 14177 Married Male 80000 5 Partial College Profession…
## 4 24381 Single <NA> 70000 0 Bachelors Profession…
## 5 25597 Single Male 30000 0 Bachelors Clerical
## 6 13507 Married Female 10000 2 Partial College Manual
## 7 27974 Single Male 160000 2 High School Management
## 8 19364 Married Male 40000 1 Bachelors Skilled Ma…
## 9 22155 <NA> Male 20000 2 Partial High School Clerical
## 10 19280 Married Male NA 2 Partial College Manual
## # ℹ 990 more rows
## # ℹ 6 more variables: `Home Owner` <chr>, Cars <dbl>, `Commute Distance` <chr>,
## # Region <chr>, Age <dbl>, `Purchased Bike` <chr>SKLEP ROWEROWY
Analizowany zbiór danych zawiera informacje na temat klientów sklepu rowerowego. Z jego pomocą możemy uzyskać informacje na temat wieku, dochodu, płci, liczby posiadanych dzieci czy regionu pochodzenia klientów sklepu. Celem projektu jest przeprowadzenie kompleksowej analizy danych, która obejmować będzie kilka kluczowych etapów, a mianowicie: czyszczenie danych, wizualizację, analizę opisową i wnioskowanie statystyczne.
I ETAP - CZYSZCZENIE DANYCH
1. Przegląd danych
Obserwujemy m.in. spacje w nazwach kolumn naszych zmiennych. Aby się ich pozbyć korzystamy z funkcji clean_names z pakietu ‘janitor’, która służy do przekształcania nazw kolumn w ramce danych w formę bardziej czytelną i zgodą z konwencją.
head(rowery) ## # A tibble: 6 × 13
## ID `Marital Status` Gender Income Children Education Occupation
## <dbl> <chr> <chr> <dbl> <dbl> <chr> <chr>
## 1 12496 Married Female 40000 1 Bachelors Skilled Manual
## 2 24107 Married Male 30000 3 Partial College Clerical
## 3 14177 Married Male 80000 5 Partial College Professional
## 4 24381 Single <NA> 70000 0 Bachelors Professional
## 5 25597 Single Male 30000 0 Bachelors Clerical
## 6 13507 Married Female 10000 2 Partial College Manual
## # ℹ 6 more variables: `Home Owner` <chr>, Cars <dbl>, `Commute Distance` <chr>,
## # Region <chr>, Age <dbl>, `Purchased Bike` <chr>rowery <- clean_names(rowery) 1. Sprawdzenie występowania brakujących obserwacji NA
Poniżej przeprowadzona została analiza wartości brakujących NA dla poszczególnych zmiennych. Wskazano zarówno liczbę wierszy, w których występują braki, jak i konkretne ich numery. W ten sposób dowiadujemy się przykładowo, że zmienna “home_owner” ma 4 braki i występują one w wierszach: 7, 366, 647 i 944. Przedstawiono również wizualizację wartości brakujących.
sum(complete.cases(rowery)) ## [1] 952Zauważono 952 pełnych wierszy, czyli mamy 48 wierszy, w ktorych sa braki.
manyNAs(rowery) ## [1] 689689 wiersz zawiera najwiecej brakow.
sum(is.na(rowery)) ## [1] 53W sumie wystepuja 53 braki.
miss_var_summary(rowery) ## # A tibble: 13 × 3
## variable n_miss pct_miss
## <chr> <int> <dbl>
## 1 gender 11 1.1
## 2 cars 9 0.9
## 3 children 8 0.8
## 4 age 8 0.8
## 5 marital_status 7 0.7
## 6 income 6 0.6
## 7 home_owner 4 0.4
## 8 id 0 0
## 9 education 0 0
## 10 occupation 0 0
## 11 commute_distance 0 0
## 12 region 0 0
## 13 purchased_bike 0 0Widzimy, że braki wystepuja jedynie dla zmiennych gender (11), cars(9),children (8), age(8), marital_status(7), income(6) i home_owner(4). Pozostale zmienne nie posiadaja zadnych wartosci brakujacych.
rowery %>%
miss_case_table()## # A tibble: 4 × 3
## n_miss_in_case n_cases pct_cases
## <int> <int> <dbl>
## 1 0 952 95.2
## 2 1 44 4.4
## 3 2 3 0.3
## 4 3 1 0.1Mamy 44 wiersze, w ktorych brak jest jednej wartosci, 3 wiersze z 2 brakami i jeden wiersz z 3 wartosciami NA
md.pattern(rowery) 
## id education occupation commute_distance region purchased_bike home_owner
## 952 1 1 1 1 1 1 1
## 10 1 1 1 1 1 1 1
## 9 1 1 1 1 1 1 1
## 5 1 1 1 1 1 1 1
## 7 1 1 1 1 1 1 1
## 1 1 1 1 1 1 1 1
## 5 1 1 1 1 1 1 1
## 1 1 1 1 1 1 1 1
## 4 1 1 1 1 1 1 1
## 1 1 1 1 1 1 1 1
## 1 1 1 1 1 1 1 1
## 4 1 1 1 1 1 1 0
## 0 0 0 0 0 0 4
## income marital_status children age cars gender
## 952 1 1 1 1 1 1 0
## 10 1 1 1 1 1 0 1
## 9 1 1 1 1 0 1 1
## 5 1 1 1 0 1 1 1
## 7 1 1 0 1 1 1 1
## 1 1 1 0 0 1 0 3
## 5 1 0 1 1 1 1 1
## 1 1 0 1 0 1 1 2
## 4 0 1 1 1 1 1 1
## 1 0 1 1 0 1 1 2
## 1 0 0 1 1 1 1 2
## 4 1 1 1 1 1 1 1
## 6 7 8 8 9 11 53Wykres do zilustrowania brakow kazdej zmiennej
which(is.na(rowery$gender))## [1] 4 155 336 602 689 696 868 909 952 974 9984, 155, 336, 602, 689, 696, 868, 909, 952, 974, 998- numery wierszy, w ktorych sa braki dla zmiennej gender
which(is.na(rowery$cars)) ## [1] 13 197 203 352 449 512 562 616 93413, 197, 203, 352, 449, 512, 562, 616, 934- numery wierszy, w ktorych sa braki dla zmiennej cars
which(is.na(rowery$children))## [1] 118 218 387 550 639 689 806 961118, 218, 387, 550, 639, 689, 806, 961- numery wierszy, w ktorych sa braki dla zmiennej children
which(is.na(rowery$age)) ## [1] 10 99 226 372 555 689 771 98710, 99, 226, 372, 555, 689, 771, 987- numery wierszy, w ktorych sa braki dla zmiennej age
which(is.na(rowery$marital_status)) ## [1] 9 28 50 99 151 235 3029, 28, 50, 99, 151, 235, 302- numery wierszy, w ktorych sa braki dla zmiennej marital_status
which(is.na(rowery$income)) ## [1] 10 111 192 302 442 51010, 111, 192, 302, 442, 510-numery wierszy, w ktorych sa braki dla zmiennej income
which(is.na(rowery$home_owner)) ## [1] 7 366 647 9447, 366, 647, 944-numery wierszy, w ktorych sa braki dla zmiennej home_owner
2. Sprawdzenie typów danych w każdej kolumnie
Sprawdzanie typów danych w każdej kolumnie jest kluczowe dla zachowania poprawności, efektywności oraz precyzji analizy danych.
data_class <- data.frame(class = sapply(rowery, class))
data_class## class
## id numeric
## marital_status character
## gender character
## income numeric
## children numeric
## education character
## occupation character
## home_owner character
## cars numeric
## commute_distance character
## region character
## age numeric
## purchased_bike character3. Sprawdzenie wiarygodności danych
Poprzez wywołanie podstawowych statystyk możemy sprawdzić, czy nasze dane wydają się być wiarygodne, tzn. czy średnia ilość posiadanych dzieci, czy samochodów wydaje się być prawdopodobna. Ponadto użycie ‘view(dfSummary(dane))’ dostarcza nam wielu cennych informacji m.in.:
- widzimy, że każdy klient posiada unikalne id,
- otrzymujemy podsumowanie braków obserwacji dla każdej zmiennej,
- dla zmiennych jakościowych widzimy możliwe kategorie wyboru wraz z informacją o częstości jej wystąpienia.
summary(rowery)## id marital_status gender income
## Min. :11000 Length:1000 Length:1000 Min. : 10000
## 1st Qu.:15291 Class :character Class :character 1st Qu.: 30000
## Median :19744 Mode :character Mode :character Median : 60000
## Mean :19966 Mean : 56268
## 3rd Qu.:24471 3rd Qu.: 70000
## Max. :29447 Max. :170000
## NA's :6
## children education occupation home_owner
## Min. :0.00 Length:1000 Length:1000 Length:1000
## 1st Qu.:0.00 Class :character Class :character Class :character
## Median :2.00 Mode :character Mode :character Mode :character
## Mean :1.91
## 3rd Qu.:3.00
## Max. :5.00
## NA's :8
## cars commute_distance region age
## Min. :0.000 Length:1000 Length:1000 Min. :25.00
## 1st Qu.:1.000 Class :character Class :character 1st Qu.:35.00
## Median :1.000 Mode :character Mode :character Median :43.00
## Mean :1.455 Mean :44.18
## 3rd Qu.:2.000 3rd Qu.:52.00
## Max. :4.000 Max. :89.00
## NA's :9 NA's :8
## purchased_bike
## Length:1000
## Class :character
## Mode :character
##
##
##
## view(dfSummary(rowery))## Switching method to 'browser'## Output file written: C:\Users\macie\AppData\Local\Temp\RtmpaU9INy\file33f842ea14d8.htmldescr(rowery)## Non-numerical variable(s) ignored: marital_status, gender, education, occupation, home_owner, commute_distance, region, purchased_bike## Descriptive Statistics
## rowery
## N: 1000
##
## age cars children id income
## ----------------- -------- -------- ---------- ---------- -----------
## Mean 44.18 1.46 1.91 19965.99 56267.61
## Std.Dev 11.36 1.12 1.63 5347.33 31067.82
## Min 25.00 0.00 0.00 11000.00 10000.00
## Q1 35.00 1.00 0.00 15289.50 30000.00
## Median 43.00 1.00 2.00 19744.00 60000.00
## Q3 52.00 2.00 3.00 24475.50 70000.00
## Max 89.00 4.00 5.00 29447.00 170000.00
## MAD 11.86 1.48 1.48 6848.13 29652.00
## IQR 17.00 1.00 3.00 9180.00 40000.00
## CV 0.26 0.77 0.85 0.27 0.55
## Skewness 0.52 0.42 0.39 0.05 0.75
## SE.Skewness 0.08 0.08 0.08 0.08 0.08
## Kurtosis -0.27 -0.41 -1.02 -1.19 0.50
## N.Valid 992.00 991.00 992.00 1000.00 994.00
## Pct.Valid 99.20 99.10 99.20 100.00 99.404. Sprawdzanie spełnienia pewnych reguł dla zbioru danych
Posiadając już podstawową wiedzę na temat naszych danych, chcemy sprawdzić kilka podstawowych reguł: czy zmienna wiek na pewno wszędzie przyjmuje wartości dodatnie, czy liczba posidanych dzieci nie jest nigdzie ujemna, czy liczba posiadanych samochodów nie jest ujemna, czy płeć przyjmuje jedną z dwóch kategorii ‘kobieta’ i ‘mężczyna’.
rules <- validator(age > 0, gender %in% c('Female','Male')
, income >= 0, children >= 0, cars >= 0)
cf <- confront(rowery, rules, key="id")
summary(cf)## name items passes fails nNA error warning expression
## 1 V1 1000 992 0 8 FALSE FALSE age > 0
## 2 V2 1000 989 0 11 FALSE FALSE gender %vin% c("Female", "Male")
## 3 V3 1000 994 0 6 FALSE FALSE income - 0 >= -1e-08
## 4 V4 1000 992 0 8 FALSE FALSE children - 0 >= -1e-08
## 5 V5 1000 991 0 9 FALSE FALSE cars - 0 >= -1e-08barplot(cf, main="rowery") ## Warning: The 'barplot' method for confrontation objects is deprecated. Use
## 'plot' instead
Wizualizacja spełnienia reguły as.data.frame(cf) %>% head()
Inny sposób:
RULE <- editset(c("age > 0","gender %in% c('Female','Male')"
, "income >= 0", "children >= 0", "cars >= 0"))
RULE##
## Data model:
## dat1 : gender %in% c('Female', 'Male')
##
## Edit set:
## num1 : 0 < age
## num2 : 0 <= income
## num3 : 0 <= children
## num4 : 0 <= carssummary(violatedEdits(RULE, rowery))## Edit violations, 1000 observations, 0 completely missing (0%):
##
## editname freq rel
## dat1 11 1.1%
##
## Edit violations per record:
##
## errors freq rel
## 0 961 96.1%
## 1 37 3.7%
## 2 1 0.1%
## 3 1 0.1%#rowery[localizeErrors(RULE, rowery)$adapt] <- NA -> w razie niespelnienia ktores z regul wartosci zmieniamy na NAOkazuje się, że wszystkie reguły w naszym zbiorze danych są spełnione.
2. Imputacja danych
Z analiz przeprowadzonych powyżej wynika, że w naszym zbiorze danych zlokalizowano 53 braki danych. Podjęto decyzję o nieusuwaniu żadnego z wierszy i uzupełnieniu wartości NA za pomocą różnych metod.
1. Imputacja-zmienne ilościowe
Braki w zmiennych dotyczących dochodu, wieku, liczby posidanych dzieci i samochodów wypełnione zostaną za pomocą średniej. Ze względu na specyfikę danych age, children i cars, wartości te nie powinny mieć żadnych miejsc po przecinku, gdyż nie możemy posiadać np. 1.5 dziecka.
rowery %>% filter(is.na(income)) %>% head## # A tibble: 6 × 13
## id marital_status gender income children education occupation home_owner
## <dbl> <chr> <chr> <dbl> <dbl> <chr> <chr> <chr>
## 1 19280 Married Male NA 2 Partial Col… Manual Yes
## 2 21006 Single Female NA 1 Partial Col… Manual No
## 3 26944 Single Male NA 2 High School Manual Yes
## 4 17926 <NA> Female NA 0 Bachelors Clerical No
## 5 11061 Married Male NA 2 Partial Col… Skilled M… Yes
## 6 24357 Married Male NA 3 Bachelors Professio… Yes
## # ℹ 5 more variables: cars <dbl>, commute_distance <chr>, region <chr>,
## # age <dbl>, purchased_bike <chr>rowery[is.na(rowery$income), "income"] <- mean(rowery$income, na.rm = T)
# Inny sposob
#dochod<-imputate_na(rowery, income, method = "mean")
#summary(dochod)
#plot(dochod)
rowery %>% filter(is.na(age)) %>% head## # A tibble: 6 × 13
## id marital_status gender income children education occupation home_owner
## <dbl> <chr> <chr> <dbl> <dbl> <chr> <chr> <chr>
## 1 19280 Married Male 56268. 2 Partial Col… Manual Yes
## 2 19441 <NA> Male 40000 0 Graduate De… Clerical Yes
## 3 14135 Married Male 20000 1 Partial Col… Manual Yes
## 4 22918 Single Male 80000 5 Graduate De… Management Yes
## 5 18580 Married Female 60000 2 Graduate De… Professio… Yes
## 6 11699 Single <NA> 60000 NA Bachelors Skilled M… No
## # ℹ 5 more variables: cars <dbl>, commute_distance <chr>, region <chr>,
## # age <dbl>, purchased_bike <chr>rowery[is.na(rowery$age), "age"] <- round(mean(rowery$age, na.rm = T), digits=0)
rowery %>% filter(is.na(cars)) %>% head## # A tibble: 6 × 13
## id marital_status gender income children education occupation home_owner
## <dbl> <chr> <chr> <dbl> <dbl> <chr> <chr> <chr>
## 1 11434 Married Male 170000 5 Partial Col… Professio… Yes
## 2 16209 Single Female 50000 0 Graduate De… Skilled M… Yes
## 3 18626 Single Male 40000 2 Partial Col… Clerical Yes
## 4 13572 Single Male 10000 3 High School Manual Yes
## 5 11383 Married Female 30000 3 Graduate De… Clerical Yes
## 6 12207 Single Male 80000 4 Bachelors Management Yes
## # ℹ 5 more variables: cars <dbl>, commute_distance <chr>, region <chr>,
## # age <dbl>, purchased_bike <chr>rowery[is.na(rowery$cars), "cars"] <- round(mean(rowery$cars, na.rm = T), digits=0)
rowery %>% filter(is.na(children)) %>% head## # A tibble: 6 × 13
## id marital_status gender income children education occupation home_owner
## <dbl> <chr> <chr> <dbl> <dbl> <chr> <chr> <chr>
## 1 24065 Single Female 20000 NA High School Manual Yes
## 2 13673 Single Female 20000 NA Partial Hig… Manual No
## 3 28957 Single Female 120000 NA Partial Hig… Professio… Yes
## 4 13453 Married Female 130000 NA Bachelors Management Yes
## 5 18949 Single Male 70000 NA Graduate De… Management Yes
## 6 11699 Single <NA> 60000 NA Bachelors Skilled M… No
## # ℹ 5 more variables: cars <dbl>, commute_distance <chr>, region <chr>,
## # age <dbl>, purchased_bike <chr>rowery[is.na(rowery$children), "children"] <- round(mean(rowery$children, na.rm = T), digits=0)2. Imputacja-zmienne jakościowe
Po uzupełnieniu braków w zmiennych ilościowych, przystępujemy teraz do korekty brakujących danych w przypadku zmiennych jakościowych. Ponieważ nasze zmienne jakościowe zawierają jedynie dwie kategorie, planujemy zidentyfikować, która z tych kategorii jest dominująca. Następnie, braki danych w tych zmiennych zostaną wypełnione wartościami dominującymi, aby zachować spójność i ułatwić analizę danych.
#uzupelnianie danych dominanta
rowery[is.na(rowery$home_owner), "home_owner"] <- "Yes" #68,5% klientow posiada dom, jest to wiekszosc, wiec braki w danych uzupelniamy wartosci 'Yes'
rowery[is.na(rowery$marital_status), "marital_status"] <- "Married" #53,9% klientow posiada meza/zone, wiec braki w danych uzupelniamy wartoscia 'Married'
rowery[is.na(rowery$gender), "gender"] <- "Male" #50,6% klientow to mezczyzni, wiec braki w danych uzupelniamy wartoscia 'Male'
view(dfSummary(rowery)) #Wywolujemy tabelke podsumowujaca nasze dane. Widzimy, ze wszystkie dane zostaly uzupelnione.## Switching method to 'browser'## Output file written: C:\Users\macie\AppData\Local\Temp\RtmpaU9INy\file33f8684933e7.htmlunique(rowery$home_owner)## [1] "Yes" "No"Dwie kategorie dla zmiennej home_owner- tak i nie
unique(rowery$marital_status)## [1] "Married" "Single"Dwie kategorie dla zmiennej marital_status- zamężny i singiel
unique(rowery$gender) ## [1] "Female" "Male"Dwie kategorie dla zmiennej gender- kobieta i mężczyzna
mice_plot <-aggr(rowery, col=c('navyblue', 'yellow'),numbers=TRUE, sortVars=TRUE, labels=names(rowery), cex.axis=7, ylab=c("Histogram of missing data","Pattern"))
##
## Variables sorted by number of missings:
## Variable Count
## id 0
## marital_status 0
## gender 0
## income 0
## children 0
## education 0
## occupation 0
## home_owner 0
## cars 0
## commute_distance 0
## region 0
## age 0
## purchased_bike 0Wykres obrazujacy braki danych ### 3. Obserwacje odstające
Sprawdzanie zbioru danych pod kątem wartości odstających jest kluczowe dla utrzymania jakości analizy danych i poprawnego zrozumienia badanego zjawiska. W przypadku identyfikacji wartości odstających, istnieją różne metody ich obsługi, takie jak usuwanie, transformacja, czy stosowanie bardziej zaawansowanych technik modelowania. Przechodzimy więc do sprawdzenia naszego zbioru danych pod względem występowania wartości odstających.
1. Zlokalizowanie wartości odstających
Możemy przykładowo stworzyć funkcję, która będzie wykrywać obserwacje odstające.
find_outliers <- function(rowery, k = 1.5) {
quantiles <- quantile(rowery, c(0.25, 0.5, 0.75))
diff <- k * (quantiles[3] - quantiles[1])
lb <- quantiles[1] - diff
ub <- quantiles[3] + diff
is_outlier <- function(el) {
el < lb || ub < el
}}Z pomocą funkcji ‘boxplot.stats’ możemy wyświetlić, które wartości są odstające. Widzimy, że mamy aż 10 wartości odstających dla zmiennej ‘income’.
out <-boxplot.stats(rowery$income)$out
out## [1] 160000 170000 170000 150000 160000 150000 160000 150000 170000 150000Możemy również skorzystać z testów statystycznych.
test <- grubbs.test(rowery$income)
test ##
## Grubbs test for one outlier
##
## data: rowery$income
## G = 3.67182, U = 0.98649, p-value = 0.1151
## alternative hypothesis: highest value 170000 is an outlierTest Grubba’a potwierdza, że najwyższa wartośc 170 000 jest odstająca.
test1 <- grubbs.test(rowery$income, opposite = TRUE)
test1 ##
## Grubbs test for one outlier
##
## data: rowery$income
## G = 1.49374, U = 0.99776, p-value = 1
## alternative hypothesis: lowest value 10000 is an outlierNajmniejsza wartość nie jest odstająca.
Zwizualizujmy teraz wartości odstające na wykresie wraz z opisem, które z nich są odstające.
boxplot(rowery$income, col = "blue",
ylab = "income",
main = "Boxplot of income")
mtext(paste("Outliers: ", paste(out, collapse = ", ")))
Sprawdźmy jeszcze występowanie wartości odstających dla zmiennej ‘age’.
boxplot.stats(rowery$age)$out## [1] 78 89 80 78Mamy 4 wartosci odstające dla age.
test <- grubbs.test(rowery$age)
test##
## Grubbs test for one outlier
##
## data: rowery$age
## G = 3.96061, U = 0.98428, p-value = 0.03514
## alternative hypothesis: highest value 89 is an outlierTest potwierdza, że najwyższa wartość 89 jest odstająca.
2. Przekształcenie wartości odstających
Zdecydowano się przekształcić wartości odstające dla zmiennych “age” i “income” za pomocą metody capping. Metoda capping polega na ustaleniu górnej (max) i dolnej (min) granicy wartości dla danej zmiennej, a następnie przypisanie wszystkim wartościom przekraczającym te granice wartości skrajnych.
qnt <- quantile(rowery$income, probs=c(.25, .75), na.rm = T)
caps <- quantile(rowery$income, probs=c(.05, .95), na.rm = T)
H <- 1.5 * IQR(rowery$income, na.rm = T)
rowery$income[rowery$income < (qnt[1] - H)] <- caps[1]
rowery$income[rowery$income > (qnt[2] + H)] <- caps[2]
boxplot.stats(rowery$income)$out## numeric(0)Brak wartości odstających dla income.
qnt <- quantile(rowery$age, probs=c(.25, .75), na.rm = T)
caps <- quantile(rowery$age, probs=c(.05, .95), na.rm = T)
H <- 1.5 * IQR(rowery$age, na.rm = T)
rowery$age[rowery$age < (qnt[1] - H)] <- caps[1]
rowery$age[rowery$age > (qnt[2] + H)] <- caps[2]
boxplot.stats(rowery$age)$out## numeric(0)Brak wartości odstających dla age.
Dzięki procesowi czyszczenia danych osiągnięto spójność w zbiorze danych. Brakujące wartości zostały uzupełnione, a błędy zostały skorygowane, co pozwali teraz na bardziej precyzyjną analizę.
II ETAP-WIZUALIZACJE
Wizualizacje stanowią potężne narzędzie w każdym projekcie, wspomagają efektywną komunikację, lepsze zrozumienie danych oraz sprzyjają szybszemu i bardziej kreatywnemu podejmowaniu decyzji.Poniżej przedstawiono kilka ciekawych wizualizacji dla analizowanego zbioru danych.
1.Średni dochód w zależności od wieku i płci
Prezentowany wykres składa się z dwóch paneli, z których lewy reprezentuje dane dotyczące kobiet, natomiast prawy mężczyzn. Na obu panelach zaznaczone są czerwone punkty, odzwierciedlające empiryczne dane dotyczące średnich dochodów w poszczególnych grupach wiekowych. Linie trendu w kolorze niebieskim zostały dopasowane do punktów, ukazując ogólny trend wzrostu średnich dochodów w miarę postępującego wieku. Warto zauważyć, że panel mężczyzn charakteryzuje się większym zróżnicowaniem (różnicą) średnich dochodów, jednocześnie prezentując wyższą średnią wartość dochodu. Dodatkowo, dla mężczyzn zauważalny jest silniejszy trend wzrostu średniego dochodu wraz z wiekiem. To sugeruje, że w miarę upływu lat różnice w dochodach między różnymi grupami wiekowymi mężczyzn mogą się nasilać, tworząc bardziej zauważalne tendencje wzrostowe.
dw1<-rowery%>%
group_by(age, gender)%>%
summarize(meaninc=mean(income))## `summarise()` has grouped output by 'age'. You can override using the `.groups`
## argument.ggplot(dw1, aes(age, meaninc))+
geom_line()+
geom_point(colour="red")+
facet_wrap(~gender)+
labs(x="Wiek", y="Średnie dochody")
ggplot(dw1, aes(age, meaninc))+
geom_line()+
geom_point(colour="red")+
facet_wrap(~gender)+labs(x="Wiek", y="Średnie dochody")+geom_smooth(method="lm")+ggtitle("Średni dochód w zależności od wieku oraz płci")## `geom_smooth()` using formula = 'y ~ x'
2. Występowanie obserwacji o określonym wieku i dochodzie
Na ponizszym wykresie przedstawiony został wykres punktowy. Każdy punkt na wykresie reprezentuje jeden przypadek. Wielkość punktu z kolei odpowiada częstości występowania obserwacji o określonym wieku i poziomie dochodów.Analizując wykres można stwierdzić, że większość obserwacji skupia się w przedziale wiekowym 30-60 lat i niższym przedziale dochodowym.
ggplot(rowery, aes(age, income))+
stat_sum(alpha=0.4)+
scale_size(range=c(1,5))+
ggtitle("Występowanie obserwacji o określonym wieku oraz poziomie dochodów")+labs(x="Wiek", y="Dochód", size="Występowanie")
3. Ilość posidanych samochodów w zależności od regionu
Na poniższym wykresie pokazany jest stosunek liczby posiadanych samochodów w gospodarstwie domowym ze względu na region z którego pochodzą klienci sklepu rowerowego. Rzuca sie w oczy fakt, że w Ameryce Północnej zdecydowanie najwięcej osób posiada 2 samochody.Region ten posiada również największy odsetek gospodarstw domowych z jednym samochodem. Najwięcej klientów nieposiadających samochodu zamieszkuje Europę- około 120.Jeśli chodzi o Pacyfik to jest tam najmniejszy odsetek gospodarstw bez samochodu, ponieważ tylko około 20. Ten region charakteryzyje się też najmniejszą dysproporcją jeżeli chodzi o liczbę samochodów.
ggplot(rowery, aes(x=cars, fill=region))+
geom_bar(position="dodge")+
labs(x="Ilość posiadanych samochodów", y="Występowanie", fill="Region")
4.Zagęszczenie obserwacji o określonym wieku w zależności od regionu
Poniższy wykres przedstawia rozkład wieku dla trzech różnych regionów: Europy, Ameryki Półnicnej i Pacyfiku. Oś pozioma (x) reprezentuje wiek, a oś pionowa (y) reprezentuje zagęszczenie, czyli estymowaną gęstość prawdopodobieństwa obserwacji w każdym punkcie osi wieku. W Europie największe zagęszczenie obserwacji występuje wśród osób w średnim wieku, z szczytem około 40 lat. Dla Ameryki Północnej rozkład wieku jest szerszy, z szczytem około 50 lat. Region Pacyfiku wydaje się mieć najszerszy rozkład wieku z największym zagęszczeniem wśród osób w wieku około 30 lat i stopniowym spadkiem w kierunku wyższych grup wiekowych. Rozkład wieku w Europie jest bardziej szpiczasty i mniej rozproszony niż w Ameryce Północnej, co może sugerować mniejszą różnorodność wieku w tym regionie. Linie obrysujące każdą z krzywych gęstości dają wyobrażenie o kształcie rozkładu dla każdego regionu, pozwalając dostrzec, gdzie znajdują się największe skupiska obserwacji.
ggplot(rowery, aes(age, fill=region))+
geom_density(alpha=0.25)+
labs(x="Wiek",y="Zagęszczenie", fill="Region")+
ggtitle("Zagęszczenie obserwacji o określonym poziomie wieku w zależności od regionu")
5. Obserwacje o określonym poziomie dochodów w zależności od rodzaju zawodu
Na przedstawionym wykresie można zauważyć, że dochody poszczególnych grup zawodowych są znacznie zróżnicowane. Pracownicy fizyczni najczęściej osiągają najniższe wynagrodzenia, podczas gdy pracownicy biurowi zarabiają nieco więcej. Wykwalifikowani pracownicy fizyczni cieszą się średnimi dochodami, a pracownicy profesjonalni oraz ci na stanowiskach kierowniczych osiągają najwyższe wynagrodzenia.
ggplot(rowery, aes(income, fill=occupation))+
geom_histogram(bins=20, color='black')+
facet_wrap(~occupation, nrow=5)+
labs(x="Dochód", y="Występowanie", fill="Praca")+
theme(legend.position = 'none')+
ggtitle("Wystepowanie obserwacji o określonym poziomie dochodów w zależności od rodzaju zawodu")
6. Wizualizacja poziomu dochodu w zależności od płci
Wykres poniżej pokazuje medianę dochodu, a także jego maksymalny, minimalny i średni poziom w zależności od płci.Mediana i średnie dochody są przedstawione na podobnym poziomie dla obu płci, z lekkim przesunięciem w kierunku wyższych wartości dla mężczyzn. Rozstęp dochodów, czyli różnica między kwartylem górnym a dolnym, również wydaje się być podobny dla obu grup.
ggplot(rowery, aes(income, fill=occupation))+
geom_histogram(bins=20)+
facet_wrap(~occupation, nrow=5)+
labs(x="Dochód", y="Występowanie", fill="Praca")+
theme(legend.position = 'none')
ggplot(rowery, aes(gender, income))+
geom_boxplot(aes(fill=gender))+
stat_boxplot(geom="errorbar",position="dodge")+
stat_summary(aes(ymin=after_stat(y),ymax=after_stat(y)),fun=mean)+ggtitle("Mediana dochodów, maksymalny, minimalny oraz średni dochód w zależności od płci")+theme(legend.position='none')
7. Ilość posiadanych samochodów w zależności od posiadania roweru
Wykres poniżej może sugerować, że osoby posidające rower mają tendencję do posiadania mniej samochodów niż osoby, które roweru nie posiadają.
ggplot(rowery, aes(occupation, fill=occupation))+geom_bar()+facet_wrap(~education, nrow=5)+labs(x="Zatrudnienie", y="Występowanie")+theme(legend.position= 'none')
ggplot(rowery, aes(cars, fill=purchased_bike))+geom_histogram(bins=5, position="dodge", color='black')+facet_wrap(~purchased_bike)+theme(legend.position='none')+labs(x="Ilość posiadanych samochodów", y="Występowanie")+ggtitle("Ilość posiadanych samochodów w zależności od posiadania roweru")
8. Występowanie obserwacji o poszczególnym rodzaju wykonywanej pracy według wykształcenia
Poniższy rysunek przedstawia występowanie obserwacji o poszczególnym rodzaju wykonywanej pracy według wykształcenia. Najwięcej osób z wykształceniem licencjackim pracuje na stanowisku kierownicznym albo jako profesjonalista. Natomiast najmniej na stanowisku urzędniczym.Jeśli chodzi o osoby z wykształceniem wyższym to także najwięcej osób pracuje na stanowisku kierowniczym (ok. 60 obserwacji). Najmniej osób pracuje na stanowisku pracy fizycznej (ok. 10 obserwacji). Spoglądając na osoby z wykształceniem licealnym to największa ich liczba jest zatrudniona na stanowisku fachowego pracownika fizycznego, jako profesjonalista i pracownik fizyczny (odpowiednio ok. 60, 50 i 40 obserwacji). Natomiast najmniej osób z tym wykształceniem jest zatrudnionych jako menedżer lub pracownik biurowy (ok. 10 i 5 obserwacji). Analizując rodzaj wykonywanej pracy przez osoby z nieskończonymi studiami wyższymi to można zauważyć, iż największy udział pracujących to profesjonaliści (ok. 60 obserwacji), a najmniejszy dotyczy menedżerów (ok. 5 obserwacji). Analizując ostatnią kategorię wykształcenia, zaobserwowano tutaj najmniejszą liczbę obserwacji. Najwięcej osób z wykształceniem niepełnym licealnym jest zatrudnionych jako pracownik manualny (ok. 30 obsrwacji), a najmniej ponieważ 0 na stanowisku menedżera.
ggplot(rowery, aes(marital_status, age))+
geom_boxplot(aes(fill=marital_status))+
stat_boxplot(geom="errorbar", position="dodge")+
stat_summary(aes(ymin=..y..,ymax=..y..), fun=mean)
ggplot(rowery, aes(occupation, fill=occupation))+
geom_bar(color='black')+
facet_wrap(~education, nrow=5)+
labs(x="Zatrudnienie", y="Występowanie")+
theme(legend.position= 'none')+
ggtitle("Występowanie obserwacji o poszczególnym rodzaju wykonywanej pracy według wykształcenia")
9. Średni dochód według wykształcenia oraz rodzaju pracy
Mapa cieplna jest pomocna w szybkim zrozumieniu, jak różne kombinacje wykształcenia i zawodu wpływają na dochód, gdzie ciemniejsze kolory wskazją na wyższe dochody, a jaśniejsze na niższe. Kategoria ‘Management’ wydaje się oferować najwyższe dochody niezależnie od poziomu wykształcenia. Z kolei prace biurowe i prace fizyczne mają tendencję do przynoszenia niższych dochodów.
ggplot(rowery, aes(occupation, education, fill=income))+
geom_tile(color='black')+
scale_fill_gradient2(low="white", mid="yellow", high="red")+
ggtitle("Średni dochód według wykształcenia oraz rodzaju pracy")+labs(x="Zawód", y="Wykształcenie", fill="Dochód")
10. Analiza wieku według stanu cywilnego
Z wykresu można zauważyć, że mediany wieku dla obu grup są różne-dla osób zamężnych/żonatych jest wyższa niż dla osób stanu wolnego. Średni wiek w obu grupach wydaje się zbliżony do mediany, ale nieznacznie wyższy u mężczyzn.
ggplot(rowery, aes(gender, income)) +
geom_boxplot(aes(fill=gender))+
stat_boxplot(geom="errorbar", position="dodge")+stat_summary(aes(ymin=..y..,ymax=..y..),fun=mean)
ggplot(rowery, aes(marital_status, age))+
geom_boxplot(aes(fill=marital_status))+
stat_boxplot(geom="errorbar", position="dodge")+
stat_summary(aes(ymin=..y..,ymax=..y..), fun=mean)+
labs(x="Stan cywilny", y="Wiek")+
theme(legend.position='none')+
ggtitle("Mediana, maksimum, minimum oraz średnia wieku według stanu cywilnego")
###11. Stan cywilny oraz region
Zdecydowanie najwięcej osób zamężnych wśród klientów sklepu rowerowego występowało w Ameryce Północnej. W Europie oraz Pacyfiku występuje niemal identyczna ilość zarówno singli jak i osób po ślubie.
ggplot(rowery, aes(marital_status, fill=marital_status))+
geom_bar(position="dodge")+
facet_wrap(~region)+
theme(legend.position='none')+
labs(x="Stan cywilny", y="Ilość")+
ggtitle("Ilość osób o poszczególnym stanie cywilnym w zależności od regionu")
III ETAP-ANALIZA OPISOWA
Analiza opisowa jest nieodzownym elementem każdego projektu. Dostarcza podstawowych informacji, które stanowią punkt wyjścia do bardziej zaawansowanych analiz statystycznych i pomagają zrozumieć istotę danych.
1. Tabele liczebności
W pierwszym etapie naszej analizy pogrupujemy nasze dane w postaci prostej tabeli częstości.Napotykamy tutaj jednak pewne problemy. Przykładowo zmienna ‘income’ jest zmienną ciągłą. Dokonamy więc diskretyzacji danych-przekształcimy zmienną ciągłą na zmienną dyskretną poprzez podział zakresu wartości na przedziały.
1.Zmienna ciągła ‘income’
etykiety1<-c("0-25 000", "25 000-50 000", "50 000-75 000", "75 000-100 000", "100 000-125 000", "125 000-150 000")
limits1<-cut(rowery$income,seq(0,150000,by=25000),labels=etykiety1)
tabela2<-freq(limits1,type="html")
tabela2## Frequencies
## limits1
## Type: Factor
##
## Freq % Valid % Valid Cum. % Total % Total Cum.
## --------------------- ------ --------- -------------- --------- --------------
## 0-25 000 147 14.70 14.70 14.70 14.70
## 25 000-50 000 327 32.70 47.40 32.70 47.40
## 50 000-75 000 294 29.40 76.80 29.40 76.80
## 75 000-100 000 157 15.70 92.50 15.70 92.50
## 100 000-125 000 43 4.30 96.80 4.30 96.80
## 125 000-150 000 32 3.20 100.00 3.20 100.00
## <NA> 0 0.00 100.00
## Total 1000 100.00 100.00 100.00 100.00tab1<-classIntervals(rowery$income,n=6,style="fixed",fixedBreaks=seq(0,150000,by=25000))
tab1## style: fixed
## one of 1,287 possible partitions of this variable into 6 classes
## [0,25000) [25000,50000) [50000,75000) [75000,1e+05) [1e+05,125000)
## 147 287 334 128 72
## [125000,150000]
## 32jenks.tests(tab1)## # classes Goodness of fit Tabular accuracy
## 6.0000000 0.9624556 0.7887639Wizualizacja:
hist(rowery$income, breaks="FD", col="green", probability = TRUE,
main="INCOME")
Wskaźnik TAI jest dosyć wysoki, wiec możemy zaakceptować konstrukcję tabeli częstości.
2. Zmienna dyskretna ‘age’
etykiety<-c("20-30 lat","30-40 lat","40-50 lat","50-60 lat","60-70 lat","70-80 lat")
limits<-cut(rowery$age,seq(20,80,by=10),labels=etykiety)
tabela1<-freq(limits,type="html")
tabela1## Frequencies
## limits
## Type: Factor
##
## Freq % Valid % Valid Cum. % Total % Total Cum.
## --------------- ------ --------- -------------- --------- --------------
## 20-30 lat 108 10.80 10.80 10.80 10.80
## 30-40 lat 313 31.30 42.10 31.30 42.10
## 40-50 lat 305 30.50 72.60 30.50 72.60
## 50-60 lat 174 17.40 90.00 17.40 90.00
## 60-70 lat 93 9.30 99.30 9.30 99.30
## 70-80 lat 7 0.70 100.00 0.70 100.00
## <NA> 0 0.00 100.00
## Total 1000 100.00 100.00 100.00 100.00tab2<-classIntervals(rowery$age,n=6,style="fixed",fixedBreaks=seq(20,80,by=10))
tab2## style: fixed
## one of 2,118,760 possible partitions of this variable into 6 classes
## [20,30) [30,40) [40,50) [50,60) [60,70) [70,80]
## 82 299 322 183 103 11jenks.tests(tab2)## # classes Goodness of fit Tabular accuracy
## 6.0000000 0.9412382 0.7494848Wizualizacja:
ggplot(rowery, aes(x = age)) +
geom_histogram(binwidth = 2, fill = "blue", color = "red", alpha = 0.8) +
labs(title = "Age Distribution", x = "Age", y = "Frequency")
Wskaźnik TAI jest dosyć wysoki, więc możemy zaakceptować konstrukcję tabeli częstości.
3. Pozostałe tabele liczebności
Education:
ggplot(rowery, aes(x = factor(education), fill = factor(education))) +
geom_bar() +
labs(title = "Education Distribution", x = "Education Level", y = "Count") +
theme_minimal()
Region:
ggplot(rowery, aes(x = factor(region), fill = factor(region))) +
geom_bar() +
labs(title = "Region Distribution", x = "Region", y = "Count") +
theme_minimal()
Liczebność pozostałych zmiennych: (zarówno liczbową, jak i procentową możemy odczytać z tabelki)
dfSummary(rowery)## Data Frame Summary
## rowery
## Dimensions: 1000 x 13
## Duplicates: 0
##
## -------------------------------------------------------------------------------------------------------------------------
## No Variable Stats / Values Freqs (% of Valid) Graph Valid Missing
## ---- ------------------ ------------------------------- ---------------------- --------------------- ---------- ---------
## 1 id Mean (sd) : 19966 (5347.3) 1000 distinct values : . . . 1000 0
## [numeric] min < med < max: : : : : : : : : : : (100.0%) (0.0%)
## 11000 < 19744 < 29447 : : : : : : : : : :
## IQR (CV) : 9180 (0.3) : : : : : : : : : :
## : : : : : : : : : :
##
## 2 marital_status 1. Married 542 (54.2%) IIIIIIIIII 1000 0
## [character] 2. Single 458 (45.8%) IIIIIIIII (100.0%) (0.0%)
##
## 3 gender 1. Female 489 (48.9%) IIIIIIIII 1000 0
## [character] 2. Male 511 (51.1%) IIIIIIIIII (100.0%) (0.0%)
##
## 4 income Mean (sd) : 55877.6 (29892.9) 14 distinct values : 1000 0
## [numeric] min < med < max: : (100.0%) (0.0%)
## 10000 < 60000 < 130000 . . . :
## IQR (CV) : 40000 (0.5) : : : : .
## : : : : : : . . . :
##
## 5 children Mean (sd) : 1.9 (1.6) 0 : 274 (27.4%) IIIII 1000 0
## [numeric] min < med < max: 1 : 169 (16.9%) III (100.0%) (0.0%)
## 0 < 2 < 5 2 : 217 (21.7%) IIII
## IQR (CV) : 3 (0.8) 3 : 133 (13.3%) II
## 4 : 126 (12.6%) II
## 5 : 81 ( 8.1%) I
##
## 6 education 1. Bachelors 306 (30.6%) IIIIII 1000 0
## [character] 2. Graduate Degree 174 (17.4%) III (100.0%) (0.0%)
## 3. High School 179 (17.9%) III
## 4. Partial College 265 (26.5%) IIIII
## 5. Partial High School 76 ( 7.6%) I
##
## 7 occupation 1. Clerical 177 (17.7%) III 1000 0
## [character] 2. Management 173 (17.3%) III (100.0%) (0.0%)
## 3. Manual 119 (11.9%) II
## 4. Professional 276 (27.6%) IIIII
## 5. Skilled Manual 255 (25.5%) IIIII
##
## 8 home_owner 1. No 314 (31.4%) IIIIII 1000 0
## [character] 2. Yes 686 (68.6%) IIIIIIIIIIIII (100.0%) (0.0%)
##
## 9 cars Mean (sd) : 1.5 (1.1) 0 : 238 (23.8%) IIII 1000 0
## [numeric] min < med < max: 1 : 276 (27.6%) IIIII (100.0%) (0.0%)
## 0 < 1 < 4 2 : 342 (34.2%) IIIIII
## IQR (CV) : 1 (0.8) 3 : 85 ( 8.5%) I
## 4 : 59 ( 5.9%) I
##
## 10 commute_distance 1. 0-1 Miles 366 (36.6%) IIIIIII 1000 0
## [character] 2. 1-2 Miles 169 (16.9%) III (100.0%) (0.0%)
## 3. 10+ Miles 111 (11.1%) II
## 4. 2-5 Miles 162 (16.2%) III
## 5. 5-10 Miles 192 (19.2%) III
##
## 11 region 1. Europe 300 (30.0%) IIIIII 1000 0
## [character] 2. North America 508 (50.8%) IIIIIIIIII (100.0%) (0.0%)
## 3. Pacific 192 (19.2%) III
##
## 12 age Mean (sd) : 44.1 (11.1) 51 distinct values . : . 1000 0
## [numeric] min < med < max: : : : : (100.0%) (0.0%)
## 25 < 43 < 74 . : : : : :
## IQR (CV) : 17 (0.3) : : : : : : : . .
## : : : : : : : : : .
##
## 13 purchased_bike 1. No 519 (51.9%) IIIIIIIIII 1000 0
## [character] 2. Yes 481 (48.1%) IIIIIIIII (100.0%) (0.0%)
## -------------------------------------------------------------------------------------------------------------------------2. Podstawowe statystyki opisowe
Kolejnym etapem będzie przedstawienie podstawowych statystyk opisowych dla zmiennych ilościowych za pomocą zbiorczej tabelki.
descr(rowery)## Non-numerical variable(s) ignored: marital_status, gender, education, occupation, home_owner, commute_distance, region, purchased_bike## Descriptive Statistics
## rowery
## N: 1000
##
## age cars children id income
## ----------------- --------- --------- ---------- ---------- -----------
## Mean 44.12 1.45 1.91 19965.99 55877.61
## Std.Dev 11.15 1.12 1.62 5347.33 29892.86
## Min 25.00 0.00 0.00 11000.00 10000.00
## Q1 35.00 1.00 0.00 15289.50 30000.00
## Median 43.00 1.00 2.00 19744.00 60000.00
## Q3 52.00 2.00 3.00 24475.50 70000.00
## Max 74.00 4.00 5.00 29447.00 130000.00
## MAD 11.86 1.48 1.48 6848.13 29652.00
## IQR 17.00 1.00 3.00 9180.00 40000.00
## CV 0.25 0.77 0.85 0.27 0.53
## Skewness 0.44 0.43 0.39 0.05 0.56
## SE.Skewness 0.08 0.08 0.08 0.08 0.08
## Kurtosis -0.55 -0.39 -1.01 -1.19 -0.15
## N.Valid 1000.00 1000.00 1000.00 1000.00 1000.00
## Pct.Valid 100.00 100.00 100.00 100.00 100.003. Korelacja
Poniżej przedstawiona została korelacja pomiędzy zmiennymi ilościowymi.
cor((rowery[,c(4,5,9,12)]), method="pearson")## income children cars age
## income 1.0000000 0.2647358 0.4313941 0.1747145
## children 0.2647358 1.0000000 0.2753641 0.5328957
## cars 0.4313941 0.2753641 1.0000000 0.1895145
## age 0.1747145 0.5328957 0.1895145 1.0000000corrplot(cor(rowery[,c(4,5,9,12)]), method = "number", type = "upper", diag =FALSE)
corr_matrix<-cor(rowery[,c(4,5,9,12)])
corrplot(corr_matrix, method="color")
IV ETAP- WNIOSKOWANIE STATYSTYCZNE
Testowanie hipotez opiera się na założeniu pewnych warunków w populacji, a następnie analizie próby w celu zweryfikowania, czy dane założenie jest prawdziwe. Statystyki testowe i wartości p-value dostarczają nam narzędzi do dokładnego zrozumienia, czy obserwowane różnice między grupami czy parametrami są statystycznie istotne. Jako poziom istotności przyjęto wartość 0.05.
1. Pytania badawcze
- Czy wartość dochodu jest zależna od regionu?
- Czy poziom wykształcenia na wpływ na poziom dochodu?
- Czy w małżeństwach rodzi się wiecej dzieci?
- Czy mężczyźni więcej zarabiają?
- Czy osoby, które nie posiadają samochodu częściej kupują rowery?
- Czy osoby, które posiadają domy częściej kupują rowery?
1. pytanie badawcze
Dla zmiennych ,region’ i ‘income’ zastosowano polecenie ggbetweenstats, adekwatne dla porównywania zmiennej jakościowej z ilościową. Na podstawie wartości p-value można stwierdzić, źe dochód istotnie różni się w zależności od regionu.
ggbetweenstats(rowery, region, income)+ggtitle("Średni dochód w zależności od regionu")+labs(x="Region", y="Dochód")
2. pytanie badawcze
Dla zmiennych ‘home_owner’ i ‘occupation’ zastosowano funkcję ggbarstats, odpowiednią w przypadku porównywania ze sobą dwóch zmiennych jakościowych. Na podstawie wartości p-value można stwierdzić, że odsetek populacji posiadającej własny dom bądź mieszkanie istotnie różni się w zależności od rodzaju wykonywanej pracy.
ggbarstats(rowery, home_owner, occupation)+ggtitle("Posiadanie domu w zależności od rodzaju wykonywanej pracy")+labs(x="Zawód", y="Odsetek", fill="Posiadanie domu")
3. pytanie badawcze
Na podstawie wartości p-value można stwierdzić, że średnia liczba posiadanych samochodów jest istotnie niższa wśród osób posiadających rower.
ggbetweenstats(rowery, purchased_bike, cars)+ggtitle("Ilość posiadanych samochodów w zależności od posiadania roweru")+labs(x="Posiadanie roweru", y="Ilość posiadanych samochodów")
4. pytanie badawcze
Na podstawie otrzymanych wartości p-value można przyjąć, że średnie dochody istotnie różnią się w zależności od poziomu wykształcenia.
ggbetweenstats(rowery, education, income)+ggtitle("Średnie dochody w zależności od poziomu wykształcenia")+labs(x="Wykształcenie", y="Dochody")
5. pytanie badawcze
Na podstawie wartości p-value dotyczącej całości obserwacji można przyjąć, że liczba posiadanych dzieci istotnie różni się w zależności od stanu cywilnego ankietowanej jednostki. Jednak przy analizie obserwacji dotyczącej wyłącznie osób posiadających dwójkę bądź trójkę dzieci, relacji pomiędzy liczbą dzieci, a stanem cywilnym nie można uznać za istotną z uwagi na wartość p-value przekraczającą przyjęty poziom istotności wynoszący 0.05.
ggpiestats(rowery, marital_status, children)+ggtitle("Ilość posiadanych dzieci w zależności od stanu cywilnego")
2. Model logitowy
Dla zmiennej ‘purchased_bike’ postanowiono stworzyć model logitowy, który ma za zadanie sprawdzić, jaki wpływ mają poszczególne zmienne na fakt, że klient zdecydował się na kupno roweru. Zmienna ‘purchased_bike’ jest jakościowa i przyjmuje dwie kategorie ‘Yes’ oraz ‘No’. Za pomocą model.matrix zmienna ta została przekodowana tak, aby miała postać binarną, czyli przyjmowała tylko dwie wartości 0 dla ‘No’ i 1 dla ‘Yes’. Zmienne o największej wartości p-value były stopniowo usuwane z początkowego modelu zgodnie z metodą a posteriori, tak, aby otrzymać ostateczny model końcowy- model7.
encoded_data <- model.matrix(~purchased_bike - 1, data = rowery)
model= glm(encoded_data ~ gender + marital_status + region + cars + income + age + occupation + education + home_owner + commute_distance, family = binomial, data=rowery)
summary(model)##
## Call:
## glm(formula = encoded_data ~ gender + marital_status + region +
## cars + income + age + occupation + education + home_owner +
## commute_distance, family = binomial, data = rowery)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.703e-02 4.452e-01 0.106 0.915874
## genderMale -1.226e-02 1.374e-01 -0.089 0.928917
## marital_statusSingle -6.247e-01 1.531e-01 -4.080 4.50e-05 ***
## regionNorth America 1.529e-01 2.136e-01 0.716 0.474025
## regionPacific -8.040e-01 2.412e-01 -3.333 0.000860 ***
## cars 4.778e-01 8.914e-02 5.360 8.31e-08 ***
## income -1.360e-05 4.189e-06 -3.246 0.001170 **
## age 5.482e-03 7.140e-03 0.768 0.442646
## occupationManagement 2.600e-01 4.152e-01 0.626 0.531141
## occupationManual 5.634e-02 2.850e-01 0.198 0.843298
## occupationProfessional -2.836e-01 3.296e-01 -0.861 0.389481
## occupationSkilled Manual 1.409e-01 2.668e-01 0.528 0.597499
## educationGraduate Degree 3.562e-01 2.198e-01 1.620 0.105157
## educationHigh School -1.371e-01 2.468e-01 -0.556 0.578415
## educationPartial College 2.646e-01 2.133e-01 1.241 0.214739
## educationPartial High School 5.272e-01 3.584e-01 1.471 0.141218
## home_ownerYes -2.592e-01 1.644e-01 -1.577 0.114883
## commute_distance1-2 Miles 1.307e-01 2.107e-01 0.620 0.535288
## commute_distance10+ Miles 1.059e+00 2.909e-01 3.641 0.000272 ***
## commute_distance2-5 Miles -1.406e-02 2.145e-01 -0.066 0.947737
## commute_distance5-10 Miles 6.088e-01 2.399e-01 2.538 0.011150 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1384.9 on 999 degrees of freedom
## Residual deviance: 1246.9 on 979 degrees of freedom
## AIC: 1288.9
##
## Number of Fisher Scoring iterations: 4Kolejno zgodnie z metoda a posteriori usuniete zostaly zmienne: commute_distance, gender, occupation, education, home_owner.
Ostateczna postać modelu:
model7= glm(encoded_data ~ marital_status + cars + income + age, family = binomial, data=rowery)
summary(model7)##
## Call:
## glm(formula = encoded_data ~ marital_status + cars + income +
## age, family = binomial, data = rowery)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.274e-01 3.033e-01 -0.750 0.453550
## marital_statusSingle -4.999e-01 1.367e-01 -3.657 0.000255 ***
## cars 5.112e-01 6.888e-02 7.422 1.16e-13 ***
## income -1.300e-05 2.547e-06 -5.107 3.28e-07 ***
## age 1.182e-02 6.205e-03 1.906 0.056694 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1384.9 on 999 degrees of freedom
## Residual deviance: 1302.4 on 995 degrees of freedom
## AIC: 1312.4
##
## Number of Fisher Scoring iterations: 4Liczymy iloraz szans, aby otrzymać wartości do interpretacji
OR=exp(model7$coefficients)
OR## (Intercept) marital_statusSingle cars
## 0.7966333 0.6065888 1.6673378
## income age
## 0.9999870 1.0118945INTERPRETACJE: Jeżeli klient sklepu rowerowego jest singlem, to szanse na to, że kupi on rower maleją o około 40%. Jeżeli klient posiada samochód, to szanse na to, że kupi rower wzrastają o około 67%. Wraz ze wzrostem wieku o 1 rok, szanse na to, że klient kupi rower wzrastają o około 1,19%.