### 8 JEDNOVYBEROVE PARAMETRICKE TESTY
# 8.1 (Test o rozptylu)

data <- 'TO-DO'
skull.HM <-'TO-DO' # vyber muzi, promenna skull.H 
skull.HM <- 'TO-DO' # odstraneni NA
n <- 'TO-DO' # pocet objektu

# overeni predpokladu normality pro test
# predpoklad normality znaku skull.H splnen (priklad 7.1 - testovani na hladine vyznamnosti 0.05)

# testy pro jednostrannou alternativu
alpha <- 0.10
sigma0 <- 5.171^2 

# pomoci fce varTest
# install.packages("EnvStats")
EnvStats::varTest(as.numeric(skull.HM), sigma.squared = sigma0, 
                  alternative = 'less', conf.level = 1 - alpha)

# kriticky obor musime vypocitat rucne
(q <- qchisq(alpha, n - 1))

# vypocet pomoci vzorcu
s <- sd(skull.HM) 
fw <- (n - 1) * s ^ 2 / sigma0 # testovaci statistika
q <- qchisq(alpha, n - 1) # krit. obor
(tab <- data.frame(fw = fw, q = q))

(hh <- (n - 1) * s ^ 2 / qchisq(alpha, n - 1)) # hranice int. spolehlivosti

(p.hodnota <- pchisq(fw, n - 1)) # p-hodnota



# 8.2 (Test o stredni hodnote pri neznamem rozptylu) 
data <- 'TO-DO'
'TO-DO' # vyfiltrujte zeny, promennou skull.L
'TO-DO' # odstraneni NA
n <- 'TO-DO'

# test normality dat (predpokladu pro parametricky test)
nortest::lillie.test(skull.LF)$p.val 

# vizualni posouzeni normality
'TO-DO' # histogram s krivkou hustoty

'TO-DO' # qqnorm prolozeny primkou

# test o stredni hodnote pri neznamem rozptylu
# pomoci funkce
alpha <- 0.10
mu0 <- 171.962
t.test(skull.LF, mu = 171.962, alternative = 'two.sided',
       conf.level = 1 - alpha)
data.frame(q1 = qt(alpha / 2, n - 1), q2 = qt(1 - alpha / 2, n - 1)) # 2.361372

# a (pomoci kritickeho oboru)
m <- mean(skull.LF)
s <- sd(skull.LF)
tw <- (m - mu0) / s * sqrt(n) # 4.314569
q1 <- qt(alpha / 2, n - 1) # -2.361372
q2 <- qt(1 - alpha / 2, n - 1) # 2.361372
(tab <- data.frame(tw = tw, q1 = q1, q2 = q2))

# b (pomoci intervalu spolehlivosti)
dh <- m - s / sqrt(n) * qt(1 - alpha / 2, n - 1)
hh <- m - s / sqrt(n) * qt(alpha / 2, n - 1)
(tab <- data.frame(dh = dh, hh = hh)) # 172.9702; 176.0941

# c (pomoci p-hodnoty)
p.hodnota <- 2 * min(pt(tw, n - 1), 1 - pt(tw, n - 1))
(tab <- data.frame(p = p.hodnota)) # 3.553156e-05

# graficka vizualizace vysledku
par(mar = c(0, 4, 1, 1))
m <- mean(skull.LF)
boxplot(skull.LF, col = 'darkolivegreen1', ylim = c (155, 200),
        xlab = '', ylab = 'nejvetsi delka mozkovny (v mm)', las = 1, 
        medcol = 'green4', border = 'darkgreen')
points(m, bg = 'darkgreen', pch = 21, cex = 1.1, col = 'darkgreen')
points(mu0, bg = 'orange', pch = 21, cex = 1.1, col = 'black')
legend('topright', pch = 21, col = c('darkgreen', 'black'), pt.bg = c('darkgreen', 'orange'), 
       bty = 'n', legend = c('staroveka pop.', 'novoveka pop.'))



# 8.3 (Parovy test)

