### R code from vignette source 'vignettes/chopsticks/inst/doc/imputation-vignette.Rnw'

###################################################
### code chunk number 1: init
###################################################
library(chopsticks)
library(hexbin)
data(for.exercise)


###################################################
### code chunk number 2: select
###################################################
training <- sample(1000, 200)
in.target<- seq(1, ncol(snps.10),2)
missing <- snps.10[training, -in.target]
present <- snps.10[training, in.target]
missing
present


###################################################
### code chunk number 3: target
###################################################
target <- snps.10[-training, in.target]
target


###################################################
### code chunk number 4: imputation-vignette.Rnw:91-93
###################################################
lost <- snps.10[-training, -in.target]
lost


###################################################
### code chunk number 5: positions
###################################################
pos.miss <- snp.support$position[-in.target]
pos.pres <- snp.support$position[in.target]


###################################################
### code chunk number 6: rules
###################################################
rules <- snp.imputation(present, missing, pos.pres, pos.miss)


###################################################
### code chunk number 7: rule1
###################################################
rules[1:10]


###################################################
### code chunk number 8: rule2
###################################################
rules[c('rs7898275', 'rs9419496')]


###################################################
### code chunk number 9: summary
###################################################
summary(rules)


###################################################
### code chunk number 10: ruleplot
###################################################
plot(rules)


###################################################
### code chunk number 11: imptest
###################################################
imp <- single.snp.tests(cc, stratum, data=subject.support,
                        snp.data=target, rules=rules)


###################################################
### code chunk number 12: realtest
###################################################
obs <- single.snp.tests(cc, stratum, data=subject.support, snp.data=lost)


###################################################
### code chunk number 13: compare
###################################################
logP.imp <- -log10(p.value(imp, df=1))
logP.obs <- -log10(p.value(obs, df=1))
hb <- hexbin(logP.obs, logP.imp, xbin=50)
sp <- plot(hb)
hexVP.abline(sp$plot.vp, 0, 1, col="black")


###################################################
### code chunk number 14: best
###################################################
use <- imputation.r2(rules)>0.9
hb <- hexbin(logP.obs[use], logP.imp[use], xbin=50)
sp <- plot(hb)
hexVP.abline(sp$plot.vp, 0, 1, col="black")


###################################################
### code chunk number 15: rsqmaf
###################################################
hb <- hexbin(imputation.maf(rules), imputation.r2(rules), xbin=50)
sp <- plot(hb)


###################################################
### code chunk number 16: imptest-rhs
###################################################
imp2 <- snp.rhs.tests(cc~strata(stratum), family="binomial",
                      data=subject.support, snp.data=target, rules=rules)
logP.imp2 <- -log10(p.value(imp2))
hb <- hexbin(logP.obs, logP.imp2, xbin=50)
sp <- plot(hb)
hexVP.abline(sp$plot.vp, 0, 1, col="black")


###################################################
### code chunk number 17: class-imp-obs
###################################################
class(imp)


###################################################
### code chunk number 18: save-scores
###################################################
obs <- single.snp.tests(cc, stratum, data=subject.support, snp.data=missing,
                        score=TRUE)
imp <- single.snp.tests(cc, stratum, data=subject.support,
                        snp.data=target, rules=rules, score=TRUE)


###################################################
### code chunk number 19: imputation-vignette.Rnw:281-283
###################################################
class(obs)
class(imp)


###################################################
### code chunk number 20: pool
###################################################
both <- pool(obs, imp)
class(both)
both[1:5]


###################################################
### code chunk number 21: pool-score
###################################################
both <- pool(obs, imp, score=TRUE)
class(both)


###################################################
### code chunk number 22: sign
###################################################
table(effect.sign(obs))


###################################################
### code chunk number 23: switch
###################################################
effect.sign(obs)[1:6]
sw.obs <- switch.alleles(obs, c("rs7093061", "rs7475011"))
class(sw.obs)
effect.sign(sw.obs)[1:6]