Code aus der Vorlesung

Vorlesung vom 04.04.2025

(1+1+3)*2
[1] 10
(1+1+3)*2
[1] 10
5-2
[1] 3
10/2
[1] 5
log(8,2)
[1] 3
log(x = 8, base = 2)
[1] 3
log(base = 2, x = 8)
[1] 3
log(2,8)
[1] 0.3333333
log(1)
[1] 0
x <- 5
x <- 10

x*3
[1] 30
y <- "gut"

v <- c(4,5,2,9,5)
v/2
[1] 2.0 2.5 1.0 4.5 2.5
v2 <- c("gut", "schlecht", "mittel", "schlecht")

v3 <- 1:20
m <- matrix(v3, 
            nrow = 4, 
            byrow = TRUE)



df <- data.frame(Name = c("Mueller", "Meyer", "Schneider", "Meyer", "Meier"), 
                 Alter = c(45,23,62,32,22), 
                 Premiumkunde = c(TRUE, FALSE, FALSE, TRUE, TRUE))

mean(df$Alter)
[1] 36.8
# Erstellen eines Vektors mit den Verspätungen
verspaetungen <- c(10, 20, 5, 10, 30, 
                   25, 5, 5, 10, 20, 
                   15, 10, 5, 20, 15, 
                   10, 5, 20, 25, 10)


#Tabelle mit absoluten Häufigkeiten
haeufigkeiten <- table(verspaetungen)

#Tabelle mit relativen Häufigkeiten
prop.table(haeufigkeiten)
verspaetungen
   5   10   15   20   25   30 
0.25 0.30 0.10 0.20 0.10 0.05 
# relative Häufigkeiten der Gänge
prop.table(table(mtcars$gear))

      3       4       5 
0.46875 0.37500 0.15625 
plot(prop.table(table(mtcars$gear)),
     type = "h",
     xlab = "Gänge",
     ylab = "relative Häufigkeit")

# Absoluten Häufigkeiten der Viertelmeilenzeit
table(mtcars$qsec)

 14.5  14.6 15.41  15.5 15.84 16.46  16.7 16.87  16.9 17.02 17.05  17.3  17.4 
    1     1     1     1     1     1     1     1     1     2     1     1     1 
17.42  17.6 17.82 17.98    18  18.3 18.52  18.6 18.61  18.9 19.44 19.47  19.9 
    1     1     1     1     1     1     1     1     1     2     1     1     1 
   20 20.01 20.22  22.9 
    1     1     1     1 
# Visualisierungen
plot(table(mtcars$qsec),
     xlab = "Viertelmeilenzeit",
     ylab = "absolute Häufigkeit")

hist(mtcars$qsec,
     xlab = "Vierteilmeilenzeit",
     main = "",
     breaks = 3)

hist(mtcars$qsec,
     xlab = "Vierteilmeilenzeit",
     main = "",
     breaks = c(14,16,18,20,24))

Vorlesung vom 11.04.2025

# Aufgabe 2.1

# Absolute Häufigkeiten des Ursprungs der Aufträge
## 120 Aufträge stammen aus Bayern, 
## 136 aus Niedersachsen, 
## 301 aus Hessen,
## 80 aus dem Saarland und 
## 326 aus Nordrhein-Westfalen

df <- data.frame(Bundesland = c("Bayern", "Niedersachsen", 
                                "Hessen", "Saarland", 
                                "Nordrhein-Westfalen"),
                 Haeufigkeit = c(120,136,301,80,326))

barplot(height = df$Haeufigkeit,
        names.arg = df$Bundesland)

# Empirische Verteilungsfunktion für qseq

plot(ecdf(mtcars$qsec))

hist(mtcars$qsec)

boxplot(mtcars$qsec)

# Aufgabe 4.1

mieten <- c(300,250,400,500,250,600,300,300,450,400)

## Lagemaße
mean(mieten)
[1] 375
median(mieten)
[1] 350
## Streuungsmaße

### Mittlere absolute Abweichung
mean(abs(mieten-median(mieten)))
[1] 95
### Median der absoluten Abweichung
median(abs(mieten-median(mieten)))
[1] 75
### Varianz
n <- length(mieten)
mean((mieten - mean(mieten))^2)
[1] 12125
var(mieten)*(n-1)/n
[1] 12125
### Standardabweichung
sqrt(mean((mieten - mean(mieten))^2))
[1] 110.1136
sd(mieten)*sqrt((n-1)/n)
[1] 110.1136
### Spannweite
diff(range(mieten))
[1] 350