data <- 'TO-DO'
'TO-DO' # vynechani NA
length.RM <- 'TO-DO' # vyber muzi, promenna length.R
length.LM <- 'TO-DO' # vyber muzi, promenna length.L
diff <- length.LM - length.RM # rozdil delek
n <- 'TO-DO' # pocet objektu

# test normality rozdilu (predpoklad parametrickeho testu)
nortest::ad.test(diff)$p.val 

# vizualni posouzeni normality
'TO-DO' 

# test o stredni hodnote pri neznamem rozptylu
# parovy t-test
alpha <- 0.05

t.test(length.LM, length.RM, paired = T, alternative = 'greater',
       conf.level = 1 - alpha)
(q = qt(1 - alpha, n - 1)) # kriticka hodnota

# pomoci vzorcu
mu0 <- 0
m <- mean(diff)
s <- sd(diff)
tw <- (m - mu0) / s * sqrt(n) # test. statistika
q <- qt(1 - alpha, n - 1) # krit.obor

(dh <- m - s / sqrt(n) * qt(1 - alpha, n - 1)) # hranice IS

(p.hodnota <- 1 - pt(tw, n - 1)) # p-hodnota

# graficka vizualizace vysledku
par(mar = c(2, 4, 1, 1))
boxplot(length.LM, length.RM, names = c('leva strana', 'prava strana'), xlab = '', ylim = c(120, 190),
        ylab = 'delka klicni kosti (v mm)', las = 1, col = 'lightgoldenrodyellow',
        medcol = 'orange2',  border = 'orange4')
points(c(mean(length.LM), mean(length.RM)), pch = 19, col = 'brown4', cex = 1.1)
legend('topright', pch = c(NA, 19), lty = c(1, NA), lwd = c(2, NA), 
       legend = c('median', 'prumer'), bty = 'n', horiz = T)

boxplot(diff, xlab = '', ylim = c(-10, 10),
        ylab = 'rozdil leve a prave klicni kosti', las = 1, col = 'lightgoldenrodyellow',
        medcol = 'orange2',  border = 'orange4')
segments(0.8, 0, 1.2, 0, lty = 2, col = 'brown2', lwd = 2)
points(mean(diff), pch = 19, col = 'brown4', cex = 1.1)
legend('bottomright', pch = c(NA, 19), lty = c(2, NA), lwd = c(2, NA), 
       col = c('brown2', 'brown4'), 
       legend = c('x = 0', 'prumer'), bty = 'n', horiz = T)



# 8.4 (Test o korelacnim koeficientu) 
data <- 'TO-DO'
data.F <- 'TO-DO'# vyber zeny, prom. skull.H a base.B
data.F <- 'TO-DO' # odstraneni NA
skull.HF <- 'TO-DO' # promenna skull.H
base.BF <- 'TO-DO' # promenna base.B
n <- # pocet pozorovani
rho <- 'TO-DO' # vypocet korelacniho koeficientu

# test dvourozmerne normality (predpokladu parametrickeho testu)
'TO-DO'

# vizualni posouzeni normality
Z <- MASS::kde2d(skull.HF, base.BF, n = 50, lims = c(108, 152, 100, 130))
par(mar = c(0, 2, 0, 2))
GA::persp3D(Z$x, Z$y, Z$z, ticktype = 'simple', xlab = 'vyska lebky',
            ylab = 'sirka lebecni baze', zlab = "relativni cetnost", 
            col.palette = heat.colors, border = 'black', theta = 15, phi = 30)

par(mar = c(3, 4, 2, 1))
car::dataEllipse(skull.HF, base.BF, level = 0.95, pch = 21,  col = 'red3', 
                 bg = 'yellow', lwd = 2, xlim = c(105, 150), 
                 ylim = c(100, 130), xlab = '', ylab = 'sirka lebecni baze (v mm)',
                 main = '', las = 1)
mtext('vyska lebky (v mm)', side = 1, line = 2.1)

# test o korelacnim koeficientu
alpha <- 'TO-DO'
rho0 <- 'TO-DO'
source('funkce-verze-01.R')
corZ.test(skull.HF, base.BF, rho0 = rho0, alternative = 'less', conf.level = 1 - alpha)
(q = qnorm(alpha)) # kriticka hodnota

