### 10 NEPARAMETRICKE TESTY
# 10.2 Znamenkovy test
data <- 'TO-DO'
tibia.LRF <- 'TO-DO' # vyber zen populace 'yos', promenna tibia.LR
tibia.LRF <- 'TO-DO' # odstraneni NA
n <- 'TO-DO' # pocet pozorovani - rozsah nah. vyberu
(tab <- data.frame(n = n, min = min(tibia.LRF), max = max(tibia.LRF))) # pocet a rozsah

## test predpokladu normality
'TO-DO'

## overeni predpokladu symetrie kolem medianu - Miaove test 
lawstat::symmetry.test(tibia.LRF, boot = F, option = 'MGG')$p.val 

## graficke posouzeni predpokladu
par(mar = c(4, 4, 1, 1))
hist(tibia.LRF, prob = T, breaks = seq(297, 333, by = 9), main = '', axes = F,
     density = 40, col = 'coral', ylim = c(0, 0.06),
     xlab = '',
     ylab = 'relativni cetnost')
box(bty = 'o')
axis(1, seq(301.5, 328.5, by = 9))
axis(2, las = 1)
xfit <- seq(280, 340, length = 512)
yfit <- dnorm(xfit, mean(tibia.LRF), sd(tibia.LRF))
lines(xfit, yfit, lwd = 2, col = 'firebrick')
mtext('delka lytkove kosti (v mm)', side = 1, line = 2.1)

qqnorm(tibia.LRF, main = '', xlab = '', pch = 21, col = 'firebrick3', bg = 'bisque',
       ylab = 'vyberovy kvantil', las = 1)
mtext('teoreticky kvantil', side = 1, line = 2.1)
qqline(tibia.LRF, lwd = 2, col = 'firebrick3')

hist(tibia.LRF, prob = T, breaks = seq(297, 333, by = 9), main = '', axes = F,
     density = 35, col = 'coral', ylim = c(0, 0.065), xlab = '',
     ylab = 'relativni cetnost')
box(bty = 'o')
axis(1, seq(301.5, 328.5, by = 9))
axis(2, las = 1)
lines(density(tibia.LRF), lwd = 2, col = 'firebrick3') # nesymetricke
abline(v = median(tibia.LRF, type = 2), lty = 2, col = 'blue', lwd = 2)

mtext('delka lytkove kosti (v mm)', side = 1, line = 2)
as.p <- lawstat::symmetry.test(tibia.LRF, boot = F, option = 'MGG')$p.val
legend('topleft', col = 'blue', lty = 2, lwd = 2, legend = 'median', bty = 'n')


## znamenkovy jednovyberovy test
alpha <- 0.05
# install.packages("BSDA")
BSDA::SIGN.test(tibia.LRF, md = 329.40, conf.level = 1 - alpha) 

m <- sum(tibia.LRF - 329.40 != 0) # pocet nenulovych rozdilu
q1 <- qbinom(alpha / 2, m, 1 / 2) - 1 
q2 <- qbinom(1 - alpha / 2, m, 1 / 2) - 1 
(tab <- data.frame(q1, q2)) # kriticke hodnoty


## graficka vizualizace vysledku
par(mar = c(1, 4, 1, 1))
boxplot(tibia.LRF, col = 'bisque', medcol = 'firebrick4', 
        border = 'firebrick3', ylim = c(298, 350),
        xlab = '', ylab = 'delka lytkove kosti (v mm)', las = 1)
points(329.40, bg = 'red', pch = 21, cex = 1.3, col = 'black')
legend('topleft', col = c('firebrick4', 'black'), pt.bg = c(NA, 'red'), 
       bty = 'n', pch = c(NA, 21), 
       lty = c(1, NA), lwd = c(2, NA),
       legend = c('neoliticka pop.', 'soucasna pop.'))



# 10.1 Wilcoxonuv jednovyberovy test
data <- 'TO-DO'
upface.HN <- 'TO-DO' # vyber nemecke populace, promenna upface.H
upface.HN <- 'TO-DO' # odstraneni NA
n <- 'TO-DO' # pocet objektu v nah. vyberu
'TO-DO' # rozsah promenne 

