Ten projekt analizuje dane sklepu rowerowego, aby: uzupełnić brakujące dane, przeprowadzić wizualizacje danych.

Import danych

library(readr)
dane <- read_csv("sklep_rowerowy.csv")

## Rows: 1000 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (8): Marital Status, Gender, Education, Occupation, Home Owner, Commute ...
## dbl (5): ID, Income, Children, Cars, Age
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

head(dane)

## # 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>

str(dane)

## spc_tbl_ [1,000 × 13] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ ID              : num [1:1000] 12496 24107 14177 24381 25597 ...
##  $ Marital Status  : chr [1:1000] "Married" "Married" "Married" "Single" ...
##  $ Gender          : chr [1:1000] "Female" "Male" "Male" NA ...
##  $ Income          : num [1:1000] 40000 30000 80000 70000 30000 10000 160000 40000 20000 NA ...
##  $ Children        : num [1:1000] 1 3 5 0 0 2 2 1 2 2 ...
##  $ Education       : chr [1:1000] "Bachelors" "Partial College" "Partial College" "Bachelors" ...
##  $ Occupation      : chr [1:1000] "Skilled Manual" "Clerical" "Professional" "Professional" ...
##  $ Home Owner      : chr [1:1000] "Yes" "Yes" "No" "Yes" ...
##  $ Cars            : num [1:1000] 0 1 2 1 0 0 4 0 2 1 ...
##  $ Commute Distance: chr [1:1000] "0-1 Miles" "0-1 Miles" "2-5 Miles" "5-10 Miles" ...
##  $ Region          : chr [1:1000] "Europe" "Europe" "Europe" "Pacific" ...
##  $ Age             : num [1:1000] 42 43 60 41 36 50 33 43 58 NA ...
##  $ Purchased Bike  : chr [1:1000] "No" "No" "No" "Yes" ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   ID = col_double(),
##   ..   `Marital Status` = col_character(),
##   ..   Gender = col_character(),
##   ..   Income = col_double(),
##   ..   Children = col_double(),
##   ..   Education = col_character(),
##   ..   Occupation = col_character(),
##   ..   `Home Owner` = col_character(),
##   ..   Cars = col_double(),
##   ..   `Commute Distance` = col_character(),
##   ..   Region = col_character(),
##   ..   Age = col_double(),
##   ..   `Purchased Bike` = col_character()
##   .. )
##  - attr(*, "problems")=<externalptr>

# Definiowanie zmiennych
categorical_vars <- c("Purchased Bike", "Marital Status")
numerical_vars <- c("Income", "Age")

Ustawienie poziomów dla zmiennych kategorycznych

W tej sekcji ustawiamy poziomy dla zmiennych kategorycznych, aby były bardziej czytelne i zgodne z oczekiwaniami analizy. Marital Status: Przyjmie wartości Married lub Single. Gender: Przyjmie wartości Male lub Female. Home Owner: Przyjmie wartości Yes lub No.

# Ustawienie poziomów dla zmiennych kategorycznych
levels(dane$`Marital Status`) <- c("Married", "Single")
levels(dane$`Gender`) <- c("Male", "Female")
levels(dane$`Home Owner`) <- c("No", "Yes")

# Sprawdzenie struktury danych po modyfikacji
str(dane)

## spc_tbl_ [1,000 × 13] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ ID              : num [1:1000] 12496 24107 14177 24381 25597 ...
##  $ Marital Status  : chr [1:1000] "Married" "Married" "Married" "Single" ...
##   ..- attr(*, "levels")= chr [1:2] "Married" "Single"
##  $ Gender          : chr [1:1000] "Female" "Male" "Male" NA ...
##   ..- attr(*, "levels")= chr [1:2] "Male" "Female"
##  $ Income          : num [1:1000] 40000 30000 80000 70000 30000 10000 160000 40000 20000 NA ...
##  $ Children        : num [1:1000] 1 3 5 0 0 2 2 1 2 2 ...
##  $ Education       : chr [1:1000] "Bachelors" "Partial College" "Partial College" "Bachelors" ...
##  $ Occupation      : chr [1:1000] "Skilled Manual" "Clerical" "Professional" "Professional" ...
##  $ Home Owner      : chr [1:1000] "Yes" "Yes" "No" "Yes" ...
##   ..- attr(*, "levels")= chr [1:2] "No" "Yes"
##  $ Cars            : num [1:1000] 0 1 2 1 0 0 4 0 2 1 ...
##  $ Commute Distance: chr [1:1000] "0-1 Miles" "0-1 Miles" "2-5 Miles" "5-10 Miles" ...
##  $ Region          : chr [1:1000] "Europe" "Europe" "Europe" "Pacific" ...
##  $ Age             : num [1:1000] 42 43 60 41 36 50 33 43 58 NA ...
##  $ Purchased Bike  : chr [1:1000] "No" "No" "No" "Yes" ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   ID = col_double(),
##   ..   `Marital Status` = col_character(),
##   ..   Gender = col_character(),
##   ..   Income = col_double(),
##   ..   Children = col_double(),
##   ..   Education = col_character(),
##   ..   Occupation = col_character(),
##   ..   `Home Owner` = col_character(),
##   ..   Cars = col_double(),
##   ..   `Commute Distance` = col_character(),
##   ..   Region = col_character(),
##   ..   Age = col_double(),
##   ..   `Purchased Bike` = col_character()
##   .. )
##  - attr(*, "problems")=<externalptr>