Vorlesung vom 09.05.2025

# Laden der Daten
library(MSBStatsData)


# Berechnung der paarweisen Korrelationen
round(cor(decathlon), 2)
                race100m longjump shotput highjump race400m race110mhurdles
race100m            1.00    -0.48   -0.15    -0.12     0.57            0.45
longjump           -0.48     1.00    0.25     0.36    -0.31           -0.38
shotput            -0.15     0.25    1.00     0.16    -0.03           -0.25
highjump           -0.12     0.36    0.16     1.00    -0.11           -0.25
race400m            0.57    -0.31   -0.03    -0.11     1.00            0.38
race110mhurdles     0.45    -0.38   -0.25    -0.25     0.38            1.00
discus             -0.12     0.20    0.72     0.14    -0.04           -0.22
polevault          -0.17     0.27    0.25     0.19    -0.13           -0.29
javelinthrow       -0.06     0.17    0.44     0.07    -0.02           -0.13
race1500m          -0.09     0.02    0.11    -0.01     0.38            0.01
                discus polevault javelinthrow race1500m
race100m         -0.12     -0.17        -0.06     -0.09
longjump          0.20      0.27         0.17      0.02
shotput           0.72      0.25         0.44      0.11
highjump          0.14      0.19         0.07     -0.01
race400m         -0.04     -0.13        -0.02      0.38
race110mhurdles  -0.22     -0.29        -0.13      0.01
discus            1.00      0.27         0.42      0.08
polevault         0.27      1.00         0.19     -0.01
javelinthrow      0.42      0.19         1.00      0.02
race1500m         0.08     -0.01         0.02      1.00
# Aufgabe 5.4

kontingenztafel <- matrix(c(17,149,19,141), ncol = 2, byrow = TRUE)

## Chi-Quadrat
chisq <- chisq.test(kontingenztafel, 
                    correct = FALSE)

chisq$statistic
X-squared 
0.2214463 
## Cramérs V
n <- sum(kontingenztafel)
k <- min(ncol(kontingenztafel),
         nrow(kontingenztafel))

V <- sqrt(chisq$statistic/(n*(k-1)))

V
 X-squared 
0.02606306 

Vorlesung vom 16.05.2025

# X~GV(1,5)

## Dichtefunktion
dunif(c(1,4,5,100), min = 1, max = 5)
[1] 0.25 0.25 0.25 0.00
curve(dunif(x, min = 1, max = 5), 
      from = -2, to = 7, col = "darkblue")

# Verteilungsfunktion

punif(0, min = 1, max = 5)
[1] 0
punif(3, min = 1, max = 5)
[1] 0.5
curve(punif(x, min = 1, max = 5), 
      from = -2, to = 7, col = "darkblue")

# P(2 <= X <= 4,5) = F(4.5) - F(2)

punif(4.5, min = 1, max = 5) - punif(2, min = 1, max = 5)
[1] 0.625
integrate(function(x) dunif(x, min = 1, max = 5), 
          lower = 2, upper = 4.5)
0.625 with absolute error < 6.9e-15
# (Pseudo-)Zufallszahl

set.seed(123)
x <- runif(n = 1000000, min = 1, max = 5)

all(x<=5)
[1] TRUE
all(x>=1)
[1] TRUE
# Darstellung der Häufigkeiten
boxplot(x)

hist(x, xlim=c(-2,7))

plot(ecdf(x), xlim=c(-2,7))

mean(x >= 2 & x <= 4.5)
[1] 0.62396
## 100 mal würfeln

set.seed(123)
wuerfe <- sample(x = 1:6, size = 100000, replace = TRUE)

prop.table(table(wuerfe))
wuerfe
      1       2       3       4       5       6 
0.16685 0.16818 0.16656 0.16536 0.16774 0.16531 

Vorlesung vom 26.06.2025

wohnflaeche <- c(80, 120, 100, 150, 200, 90, 110, 140, 180, 160) 
verkaufspreis <- c(300, 480, 400, 600, 800, 350, 440, 560, 720, 640)
df_haeuser <- data.frame(wohnflaeche, 
                         verkaufspreis)

