Piraci-z-Zatoki: Analiza Sklepu Rowerowego

Wstęp

Klienci sklepu rowerowego wzięli udział w ankiecie, w której dostarczyli szczegółowych informacji na swój temat, takich jak: status cywilny, płeć, poziom dochodów, liczba dzieci, poziom wykształcenia, wykonywany zawód, status posiadania domu, liczba samochodów, odległość do miejsca pracy, region zamieszkania oraz wiek.

Celem analizy jest określenie, które z tych czynników mają największy wpływ na decyzję o zakupie roweru.

W pierwszym etapie projektu przeprowadzono instalajcę oraz załadowanie pakietów niezbędnych do analizy danych.

Podstawowa analiza

head(sklep_rowerowy)

##      ID Marital.Status Gender Income Children       Education     Occupation
## 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         70000        0       Bachelors   Professional
## 5 25597         Single   Male  30000        0       Bachelors       Clerical
## 6 13507        Married Female  10000        2 Partial College         Manual
##   Home.Owner Cars Commute.Distance  Region Age Purchased.Bike
## 1        Yes    0        0-1 Miles  Europe  42             No
## 2        Yes    1        0-1 Miles  Europe  43             No
## 3         No    2        2-5 Miles  Europe  60             No
## 4        Yes    1       5-10 Miles Pacific  41            Yes
## 5         No    0        0-1 Miles  Europe  36            Yes
## 6        Yes    0        1-2 Miles  Europe  50             No

str(sklep_rowerowy)

## 'data.frame':    1000 obs. of  13 variables:
##  $ ID              : int  12496 24107 14177 24381 25597 13507 27974 19364 22155 19280 ...
##  $ Marital.Status  : chr  "Married" "Married" "Married" "Single" ...
##  $ Gender          : chr  "Female" "Male" "Male" "" ...
##  $ Income          : int  40000 30000 80000 70000 30000 10000 160000 40000 20000 NA ...
##  $ Children        : int  1 3 5 0 0 2 2 1 2 2 ...
##  $ Education       : chr  "Bachelors" "Partial College" "Partial College" "Bachelors" ...
##  $ Occupation      : chr  "Skilled Manual" "Clerical" "Professional" "Professional" ...
##  $ Home.Owner      : chr  "Yes" "Yes" "No" "Yes" ...
##  $ Cars            : int  0 1 2 1 0 0 4 0 2 1 ...
##  $ Commute.Distance: chr  "0-1 Miles" "0-1 Miles" "2-5 Miles" "5-10 Miles" ...
##  $ Region          : chr  "Europe" "Europe" "Europe" "Pacific" ...
##  $ Age             : int  42 43 60 41 36 50 33 43 58 NA ...
##  $ Purchased.Bike  : chr  "No" "No" "No" "Yes" ...

Identyfikacja braków w danych

W celu oceny kompletności zbioru danych „sklep_rowerowy” przeprowadzono analizę brakujących wartości. Wyniki wskazują, że w zestawie danych znajduje się 31 brakujących wartości. W zbiorze brakuje 0,2% wartości, w kolumnach: Income, Children, Cars, Age. Sprawdzono również rozłożenie braków w kolumnach w wartościach procentowych.

n_miss(sklep_rowerowy)

## [1] 31

vis_miss(sklep_rowerowy)

miss_var_summary(sklep_rowerowy)

## # A tibble: 13 × 3
##    variable         n_miss pct_miss
##    <chr>             <int>    <num>
##  1 Cars                  9      0.9
##  2 Children              8      0.8
##  3 Age                   8      0.8
##  4 Income                6      0.6
##  5 ID                    0      0  
##  6 Marital.Status        0      0  
##  7 Gender                0      0  
##  8 Education             0      0  
##  9 Occupation            0      0  
## 10 Home.Owner            0      0  
## 11 Commute.Distance      0      0  
## 12 Region                0      0  
## 13 Purchased.Bike        0      0

braki_procent <- sklep_rowerowy %>%
  summarise(across(everything(), ~ mean(is.na(.)) * 100)) %>%  
  pivot_longer(everything(), names_to = "Kolumna", values_to = "Procent")  
ggplot(braki_procent, aes(x = reorder(Kolumna, -Procent), y = Procent)) +  
  geom_bar(stat = "identity", fill = "steelblue") +
  coord_flip() +
  labs(title = "Procent brakujących danych w kolumnach",
       x = "Kolumna", y = "% braków") +
  theme_minimal()

## Przypisywanie zmiennych typu factor

