8 Fallstudie Smartphone

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.1     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(easystats)

# Attaching packages: easystats 0.7.1 (red = needs update)
✔ bayestestR  0.13.2    ✖ correlation 0.8.4  
✖ datawizard  0.10.0    ✖ effectsize  0.8.7  
✖ insight     0.19.10   ✖ modelbased  0.8.7  
✖ performance 0.11.0    ✖ parameters  0.21.6 
✔ report      0.5.8     ✔ see         0.8.4  

Restart the R-Session and update packages with `easystats::easystats_update()`.

library(ggpubr)


Attache Paket: 'ggpubr'

Die folgenden Objekte sind maskiert von 'package:datawizard':

    mean_sd, median_mad

library(DataExplorer)
library(rbthemes)

data <- read.csv("https://raw.githubusercontent.com/sebastiansauer/statistik1/main/daten/Smartphone-Nutzung%20(Responses)%20-%20Form%20responses%201.csv")

8.1 Vorverarbeitung

8.1.1 Umbenennung der Spalten

names(data)[15] <- "sex"
names(data)[16] <- "age"
names(data)[17] <- "os"
names(data)[18] <- "price"

item_labels_new <- paste0("item", 1:11)
names(data)[3:13] <- item_labels_new

8.1.2 Umgang mit fehlenden Werten

Zunächst überprüfen wir, ob und wenn ja, in welchen Spalten es fehlende Werte gibt.

data %>% 
  summarise((across(everything(),~sum(is.na(.x)))))

ABCDEFGHIJ0123456789

Timestamp <int>
0

Bei den Spalten alter und preis scheint es einige fehlende Werte zu geben. Wir ersetzen diese mit dem Mittelwert der Spalten, um die anderen ausgefüllten Spalten nicht zu verlieren. Hierzu müssen wir alle numerischen Spalten in das Format double umwandenln.

data <- data %>%
  mutate(across(where(is.numeric), as.double))

data <- data %>%
  mutate(across(where(is.numeric), ~replace_na(., mean(., na.rm = TRUE))))

data <- data %>% 
  mutate(sex = factor(sex),
         os = factor(os))

data <- data %>% 
  mutate(sex = case_when(sex == NA ~ "missing", 
                                sex == "Mann" ~ "männlich",
                                sex == "Frau" ~ "weiblich"))
data <- data %>% 
  mutate(os = case_when(os == NA ~ "missing", 
                                os == "iOS" ~ "iOS",
                                os == "Android" ~ "Android"))

8.2 EDA

Jetzt können wir uns die Daten genauer unter die Lupe nehmen.

data %>% 
  group_by(sex) %>% 
  summarise(mean(price))

ABCDEFGHIJ0123456789

sex <chr>	mean(price) <dbl>
männlich	816.6667
weiblich	644.2628
NA	667.2500

data %>% 
  group_by(os) %>% 
  summarise(mean(price))

ABCDEFGHIJ0123456789

os <chr>	mean(price) <dbl>
Android	412.0000
iOS	740.1786
NA	667.2500

8.2.1 Berechnung des Smartphone-Addiction-Scores

Zur Erstellung einer Spalte, die das allgemeine Maß der Smartphone-Abhängigkeit angibt, berechnen wir einfach den Mittelwert aller Items:

data <- data %>% 
  mutate(addiction_score = rowMeans(across(starts_with("item")))) %>% 
  mutate(is_addicted =
           case_when(addiction_score > 3.1 & sex == "männlich" ~ "addicted",
                     addiction_score > 3.3 & sex == "weiblich" ~ "addicted",
                     TRUE ~ "not-addicted"))

data %>%  
  ggdensity(x = "addiction_score", 
            color = "sex")

smartphone_count <- 
data %>% 
  group_by(sex) %>%  
  count(is_addicted)

smartphone_count %>%
  drop_na() %>% 
  plot_bar(by = "sex")

8.3 Modellierung

Zunächst erstellen wir das Modell und bewerten die Modellgüte

lm <- lm(addiction_score ~ 1, data = data)

mae(lm)

[1] 0.5877067

Dann visualisieren wir das Modell:

data %>% 
  mutate(id = 1:n(),
         mean_addiction_score = mean(addiction_score),
         residual = addiction_score - mean_addiction_score) %>% 
  ggplot(aes(x = id, y = addiction_score)) +
  geom_point() +
  geom_hline(aes(yintercept = mean_addiction_score), color = "#6388b4") +
  geom_label(aes(x = 0, y = mean_addiction_score, label = "MW"), color = "#6388b4", fill = "white") +
  geom_segment(aes(x = id, xend = id, y = addiction_score, yend = mean_addiction_score), alpha = 0.5, color = "grey") +
  theme_minimal()

data %>% 
  drop_na() %>% 
  ggplot(aes(age,addiction_score, color = sex)) + 
  geom_point() +
  geom_smooth(method = "lm", se = FALSE) +
  theme_pastel

`geom_smooth()` using formula = 'y ~ x'