library(tidyverse)
library(plotly)
library(reactable)
library(glue)Adventskalender
Lions-Landshut
1 Adventskalender
Losnummern und tagesweise Ziehungen der Adventskalenderaktion des Lions-Club Landshut.
2 CSV-Daten einlesen
Tagesweise werden auf den Webseiten des Lions-Club Landshut zur Adventskalenderaktion die gelosten Adventskalendernummern, sowie die verlosten Preise und deren Geldwert veröffentlicht. Der Einfachheit halber verzeichnen wir hier die Ergebnisse in einer CSV-Datei; dies erspart uns das web-scraping.
adventsKalender <- read_csv("losziehungen-2024.csv")3 CSV-Objekt
Lassen wir uns kurz die 10 ersten Zeilen (von oben her) ausgeben.
adventsKalender |>
head(n = 10)# A tibble: 10 × 4
Dezember Losnummer Rang Preis
<dbl> <dbl> <dbl> <dbl>
1 1 5046 1 600
2 1 4675 2 149
3 1 4390 3 149
4 1 3508 4 149
5 1 3400 5 50
6 2 2516 1 1000
7 2 4411 2 200
8 2 1175 3 125
9 2 1082 4 35
10 3 1753 1 2504 als schönere Tabelle
Die tabellarische Darstellung kann optimiert werden:
adventsKalender |>
reactable(
defaultPageSize = 20,
compact = TRUE,
searchable = TRUE,
bordered = TRUE,
highlight = TRUE,
theme = reactableTheme(style = list(fontSize = "12pt"))
)5 Visualisierung mit ggplot
Versuchen wir hier nun eine andere Darstellung der Streung einzelner Losungen. Nehmen wir hierzu die Dezembertage – und damit die jeweiligen Losungen – auf die X-Achse und die jeweilige Adventskalendernummer auf die Hoch-Achse.
Hier bereiten wir erstmal die Leinwand vor, auf welcher später dann unser Streudiagramm angezeigt werden soll. Wir wollen diese Art des Aufbaus verwenden, weil wir zu einem späteren Zeitpunkt wieder auf die Vorarbeiten zurückgreifen wollen, ohne uns zu sehr/oft zu wiederholen.
adventsKalenderGgplot <- adventsKalender |>
ggplot(
aes(
x = factor(Dezember),
y = Losnummer
)
) +
theme_minimal() +
theme(
axis.title.x = element_text(vjust = -5),
axis.title.y = element_text(vjust = 5),
plot.title = element_text(vjust = 5),
plot.caption = element_text(vjust = -5),
plot.margin = margin(1.4, 1, 1, 1, "cm")
) +
labs(
title = "Adventskalenderauslosungen, Lions-Club Landshut",
caption = "(Daten von der Lions-Club Landshut Website)",
x = "Dezembertag"
) +
scale_y_continuous(
breaks = seq(
from = 0,
to = 7000,
by = 1000
),
limits = c(0, 7000)
)
adventsKalenderGgplot
Das Objekt adventsKalenderGgplot beinhaltet nun diese Leinwand. Fügen wir nun die Daten hinzu:
adventsKalenderGgplot +
geom_point(
aes(
x = factor(Dezember),
y = Losnummer
),
size = 5,
alpha = 0.7
)
6 Visualisierung mit plotly
Hier nun noch eine weitere Variante. Eine interaktive Darstellung mit plotly:
adventsKalender |>
plot_ly(
x = ~Dezember,
y = ~Losnummer,
type = "scatter",
mode = "markers",
marker = list(
color = "red",
size = 14
)
) |>
layout(
title = "jeden Tag nur ein Türchen!",
xaxis = list(title = list(text = "Dezembertag", standoff = 20))
)7 Verteilung hinsichtlich Rang/Preis
Pro Tageslosung gibt es mehrere Preise. Welche Möglichkeiten haben wir dies ebenfalls noch in unseren Darstellungen mitzuberücksichtigen:
adventsKalenderGgplot +
geom_point(
aes(
x = factor(Dezember),
y = Losnummer,
colour = factor(Rang)
),
size = 5,
alpha = 0.7
) +
labs(colour = "Rang/Preis") +
scale_colour_viridis_d(direction = -1)
8 checking randomness? no!
Exkurs: Im vorliegenden Fall kann ein Los nur einmal gezogen werden. Entnahme ohne Rückgabe. Zufall mit dieser Datenmenge nahzuweisen wird eh nicht gelingen. Deswegen schauen wir uns die Verteilung an, welche wir mit Zufallszahlengeneratoren bekommen können. Einmal für eine kleine Anzahl von Zahlen, einmal mit etwas größer Wiederhoung:
auslosungen <- params$casinoSmall
set.seed(5)
histPlot <- sample(
x = c(1:38),
size = auslosungen,
replace = TRUE
) |>
hist(
breaks = c(1:39),
border = "white",
xaxt = "n",
main = glue("Casino mit {format(auslosungen, scientific = FALSE)} Auslosungen"),
xlab = "die möglichen Felder beim Roulette",
ylab = "Häufigkeitsverteilungen"
)
axis(
side = 1,
at = histPlot$mids,
labels = seq(1, 38)
)
Statt nun aber gerade einmal 50-mal zu ziehen/würfeln/testen sehen wir uns die Verteilung nun für 1000000 Züge an:
auslosungen <- params$casinoBig
set.seed(5)
histPlot <- sample(
x = c(1:38),
size = auslosungen,
replace = TRUE
) |>
hist(
breaks = seq(from = 0, to = 38, by = 1),
border = "white",
xaxt = "n",
main = glue("Casino mit {format(auslosungen, scientific = FALSE)} Auslosungen"),
xlab = "die möglichen Felder beim Roulette",
ylab = "Häufigkeitsverteilungen"
)
axis(
side = 1,
at = histPlot$mids,
labels = seq(1, 38)
)
9 trotzdem kurzer Test
Kritikpunkte der geringen Anzahl unserer Stichprobe, des Nicht-Zurücklegens, wie auch die Komplexität Zufall zu testen bleiben bestehen. Dennoch wollen wir nun unsere Daten nochmal in 1000er-Kohorten visualisieren – aufgrund der bisherigen Losziehungen von 0 bis 6489 gehen wir verkauften Adventskalendern < 7000 aus. Mit 1000er-Kohorten könnten wir dann die Verteilung ganz gut darstellen.
10 1000er-Kohorten
adventsKalender$Losnummer |>
hist(
breaks = seq(
from = 0,
to = 7000,
by = 1000
),
main = glue("Verteilung der Losziehungen ({adventsKalender$Losnummer |> length()}) in 1000er-Schritten"),
xlab = "1000er-Kohorten",
ylab = "Anzahl",
border = "white"
)
11 sonstnochwas ?
Hier wollen wir nochmal bestimmte Werte aus dem Datensatz im Text verwerten:
Die bisherigen Verlosungen sind bis zum 11. Dezember verzeichnet. Es wurden bisher an den 11 Tagen insgesamt 42 Teilverlosungen durchgeführt mit der bisherigen Gesamtpreissumme von ca. 17875 Euro. Die Einzelverlosungen an den jeweiligen Tagesauslosung entsprechen ungefähr auch einer preislich absteigenden Sortierung, dies muss aber nicht immer der Fall sein, siehe 11ter Dezember:
Code
adventsKalender |>
filter(Dezember == 11) |>
select(Dezember, Rang, Preis) |>
reactable(
columns = list(
Dezember = colDef(align = "center"),
Rang = colDef(align = "center"),
Preis = colDef(
format = colFormat(
currency = "EUR",
separators = TRUE,
locales = "de-DE"
)
)
)
)- 1: 11
- 2: 11
- 3: 11
- 4: 8
- 5: 1
follow the money!