Potrebné balíky
#| label: instalacia #| eval: false
install.packages(c( “readxl”, “janitor”, “dplyr”, “ggplot2”, “broom”, “knitr”, “kableExtra” ))
#| label: nacitanie
cesta <- “data/data.xlsx”
if (!file.exists(cesta)) { stop(“Súbor data/data.xlsx sa nenašiel. Skontrolujte jeho umiestnenie.”) }
udaje <- read_excel(cesta) |> clean_names()
cat(“Počet respondentov:”, nrow(udaje), “”) cat(“Počet premenných:”, ncol(udaje), “”)
head(udaje, 6) |> kable( format = “html”, digits = 3, row.names = FALSE, caption = “Prvých šesť riadkov databázy” ) |> kable_styling( bootstrap_options = c(“striped”, “hover”), full_width = FALSE )
#| label: prehlad-premennych
prehľad_premennych <- data.frame( Premenna = names(udaje), Typ = sapply(udaje, function(x) class(x)[1]), Pocet_chybajucich = sapply(udaje, function(x) sum(is.na(x))) )
prehľad_premennych |> kable( format = “html”, row.names = FALSE, col.names = c( “Premenná”, “Typ údajov”, “Počet chýbajúcich hodnôt” ), caption = “Prehľad premenných a ich dátových typov” ) |> kable_styling( bootstrap_options = c(“striped”, “hover”), full_width = FALSE )
cat(“Názvy stĺpcov v databáze:”) print(names(udaje))
#| label: chybajuce-hodnoty
chybajuce <- data.frame( Premenna = names(udaje), Pocet_NA = sapply(udaje, function(x) sum(is.na(x))), Podiel_NA_percent = sapply( udaje, function(x) mean(is.na(x)) * 100 ) )
chybajuce |> kable( format = “html”, digits = 2, row.names = FALSE, col.names = c( “Premenná”, “Počet chýbajúcich hodnôt”, “Podiel chýbajúcich hodnôt (%)” ), caption = “Chýbajúce hodnoty v pôvodnej databáze” ) |> kable_styling( bootstrap_options = c(“striped”, “hover”), full_width = FALSE )
#| label: graf-chybajucich #| fig-cap: “Počet chýbajúcich hodnôt podľa premennej.” #| fig-width: 9 #| fig-height: 5
ggplot( chybajuce, aes(x = reorder(Premenna, Pocet_NA), y = Pocet_NA) ) + geom_col(fill = “steelblue”) + coord_flip() + labs( x = “Premenná”, y = “Počet chýbajúcich hodnôt”, title = “Kontrola úplnosti údajov” ) + theme_minimal(base_size = 12)
#| label: opisna-statistika
ciselne_premenne <- names(udaje)[sapply(udaje, is.numeric)]
if (length(ciselne_premenne) > 0) {
opisna_statistika <- data.frame( Premenna = ciselne_premenne, Pocet = sapply( udaje[ciselne_premenne], function(x) sum(!is.na(x)) ), Minimum = sapply( udaje[ciselne_premenne], function(x) if (all(is.na(x))) NA_real_ else min(x, na.rm = TRUE) ), Median = sapply( udaje[ciselne_premenne], function(x) if (all(is.na(x))) NA_real_ else median(x, na.rm = TRUE) ), Priemer = sapply( udaje[ciselne_premenne], function(x) if (all(is.na(x))) NA_real_ else mean(x, na.rm = TRUE) ), Smerodajna_odchylka = sapply( udaje[ciselne_premenne], function(x) if (sum(!is.na(x)) < 2) NA_real_ else sd(x, na.rm = TRUE) ), Maximum = sapply( udaje[ciselne_premenne], function(x) if (all(is.na(x))) NA_real_ else max(x, na.rm = TRUE) ) )
opisna_statistika |> kable( format = “html”, digits = 3, row.names = FALSE, caption = “Opisná štatistika číselných premenných” ) |> kable_styling( bootstrap_options = c(“striped”, “hover”), full_width = FALSE )
} else {
cat(“V databáze sa nenašli číselné premenné.”)
}
#| label: priprava-skore
najdi_premenne <- function(vzory, nazvy) { unique(unlist( lapply( vzory, function(vzor) { grep(vzor, nazvy, ignore.case = TRUE, value = TRUE) } ) )) }
vytvor_skore <- function(data, vzory, nazov) {
kandidati <- najdi_premenne(vzory, names(data)) kandidati <- kandidati[sapply(data[kandidati], is.numeric)]
if (length(kandidati) == 0) { return(list(data = data, prem = NA_character_)) }
vzor_skore <- “total|sum|mean|score|average|overall|composite|celk|priemer|skore” kandidati_skore <- kandidati[ grepl(vzor_skore, kandidati, ignore.case = TRUE) ]
if (length(kandidati_skore) > 0) {
vybrana <- kandidati_skore[1]
data[[nazov]] <- data[[vybrana]]
} else {
matica <- data[candidati]
data[[nazov]] <- rowMeans(matica, na.rm = TRUE)
data[[nazov]][rowSums(!is.na(matica)) == 0] <- NA_real_
}
list(data = data, prem = nazov) }
vysledok_podpora <- vytvor_skore( udaje, c(“psss”, “social_support”, “socialsupport”, “support”), “socialna_podpora” )
udaje <- vysledok_podpora\(data
prem_podpora <- vysledok_podpora\)prem
vysledok_prosocialne <- vytvor_skore( udaje, c(“prosocial”, “pro_social”, “prosocialne”), “prosocialne_spravanie” )
udaje <- vysledok_prosocialne\(data
prem_prosocialne <- vysledok_prosocialne\)prem
vysledok_antisocialne <- vytvor_skore( udaje, c(“antisocial”, “anti_social”, “antisocialne”), “antisocialne_spravanie” )
udaje <- vysledok_antisocialne\(data
prem_antisocialne <- vysledok_antisocialne\)prem
vysledok_uzkost <- vytvor_skore( udaje, c(“social_anxiety”, “socialanxiety”, “(^|)sas($|)”, “uzkost”), “socialna_uzkost” )
udaje <- vysledok_uzkost\(data
prem_uzkost <- vysledok_uzkost\)prem
vysledok_odolnost <- vytvor_skore( udaje, c(“cd_risc”, “cdrisc”, “resilience”, “odolnost”), “psychicka_odolnost” )
udaje <- vysledok_odolnost\(data
prem_odolnost <- vysledok_odolnost\)prem
rozpoznane <- data.frame( Konstruk = c( “Sociálna podpora”, “Prosociálne správanie”, “Antisociálne správanie”, “Sociálna úzkosť”, “Psychická odolnosť” ), Premenna_v_analyze = c( prem_podpora, prem_prosocialne, prem_antisocialne, prem_uzkost, prem_odolnost ) )
rozpoznane |> kable( format = “html”, row.names = FALSE, col.names = c(“Konštrukt”, “Použitá premenná”), caption = “Automaticky identifikované premenné” ) |> kable_styling( bootstrap_options = c(“striped”, “hover”), full_width = FALSE )
#| label: graf-podpora-prosocialne #| fig-cap: “Vzťah medzi sociálnou podporou a prosociálnym správaním.” #| fig-width: 8 #| fig-height: 5
if (!is.na(prem_podpora) && !is.na(prem_prosocialne)) {
graf_data <- udaje |> filter( !is.na(.data[[prem_podpora]]), !is.na(.data[[prem_prosocialne]]) )
ggplot( graf_data, aes( x = .data[[prem_podpora]], y = .data[[prem_prosocialne]] ) ) + geom_point(color = “steelblue”, size = 2, alpha = 0.6) + labs( x = “Sociálna podpora”, y = “Prosociálne správanie”, title = “Sociálna podpora a prosociálne správanie” ) + theme_minimal(base_size = 13)
} else {
cat(“Graf nemožno vytvoriť, pretože sa nepodarilo rozpoznať potrebné premenné.”)
}
#| label: jednoducha-regresia-prosocialne
model1 <- NULL data_model1 <- NULL
if (!is.na(prem_podpora) && !is.na(prem_prosocialne)) {
data_model1 <- udaje |> filter( is.finite(.data[[prem_podpora]]), is.finite(.data[[prem_prosocialne]]) )
if ( nrow(data_model1) >= 3 && length(unique(data_model1[[prem_podpora]])) > 1 ) {
model1 <- lm(
reformulate(prem_podpora, response = prem_prosocialne),
data = data_model1
)
tidy(model1)[c("term", "estimate")] |>
kable(
format = "html",
digits = 4,
row.names = FALSE,
col.names = c("Člen modelu", "Odhad koeficienta"),
caption = "Jednoduchá regresia prosociálneho správania"
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)
} else {
cat("Na odhad jednoduchej regresie nie je dostatok vhodných údajov.")
}
} else {
cat(“Jednoduchú regresiu nemožno odhadnúť bez potrebných premenných.”)
}
#| label: regresna-priamka-prosocialne #| fig-cap: “Bodový graf s odhadnutou regresnou priamkou.” #| fig-width: 8 #| fig-height: 5
if (!is.null(model1)) {
ggplot( data_model1, aes( x = .data[[prem_podpora]], y = .data[[prem_prosocialne]] ) ) + geom_point(color = “steelblue”, alpha = 0.6) + geom_abline( intercept = coef(model1)[1], slope = coef(model1)[2], color = “firebrick”, linewidth = 1 ) + labs( x = “Sociálna podpora”, y = “Prosociálne správanie”, title = “Odhadnutá regresná priamka” ) + theme_minimal(base_size = 13)
} else {
cat(“Regresnú priamku nemožno zobraziť bez odhadnutého modelu.”)
}
#| label: jednoducha-regresia-antisocialne
model_anti <- NULL data_model_anti <- NULL
if (!is.na(prem_podpora) && !is.na(prem_antisocialne)) {
data_model_anti <- udaje |> filter( is.finite(.data[[prem_podpora]]), is.finite(.data[[prem_antisocialne]]) )
if ( nrow(data_model_anti) >= 3 && length(unique(data_model_anti[[prem_podpora]])) > 1 ) {
model_anti <- lm(
reformulate(prem_podpora, response = prem_antisocialne),
data = data_model_anti
)
tidy(model_anti)[c("term", "estimate")] |>
kable(
format = "html",
digits = 4,
row.names = FALSE,
col.names = c("Člen modelu", "Odhad koeficienta"),
caption = "Jednoduchá regresia antisociálneho správania"
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)
} else {
cat("Na odhad modelu nie je dostatok vhodných údajov.")
}
} else {
cat(“Regresiu nemožno odhadnúť bez potrebných premenných.”)
}
#| label: viacnasobna-regresia
model <- NULL data_model <- NULL
potrebne_premenne <- c( prem_antisocialne, prem_podpora, prem_uzkost, prem_odolnost )
if ( all(!is.na(potrebne_premenne)) && all(potrebne_premenne %in% names(udaje)) ) {
data_model <- udaje |> filter( if_all( all_of(potrebne_premenne), ~ is.finite(.x) ) )
if ( nrow(data_model) >= 5 && all(sapply( data_model[potrebne_premenne], function(x) length(unique(x)) > 1 )) ) {
model <- lm(
reformulate(
c(prem_podpora, prem_uzkost, prem_odolnost),
response = prem_antisocialne
),
data = data_model
)
tidy(model)[c("term", "estimate")] |>
kable(
format = "html",
digits = 6,
row.names = FALSE,
col.names = c("Člen modelu", "Odhad koeficienta"),
caption = "Viacnásobná regresia antisociálneho správania"
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)
} else {
cat(
"Na viacnásobnú regresiu nie je dostatok vhodných údajov ",
"alebo niektorá premenná nemá dostatočnú variabilitu."
)
}
} else {
cat( “Viacnásobnú regresiu nemožno zostaviť, pretože sa nepodarilo”, “identifikovať všetky potrebné premenné.” )
}
#| label: suhrn-modelu
if (!is.null(model)) {
suhrn_modelu <- glance(model)
suhrn_modelu[c(“nobs”, “r.squared”, “sigma”)] |> kable( format = “html”, digits = 3, row.names = FALSE, col.names = c( “Počet pozorovaní”, “R²”, “Odhad SD rezíduí” ), caption = “Základné charakteristiky viacnásobného modelu” ) |> kable_styling( bootstrap_options = c(“striped”, “hover”), full_width = FALSE )
} else {
cat( “Súhrn viacnásobného modelu nie je dostupný,”, “pretože sa model nepodarilo odhadnúť.” )
}
#| label: skutocnost-predikcia
if (!is.null(model)) {
porovnanie <- data.frame( Skutocna_hodnota = model.response(model.frame(model)), Predikcia = fitted(model), Reziduum = residuals(model) )
head(porovnanie, 10) |> kable( format = “html”, digits = 3, row.names = FALSE, col.names = c( “Skutočná hodnota”, “Predikcia”, “Rezíduum” ), caption = “Porovnanie skutočných a predikovaných hodnôt” ) |> kable_styling( bootstrap_options = c(“striped”, “hover”), full_width = FALSE )
} else {
cat( “Porovnanie nie je dostupné, pretože sa nepodarilo”, “odhadnúť viacnásobný model.” )
}
#| label: predikcia-jednoducha
if (!is.null(model1)) {
rozsah_podpory <- range( data_model1[[prem_podpora]], na.rm = TRUE )
nove_udaje <- data.frame( hodnota = seq( rozsah_podpory[1], rozsah_podpory[2], length.out = 3 ) )
names(nove_udaje) <- prem_podpora
nove_udaje$Predikcia <- predict( model1, newdata = nove_udaje )
nove_udaje |> kable( format = “html”, digits = 3, row.names = FALSE, col.names = c( “Sociálna podpora”, “Predikcia prosociálneho správania” ), caption = “Predikcie jednoduchého regresného modelu” ) |> kable_styling( bootstrap_options = c(“striped”, “hover”), full_width = FALSE )
} else {
cat( “Predikciu nemožno vypočítať, pretože jednoduchý model”, “nie je dostupný.” )
}