## test predpokladu normality
'TO-DO'

## Miaove test symetrie
'TO-DO'

## graficke posouzeni predpokladu
par(mar = c(4, 4, 1, 1))
'TO-DO' # vykresleni histogramu

'TO-DO' # vykresleni qqplotu

# znazorneni symetrie kolem medianu
hist(upface.HN, prob = T, breaks = seq(61, 76, by = 3), main = '', axes = F,
     density = 40, col = 'yellow', border = 'orange3',
     xlab = '', ylab = 'relativni cetnost')
box(bty = 'o')
axis(1, seq(62.5, 74.5, by = 3))
axis(2, las = 1)
lines(density(upface.HN), lwd = 2, col = 'orange4') 
abline(v = median(upface.HN, type = 2), lty = 2, col = 'red', lwd = 3)

mtext('vyska horni casti tvare (v mm)', side = 1, line = 2.1)
as.p <- lawstat::symmetry.test(upface.HN, boot = F)$p.val 
legend('topleft', col = 'red', lty = 2, lwd = 2, legend = 'median', bty = 'n')


## Wilcoxonuv jednovyberovy test
alpha <- 0.05
wilcox.test(upface.HN, mu = 70, conf.int = T, conf.level = 1 - alpha, 
            alt = 'greater', correct = F)
m <- sum(upface.HN - 70 != 0) # pocet nenulovych rozdilu
(q <- qsignrank(1 - alpha, m)) # kriticka hodnota


## graficka vizualizace vysledku
'TO-DO' # krabicovy graf se zvyraznenim prumeru cern. populace




# 10.3 Wilcoxonuv parovy test
data <- 'TO-DO'
data.F <- 'TO-DO' # zeny pop.'Ipituaq', promenne femur.HDR a femur.HDL
data.F <- 'TO-DO' # odstran NA
femur.HDL <- 'TO-DO' # femur.HDL
femur.HDR <- 'TO-DO' # femur.HDR
diff <- femur.HDL - femur.HDR
n <- # pocet objektu v nah. vyberu
(tab <- data.frame(n = n, min.L = min(femur.HDL), max.L = max(femur.HDL),
                   min.R = min(femur.HDR), max.R = max(femur.HDR))) # rozsahy


## test predpokladu normality
'TO-DO'

## Miaove test symetrie
'TO-DO'

## graficke posouzeni predpokladu
par(mar = c(4, 4, 1, 1))
'TO-DO' # histogram

'TO-DO' # qqplot

hist(diff, prob = T, breaks = seq(min(diff), max(diff), by = 0.824), main = '', 
     density = 40, col = 'deepskyblue', ylim = c(0, 0.55), axes = F,
     xlab = '', ylab = 'relativni cetnost')
box(bty = 'o')
axis(1, seq(-2.428, 0.868, by = 0.824))
axis(2, las = 1)

lines(density(diff), lwd = 2, col = 'deepskyblue4') # nesymetricke
abline(v = median(diff, type = 2), lty = 2, col = 'red', lwd = 2)
mtext('rozdil prumeru L - P (v mm)', side = 1, line = 2.1)
legend('topleft', col = 'red', lty = 2, lwd = 2, legend = 'median', bty = 'n')


## Wilcoxonuv parovy test
m <- sum(diff - 0 != 0) # pocet nenulovych rozdilu
alpha <- 'TO-DO'
wilcox.test(diff, mu = 'TO-DO', conf.int = T, conf.level = 'TO-DO', 
            alternative = 'TO-DO', correct = F)
wilcox.test(femur.HDL, femur.HDR, paired = T, conf.int = T, conf.level = 'TO-DO', 
            alternative = 'TO-DO', correct = F) # parovy test
(q <- qsignrank(alpha , m) - 1) 


## graficka vizualizace vysledku
# boxplot pro rozdily
par(mar = c(1, 4, 1, 1))
boxplot(diff, col = 'lightcyan1', ylim = c(-5, 1.5),
        xlab = '', ylab = 'rozdily a-p. prumeru (v mm)', las = 1, 
        medcol = 'royalblue4', border = 'deepskyblue4') 