Analiza braków danych

W tej sekcji analizujemy braki danych w zbiorze, wykorzystując wizualizacje i podsumowania. 1. Wizualizacja braków danych: Funkcja vis_miss() z pakietu naniar pokazuje, które dane są brakujące w każdej kolumnie. 2. Podsumowanie braków: Funkcja miss_var_summary() dostarcza liczbowego podsumowania brakujących wartości. 3. Klasteryzacja braków: Użycie klasteryzacji, aby sprawdzić, czy braki w kolumnach są ze sobą powiązane. 4. Eksport wyników: Wyniki są zapisane do zmiennej brak_summary oraz wyświetlane w konsoli i w zakładce Viewer.

# Wizualizacja braków danych
vis_miss(dane)

# Podsumowanie braków w każdej kolumnie
miss_var_summary(dane)

## # A tibble: 13 × 3
##    variable         n_miss pct_miss
##    <chr>             <int>    <num>
##  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      0

vis_miss(dane, cluster = TRUE)  # Klasteryzacja braków, aby znaleźć powiązania między kolumnami

brak_summary <- miss_var_summary(dane)
print(brak_summary)

## # A tibble: 13 × 3
##    variable         n_miss pct_miss
##    <chr>             <int>    <num>
##  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      0

View(brak_summary)  # Otwiera podsumowanie w zakładce Viewer w RStudio
# Liczba braków dla każdej kolumny
na_counts <- miss_var_summary(dane)
print(na_counts)

## # A tibble: 13 × 3
##    variable         n_miss pct_miss
##    <chr>             <int>    <num>
##  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      0

Obliczanie unikatowych wartości w każdej kolumnie

Poniższy fragment kodu tworzy ramkę danych unique_value, która zawiera liczbę unikatowych wartości w każdej kolumnie ramki danych dane, gdzie zawarte są informacje na temat sklepu rowerowego.

unique_value <- data.frame(liczba_unikatowych_wartosci = sapply(dane, n_distinct))
print(unique_value)

##                  liczba_unikatowych_wartosci
## ID                                      1000
## Marital Status                             3
## Gender                                     3
## Income                                    17
## Children                                   7
## Education                                  5
## Occupation                                 5
## Home Owner                                 3
## Cars                                       6
## Commute Distance                           5
## Region                                     3
## Age                                       54
## Purchased Bike                             2

Przekształcanie zmiennych kategorycznych

W tej sekcji przekształcamy wybrane zmienne kategoryczne na typ factor. Dzięki temu możliwe jest prawidłowe wykorzystanie tych zmiennych w późniejszych etapach analizy.

table_with_na <- function(column) {
  tab <- table(column, useNA = "ifany")  # Uwzględnienie braków danych
  prop <- prop.table(tab) * 100  # Proporcje w procentach
  data.frame(Odpowiedzi = names(tab), Liczba_Obserwacji = as.vector(tab), Proporcje = as.vector(prop))
}

dane <- dane %>%
  mutate(
    `Marital Status` = as.factor(`Marital Status`),
    `Gender` = as.factor(`Gender`),
    `Home Owner` = as.factor(`Home Owner`)
  )

Analiza zmiennych kategorycznych

W tej sekcji obliczamy proporcje odpowiedzi dla każdej zmiennej kategorycznej w zbiorze danych.

proportions <- dane %>%
  select(where(is.factor)) %>%
  summarise(across(everything(), ~ list(table_with_na(.)))) %>%
  pivot_longer(cols = everything(), names_to = "Kategoria", values_to = "Tabela") %>%
  unnest(Tabela)

proportions %>% print(n = Inf)

## # A tibble: 9 × 4
##   Kategoria      Odpowiedzi Liczba_Obserwacji Proporcje
##   <chr>          <chr>                  <int>     <dbl>
## 1 Marital Status Married                  535      53.5
## 2 Marital Status Single                   458      45.8
## 3 Marital Status <NA>                       7       0.7
## 4 Gender         Female                   489      48.9
## 5 Gender         Male                     500      50  
## 6 Gender         <NA>                      11       1.1
## 7 Home Owner     No                       314      31.4
## 8 Home Owner     Yes                      682      68.2
## 9 Home Owner     <NA>                       4       0.4

Wizualizacja braków danych