W celu poprawności analiz dokonano konwersji wybranych kolumn na zmienne kategoryczne (factor), obejmujących m.in. stan cywilny, płeć, wykształcenie, zawód, status własności nieruchomości, dystans do pracy, region oraz decyzję o zakupie roweru. Przekształcenie to umożliwia poprawne traktowanie danych przez R jako nominalne lub porządkowe, co jest istotne dla analiz statystycznych, modeli predykcyjnych oraz wizualizacji.

sklep_rowerowy <- sklep_rowerowy %>%
  mutate(
    `Marital.Status` = na_if(`Marital.Status`, ""),
    Gender = na_if(Gender, ""),
    `Home.Owner` = na_if(`Home.Owner`, ""),
    `Marital.Status` = factor(`Marital.Status`),
    Gender = factor(Gender),
    Education = factor(Education),
    Occupation = factor(Occupation),
    `Home.Owner` = factor(`Home.Owner`),
    `Commute.Distance` = factor(`Commute.Distance`),
    Region = factor(Region),
    `Purchased.Bike` = factor(`Purchased.Bike`)
  )

Imputacja Danych

W celu uzupełnienia brakujących wartości w zbiorze “sklep_rowerowy” zastosowano średnią adaptacyjną do zmiennych liczbowych oraz metodę Predictive Mean Matching (pmm) dla zmiennych kategorycznych. Imputacja pozwoliła na eliminację braków danych, co zwiększa kompletność i wiarygodność zbioru, umożliwiając dokładniejsze analizy. Dzięki tym metodom zachowano strukturę danych, minimalizując wpływ braków na wyniki statystyczne i modele predykcyjne. Wizualizacja potwierdza, że po imputacji wszystkie kolumny są w pełni uzupełnione (0% braków).

sklep_rowerowy <- sklep_rowerowy %>%
mutate(across(where(is.numeric), ~ ifelse(is.na(.), mean(., na.rm = TRUE, trim = 0.1), .)))

imputed_data <- mice(sklep_rowerowy, m = 5, method = 'pmm', seed = 123)

## 
##  iter imp variable
##   1   1  Marital.Status  Gender  Home.Owner
##   1   2  Marital.Status  Gender  Home.Owner
##   1   3  Marital.Status  Gender  Home.Owner
##   1   4  Marital.Status  Gender  Home.Owner
##   1   5  Marital.Status  Gender  Home.Owner
##   2   1  Marital.Status  Gender  Home.Owner
##   2   2  Marital.Status  Gender  Home.Owner
##   2   3  Marital.Status  Gender  Home.Owner
##   2   4  Marital.Status  Gender  Home.Owner
##   2   5  Marital.Status  Gender  Home.Owner
##   3   1  Marital.Status  Gender  Home.Owner
##   3   2  Marital.Status  Gender  Home.Owner
##   3   3  Marital.Status  Gender  Home.Owner
##   3   4  Marital.Status  Gender  Home.Owner
##   3   5  Marital.Status  Gender  Home.Owner
##   4   1  Marital.Status  Gender  Home.Owner
##   4   2  Marital.Status  Gender  Home.Owner
##   4   3  Marital.Status  Gender  Home.Owner
##   4   4  Marital.Status  Gender  Home.Owner
##   4   5  Marital.Status  Gender  Home.Owner
##   5   1  Marital.Status  Gender  Home.Owner
##   5   2  Marital.Status  Gender  Home.Owner
##   5   3  Marital.Status  Gender  Home.Owner
##   5   4  Marital.Status  Gender  Home.Owner
##   5   5  Marital.Status  Gender  Home.Owner

sklep_rowerowy <- complete(imputed_data)

n_miss(sklep_rowerowy)

## [1] 0

vis_miss(sklep_rowerowy) + labs(title = "Braki danych po imputacji")

Wizualizacje