segments(0.8,0,1.2,0, lty = 2, col = 'red', lwd = 3)
legend('bottomleft', col = c('royalblue4', 'red'), bty = 'n',
       lty = c(1, 2), lwd = c(2, 2), 
       legend = c('namerene rozdily', expression(paste(z[0] == 0))))

# 2 boxploty vedle sebe (hlavice stehenni kosti pro pravou a levou stranu)
'TO-DO'


# 10.4 Wilcoxonuv dvouvyberovy test
data <- 'TO-DO'
intorb.BB <- 'TO-DO'# vyber populace 'ban', promenna intorb.B
intorb.BB <- 'TO-DO' # odstraneni NA
intorb.BP <- 'TO-DO'# vyber populace 'per', promenna intorb.B
intorb.BP <- 'TO-DO' # odstraneni NA
n1 <- 'TO-DO' # pocet pozorovani pro bantuskou populaci
n2 <- 'TO-DO' # pocet pozorovani pro peruanskou populaci
'TO-DO' # rozsah pro oba nah. vybery

## test predpokladu normality
'TO-DO' # pro obe populace zvlast


## graficke posouzeni predpokladu
'TO-DO' # histogram a qqplot zvlast pro kazdou populaci

## Wilcoxonuv dvouvyberovy test
alpha <- 'TO-DO'
'TO-DO' # test
(q <- qwilcox(1 - alpha, n1, n2)) # kriticka hodnota


## graficka vizualizace vysledku
'TO-DO' # boxploty jednotlivych populaci vedle sebe



# 10.5 Spearmanuv poradovy exaktni test o nezavislosti
data <- read.delim('./data/23-3D-sken.txt', sep = '&', header = F, row.names = 1,
                   col.names = c('tym', paste('sf', 1:12, sep = '_')))
it <- as.numeric(data[1, ])
ant <- as.numeric(data[2, ])
n <- 'TO-DO' # pocet pozorovani nah. vyberu

## Spearmanuv poradovy exaktni test o nezavislosti
alpha <- 'TO-DO'
source('TO-DO')
Spearman.test(it, ant, alternative = 'TO-DO', conf.level = 'TO-DO', exact = T)
# install.packages("SuppDists")
(q <- SuppDists::qSpearman(1 - alpha, n))



## graficka vizualizace vysledku
par(mar = c(3, 4, 1, 1))
plot(it, ant, pch = 21, col = 'purple4', bg = 'plum', xlab = '', 
     ylab = 'hodnoceni antrop. tymu', las = 1)
mtext('hodnoceni IT tymu', side = 1, line = 2.1)



# 10.6 Spearmanuv poradovy asymptoticky test o nezavislosti
data <- 'TO-DO'
data.M <- 'TO-DO' # vyber muzi, vek >= 10, promenne age a WHR
data.M <- 'TO-DO' # odstraneni NA
age.M <- 'TO-DO' # vek
WHR.M <- 'TO-DO' # pomer obvodu pasu a boku
n <- 'TO-DO' # pocet objektu


## test predpokladu dvourozmerne normality
alpha <- 'TO-DO'
'TO-DO' # mardiuv test


## vizualni posouzeni predpokladu dvourozmerne normality
Z <- MASS::kde2d(age.M, WHR.M, n = 50, lims = c(9, 17, 0.6, 1))
par(mar = c(0, 2, 0, 4))
GA::persp3D(Z$x, Z$y, Z$z, ticktype = 'simple', xlab = 'vek (v letech)',
            ylab = 'pomer obvodu pasu a boku', zlab = "relativni cetnost", 
            col.palette = terrain.colors, border = 'black', theta = 15, phi = 30)

'TO-DO' # vykresleni elipsy spolehlivosti - je potreba nastavit xlim = c(9, 17) a ylim = c(0.65, 1), 



## Spearmanuv poradovy asymptoticky test o nezavislosti
alpha <- 'TO-DO'
source('TO-DO')
'TO-DO' #Spearmanuv test z funkci ve skriptu ke sbirce
q1 <- qnorm(alpha / 2)
q2 <- qnorm(1 - alpha / 2)
(tab <- data.frame(q1, q2)) 


## graficka vizualizace vysledku
'TO-DO'