# pomoci vzorcu
zR <- 1 / 2 * log((1 + r) / (1 - r)) 
ksi0 <- 1 / 2 * log((1 + rho0) / (1 - rho0))
zw <- (zR - ksi0) * sqrt(n - 3) # test. statistika
q <- qnorm(alpha) # kriticky obor
(tab <- data.frame(zR, ksi0, zw, q))

(hh <- tanh(zR - qnorm(alpha) / sqrt(n - 3))) # hranice int. spolehlivosti

(p.hodnota <- pnorm(zw)) # p-hodnota

# graficka vizualizace vysledku
par(mar = c(4, 4, 1, 1))
plot(skull.HF, base.BF, pch = 21, col = 'red3', bg = 'yellow',
     xlim = c(114, 144), ylim = c(107, 124),
     xlab = '', ylab = 'sirka lebecni baze (v mm)', 
     las = 1)
mtext('vyska lebky (v mm)', side = 1, line = 2.3)

k <- lm(base.BF ~ skull.HF)$coef
x <- seq(min(skull.HF), max(skull.HF), length = 500)
y <- k[1] + x * k[2]
lines(x, y , col = 'red3', lwd = 2)


# 8.5 Test o nezavislosti (nulovosti korelacniho koeficientu)

alpha <- 'TO-DO'
cor.test('TO-DO', 'TO-DO', method = 'TO-DO',
         conf.level = 1 - alpha, alternative = 'less')

# pomoci vzorcu
r <- cor(skull.HF, base.BF, method = 'pearson') 
n <- length(skull.HF)
(tw <- sqrt(n - 2) * r / sqrt(1 - r^2))
(q <- qt(alpha, n - 2)) # kriticky obor

(dh <- qt(alpha, n - 2) / sqrt(qt(alpha, n - 2)^2 + n - 2)) # interval spolehlivosti

(p.hodnota <- pnorm(tw)) # p-hodnota


# 8.6 Test o pravdepodobnosti
data <- 'TO-DO'
N <- 'TO-DO' # celkovy pocet muzu
x <- 'TO-DO' # pocet vzoru smycka
p <- 'TO-DO' # pravdepodobnost vyskytu vzoru smycka
(tab <- data.frame(x = x, N = N, p = p))

# overeni podminky dobre aproximace
p0 <- 'TO-DO'
(hp <- N * p0 * (1 - p0)) # porovnavame s hodnotou 9

# pomoci funkce
alpha <- 'TO-DO'
prop.test(x = 'TO-DO', n = 'TO-DO', p = 'TO-DO', alternative = 'TO-DO',
          conf.level = 'TO-DO', correct = F)

# pomoci vzorcu
zw <- (p - p0) / (sqrt(p0 * (1 - p0) / N)) 
q1 <- qnorm(alpha / 2) 
q2 <- qnorm(1 - alpha / 2) 
(tab <- data.frame(zw = zw, q1 = q1, q2 = q2)) # kriticky obor

dh <- p - sqrt(p * (1 - p) / N) * qnorm(1 - alpha / 2) # int. spolehlivosti
hh <- p - sqrt(p * (1 - p) / N) * qnorm(alpha / 2) 
(tab <- data.frame(dh = dh, hh = hh))

(p.hodnota <- 2 * min (pnorm(zw), 1 - pnorm(zw))) # p-hodnota

# graficka vizualizace vysledku
source('funkce-verze-01.R')
par(mar = c(4, 4, 0, 0))
rel.barplot(c(x, N - x), col = c('orange2', 'darkseagreen3'), 
            border = 'goldenrod4',
            names = c('smycka', 'jiny'),
            density = 60, main = '', 
            xlab = 'dermatoglyficky vzor', ylab = 'relativni cetnost')
segments(0.2, 0.5618, 1.2, 0.5618, lty = 2, lwd = 2, col = 'red')
text(1.5, 0.5618, '56.18 %', col = 'red')
legend('bottomright', lty = 2, lwd = 2, col = 'red', legend = 'Lambadis', bty = 'n')