modell <- lm(verkaufspreis ~ wohnflaeche, data = df_haeuser)
summary(modell)

Call:
lm(formula = verkaufspreis ~ wohnflaeche, data = df_haeuser)

Residuals:
     Min       1Q   Median       3Q      Max 
-11.4426  -2.3505   0.6932   3.8388   6.4602 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) -16.94581    6.53137  -2.595   0.0319 *  
wohnflaeche   4.10486    0.04725  86.881 3.44e-13 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 5.632 on 8 degrees of freedom
Multiple R-squared:  0.9989,    Adjusted R-squared:  0.9988 
F-statistic:  7548 on 1 and 8 DF,  p-value: 3.437e-13
predict(modell, newdata = data.frame(wohnflaeche = c(130, 150, 170)))
       1        2        3 
516.6854 598.7825 680.8797 
df_icecream <- data.frame(
  Eismenge = c(2000,2000,6000,4000,6000,
               4000,4000,7000,7000,8000),
  Temperatur =  c(10,  15,  20,  15,  25,  
                  25,  30,  30,  40,  40),
  Niederschlag = c(25,20,15,20,10,8,1,1,0,0),
  Wochentag = factor(c("Mittwoch", "Freitag", "Sonntag", 
                       "Freitag","Sonntag", "Mittwoch", 
                       "Freitag", "Sonntag", "Freitag", 
                       "Sonntag"), 
                     levels = c("Mittwoch", 
                                "Freitag", 
                                "Sonntag"))
) 


# Regressionsmodell mit kategoriellem Merkmal
lm_model <- lm(Eismenge ~ ., data = df_icecream)
summary(lm_model)

Call:
lm(formula = Eismenge ~ ., data = df_icecream)

Residuals:
     1      2      3      4      5      6      7      8      9     10 
-155.5 -996.1  349.7 1003.9 -267.2  155.5 -523.7  439.0  515.9 -521.5 

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)  
(Intercept)      -1904.45    3111.82  -0.612   0.5673  
Temperatur         204.12      88.24   2.313   0.0686 .
Niederschlag        80.75      94.42   0.855   0.4315  
WochentagFreitag   223.80     731.48   0.306   0.7720  
WochentagSonntag  2261.17     769.61   2.938   0.0323 *
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 805.9 on 5 degrees of freedom
Multiple R-squared:  0.9188,    Adjusted R-squared:  0.8539 
F-statistic: 14.15 on 4 and 5 DF,  p-value: 0.00619
newdata <- data.frame(Temperatur = c(20, 25),
                      Niederschlag = c(10, 15),
                      Wochentag = c("Mittwoch", "Freitag"))

predict(lm_model, newdata = newdata)
       1        2 
2985.420 4633.563 
automarke_chr <- c("Opel", "BMW", "Mercedes", "Mercedes", "Opel", "BMW")
automarke_factor <- factor(automarke_chr, 
                           levels = c("Opel", "VW",  "Mercedes", "BMW"),
                           ordered = TRUE)
automarke_chr
[1] "Opel"     "BMW"      "Mercedes" "Mercedes" "Opel"     "BMW"     
tafel <-table(automatik = mtcars$am, gaenge = mtcars$gear)
chisq.test(tafel)
Warning in chisq.test(tafel): Chi-squared approximation may be incorrect

    Pearson's Chi-squared test

data:  tafel
X-squared = 20.945, df = 2, p-value = 2.831e-05
kt_zoo <- matrix(c(90,10,60,40,50,150),
                 ncol = 2, byrow= TRUE)
chisq.test(kt_zoo)

    Pearson's Chi-squared test

data:  kt_zoo
X-squared = 118, df = 2, p-value < 2.2e-16
df_zoo <- data.frame(
  Besuche = factor(c(rep("1-2", 90),
                     rep("3-4", 60), 
                     rep(">4", 50),
                     rep("1-2", 10), 
                     rep("3-4", 40), 
                     rep(">4", 150)),
                   levels = c("1-2", "3-4", ">4")),
  Jahreskarte = factor(rep(c("nein","ja"),
                           each = 200),
                       levels = c("nein","ja"))
)
Zurück nach oben