Rozkład zmiennych liczbowych i kategorycznych - Przeanalizowano rozkład zmiennych liczbowych oraz kategorycznych w zbiorze “sklep_rowerowy”. Histogramy przedstawiają rozkład wartości w zmiennych takich jak wiek (Age), liczba samochodów (Cars), liczba dzieci (Children), dochód (Income), ukazując różnorodność danych i potencjalne odstępstwa. Wykresy kategorii pokazują liczbę obserwacji dla zmiennych takich jak płeć, wykształcenie, region oraz status zakupu roweru.
Czynniki wpływające na zakup roweru - Dane wskazują na zróżnicowanie decyzji zakupowych w zależności od regionu, gdzie w Ameryce Północnej zakupów jest najwięcej, a w regionie Pacyfiku najmniej. Istotnym czynnikiem jest także dystans do pracy, gdzie osoby mieszkające bliżej miejsca pracy (0-1 mil) częściej decydują się na zakup roweru.
Dochód klientów a zakup roweru - Analiza dochodów pokazuje, że większość klientów ma dochody w przedziale 25 000 - 75 000, przy czym nie ma wyraźnej różnicy w zakupach rowerów w zależności od dochodu. Wykres pudełkowy dochodów w regionach wskazuje, że najwyższe zarobki występują w regionie Pacyfiku, a najniższe w Europie.
Korelacje między zmiennymi - Macierz korelacji wykazuje, że najwyższa zależność występuje między liczbą dzieci a dochodem (0,53) oraz liczbą samochodów a dochodem (0,43). Sugeruje to, że dochód jest kluczowym czynnikiem wpływającym na styl życia klientów

sklep_rowerowy %>%
select(where(is.numeric)) %>%
pivot_longer(everything()) %>%
ggplot(aes(x = value)) +
geom_histogram(bins = 30, fill = "skyblue", color = "black") +
facet_wrap(~ name, scales = "free") +
labs(title = "Rozkład zmiennych liczbowych", x = "Wartość", y = "Częstość") +
theme_minimal()

sklep_rowerowy %>%
select(where(is.factor)) %>%
pivot_longer(everything()) %>%
ggplot(aes(x = value)) +
geom_bar(fill = "steelblue") +
facet_wrap(~ name, scales = "free") +
labs(title = "Rozkład zmiennych kategorycznych", x = "Kategorie", y = "Liczba obserwacji") +
theme_minimal()

  ggplot(sklep_rowerowy, aes(x = Region, fill = Purchased.Bike)) +
    geom_bar(position = "dodge") +
    labs(title = "Zakup rowerów względem regionu",
         x = "Region",
         y = "Liczba zakupów",
         fill = "Zakup roweru (No = 0, Yes = 1)") +
    theme_minimal()

ggplot(sklep_rowerowy, aes(x = Commute.Distance, fill = Purchased.Bike)) +
  geom_bar(position = "dodge") +
  labs(title = "Zakup rowerów względem przejechanych kilometrów",
       x = "Dystans dojazdu do pracy",
       y = "Liczba zakupów",
       fill = "Zakup roweru (No = 0, Yes = 1)") +
  theme_minimal()

ggplot(sklep_rowerowy, aes(x = Income, fill = Purchased.Bike)) +
  geom_histogram(position = "dodge", bins = 30, alpha = 0.7) +
  labs(title = "Dochód klientów względem zakupu roweru",
       x = "Dochód",
       y = "Liczba klientów",
       fill = "Zakup roweru (No = 0, Yes = 1)") +
  theme_minimal()

ggplot(sklep_rowerowy, aes(x = Region, y = Income, fill = Region)) +
  geom_boxplot() +
  labs(title = "Dochód klientów w różnych regionach",
       x = "Region",
       y = "Dochód") +
  theme_minimal()

cor_matrix <- cor(sklep_rowerowy %>% select(where(is.numeric)), use = "complete.obs")
ggcorrplot(cor_matrix, hc.order = TRUE, type = "lower", lab = TRUE)

Model drzewa decyzyjnego

Budowa modelu W celu przewidywania zakupu roweru zbudowano model drzewa decyzyjnego, wykorzystując dane treningowe stanowiące 70% zbioru, a pozostałe 30% jako zbiór testowy. Model został wytrenowany na podstawie zmiennych niezależnych, a następnie zwizualizowany, co umożliwia interpretację kluczowych czynników wpływających na zakup roweru.
Wyniki predykcji Macierz pomyłek pokazuje, że model poprawnie sklasyfikował 102 przypadki braku zakupu oraz 77 przypadków zakupu, jednak 71 osób, które nie kupiły roweru, zostało błędnie zaklasyfikowanych jako kupujący, a 50 osób, które dokonały zakupu, zostały zaklasyfikowane jako niekupujący.
Dokładność modelu Uzyskana dokładność modelu wynosi 59,67%, co sugeruje umiarkowaną skuteczność klasyfikacji. Wynik ten może wskazywać na potrzebę optymalizacji modelu, np. poprzez pruning drzewa, zastosowanie innych metod klasyfikacyjnych lub inżynierię cech w celu zwiększenia jego predykcyjnej wartości.

