-
Notifications
You must be signed in to change notification settings - Fork 4
/
CI.R
36 lines (35 loc) · 1.04 KB
/
CI.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
###########################################################################
##
## File Name: 'CI'
##
## Author: SB Fernandes < [email protected] >
##
## Date: May 10th, 2017
##
## Contents: Auxiliar codes for obtaining coincidence index
## (Hamblin and Zimmermann, 1986) for GEBV's from
## GS-cross validations
##
## input: GEBV's from different models and adjusted means
##
## output: mean and standard deviation of a given CI
##
############################################################################
#x: GEBV's from a given model
#y: reference means
#s: proportion of selection
#top: selection for top or bottom genotypes
CI<-function(x,y,s=0.2,top=T){
ci<-c()
for(i in 2:ncol(x)){
x2<-as.matrix(x)
y2<-as.matrix(y)
size<-ceiling(nrow(x2)*s)
x2<-x2[order(x2[,i], decreasing=top),]
y2<-y2[order(y2[,2], decreasing=top),]
both<-sum(x2[1:size,1]%in%y2[1:size,1])
random<-both*s
ci[i-1]<-(both-random)/(size-random)
}
return(list(ci=mean(ci), sd=sd(ci)))
}