# Spustiť iba raz, pokiaľ balíky chýbajú:
install.packages(c("knitr", "rmarkdown", "broom", "ggplot2"))Econometrics in R – cvičenie 4
Prvé zoznámenie s lineárnou regresiou | analýza hier
1 Predmet výskumu
V tomto cvičení odhadneme a interpretujeme lineárnu regresiu na údajoch o videohrách na platforme Steam zo súboru games_upravene.csv. Z pôvodného cvičenia V. Gazdu preberáme štruktúru a postup (príprava dát, graf, jednoduchá a viacnásobná regresia, tidy(), glance(), rezíduá, predikcia a úlohy), ale všetky premenné, výpočty a závery prispôsobujeme hrám.
Výskumná otázka: Ako súvisí cena hry s počtom pozitívnych hodnotení? Mení sa tento vzťah po zohľadnení počtu negatívnych hodnotení a akčného žánru?
- Na porovnateľnejší prierez použijeme hry vydané v roku 2023.
- Preskúmame rozloženie cien a pozitívnych hodnotení.
- Odhadneme jednoduchú regresiu a vysvetlíme jej koeficienty.
- Pridáme ďalšie vysvetľujúce premenné.
- Porovnáme predikcie s realitou a vyriešime doplňujúce cvičenia.
DôležitéMetodická poznámka
Pozitívne hodnotenia nie sú predaje ani priama miera kvality. Pri hrách môžu závisieť od veku titulu, počtu hráčov, viditeľnosti či marketingu. Vzťahy, ktoré v cvičení odhadujeme, sú asociácie, nie dokázané kauzálne účinky. Analýza je didaktická a neopiera sa o diagnostiku modelových predpokladov.
2 Príprava údajov
2.1 Umiestnenie súboru
Uložte games_upravene.csv do rovnakého priečinka ako tento dokument .qmd. V RStudio / Quarto otvorte súbor a použite Render. Dokument používa vstavanú tmavú tému Quarta, bez samostatného CSS súboru. Výsledky zobrazíme pomocou balíkov broom a knitr, grafy pripravíme pomocou ggplot2.
library(broom)
library(knitr)
library(ggplot2)Operátor |> posiela výsledok príkazu do ďalšej funkcie. Nemusíme používať príkaz na manuálne nastavenie pracovného priečinka. Pri bežnom renderovaní Quarta sa súbor načíta z priečinka dokumentu.
2.2 Načítanie CSV
CSV obsahuje oddeľovač čiarka a desatinný oddeľovač bodka. Každý riadok predstavuje záznam jednej hry. Prierez vytvoríme výberom hier s Rok == 2023.
cesta <- "games_upravene.csv"
if (!file.exists(cesta)) stop("Súbor games_upravene.csv musí byť v rovnakom priečinku ako QMD.")
udaje <- read.csv(cesta, sep = ",", dec = ".", na.strings = c("", "NA"),
check.names = FALSE, stringsAsFactors = FALSE)
names(udaje) <- make.names(trimws(names(udaje)), unique = TRUE)
udaje.2023 <- udaje[!is.na(udaje$Rok) & udaje$Rok == 2023,
c("ID", "Nazov", "Cena", "Pozitivne", "Negativne", "Zanre", "Typ", "Rok")]
head(udaje.2023[, c("Nazov", "Cena", "Pozitivne", "Negativne", "Typ")]) |>
kable(format = "html", digits = 2, row.names = FALSE,
caption = "Prvých šesť hier zo vzorky 2023")| Nazov | Cena | Pozitivne | Negativne | Typ |
|---|---|---|---|---|
| Death Corp | 0.00 | 0 | 0 | Zadarmo |
| Transcendence | 0.00 | 0 | 0 | Zadarmo |
| Crab Champions Playtest | 0.00 | 0 | 0 | Zadarmo |
| BOSSES | 0.00 | 0 | 0 | Zadarmo |
| The 9th Charnel Playtest | 0.00 | 0 | 0 | Zadarmo |
| LOST EGG 3: The Final | 2.69 | 0 | 0 | Platená |
V celom CSV je 97 404 záznamov; v analyzovanom roku 2023 15 542 hier. Ide o prierez naprieč titulmi, nie o časový vývoj jednej hry.
| Premenná | Význam |
|---|---|
| Nazov | Názov hry. |
| Cena | Cena hry v jednotkách CSV (mena nie je v údajoch určená). |
| Pozitivne | Počet pozitívnych hodnotení; pôvodná veličina záujmu. |
| Negativne | Počet negatívnych hodnotení. |
| Zanre | Zoznam žánrov, oddelených čiarkami. |
| Akcna | 1 = žánre obsahujú presne Action, inak 0. |
| LogPozitivne | ln(1 + Pozitivne); vysvetľovaná premenná regresie. |
| LogNegativne | ln(1 + Negativne); vysvetľujúca premenná v rozšírenom modeli. |
Pretože počty hodnotení sú silne asymetrické a mnohé hry majú nula hodnotení, použijeme prirodzený logaritmus log1p(x) = ln(1+x). Takto nestratíme nulové pozorovania. Model predikuje logaritmickú transformáciu počtu, nie priamo počet hodnotení.
2.3 Chýbajúce hodnoty
chybajuce <- data.frame(
Premenna = names(udaje.2023),
Pocet_NA = colSums(is.na(udaje.2023))
)
chybajuce |>
kable(format = "html", row.names = FALSE,
col.names = c("Premenná", "Počet chýbajúcich hodnôt"),
caption = "Chýbajúce hodnoty v roku 2023")| Premenná | Počet chýbajúcich hodnôt |
|---|---|
| ID | 0 |
| Nazov | 0 |
| Cena | 0 |
| Pozitivne | 0 |
| Negativne | 0 |
| Zanre | 1436 |
| Typ | 0 |
| Rok | 0 |
V analyzovanej vzorke nechýba Cena, Pozitivne ani Negativne. Premenná Zanre chýba pri 1436 hrách. Namiesto imputovania žánru mediánom (čo pri texte nedáva zmysel) použijeme pre akčný žáner premennú s hodnotou 1 len vtedy, keď je Action skutočne uvedené. Pri chýbajúcom žánri tak má Akcna = 0; 0 preto zahŕňa aj hry s neznámym žánrom, čo je obmedzenie analýzy.
udaje.2023.povodne <- udaje.2023
# Ak je žáner NA, označíme ho reťazcom "Nezistené".
udaje.2023$Zanre[is.na(udaje.2023$Zanre)] <- "Nezistené"
# Presné členstvo v zozname žánrov (nie iba čiastočná zhoda textu).
udaje.2023$Akcna <- as.integer(vapply(
strsplit(udaje.2023$Zanre, ",", fixed = TRUE),
function(z) "Action" %in% trimws(z), logical(1)))
udaje.2023$LogPozitivne <- log1p(udaje.2023$Pozitivne)
udaje.2023$LogNegativne <- log1p(udaje.2023$Negativne)
premenne <- c("Cena", "Pozitivne", "Negativne", "LogPozitivne", "LogNegativne", "Akcna")
opis <- data.frame(
Premenna = premenne,
Minimum = sapply(udaje.2023[premenne], min),
Median = sapply(udaje.2023[premenne], median),
Priemer = sapply(udaje.2023[premenne], mean),
Maximum = sapply(udaje.2023[premenne], max)
)
opis |>
kable(format = "html", digits = 2, row.names = FALSE,
col.names = c("Premenná", "Minimum", "Medián", "Priemer", "Maximum"),
caption = "Opisná štatistika vybraných premenných")| Premenná | Minimum | Medián | Priemer | Maximum |
|---|---|---|---|---|
| Cena | 0 | 3.99 | 7.48 | 999.98 |
| Pozitivne | 0 | 0.00 | 75.50 | 110177.00 |
| Negativne | 0 | 0.00 | 21.83 | 41287.00 |
| LogPozitivne | 0 | 0.00 | 0.96 | 11.61 |
| LogNegativne | 0 | 0.00 | 0.41 | 10.63 |
| Akcna | 0 | 0.00 | 0.37 | 1.00 |
3 Graf
Pracovná hypotéza: cena môže pozitívne súvisieť s objemom hodnotení (napríklad preto, že drahšie tituly môžu mať vyššiu produkčnú hodnotu či dosah). Zároveň je možné, že závislosť bude slabá. Graf nič nedokazuje o príčinách.
graf_cena <- ggplot(udaje.2023, aes(x = Cena, y = LogPozitivne)) +
geom_point(color = "#60a5fa", size = 1.1, alpha = 0.28) +
coord_cartesian(xlim = c(0, 50)) +
labs(x = "Cena (jednotky v CSV)", y = "ln(1 + počet pozitívnych hodnotení)") +
theme_minimal(base_size = 13)
graf_cena
Odpoveď: Vzťah má vo vzorke mierne rastúcu tendenciu, ale pri podobnej cene sú medzi hrami veľké rozdiely v počte pozitívnych hodnotení. Graf obmedzuje zobrazený rozsah osí; regresný model nižšie zahŕňa všetky ceny, vrátane extrémnych.
4 Jednoduchá lineárna regresia
4.1 Zápis modelu
Najprv použijeme iba cenu:
\[ \operatorname{ln}(1+Pozitivne_i)=\beta_0+\beta_1 Cena_i+u_i. \]
- \(i\) označuje hru vydanú v roku 2023.
- \(\beta_0\) je modelová hodnota LogPozitivne pri cene 0.
- \(\beta_1\) je rozdiel modelovej hodnoty LogPozitivne pri zvýšení ceny o 1 jednotku.
- \(u_i\) predstavuje nevysvetlenú časť výsledku.
Metóda najmenších štvorcov minimalizuje súčet štvorcov rezíduí.
4.2 Odhad pomocou lm()
model1 <- lm(LogPozitivne ~ Cena, data = udaje.2023)
vysledky1 <- tidy(model1)
vysledky1[c("term", "estimate")] |>
kable(format = "html", digits = 5, row.names = FALSE,
col.names = c("Člen modelu", "Odhad koeficienta"),
caption = "Jednoduchá regresia: cena a pozitívne hodnotenia")| Člen modelu | Odhad koeficienta |
|---|---|
| (Intercept) | 0.80367 |
| Cena | 0.02107 |
tidy() prevádza výstup modelu na tabuľku: stĺpec term obsahuje názov koeficienta a estimate jeho hodnotu. Funkcia kable() vytvorí jednoduchú HTML tabuľku bez vlastného štýlovania. Zápis Y ~ X znamená „Y vysvetľujeme pomocou X“.
Pre naše údaje vychádza približne:
\[ \widehat{\operatorname{ln}(1+Pozitivne_i)} = 0.8037 + 0.0211\, Cena_i. \]
Interpretácia smernice: Pri cene vyššej o 1 jednotku je predikovaná hodnota ln(1 + Pozitivne) v jednoduchom modeli vyššia približne o 0.0211. V transformovanej škále zodpovedá jednotkový rozdiel ceny zmene predikovaného ****1 + Pozitivne** približne o 2,13 %** (podľa 100 × (exp(β₁) − 1)), nie automaticky rovnakému percentuálnemu rozdielu samotného počtu recenzií.
Interpretácia konštanty: Pri cene 0 model odhaduje ln(1 + Pozitivne) na približne 0.8037. Cena 0 je v dátach pozorovaná, takže nejde o extrapoláciu mimo rozsah cien.
Poznámka
Zistená súvislosť nedokazuje, že zvýšenie ceny hry spôsobí viac pozitívnych hodnotení. Do vzťahu môžu vstupovať popularita, vek, značka či marketing. Model navyše nie je určený na kauzálnu analýzu.
4.3 Regresná priamka v grafe
graf_cena +
geom_abline(intercept = coef(model1)["(Intercept)"],
slope = coef(model1)["Cena"],
color = "#f472b6", linewidth = 1.1)
5 Viacnásobná lineárna regresia
Počet pozitívnych hodnotení závisí aj od celkovej aktivity hráčov a typu hry. Rozšírime preto regresiu o logaritmus negatívnych hodnotení a indikátor akčného žánru.
\[ \operatorname{ln}(1+Pozitivne_i)=\beta_0+\beta_1 Cena_i+\beta_2\operatorname{ln}(1+Negativne_i)+\beta_3 Akcna_i+u_i. \]
model <- lm(LogPozitivne ~ Cena + LogNegativne + Akcna,
data = udaje.2023)
vysledky <- tidy(model)
vysledky[c("term", "estimate")] |>
kable(format = "html", digits = 5, row.names = FALSE,
col.names = c("Člen modelu", "Odhad koeficienta"),
caption = "Viacnásobná regresia: cena, negatívne hodnotenia a akčný žáner")| Člen modelu | Odhad koeficienta |
|---|---|
| (Intercept) | 0.40676 |
| Cena | 0.00248 |
| LogNegativne | 1.21783 |
| Akcna | 0.09851 |
Odhadnutá rovnica:
\[ \widehat{\operatorname{ln}(1+Pozitivne_i)} = 0.4068 + 0.0025\,Cena_i + 1.2178\,\operatorname{ln}(1+Negativne_i) + 0.0985\,Akcna_i. \]
Cena: Pri nezmenenom počte negatívnych hodnotení a rovnakom indikátore akčného žánru je rozdiel jednej cenovej jednotky spojený s rozdielom 0.0025 v LogPozitivne. Tento koeficient je nižší než v jednoduchom modeli.
Negatívne hodnotenia: Koeficient 1.2178 vyjadruje súvislosť medzi transformovanými počtami pozitívnych a negatívnych hodnotení. Vyšší počet negatívnych hodnotení často sprevádza vyšší celkový objem recenzií. Nie je vhodné interpretovať ho ako účinok negatívnej recenzie na získanie pozitívnej recenzie: obe hodnoty vznikajú v tom istom procese hodnotenia.
Akčný žáner: Pri rovnakých ostatných premenných je predikovaná hodnota LogPozitivne pri hre označenej Action vyššia o 0.0985 než pri zvyšnej skupine (ktorá zahŕňa aj neznáme žánre). Asociácia nemusí mať kauzálne vysvetlenie.
6 Stručný súhrn modelu pomocou glance()
tidy() ukazuje jednotlivé koeficienty, zatiaľ čo glance() sumarizuje celý model.
suhrn <- glance(model)
suhrn[c("nobs", "r.squared", "sigma")] |>
kable(format = "html", digits = c(0, 3, 3), row.names = FALSE,
col.names = c("Počet hier", "R²", "Odhad SD chyby (log škála)"),
caption = "Základné charakteristiky viacnásobného modelu")| Počet hier | R² | Odhad SD chyby (log škála) |
|---|---|---|
| 15542 | 0.667 | 0.921 |
- nobs = počet hier v regresii.
- r.squared = podiel výberovej variability transformovanej vysvetľovanej premennej zachytený modelom.
- sigma = odhad štandardnej odchýlky rezíduí v logaritmickej škále.
V našej vzorke je \(R^2 \approx 0,667\), teda model zachytáva približne 66,7 % variability ln(1+Pozitivne). Nie je to percento správne predikovaných hier a neznamená to kauzalitu. Vyššie \(R^2\) súvisí aj s tým, že pozitívne a negatívne recenzie odrážajú podobnú aktivitu publika.
summary(model) zobrazí podrobnejší výstup vrátane štandardných chýb a testov; tie v tomto úvodnom cvičení detailne neanalyzujeme.
7 Skutočná hodnota, predikcia a rezíduum
Rezíduum je rozdiel skutočnej a predikovanej hodnoty na rovnakej logaritmickej škále:
\[e_i=\operatorname{ln}(1+Pozitivne_i)-\widehat{\operatorname{ln}(1+Pozitivne_i)}.\]
porovnanie <- data.frame(
Hra = udaje.2023$Nazov,
Skutocnost = udaje.2023$LogPozitivne,
Predikcia = fitted(model),
Reziduum = residuals(model)
)
head(porovnanie, 8) |>
kable(format = "html", digits = 3, row.names = FALSE,
col.names = c("Hra", "Skutočnosť (log)", "Predikcia (log)", "Rezíduum"),
caption = "Skutočné a odhadnuté hodnoty v logaritmickej škále")| Hra | Skutočnosť (log) | Predikcia (log) | Rezíduum |
|---|---|---|---|
| Death Corp | 0 | 0.407 | -0.407 |
| Transcendence | 0 | 0.407 | -0.407 |
| Crab Champions Playtest | 0 | 0.407 | -0.407 |
| BOSSES | 0 | 0.505 | -0.505 |
| The 9th Charnel Playtest | 0 | 0.407 | -0.407 |
| LOST EGG 3: The Final | 0 | 0.512 | -0.512 |
| Mecha Blade | 0 | 0.525 | -0.525 |
| Integument | 0 | 0.407 | -0.407 |
Overenie: V každom riadku platí Skutocnost - Predikcia = Reziduum (s rozdielmi len z dôvodu zaokrúhlenia). Kladné rezíduum znamená viac pozitívnych hodnotení na logaritmickej škále, než model predikuje; záporné menej.
8 Predikcia pre zadanú hodnotu
Pre ceny 0, 5 a 15 použijeme jednoduchý model. Všetky patria do rozsahu pozorovaných cien. Spätne transformované expm1(predikcia) je exp(predikcia) − 1; nejde o neskreslenú predikciu priemerného počtu recenzií na pôvodnej škále.
nove_udaje <- data.frame(Cena = c(0, 5, 15))
nove_udaje$Predikcia_log <- predict(model1, newdata = nove_udaje)
nove_udaje$Spatna_transformacia <- expm1(nove_udaje$Predikcia_log)
nove_udaje |>
kable(format = "html", digits = 3, row.names = FALSE,
col.names = c("Cena", "Predikcia ln(1 + pozitívne)", "exp(predikcia) − 1"),
caption = "Predikcie z jednoduchého regresného modelu")| Cena | Predikcia ln(1 + pozitívne) | exp(predikcia) − 1 |
|---|---|---|
| 0 | 0.804 | 1.234 |
| 5 | 0.909 | 1.482 |
| 15 | 1.120 | 2.064 |
Napríklad pri cene 5 je predikcia približne 0,909 na logaritmickej škále. Predikcia nie je zárukou skutočného počtu pozitívnych hodnotení konkrétnej hry.
9 Malé cvičenia
9.1 Identifikujte premenné
Zadanie: Ktorá premenná je vysvetľovaná a ktoré sú vysvetľujúce?
Riešenie: Vysvetľovaná je LogPozitivne = ln(1 + Pozitivne). V jednoduchom modeli je vysvetľujúca Cena; vo viacnásobnom modeli sú to Cena, LogNegativne a Akcna.
9.2 Alternatívna jednoduchá regresia
Zadanie: Odhadnite model s LogNegativne ako jediným vysvetľujúcim ukazovateľom, zobrazte koeficienty v tabuľke a graf s regresnou priamkou.
model2 <- lm(LogPozitivne ~ LogNegativne, data = udaje.2023)
tidy(model2)[, c("term", "estimate")] |>
kable(format = "html", digits = 4, row.names = FALSE,
col.names = c("Člen modelu", "Odhad koeficienta"),
caption = "Cvičenie 2 – samostatná regresia na negatívnych hodnoteniach")| Člen modelu | Odhad koeficienta |
|---|---|
| (Intercept) | 0.4555 |
| LogNegativne | 1.2319 |
ggplot(udaje.2023, aes(x = LogNegativne, y = LogPozitivne)) +
geom_point(color = "#60a5fa", alpha = 0.20, size = 1) +
geom_abline(intercept = coef(model2)["(Intercept)"],
slope = coef(model2)["LogNegativne"],
color = "#f472b6", linewidth = 1) +
labs(x = "ln(1 + negatívne)", y = "ln(1 + pozitívne)") +
theme_minimal(base_size = 13)
Výsledok: \(\widehat{LogPozitivne} \approx 0.4555 + 1.2319\,LogNegativne\). Vidíme kladnú súvislosť súvisiacu s celkovou aktivitou hodnotení, nie dôkaz príčiny a následku.
9.3 Porovnajte koeficient ceny v dvoch modeloch
Riešenie: V jednoduchom modeli je smernica ceny 0.0211, v rozšírenom 0.0025. Prvý porovnáva hry podľa ceny bez ďalších kontrol; druhý porovnáva pri rovnakom logaritme negatívnych hodnotení a rovnakom indikátore žánru Action. Koeficienty preto nevyjadrujú tú istú podmienenú asociáciu.
9.4 Predikcia pre cenu 13
cena_13 <- data.frame(Cena = 13)
modelova_predikcia <- predict(model1, newdata = cena_13)
rucna_predikcia <- unname(coef(model1)[1] + 13 * coef(model1)[2])
data.frame(Postup = c("Funkcia predict()", "Ručné dosadenie"),
Predikcia_log = c(unname(modelova_predikcia), rucna_predikcia)) |>
kable(format = "html", digits = 5, row.names = FALSE,
caption = "Cvičenie 4 – overenie predikcie")| Postup | Predikcia_log |
|---|---|
| Funkcia predict() | 1.07755 |
| Ručné dosadenie | 1.07755 |
Riešenie: \(0.8037 + 13\times 0.0211 \approx 1,0776\). Oba postupy sa zhodujú (až na zaokrúhlenie).
9.5 Nájdite kladné a záporné rezíduum
priklad_plus <- head(porovnanie[porovnanie$Reziduum > 0, ], 1)
priklad_minus <- head(porovnanie[porovnanie$Reziduum < 0, ], 1)
priklady <- rbind(priklad_plus, priklad_minus)
priklady |>
kable(format = "html", digits = 3, row.names = FALSE,
caption = "Cvičenie 5 – príklad kladného a záporného rezídua")| Hra | Skutocnost | Predikcia | Reziduum |
|---|---|---|---|
| Double Line Confrontation：New World（双线交锋：新世界） | 0.693 | 0.523 | 0.171 |
| Death Corp | 0.000 | 0.407 | -0.407 |
Riešenie: Pri prvom riadku model podhodnotil logaritmovaný počet pozitívnych recenzií; pri druhom ho nadhodnotil. Rezíduá nehodnotia, či je hra „dobrá“ alebo „zlá“.
9.6 Prečo nejde o kauzálny vzťah?
Riešenie: Cena nie je náhodne pridelená a populárnejšie hry sa môžu líšiť v rozpočte, propagácii, značke, hráčskej základni a ďalších charakteristikách. Navyše počet negatívnych hodnotení súvisí s počtom pozitívnych prostredníctvom celkového objemu recenzií. Pozorované korelácie preto nemôžeme bez ďalšieho považovať za príčinné účinky.
Zdroj dát: používateľský súbor games_upravene.csv. Metodická štruktúra: adaptácia cvičenia 4 od V. Gazdu. Všetky číselné interpretácie sa týkajú výberu hier z roku 2023. Výpočty sa pri renderovaní vykonávajú priamo z CSV.