set.seed(123)
train_index <- sample(seq_len(nrow(sklep_rowerowy)), size = 0.7 * nrow(sklep_rowerowy))
train_data <- sklep_rowerowy[train_index, ]
test_data <- sklep_rowerowy[-train_index, ]

tree_model <- rpart(`Purchased.Bike` ~ ., data = train_data, method = "class")
tree_model

## n= 700 
## 
## node), split, n, loss, yval, (yprob)
##       * denotes terminal node
## 
##   1) root 700 333 No (0.52428571 0.47571429)  
##     2) Cars>=1.184741 337 121 No (0.64094955 0.35905045)  
##       4) ID>=18668.5 195  56 No (0.71282051 0.28717949) *
##       5) ID< 18668.5 142  65 No (0.54225352 0.45774648)  
##        10) Children>=4.5 25   6 No (0.76000000 0.24000000) *
##        11) Children< 4.5 117  58 Yes (0.49572650 0.50427350)  
##          22) Occupation=Clerical,Management 37  11 No (0.70270270 0.29729730) *
##          23) Occupation=Manual,Professional,Skilled Manual 80  32 Yes (0.40000000 0.60000000) *
##     3) Cars< 1.184741 363 151 Yes (0.41597796 0.58402204)  
##       6) ID< 17728 140  61 No (0.56428571 0.43571429)  
##        12) Occupation=Management,Manual,Skilled Manual 74  22 No (0.70270270 0.29729730) *
##        13) Occupation=Clerical,Professional 66  27 Yes (0.40909091 0.59090909)  
##          26) Age< 33.5 10   2 No (0.80000000 0.20000000) *
##          27) Age>=33.5 56  19 Yes (0.33928571 0.66071429)  
##            54) Age>=54.5 8   2 No (0.75000000 0.25000000) *
##            55) Age< 54.5 48  13 Yes (0.27083333 0.72916667) *
##       7) ID>=17728 223  72 Yes (0.32286996 0.67713004)  
##        14) Age< 31.5 30  11 No (0.63333333 0.36666667)  
##          28) Region=Europe,North America 22   3 No (0.86363636 0.13636364) *
##          29) Region=Pacific 8   0 Yes (0.00000000 1.00000000) *
##        15) Age>=31.5 193  53 Yes (0.27461140 0.72538860)  
##          30) Age>=39.5 110  49 Yes (0.44545455 0.55454545)  
##            60) Commute.Distance=10+ Miles 7   0 No (1.00000000 0.00000000) *
##            61) Commute.Distance=0-1 Miles,1-2 Miles,2-5 Miles,5-10 Miles 103  42 Yes (0.40776699 0.59223301)  
##             122) ID< 21870.5 43  20 No (0.53488372 0.46511628)  
##               244) Income>=65000 10   1 No (0.90000000 0.10000000) *
##               245) Income< 65000 33  14 Yes (0.42424242 0.57575758) *
##             123) ID>=21870.5 60  19 Yes (0.31666667 0.68333333) *
##          31) Age< 39.5 83   4 Yes (0.04819277 0.95180723) *

rpart.plot(tree_model, type = 4, extra = 104, fallen.leaves = TRUE, 
           box.palette = "RdBu", shadow.col = "gray", nn = TRUE )

tree_predictions <- predict(tree_model, test_data, type = "class")

conf_matrix <- table(Predicted = tree_predictions, Actual = test_data$`Purchased.Bike`)
conf_matrix

##          Actual
## Predicted No Yes
##       No  98  71
##       Yes 54  77

accuracy <- mean(tree_predictions == test_data$`Purchased.Bike`)
cat("Dokładność modelu drzewa decyzyjnego:", round(accuracy * 100, 2), "%\n")

## Dokładność modelu drzewa decyzyjnego: 58.33 %

Segmentacja klientów (Klasteryzacja K-średnich) dla osób które kupiły rower ze względu na dane numeryczne

Przeprowadzono segmentację klientów, którzy kupili rower, wykorzystując metodę K-średnich na podstawie numerycznych cech. Dane zostały standaryzowane, a optymalną liczbę klastrów określono metodą WSS (Elbow Method). Klasteryzacja podzieliła klientów na trzy grupy, co wizualizacja przedstawia jako odrębne segmenty. Analiza ta pozwala lepiej zrozumieć różnice między kupującymi oraz identyfikować ich charakterystyczne cechy, co może być użyteczne w strategiach marketingowych i sprzedażowych.

bike_buyers <- sklep_rowerowy %>% filter(Purchased.Bike == "Yes")