W tej sekcji wizualizujemy liczbę brakujących wartości w każdej kolumnie danych. Dzięki temu można łatwo zobaczyć, które kolumny wymagają dalszego przetworzenia.

ggplot(na_counts, aes(x = variable, y = n_miss)) +
  geom_bar(stat = "identity") +
  labs(title = "Liczba braków danych w każdej kolumnie", x = "Kolumna", y = "Liczba braków") +
  theme_minimal()

Analiza braków w zmiennych kluczowych

W tej sekcji koncentrujemy się na zmiennych kluczowych, które mają największy wpływ na dalszą analizę: - Purchased Bike - Income - Age - Marital Status Najpierw obliczamy liczbę brakujących danych dla każdej z tych kolumn, a następnie wizualizujemy wyniki.

required_columns <- c("`Purchased Bike`", "Income", "Age", "`Marital Status`")
missing_summary <- sapply(required_columns, function(col) sum(is.na(dane[[col]])))
print(missing_summary)

## `Purchased Bike`           Income              Age `Marital Status` 
##                0                6                8                0

missing_summary_df <- data.frame(
  Zmienna = required_columns,
  Braki = sapply(required_columns, function(col) sum(is.na(dane[[col]])))
)

ggplot(missing_summary_df, aes(x = Zmienna, y = Braki)) +
  geom_bar(stat = "identity") +
  labs(title = "Liczba braków w zmiennych kluczowych", x = "Zmienna", y = "Liczba braków") +
  theme_minimal()

Konwersja wybranych kolumn na typ `factor`

W tej sekcji dokonujemy konwersji wybranych kolumn w zbiorze danych na typ factor.

factor_cols <- c("Marital Status", "Gender", "Education", "Occupation", "Home Owner", "Commute Distance", "Region", "Purchased Bike")
dane <- dane %>%
  mutate(across(all_of(factor_cols), as.factor))
# Sprawdzenie typów danych po konwersji
typy_danych <- sapply(dane, class)
print(typy_danych)

##               ID   Marital Status           Gender           Income 
##        "numeric"         "factor"         "factor"        "numeric" 
##         Children        Education       Occupation       Home Owner 
##        "numeric"         "factor"         "factor"         "factor" 
##             Cars Commute Distance           Region              Age 
##        "numeric"         "factor"         "factor"        "numeric" 
##   Purchased Bike 
##         "factor"

Uzupełnianie braków w danych

Braki danych zostały uzupełnione różnymi metodami w zależności od typu zmiennych: 1. Zmienne liczbowe: Uzupełniane za pomocą średniej adaptacyjnej. 2. Zmienne kategoryczne: Uzupełniane za pomocą dominującej wartości (moda) lub imputacji wielowymiarowej (metoda mice).

Zastępowanie braków w zmiennych liczbowych

Dla zmiennych liczbowych zastosowano średnią adaptacyjną (z obcięciem 10%) w celu uzupełnienia braków danych. Średnia adaptacyjna jest mniej podatna na wartości odstające niż standardowa średnia.

dane <- dane %>%
  mutate(
    Income = ifelse(is.na(Income), mean(Income, na.rm = TRUE, trim = 0.1), Income),
    Age = ifelse(is.na(Age), mean(Age, na.rm = TRUE, trim = 0.1), Age),
    Children = ifelse(is.na(Children), mean(Children, na.rm = TRUE, trim = 0.1), Children),
    Cars = ifelse(is.na(Cars), mean(Cars, na.rm = TRUE, trim = 0.1), Cars)
  )

Imputacja wielowymiarowa

Dla zmiennych kategorycznych przeprowadzono imputację wielowymiarową. To zaawansowane podejście opiera się na przewidywaniu brakujących wartości na podstawie podobieństwa do istniejących danych.

# Tworzenie kopii danych z poprawionymi nazwami kolumn (dla mice)
dane_mice <- dane
colnames(dane_mice) <- make.names(colnames(dane_mice))  # Zamiana spacji na kropki

