---
exname: Bed-Wskt2
extype: num
exsolution: r sol
expoints: 1
extol: 0.02
categories:
- probability
- bayes
- num
- qm2
- qm2-pruefung2023
date: '2023-11-08'
title: Bed-Wskt2
---
```{r libs, include = FALSE}
library (tidyverse)
library (glue)
library (testthat)
library (ggraph)
library (igraph)
library (gt)
```
```{r global-knitr-options, include=FALSE}
knitr:: opts_chunk$ set (fig.pos = 'H' ,
fig.asp = 0.618 ,
fig.width = 9 ,
fig.cap = "" ,
fig.path = "" ,
echo = FALSE ,
message = FALSE ,
fig.show = "hold" ,
out.width = "50%" ,
dpi = 200 )
```
# Aufgabe
Als Bildungsforscher(in) untersuchen Sie den Lernerfolg in einem Statistikkurs.
```{r defs}
#| echo: false
# rbeta(10, 6, 2)
A_marg <- rbeta (1 , 6 , 2 ) %>% round (2 )
Aneg_marg <- 1 - A_marg %>% round (2 )
A_distrib <- rbeta (1 , 6 , 2 ) %>% round (2 )
Aneg_distrib <- rbeta (1 , 6 , 2 ) %>% round (2 )
AandB <- A_marg * A_distrib %>% round (2 )
AandBneg <- A_marg - AandB %>% round (2 )
AnegandB <- Aneg_marg * Aneg_distrib %>% round (2 )
AnegandBneg <- Aneg_marg - AnegandB %>% round (2 )
B_marg <- AandB + AnegandB %>% round (2 )
Bneg_marg <- AandBneg + AnegandBneg %>% round (2 )
d <- tibble (
row_ids = c ("A" , "Aneg" , "row_sum" ),
B = c (AandB, AnegandB, AandB+ AnegandB),
Bneg = c (AandBneg, AnegandBneg, AandBneg+ AnegandBneg)
) %>%
mutate (col_sum = B + Bneg)
d %>%
filter (row_ids == "row_sum" ) %>%
select (B, Bneg) %>%
mutate (sum_B_Bneg = sum (B, Bneg)) %>%
pull (sum_B_Bneg) %>%
expect_equal (1 , tolerance = .01 )
A_cond_B <- AandB / B_marg %>% round (2 )
Aneg_cond_B <- AnegandB / B_marg %>% round (2 )
A_cond_Bneg <- AandBneg / Bneg_marg %>% round (2 )
Aneg_cond_Bneg <- AnegandBneg / Bneg_marg %>% round (2 )
```
Eine Gruppe von Studierenden absolviert einen Statistikkurs.
Ein Teil lernt gut mit (Ereignis $A$), ein Teil nicht (Ereignis $A^C$).
Ein Teil besteht die Prüfung (Ereignis $B$); ein Teil nicht ($B^C$).
(Eselsbrücke: Das Ereignis "A" steht für "Ah, hat *A*ufgepasst.)
Hinweis: Das Gegenereignis zum Ereignis $A$ wird oft das Komplementärereignis
oder kurz Komplement von $A$ genannt und mit $A^C$ bezeichnet.
Wir ziehen zufällig eine/n Studierende/n: Siehe da -- Die Person hat bestanden. Yeah!
**Aufgabe**: Gesucht ist die Wahrscheinlichkeit, dass *diese Person* gut mitgelernt hat,
*gegeben* der Tatsache, dass dieser Person bestanden hat.
Die Anteile der Gruppen (bzw. Wahrscheinlichkeit des Ereignisses) lassen sich unten stehender Tabelle entnehmen.
```{r results = "asis"}
d %>%
select (row_ids, B, Bneg) %>%
filter (row_ids != "row_sum" ) %>%
mutate (across (c (B, Bneg), \(x) sprintf (x, fmt = "%.2f" ))) %>%
gt ()
```
*Hinweise*:
- Runden Sie auf 2 Dezimalstellen.
- Geben Sie Anteile stets in der Form `0.42` an (mit führender Null und Dezimalzeichen).
- "Aneg" bezieht sich auf das Komplementärereignis zu A ("A negativ")
- Berücksichtigen Sie die üblichen Hinweise des Datenwerks.
```{r}
items <-
c ("Zeichnen Sie (per Hand) ein Baumdiagramm, um die gemeinsamen Wahrscheinlichkeiten darzustellen. Weiterhin sollen die Randwahrscheinlichkeiten für $A$ dargestellt sein." ,
"Zeichnen Sie (per Hand) ein Baumdiagramm, um diesen Sachverhalt darzustellen." ,
"Geben Sie die Wahrscheinlichkeit des gesuchten Ereignisses an."
)
```
```{r questionlist, echo = FALSE, results = "asis"}
exams:: answerlist (items, markup = "markdown" )
```
</ br >
</ br >
</ br >
</ br >
</ br >
</ br >
</ br >
</ br >
</ br >
</ br >
# Lösung
```{r defs-studis}
edf <- #events data frame
tibble (
from = c ("Studis" ,"Studis" ,"Mitlerner" ,
"Mitlerner" ,"Nichtlerner" ,"Nichtlerner" ),
to = c ("Mitlerner" ,"Nichtlerner" ,"Besteher" ,
"Nichtbesteher" ,"Besteher" ,"Nichtbesteher" )
)
studi_type <- unique (c ("Studis" ,"Studis" ,"Mitlerner" ,
"Mitlerner" ,"Nichtlerner" ,"Nichtlerner" , "Mitlerner" ,"Nichtlerner" ,"Besteher" ,
"Nichtbesteher" ,"Besteher" ,"Nichtbesteher" ))
```
```{r graph1}
studies_props <- round (c (A_marg, 1 - A_marg, AandB, AandBneg, AnegandB, AnegandBneg), 2 )
studis_graph <-
tibble (
type = unique (c (edf$ from, edf$ to))
)
studis_graph <- graph_from_data_frame (d = edf, v = studis_graph, directed = TRUE )
#V(studis_graph)$name <- studi_type
E (studis_graph)$ studies_props <- studies_props
# as_data_frame(studis_graph, what = "edges")
```
```{r graph2}
studies_prop_cond <- round (c (
B_marg,
1 - B_marg,
A_cond_B,
Aneg_cond_B,
A_cond_Bneg,
Aneg_cond_Bneg
),
2
)
edf2 <- tibble (
from = c ("Studis" , "Studis" ,
"Besteher" , "Besteher" ,
"Nichtbesteher" , "Nichtbesteher" ),
to = c ("Besteher" , "Nichtbesteher" ,
"Lerner" , "Nichtlerner" ,
"Lerner" , "Nichtlerner" )
)
studis_graph_v2 <-
tibble (
type = unique (c (edf2$ from, edf2$ to))
)
studis_graph2 <- graph_from_data_frame (d = edf2, v = studis_graph_v2, directed = TRUE )
E (studis_graph)$ studies_props <- studies_props
# as_data_frame(studis_graph, what = "edges")
E (studis_graph2)$ studies_prop_cond <- studies_prop_cond
```
```{r}
sol <- vector (mode = "character" , length = 4 )
```
A)
```{r fig.align='center'}
p1 <- ggraph (studis_graph, layout = 'dendrogram' , circular = FALSE ) +
geom_edge_diagonal (aes (label = studies_props),
hjust = 1.5 ) +
geom_node_point () +
geom_node_label (aes (label = name)) +
theme_void () +
labs (title = "Randhäufigkeiten für A sowie gemeinsame Wahrscheinlichkeiten" )
p1
```
B)
```{r fig.align='center'}
p2 <- ggraph (studis_graph2, layout = 'dendrogram' , circular = FALSE ) +
geom_edge_diagonal (aes (label = studies_prop_cond),
hjust = 1.5 ) +
geom_node_point () +
geom_node_label (aes (label = name)) +
theme_void () +
labs (title = "Randhäufigkeiten für B sowie bedingte Wahrscheinlichkeiten" )
p2
```
C)
```{r}
sol <- A_cond_B %>% round (2 ) %>% as.character ()
```
`r sol`
```{r echo = TRUE}
A_cond_B <- (AandB / B_marg) %>% round (2 )
Aneg_cond_B <- (AnegandB / B_marg) %>% round (2 )
A_cond_Bneg <- (AandBneg / Bneg_marg) %>% round (2 )
Aneg_cond_Bneg <- (AnegandBneg / Bneg_marg) %>% round (2 )
```
$Pr(A) = `r A_marg` $.
$Pr(B) = `r B_marg` $.
$Pr(AB) = `r AandB` $.
$Pr(A|B)= `r A_cond_B` $.
$Pr(\neg A|B) = `r Aneg_cond_B` $.
$Pr(A|\neg B) = `r A_cond_Bneg` $.
$Pr(\neg A|\neg B) = `r Aneg_cond_Bneg` $.
---
Categories:
- probability
- conditional
- bayes
- num