cluster_data <- bike_buyers %>% select(where(is.numeric))
cluster_data_scaled <- scale(cluster_data)

fviz_nbclust(cluster_data_scaled, kmeans, method = "wss")

set.seed(123)
kmeans_model <- kmeans(cluster_data_scaled, centers = 3, nstart = 25)

fviz_cluster(kmeans_model, data = cluster_data_scaled, geom = "point") +
  labs(title = "Segmentacja klientów - Klasteryzacja K-średnich (Kupujący rowery)")

Test Shapiro-Wilka dla dochodu a zakupu roweru

Pomaga określić, czy stosować testy parametryczne czy nieparametryczne. Hipotezy testowe: H₀ (hipoteza zerowa): Dane mają rozkład normalny. H₁ (hipoteza alternatywna): Dane nie mają rozkładu normalnego.

by(sklep_rowerowy$Income, sklep_rowerowy$`Purchased.Bike`, shapiro.test)

## sklep_rowerowy$Purchased.Bike: No
## 
##  Shapiro-Wilk normality test
## 
## data:  dd[x, ]
## W = 0.94371, p-value = 3.956e-13
## 
## ------------------------------------------------------------ 
## sklep_rowerowy$Purchased.Bike: Yes
## 
##  Shapiro-Wilk normality test
## 
## data:  dd[x, ]
## W = 0.94003, p-value = 5.172e-13

Przy poziomie istotności 95% bardzo niskie wartości p-value (< 0.05) oznaczają, że istnieją statystyczne przesłanki do odrzucenia hipotezy zerowej na rzecz hipotezy alternatywnej, co wskazuje, że dane nie mają rozkładu normalnego.Należy zastosować testy nieprarametryczne.

Chi2 dla region a zakup roweru

Test chi-kwadrat dla zakupu roweru i regionu (p = 0.001032) wykazał istotną zależność, co oznacza, że miejsce zamieszkania wpływa na decyzję o zakupie. Niektóre regiony wykazują większą skłonność do kupowania rowerów niż inne

chi_Region <- chisq.test(table(sklep_rowerowy$`Purchased.Bike`, sklep_rowerowy$Region))
print(chi_Region)

## 
##  Pearson's Chi-squared test
## 
## data:  table(sklep_rowerowy$Purchased.Bike, sklep_rowerowy$Region)
## X-squared = 13.752, df = 2, p-value = 0.001032

Chi2 dla dystans do pracy a zakup roweru

Testy chi-kwadrat wykazały istotne zależności między zakupem roweru a regionem (p = 0.001032) oraz dystansem dojazdu (p = 5.852e-07). Oznacza to, że miejsce zamieszkania i odległość do pracy wpływają na decyzję o zakupie roweru – osoby mieszkające bliżej pracy częściej go wybierają.

chi_Distance <- chisq.test(table(sklep_rowerowy$`Purchased.Bike`, sklep_rowerowy$Commute.Distance))
print(chi_Distance)

## 
##  Pearson's Chi-squared test
## 
## data:  table(sklep_rowerowy$Purchased.Bike, sklep_rowerowy$Commute.Distance)
## X-squared = 34.512, df = 4, p-value = 5.852e-07

Test Kruskala-Wallisa dla zakupu roweru a dochodu

kruskal_test_income_purchasedbike <- kruskal.test(Income ~ `Purchased.Bike`, data = sklep_rowerowy)
kruskal_test_income_purchasedbike

## 
##  Kruskal-Wallis rank sum test
## 
## data:  Income by Purchased.Bike
## Kruskal-Wallis chi-squared = 2.2551, df = 1, p-value = 0.1332

Powiązanie testów z analizą klientów

- Test Shapiro-Wilka: Wyniki testu wykazały, że dochód nie ma rozkładu normalnego zarówno w grupie kupujących, jak i niekupujących roweru (p < 0,05). Wskazuje to, że w dalszej analizie należy stosować testy nieparametryczne (np. Kruskala-Wallisa) zamiast testów parametrycznych (np. ANOVA).

- Test Kruskala-Wallisa: Wynik testu (p = 0.1274) wskazuje, że dochód nie różni się istotnie między osobami, które kupiły rower, a tymi, które go nie kupiły. Oznacza to, że dochód nie jest kluczowym czynnikiem decyzyjnym przy zakupie roweru – inne aspekty, takie jak region zamieszkania, dystans do pracy czy styl życia, mogą mieć większe znaczenie.

Test Kruskala- Wallisa dla zakupu roweru a regionu

