Solution von Elisa Herold hinzugefügt

###############################################################

# Universität Hohenheim

# Stichprobenbasierte Datenanalyse

# Aufgabenblatt 00, Aufgabe 9

# Erstellt von Elisa Herold

###########

#Gegeben:

n <- 3000 # Gesamtzahl der Projekte

r <- 40 # Stichprobengröße

u <- 100 # Anzahl der Projekte mit Unregelmäßigkeiten laut Experte

k <- 25 # Beobachtete Unregelmäßigkeiten in der Stichprobe

# a) Anzahl Möglichkeiten, 40 aus 3000 zu wählen 

a <- choose(n, r)

cat("a) Anzahl Möglichkeiten (C(3000,40)) =", format(a, scientific=TRUE), "\n")

# b) Anzahl Möglichkeiten, 25 aus 100 Unregelmäßigen zu wählen 

b <- choose(u, k)

cat("b) Anzahl Möglichkeiten (C(100,25)) =", format(b, scientific=TRUE), "\n")

# c) Anzahl Möglichkeiten, 15 aus 2900 Regelmäßigen zu wählen 

c <- choose(n - u, r - k)

cat("c) Anzahl Möglichkeiten (C(2900,15)) =", format(c, scientific=TRUE), "\n")

# d) Gemeinsame Möglichkeiten b) * c) 

d <- b * c

cat("d) Gemeinsame Kombinationen =", format(d, scientific=TRUE), "\n")

# e) Wahrscheinlichkeit q für genau 25 Unregelmäßigkeiten 

# Mit Hypergeometrischer Formel bzw. Wahrscheinlichkeit:

# q = [C(u,k) * C(n-u, r-k)] / C(n,r)

q <- (choose(u, k) * choose(n - u, r - k)) / choose(n, r)

cat("e) q =", format(q, scientific=TRUE), "\n")

# -> Erwartung: q ≈ 1.345e-28 (Ist fast 0 und damit eher unglaubwürdig, da sehr unwahrscheinlich.)

# f) Vergleich: q(u) für verschiedene Werte von u 

u_values <- c(500, 1000, 2000, 2500)

q_values <- sapply(u_values, function(u_tmp) {

  (choose(u_tmp, k) * choose(n - u_tmp, r - k)) / choose(n, r)

})

# Darstellung in Tabelle

cat("\nf) q(u) für verschiedene u:\n")

print(data.frame(u = u_values, q = format(q_values, scientific = TRUE)))

# g) Verbesserung der Schätzung

#Hypergeometrische Verteilung (wie beschrieben in Kurzlösung)

hypergeo_ws <- function (U,N,r,k){

if (U< k || U > N - (r - k)) return(0) # Unmögliche Werte

  choose(U, k) * choose(N - U, r - k) / choose(N, r)

}

# Alle möglichen U-Werte

U_vals <- k:(n - (r - k))

# Wahrscheinlichkeiten berechnen

probs <- sapply(U_vals, hypergeo_ws, N=n,r=r, k=k)

# Maximum-Likelihood Schätzung

U_ML <- U_vals[which.max(probs)]

cat("\nMaximum-Likelihood Schätzung der Gesamtzahl unregelmäßiger Projekte (U_ML) =",U_ML,"\n")

# Alternative Lösung mit Graphik:

# Parameter

N <- 3000   

r <- 40     

k <- 25     

# Sequenz der Anzahl möglicher unregelmäßiger Projekte

u_values <- 1:N

# Hypergeometrische Wahrscheinlichkeit

likelihood <- dhyper(k, u_values, N - u_values, r)

# Maximierung

u_hat <- u_values[which.max(likelihood)]

cat("Wahrscheinlichste Anzahl aller unregelmäßigen Projekte (MLE):", u_hat, "\n")

# Graphik zur Funktion

plot(u_values, likelihood, type = "l", 

     main = "Wahrscheinlichkeit aller unregelmäßigen Projekte (u)",

     xlab = "Anzahl unregelmäßiger Projekte (u)",

     ylab = "Wahrscheinlichkeit")

abline(v = u_hat, col = "red", lty = 2)