# Imputacja wielowymiarowa dla zmiennych liczbowych (używając skorygowanych nazw)
imputed_data <- mice(dane_mice, 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

# Konwersja z powrotem do pełnych danych
dane <- complete(imputed_data)

# Wizualizacja imputacji
plot(imputed_data)

# Przywrócenie oryginalnych nazw kolumn
colnames(dane) <- colnames(dane)

# Sprawdzenie czy wszystko działa
print(head(dane))

##      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   Male  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

summary(dane)  # Podsumowanie danych po imputacji

##        ID        Marital.Status    Gender        Income          Children    
##  Min.   :11000   Married:538    Female:494   Min.   : 10000   Min.   :0.000  
##  1st Qu.:15291   Single :462    Male  :506   1st Qu.: 30000   1st Qu.:0.000  
##  Median :19744                               Median : 60000   Median :2.000  
##  Mean   :19966                               Mean   : 56252   Mean   :1.909  
##  3rd Qu.:24471                               3rd Qu.: 70000   3rd Qu.:3.000  
##  Max.   :29447                               Max.   :170000   Max.   :5.000  
##                Education            Occupation  Home.Owner      Cars      
##  Bachelors          :306   Clerical      :177   No :316    Min.   :0.000  
##  Graduate Degree    :174   Management    :173   Yes:684    1st Qu.:1.000  
##  High School        :179   Manual        :119              Median :1.000  
##  Partial College    :265   Professional  :276              Mean   :1.454  
##  Partial High School: 76   Skilled Manual:255              3rd Qu.:2.000  
##                                                            Max.   :4.000  
##    Commute.Distance           Region         Age        Purchased.Bike
##  0-1 Miles :366     Europe       :300   Min.   :25.00   No :519       
##  1-2 Miles :169     North America:508   1st Qu.:35.00   Yes:481       
##  10+ Miles :111     Pacific      :192   Median :43.00                 
##  2-5 Miles :162                         Mean   :44.18                 
##  5-10 Miles:192                         3rd Qu.:52.00                 
##                                         Max.   :89.00

colSums(is.na(dane))

##               ID   Marital.Status           Gender           Income 
##                0                0                0                0 
##         Children        Education       Occupation       Home.Owner 
##                0                0                0                0 
##             Cars Commute.Distance           Region              Age 
##                0                0                0                0 
##   Purchased.Bike 
##                0

Uzupełnianie braków w danych kategorycznych

# Imputacja wielowymiarowa dla zmiennych kategorycznych
categorical_vars <- gsub(" ", ".", categorical_vars)
categorical_data <- dane %>% select(all_of(categorical_vars))
imputed_data <- mice(categorical_data, m = 5, method = "logreg", seed = 123)

## 
##  iter imp variable
##   1   1
##   1   2
##   1   3
##   1   4
##   1   5
##   2   1
##   2   2
##   2   3
##   2   4
##   2   5
##   3   1
##   3   2
##   3   3
##   3   4
##   3   5
##   4   1
##   4   2
##   4   3
##   4   4
##   4   5
##   5   1
##   5   2
##   5   3
##   5   4
##   5   5

dane[categorical_vars] <- complete(imputed_data)
# Sprawdzenie braków po imputacji
colSums(is.na(dane[categorical_vars]))

## Purchased.Bike Marital.Status 
##              0              0

str(dane)

## 'data.frame':    1000 obs. of  13 variables:
##  $ ID              : num  12496 24107 14177 24381 25597 ...
##  $ Marital.Status  : Factor w/ 2 levels "Married","Single": 1 1 1 2 2 1 2 1 2 1 ...
##  $ Gender          : Factor w/ 2 levels "Female","Male": 1 2 2 2 2 1 2 2 2 2 ...
##  $ Income          : num  40000 30000 80000 70000 30000 ...
##  $ Children        : num  1 3 5 0 0 2 2 1 2 2 ...
##  $ Education       : Factor w/ 5 levels "Bachelors","Graduate Degree",..: 1 4 4 1 1 4 3 1 5 4 ...
##  $ Occupation      : Factor w/ 5 levels "Clerical","Management",..: 5 1 4 4 1 3 2 5 1 3 ...
##  $ Home.Owner      : Factor w/ 2 levels "No","Yes": 2 2 1 2 1 2 1 2 2 2 ...
##  $ Cars            : num  0 1 2 1 0 0 4 0 2 1 ...
##  $ Commute.Distance: Factor w/ 5 levels "0-1 Miles","1-2 Miles",..: 1 1 4 5 1 2 1 1 5 1 ...
##  $ Region          : Factor w/ 3 levels "Europe","North America",..: 1 1 1 3 1 1 3 1 3 1 ...
##  $ Age             : num  42 43 60 41 36 ...
##  $ Purchased.Bike  : Factor w/ 2 levels "No","Yes": 1 1 1 2 2 1 2 2 1 2 ...

Metoda drzewa decyzyjnego

# Funkcja do imputacji zmiennych kategorycznych za pomocą drzewa decyzyjnego
impute_with_tree <- function(data, target_var) {
  # Użycie backticków w formule, aby obsłużyć nazwy z spacjami
  fit <- rpart(as.formula(paste0("`", target_var, "` ~ .")), data = data, method = "class", na.action = na.exclude)
  # Imputacja brakujących wartości
  data[[target_var]][is.na(data[[target_var]])] <- predict(fit, data[is.na(data[[target_var]]), ], type = "class")
  return(data)
}
# Imputacja dla zmiennych kategorycznych
for (var in categorical_vars) {
  dane <- impute_with_tree(dane, var)
}

Wizualizacja danych kategorycznych

Poniższe wykresy przedstawiają rozkłady danych dla wybranych zmiennych kategorycznych.

# `Marital Status`
ggplot(dane, aes(x = `Marital.Status`)) +
  geom_bar() +
  labs(title = "Rozkład stanu cywilnego", x = "Stan cywilny", y = "Liczba osób")

# `Gender`
ggplot(dane, aes(x = `Gender`)) +
  geom_bar() +
  labs(title = "Rozkład płci", x = "Płeć", y = "Liczba osób")

# `Home Owner`
ggplot(dane, aes(x = `Home.Owner`)) +
  geom_bar() +
  labs(title = "Rozkład własności domu", x = "Czy posiada dom", y = "Liczba osób")

Statystyki opisowe zmiennych liczbowych

Podstawowes statystyki opisowe (średnia, mediana, odchylenie standardowe) dla każdej zmiennej liczbowej w zbiorze danych “dane”, pomijając brakujące wartości. Dla danych uznanych przez nas za najważniejsze, to jest dla Income oraz Age są one następujące:

Dla Income średnia to 56252.09, mediana 60000, zaś odchylenie standardowe to znaczące 30975.03.

Natiomiast dla Age średnia to 44.17587, mediana 43, a odchylenie standardowe to mniej ekstremalne 11.31659.

dane %>%
  summarise(across(where(is.numeric), list(
    mean = \(x) mean(x, na.rm = TRUE),
    median = \(x) median(x, na.rm = TRUE),
    sd = \(x) 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 zmiennych kategorycznych

Tabela częstości dla każdej zmiennej kategorycznej w zbiorze danych “dane”. Pośród nich najważniejsze dla tego raportu są: Purchased Bike oraz Marital Status

dane %>%
  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

Podsumowanie za pomocą summarytools

Jak widocznym jest w wygenerowanym pliku, dokonano 519 pozytywnych decyzji o zakupie roweru i 481 negatywnych oraz 539 spośród badanych jest w związku małżeńskim, zaś 461 nie jest.

dfSummary(dane) %>%
  print(method = "render", style = "grid")

Data Frame Summary

dane

Dimensions: 1000 x 13
Duplicates: 0

Variable

Stats / Values

Freqs (% of Valid)

Graph

Valid

Missing

ID [numeric]

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.1)
2025-02-02

Wizualizacja zmiennych kategorycznych

Wykresy słupkowe dla każdej zmiennej kategorycznej, pokazując ich rozkład.

dane %>%
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()  #wizualizacja zmiennych kategorycznych

Wizualizacja zmiennych liczbowych

Histogramy dla każdej zmiennej liczbowej, wizualizując ich rozkład.

# Wybór zmiennych liczbowych z wykluczeniem ID
numerical_vars <- dane %>%
  select(where(is.numeric)) %>%
  select(-ID) %>%  # Wykluczenie ID
  colnames()

# Generowanie histogramów dla każdej zmiennej liczbowej
walk(numerical_vars, ~ {
  plot <- gghistostats(
    data = dane,
    x = !!sym(.x),
    bins = 30,
    title = paste("Histogram zmiennej:", .x),
    xlab = .x,
    ylab = "Częstość",
    type = "parametric"
  )
  print(plot)
})

Korelacja zmiennych liczbowych

Macierz korelacji dla zmiennych liczbowych i wizualizacja jako mapa cieplna przy użyciu ggcorrplot.

cor_matrix <- cor(dane %>% select(where(is.numeric)), use = "complete.obs")
ggcorrplot(cor_matrix, hc.order = TRUE, type = "lower", lab = TRUE, lab_size = 3,
           title = "Mapa korelacji zmiennych liczbowych", 
           colors = c("red", "white", "blue"))

Relacje liczbowo-kategoryczne (wykres pudełkowy)

Wykresy pudełkowe pokazujące rozkład wartości liczbowych w podziale na kategorie zmiennych kategorycznych

# Pętla po zmiennych kategorycznych i numerycznych
for (cat_var in categorical_vars) {
  for (num_var in numerical_vars) {
    plot <- ggbetweenstats(
      data = dane,
      x = !!sym(cat_var),
      y = !!sym(num_var),
      pairwise.comparisons = TRUE,
      title = paste("Rozkład", num_var, "względem", cat_var),
      xlab = cat_var,
      ylab = num_var,
      plot.type = "box"
    )
    
    # Drukowanie wykresu w konsoli
    print(plot)
  }
}

Model regresji logistycznej

W tej sekcji przeprowadzono proces budowy modelu regresji logistycznej, który przewiduje zmienną Purchased Bike (czy dana osoba zakupiła rower). Model wykorzystuje wszystkie dostępne zmienne jako predyktory.

#podział danych na zbiory treningowy i testowy
set.seed(123)  # Ustalanie losowości
train_index <- sample(seq_len(nrow(dane)), size = 0.7 * nrow(dane))
train_data <- dane[train_index, ]
test_data <- dane[-train_index, ]
# Budowa modelu
log_model <- glm(`Purchased.Bike` ~ ., data = train_data, family = binomial)
summary(log_model)

## 
## Call:
## glm(formula = Purchased.Bike ~ ., family = binomial, data = train_data)
## 
## Coefficients:
##                                Estimate Std. Error z value Pr(>|z|)   
## (Intercept)                  -6.204e-01  6.641e-01  -0.934  0.35027   
## ID                            2.363e-05  1.591e-05   1.485  0.13762   
## Marital.StatusSingle          4.755e-01  1.821e-01   2.611  0.00904 **
## GenderMale                    2.830e-02  1.664e-01   0.170  0.86498   
## Income                        8.436e-06  4.755e-06   1.774  0.07602 . 
## Children                     -1.342e-01  6.389e-02  -2.101  0.03568 * 
## EducationGraduate Degree     -1.660e-01  2.640e-01  -0.629  0.52959   
## EducationHigh School         -1.040e-01  2.955e-01  -0.352  0.72491   
## EducationPartial College     -5.856e-01  2.640e-01  -2.218  0.02652 * 
## EducationPartial High School -7.672e-01  4.323e-01  -1.775  0.07595 . 
## OccupationManagement         -4.654e-01  4.978e-01  -0.935  0.34990   
## OccupationManual              5.997e-02  3.296e-01   0.182  0.85562   
## OccupationProfessional        6.364e-01  4.083e-01   1.558  0.11913   
## OccupationSkilled Manual     -2.123e-01  3.230e-01  -0.657  0.51091   
## Home.OwnerYes                 5.083e-01  2.039e-01   2.494  0.01264 * 
## Cars                         -3.000e-01  1.082e-01  -2.773  0.00555 **
## Commute.Distance1-2 Miles    -2.296e-02  2.528e-01  -0.091  0.92762   
## Commute.Distance10+ Miles    -1.091e+00  3.527e-01  -3.095  0.00197 **
## Commute.Distance2-5 Miles     5.077e-02  2.610e-01   0.195  0.84578   
## Commute.Distance5-10 Miles   -5.338e-01  2.981e-01  -1.790  0.07338 . 
## RegionNorth America          -1.130e-01  2.589e-01  -0.437  0.66236   
## RegionPacific                 7.637e-01  2.964e-01   2.576  0.00999 **
## Age                           5.746e-04  9.367e-03   0.061  0.95109   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 968.75  on 699  degrees of freedom
## Residual deviance: 867.93  on 677  degrees of freedom
## AIC: 913.93
## 
## Number of Fisher Scoring iterations: 4

Ocena modelu predykcyjnego

W tej sekcji przeprowadzono ocenę dwóch modeli predykcyjnych: regresji logistycznej i drzewa decyzyjnego. Obliczono ich dokładność, macierz pomyłek oraz miarę F1 w celu porównania skuteczności obu podejść.

# Przewidywanie i obliczenie dokładności
predictions <- predict(log_model, test_data, type = "response")
predicted_class <- ifelse(predictions > 0.5, "Yes", "No")
actual_class <- test_data$`Purchased.Bike`

# Obliczanie dokładności
accuracy <- mean(predicted_class == actual_class)
cat("Dokładność modelu:", accuracy, "\n")

## Dokładność modelu: 0.6166667

# Tworzenie macierzy pomyłek
length(predicted_class)

## [1] 300

length(actual_class)

## [1] 300

colnames(test_data)

##  [1] "ID"               "Marital.Status"   "Gender"           "Income"          
##  [5] "Children"         "Education"        "Occupation"       "Home.Owner"      
##  [9] "Cars"             "Commute.Distance" "Region"           "Age"             
## [13] "Purchased.Bike"

conf_matrix <- table(Predicted = predicted_class, Actual = actual_class)
print(conf_matrix)

##          Actual
## Predicted  No Yes
##       No  103  66
##       Yes  49  82

# Obliczanie F1-score
f1_score <- F_meas(as.factor(predicted_class), as.factor(actual_class))
cat("F1-score:", f1_score, "\n")

## F1-score: 0.6417445

Drzewo decyzyjne:

Budowa i ocena modelu Drzewo decyzyjne zostało dopasowane do zbioru treningowego, a następnie ocenione na zbiorze testowym. Poniżej przedstawiono wizualizację drzewa oraz obliczenia dokładności.

Drzewo decyzyjne dla Purchased Bike

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

Przewidywanie na zbiorze testowym

tree_predictions <- predict(tree_model, test_data, type = "class")
tree_accuracy <- mean(tree_predictions == actual_class)
cat("Dokładność drzewa decyzyjnego:", tree_accuracy, "\n")

## Dokładność drzewa decyzyjnego: 0.5833333

Wnioski

Regresja logistyczna dostarcza bardziej szczegółowych statystyk, natomiast drzewo decyzyjne jest łatwiejsze do interpretacji wizualnej.

Test chi-kwadrat dla Purchased bike

# Test chi-kwadrat dla płci a zakup roweru
chi_gender <- chisq.test(table(dane$`Purchased.Bike`, dane$Gender))
print(chi_gender)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  table(dane$Purchased.Bike, dane$Gender)
## X-squared = 0.13348, df = 1, p-value = 0.7149

# Test chi-kwadrat dla stanu cywilnego a zakup roweru
chi_marital <- chisq.test(table(dane$`Purchased.Bike`, dane$`Marital.Status`))
print(chi_marital)

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  table(dane$Purchased.Bike, dane$Marital.Status)
## X-squared = 11.992, df = 1, p-value = 0.0005343

# Test chi-kwadrat dla regionu a zakup roweru
chi_region <- chisq.test(table(dane$`Purchased.Bike`, dane$Region))
print(chi_region)

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

Czy gender ma wpływ na zakup roweru?

P-value = 0.7149 (dużo większe niż 0.05) Brak istotnej zależności między płcią a zakupem roweru. Wniosek: Płeć nie wpływa znacząco na decyzję o zakupie roweru.

Czy stan cywilny ma wpływ na zakup roweru?

P-value = 0.0005343 (znacznie mniejsze niż 0.05) Istotna zależność – stan cywilny wpływa na zakup roweru. Wniosek: Osoby zamężne/żonate kupują rowery w inny sposób niż osoby samotne.

Czy region ma wpływ na zakup roweru?

P-value = 0.001032 (mniejsze niż 0.05) Istotna zależność – region wpływa na zakup roweru. Wniosek: Mieszkańcy różnych regionów różnią się pod względem liczby zakupionych rowerów.

table(dane$`Purchased.Bike`, dane$`Marital.Status`)

##      
##       Married Single
##   No      307    212
##   Yes     231    250

#wizualizacja 
ggplot(dane, aes(x = `Marital.Status`, fill = `Purchased.Bike`)) +
  geom_bar(position = "dodge") +
  labs(title = "Zakup roweru a stan cywilny", x = "Stan cywilny", y = "Liczba osób") +
  theme_minimal()

Wniosek: Osoby samotne częściej kupują rowery!

W grupie “Single” więcej osób kupiło rower (250) niż nie kupiło (212). W grupie “Married” mniej osób kupiło rower (231) niż nie kupiło (307). Test chi-kwadrat pokazał, że ta różnica jest istotna statystycznie.

Zakup roweru a region

table(dane$`Purchased.Bike`, dane$Region)

##      
##       Europe North America Pacific
##   No     152           288      79
##   Yes    148           220     113

#wizualizacja 
ggplot(dane, aes(x = Region, fill = `Purchased.Bike`)) +
  geom_bar(position = "dodge") +
  labs(title = "Zakup roweru a region", x = "Region", y = "Liczba osób") +
  theme_minimal()

Wnioski

W Europie: 152 osób nie kupiło roweru, 148 kupiło. W Ameryce Północnej: 288 osób nie kupiło roweru, 220 kupiło. W rejonie Pacyfiku: 79 osób nie kupiło roweru, 113 kupiło. Najwięcej rowerów kupują osoby w rejonie Pacyfiku, a najmniej w Ameryce Północnej.W Europie liczba kupujących i niekupujących jest prawie równa.W Ameryce Północnej więcej osób nie kupiło roweru niż kupiło. W rejonie Pacyfiku sytuacja jest odwrotna – więcej osób kupiło rower niż nie kupiło.

Wybór testu

# Sprawdzamy normalność wieku
shapiro.test(dane$Age)

## 
##  Shapiro-Wilk normality test
## 
## data:  dane$Age
## W = 0.97007, p-value = 1.725e-13

Wybieramy Test Kruskala-Wallisa, ponieważ p < 0.05, więc odrzucamy hipotezę zerową o normalności rozkładu.

Dane Age NIE są normalnie rozkłócone!

kruskal.test(Age ~ `Purchased.Bike`, data = dane)

## 
##  Kruskal-Wallis rank sum test
## 
## data:  Age by Purchased.Bike
## Kruskal-Wallis chi-squared = 8.4015, df = 1, p-value = 0.003749

P-value = 0.003749 jest mniejsze niż 0.05, czyli odrzucamy hipotezę zerową. Oznacza to, że istnieje istotna statystycznie różnica w wieku między grupami, które kupiły i nie kupiły roweru. Wniosek: Wiek wpływa na decyzję o zakupie roweru! Grupy wiekowe kupujących i niekupujących różnią się istotnie pod względem wieku.

Wizualizacja testu

ggbetweenstats( data = dane, x = `Purchased.Bike`,
y = Age,
type = "nonparametric",
title = "Wiek a decyzja o zakupie roweru", xlab = "Zakup roweru", ylab = "Wiek", )

Podsumowanie

W całym raporcie przeprowadziliśmy kolejne etapy analizy danych, obejmujące data wrangling, wizualizację danych, analizę opisową oraz wnioskowanie statystyczne.

Data wrangling

Na początku dokonaliśmy wstępnej analizy danych, w której zidentyfikowaliśmy braki danych oraz sprawdziliśmy strukturę zbioru. Następnie oczyszczono dane, przekształcono zmienne kategoryczne na format odpowiedni do analizy oraz uzupełniono brakujące wartości. Wartości liczbowe zostały uzupełnione metodą średniej adaptacyjnej, a zmienne kategoryczne poprzez imputację wielowymiarową (MICE).

Wizualizacja danych

Aby lepiej zrozumieć rozkłady zmiennych i ich zależności, przygotowaliśmy wykresy słupkowe, histogramy, wykresy pudełkowe oraz mapę korelacji.

Wizualizacje te pozwoliły na zauważenie potencjalnych zależności między zmiennymi, w tym między zakupem roweru a zmiennymi demograficznymi oraz finansowymi klientów.

Analiza opisowa

Przeprowadziliśmy szczegółową analizę statystyk opisowych, obejmującą średnią, medianę, odchylenie standardowe dla zmiennych liczbowych oraz częstość występowania wartości dla zmiennych kategorycznych.

Dodatkowo wykonaliśmy analizę korelacji, aby sprawdzić, które zmienne są ze sobą powiązane.

Wnioskowanie statystyczne

Aby zbadać czynniki wpływające na zakup roweru, przeprowadziliśmy testy statystyczne: Testy chi-kwadrat dla sprawdzenia zależności między zakupem roweru a zmiennymi kategorycznymi (m.in. płcią, stanem cywilnym, regionem).

Wykazały one, że stan cywilny i region są istotnie związane z decyzją o zakupie roweru, natomiast płeć nie ma istotnego wpływu. Test Kruskala-Wallisa do analizy wpływu wieku na zakup roweru – wyniki wykazały, że osoby młodsze częściej kupują rower.

Wnioski końcowe

Z przeprowadzonej analizy wynika, że zakup roweru zależy istotnie od wieku, stanu cywilnego i regionu zamieszkania, natomiast płeć klienta nie ma znaczącego wpływu na decyzję o zakupie.

Wnioskowanie statystyczne oraz modelowanie predykcyjne dostarczyły cennych informacji, które mogą być wykorzystane do optymalizacji strategii sprzedażowej sklepu rowerowego.

Podsumowując, raport pozwolił na identyfikację kluczowych czynników wpływających na decyzję zakupową klientów oraz dostarczył istotnych wskazówek dla biznesu w zakresie targetowania oferty i strategii marketingowej.

Analiza danych - sklep rowerowy

Oliwia Podufalska, Miłosz Stańko, Marek Psyta

2025-02-02

Import danych

Ustawienie poziomów dla zmiennych kategorycznych

Analiza braków danych

Obliczanie unikatowych wartości w każdej kolumnie

Przekształcanie zmiennych kategorycznych

Analiza zmiennych kategorycznych

Wizualizacja braków danych

Analiza braków w zmiennych kluczowych

Konwersja wybranych kolumn na typ factor

Uzupełnianie braków w danych

Zastępowanie braków w zmiennych liczbowych

Imputacja wielowymiarowa

Uzupełnianie braków w danych kategorycznych

Metoda drzewa decyzyjnego

Wizualizacja danych kategorycznych

Statystyki opisowe zmiennych liczbowych

Statystyki opisowe zmiennych kategorycznych

Podsumowanie za pomocą summarytools

Data Frame Summary

dane

Wizualizacja zmiennych kategorycznych

Wizualizacja zmiennych liczbowych

Korelacja zmiennych liczbowych

Relacje liczbowo-kategoryczne (wykres pudełkowy)

Model regresji logistycznej

Ocena modelu predykcyjnego

Drzewo decyzyjne:

Drzewo decyzyjne dla Purchased Bike

Przewidywanie na zbiorze testowym

Wnioski

Test chi-kwadrat dla Purchased bike

Czy gender ma wpływ na zakup roweru?

Czy stan cywilny ma wpływ na zakup roweru?

Czy region ma wpływ na zakup roweru?

Wniosek: Osoby samotne częściej kupują rowery!

Zakup roweru a region

Wnioski

Wybór testu

Wybieramy Test Kruskala-Wallisa, ponieważ p < 0.05, więc odrzucamy hipotezę zerową o normalności rozkładu.

Dane Age NIE są normalnie rozkłócone!

Wizualizacja testu

Podsumowanie

Data wrangling

Wizualizacja danych

Analiza opisowa

Wnioskowanie statystyczne

Wnioski końcowe

Konwersja wybranych kolumn na typ `factor`