kruskal_test_Region_purchasedbike <- kruskal.test(Region ~ `Purchased.Bike`, data = sklep_rowerowy)
kruskal_test_Region_purchasedbike

## 
##  Kruskal-Wallis rank sum test
## 
## data:  Region by Purchased.Bike
## Kruskal-Wallis chi-squared = 1.89, df = 1, p-value = 0.1692

Test Kruskala - Wallisa dla zakupu roweru a dystans do pracy

kruskal_test_Commute_Distance_purchasedbike <- kruskal.test(`Commute.Distance` ~ `Purchased.Bike`, data = sklep_rowerowy)
print(kruskal_test_Commute_Distance_purchasedbike)

## 
##  Kruskal-Wallis rank sum test
## 
## data:  Commute.Distance by Purchased.Bike
## Kruskal-Wallis chi-squared = 7.3539, df = 1, p-value = 0.006692

Analiza wyniku testu Kruskala-Wallisa dla dystansu do pracy a zakupu roweru

Przeprowadzony test Kruskala-Wallisa wykazał istotne statystycznie różnice w dystansie do pracy między osobami, które kupiły rower, a tymi, które go nie kupiły (p = 0.0067). Oznacza to, że dystans do pracy jest kluczowym czynnikiem wpływającym na decyzję zakupową, co potwierdzają wcześniejsze wizualizacje. Wynik sugeruje, że osoby pokonujące określone odległości częściej decydują się na zakup roweru, dlatego warto skupić się na segmentacji klientów według dystansu i dostosowaniu strategii marketingowych do tej grupy.

Statystyki opisowe dla zmiennych liczbowych

W analizowanym zbiorze danych kluczowe zmienne liczbowe obejmują m.in. dochód klientów (Income) oraz dystans dojazdu do pracy. Obliczamy podstawowe statystyki, takie jak: - Średnia arytmetyczna (mean) – określa przeciętną wartość danej cechy, - Mediana (median) – wartość środkowa, mniej podatna na wartości odstające, - Odchylenie standardowe (sd) – określa zmienność w ramach danej zmiennej

sklep_rowerowy %>% summarise(across(where(is.numeric), list(
  mean = ~mean(.x, na.rm = TRUE),
  median = ~median(.x, na.rm = TRUE),
  sd = ~sd(.x, na.rm = TRUE)
)))

##    ID_mean ID_median    ID_sd Income_mean Income_median Income_sd Children_mean
## 1 19965.99     19744 5347.334    56252.09         60000  30975.03      1.909287
##   Children_median Children_sd Cars_mean Cars_median Cars_sd Age_mean Age_median
## 1               2    1.620421  1.454325           1 1.11672 44.17587         43
##     Age_sd
## 1 11.31659

Statystyki opisowe dla zmiennych kategorycznych

Analizujemy również zmienne kategoryczne, takie jak region zamieszkania (Region), poziom wykształcenia (Education) czy czy klient kupił rower (Purchased.Bike). Dla tych zmiennych tworzymy tabelę liczebności, aby zidentyfikować dominujące grupy klientów.

sklep_rowerowy %>% summarise(across(where(is.factor), ~list(table(.))))

##   Marital.Status   Gender              Education              Occupation
## 1       538, 462 494, 506 306, 174, 179, 265, 76 177, 173, 119, 276, 255
##   Home.Owner        Commute.Distance        Region Purchased.Bike
## 1   316, 684 366, 169, 111, 162, 192 300, 508, 192       519, 481

table(sklep_rowerowy$Marital.Status)

## 
## Married  Single 
##     538     462

table(sklep_rowerowy$Gender)

## 
## Female   Male 
##    494    506

table(sklep_rowerowy$Education)

## 
##           Bachelors     Graduate Degree         High School     Partial College 
##                 306                 174                 179                 265 
## Partial High School 
##                  76

table(sklep_rowerowy$Occupation)

## 
##       Clerical     Management         Manual   Professional Skilled Manual 
##            177            173            119            276            255

table(sklep_rowerowy$Home.Owner)

## 
##  No Yes 
## 316 684

table(sklep_rowerowy$Commute.Distance)

## 
##  0-1 Miles  1-2 Miles  10+ Miles  2-5 Miles 5-10 Miles 
##        366        169        111        162        192

table(sklep_rowerowy$Region)

## 
##        Europe North America       Pacific 
##           300           508           192

Podsumowanie statystyk opisowych

Kluczowe statystyki opisowe: Dochód (Income): Średnia wynosi 56 252,1 z dużym rozrzutem (od 10 000 do 170 000). Wiek (Age): Średnia wynosi 44,2, a mediana 43 lata, z minimalnym wiekiem 25 lat i maksymalnym 89 lat. Liczba dzieci (Children): Średnia 1.9, przy wartości od 0 do 5. Liczba samochodów (Cars): Średnia 1.5, większość osób posiada od 0 do 2 pojazdów.
Struktura demograficzna i społeczna: Płeć (Gender): Kobiety i mężczyźni są prawie równomiernie podzieleni (49,4% vs. 50,6%). Stan cywilny (Marital Status): 53,8% osób jest w związku małżeńskim, a 46,2% to osoby samotne. Wykształcenie (Education): Najwięcej osób ma stopień licencjata (30,6%), a najmniej niepełne wykształcenie średnie (7,6%). Status własności nieruchomości (Home Owner): 68,4% klientów posiada własne mieszkanie lub dom.
Charakterystyka transportu: Dystans do pracy (Commute Distance): Najwięcej osób dojeżdża 0-1 mili (36,6%), podczas gdy najrzadziej spotykany dystans to 10+ mil (11,1%). Region zamieszkania (Region): 30% klientów pochodzi z Europy, 50,8% z Ameryki Północnej, a 19,2% z regionu Pacyfiku.
Decyzja o zakupie roweru: 51,9% klientów nie kupiło roweru, a 48,1% zdecydowało się na zakup. Wnioski: Z analizy wynika, że dochody są zróżnicowane, a większość klientów mieszka blisko miejsca pracy. Własność nieruchomości i liczba samochodów mogą wpływać na decyzję o zakupie roweru, natomiast region zamieszkania wydaje się mniej istotny.

library(summarytools)
dfSummary(sklep_rowerowy) %>% print(method = "render", style = "grid")

Data Frame Summary

sklep_rowerowy

Dimensions: 1000 x 13
Duplicates: 0

Variable

Stats / Values

Freqs (% of Valid)

Graph

Valid

Missing

ID [integer]

Mean (sd) : 19966 (5347.3)

min ≤ med ≤ max:

11000 ≤ 19744 ≤ 29447

IQR (CV) : 9180 (0.3)

1000 distinct values

1000 (100.0%)

0 (0.0%)

Marital.Status [factor]

1. Married

2. Single

538	(	53.8%	)
462	(	46.2%	)

1000 (100.0%)

0 (0.0%)

Gender [factor]

1. Female

2. Male

494	(	49.4%	)
506	(	50.6%	)

1000 (100.0%)

0 (0.0%)

Income [numeric]

Mean (sd) : 56252.1 (30975)

min ≤ med ≤ max:

10000 ≤ 60000 ≤ 170000

IQR (CV) : 40000 (0.6)

17 distinct values

1000 (100.0%)

0 (0.0%)

Children [numeric]

Mean (sd) : 1.9 (1.6)

min ≤ med ≤ max:

0 ≤ 2 ≤ 5

IQR (CV) : 3 (0.8)

0.00	:	274	(	27.4%	)
1.00	:	169	(	16.9%	)
1.79 !	:	8	(	0.8%	)
2.00	:	209	(	20.9%	)
3.00	:	133	(	13.3%	)
4.00	:	126	(	12.6%	)
5.00	:	81	(	8.1%	)
! rounded

1000 (100.0%)

0 (0.0%)

Education [factor]

1. Bachelors

2. Graduate Degree

3. High School

4. Partial College

5. Partial High School

306	(	30.6%	)
174	(	17.4%	)
179	(	17.9%	)
265	(	26.5%	)
76	(	7.6%	)

1000 (100.0%)

0 (0.0%)

Occupation [factor]

1. Clerical

2. Management

3. Manual

4. Professional

5. Skilled Manual

177	(	17.7%	)
173	(	17.3%	)
119	(	11.9%	)
276	(	27.6%	)
255	(	25.5%	)

1000 (100.0%)

0 (0.0%)

Home.Owner [factor]

1. No

2. Yes

316	(	31.6%	)
684	(	68.4%	)

1000 (100.0%)

0 (0.0%)

Cars [numeric]

Mean (sd) : 1.5 (1.1)

min ≤ med ≤ max:

0 ≤ 1 ≤ 4

IQR (CV) : 1 (0.8)

0.00	:	238	(	23.8%	)
1.00	:	267	(	26.7%	)
1.37 !	:	9	(	0.9%	)
2.00	:	342	(	34.2%	)
3.00	:	85	(	8.5%	)
4.00	:	59	(	5.9%	)
! rounded

1000 (100.0%)

0 (0.0%)

Commute.Distance [factor]

1. 0-1 Miles

2. 1-2 Miles

3. 10+ Miles

4. 2-5 Miles

5. 5-10 Miles

366	(	36.6%	)
169	(	16.9%	)
111	(	11.1%	)
162	(	16.2%	)
192	(	19.2%	)

1000 (100.0%)

0 (0.0%)

Region [factor]

1. Europe

2. North America

3. Pacific

300	(	30.0%	)
508	(	50.8%	)
192	(	19.2%	)

1000 (100.0%)

0 (0.0%)

Age [numeric]

Mean (sd) : 44.2 (11.3)

min ≤ med ≤ max:

25 ≤ 43 ≤ 89

IQR (CV) : 17 (0.3)

54 distinct values

1000 (100.0%)

0 (0.0%)

Purchased.Bike [factor]

1. No

2. Yes

519	(	51.9%	)
481	(	48.1%	)

1000 (100.0%)

0 (0.0%)

Generated by summarytools 1.0.1 (R version 4.4.2)
2025-02-03

Wizualizacja danych

# Filtrujemy dane tylko dla klientów, którzy kupili rower
sklep_rowerowy_yes <- sklep_rowerowy %>% filter(Purchased.Bike == "Yes")

# Wizualizacja wieku dla klientów, którzy kupili rower
ggbetweenstats(
  data = sklep_rowerowy_yes,
  x = Purchased.Bike,
  y = Age,
  type = "nonparametric",
  title = "Wiek klientów, którzy kupili rower",
  xlab = "Zakup roweru (Yes)",
  ylab = "Wiek"
)

# Wizualizacja dochodu dla klientów, którzy kupili rower
ggbetweenstats(
  data = sklep_rowerowy_yes,
  x = Purchased.Bike,
  y = Income,
  type = "nonparametric",
  title = "Dochód klientów, którzy kupili rower",
  xlab = "Zakup roweru (Yes)",
  ylab = "Dochód"
)

Podsumowanie

Z przeprowadzonej analizy wynika iż głównymi powodami zakupu rowerów jest (Commute.Distance) trasa do pokonania do pracy, oraz wiek i region.

Z przeprowadzonych testów Kruskala-Wallisa znaleziono zależność miedzy trasą do pokonania a zakupem roweru, wykazały istotnie statystyczne różnice w dystansie do pracy miedzy osobami ktore kupiły rower a osobami które go nie kupiły. Oznacza to że dystans do pracy jest kluczowym czynnikiem wpływającym na zakup roweru. Im mniejsza odległość do pracy tym chętniej kupujemy rower.

W ramach analizy statystycznej przeprowadzono również segmentację klientów na podstawie profilu klientów, co pozwoliło zidentyfikować różne grupy konsumentów.

Podsumowując, wyniki analizy wskazują na dużą koncentrację klientów w określonych grupach wiekowych oraz o dużej zależności miedzy odległością do pracy a zakupem roweru. Przeprowadzone analizy pozwalają na lepsze zrozumienie potrzeb klientów, co może przyczynić się do poprawy efektywności działań marketingowych i sprzedażowych sklepu rowerowego.

Analiza Sklepu Rowerowego

Jagoda Chęcińska, Piotr Łukowski, Tomasz Kotliński

2025-02-03

Piraci-z-Zatoki: Analiza Sklepu Rowerowego

Wstęp

Podstawowa analiza

Identyfikacja braków w danych

Imputacja Danych

Wizualizacje

Model drzewa decyzyjnego

Segmentacja klientów (Klasteryzacja K-średnich) dla osób które kupiły rower ze względu na dane numeryczne

Test Shapiro-Wilka dla dochodu a zakupu roweru

Chi2 dla region a zakup roweru

Chi2 dla dystans do pracy a zakup roweru

Test Kruskala-Wallisa dla zakupu roweru a dochodu

Powiązanie testów z analizą klientów

Test Kruskala- Wallisa dla zakupu roweru a regionu

Test Kruskala - Wallisa dla zakupu roweru a dystans do pracy

Analiza wyniku testu Kruskala-Wallisa dla dystansu do pracy a zakupu roweru

Statystyki opisowe dla zmiennych liczbowych

Statystyki opisowe dla zmiennych kategorycznych

Podsumowanie statystyk opisowych

Data Frame Summary

sklep_rowerowy

Wizualizacja danych

Podsumowanie