-
Notifications
You must be signed in to change notification settings - Fork 2
/
FMtables.R
149 lines (122 loc) · 5.48 KB
/
FMtables.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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
#' @title Formats flashfm output to table format
#' @param PP MFM:::MPP.PP.groups.fn output from 'flashfm' in Rdata format.
#' @param SW stepwise list of results from Stepwise model. By def. = NULL
#' @param stepwise TRUE if list of results from sw is provided. By def. = FALSE
#' @param method name of the method used for the FineMap eg: 'FineMap', 'JAM' etc. By def. = FineMap
#' @param regname Region name for table caption
#' @param path.input path where the input files are located.
#' @param path.output path to save the output latex table.
#' @param trait.id id. number if the traits.
#' @param trait.names trait names. If not provided a vector is constructed. 'Trait_1', 'Trait_2', ...
#' @return Table results as txt file.
#' @author Nico Hernandez
#' @export
FMtables <- function(PP,SW=NULL, stepwise=F, method='FineMap', regname, path.input, path.output, trait.id, trait.names=NULL){
load(paste0(path.input,PP,'.Rdata'))
mpp.pp<-get(PP)
# TRAITS
qt <- trait.id
if (is.null(trait.names)) {
ts.aux <- rep('trait_',length(qt));
ts<-c()
for (i in 1:length(qt)){ts[i]<-paste0(ts.aux[i],i)}
} else {ts <- trait.names}
M = length(ts)
aux<-matrix(c(1:length(ts),qt),nrow=length(ts),ncol=2)
RES_FM=RES.sw=ST<-list()
for (i in 1:M){
#### STOCHASTIC FineMap
a<-as.data.frame(mpp.pp$gPP[[i]])
a<-a[which(a[,1]>=0.05|a[,2]>=0.05),]
model<-rownames(a)
result<-data.frame()
for (j in 1:dim(a)[1]){
result[j,1]<-as.character(model[j])
result[j,2]<-round(a[j,1],3)
result[j,3]<-as.character(model[j])
result[j,4]<-round(a[j,2],3)
}
res.aux1<-result[,1:2];res.aux2<-result[,3:4]
result2<-cbind(res.aux1[order(-res.aux1$V2),],res.aux2[order(-res.aux2$V4),])
result2$V1[which(result2$V2<0.05)]<-0;result2$V3[which(result2$V4<0.05)]<-0
result2[result2 < 0.05] <- 0
aux<-c()
for (l in 1:nrow(result2)){
aux[l]<-!all(result2[l,]==0)
}
result2<-result2[aux,]
result2[result2 ==0] <- '--'
RES_FM[[i]]<-result2
#### STEPWISE FineMap
if (stepwise==FALSE){
ST[[i]]<-RES_FM[[i]]
ST[[i]][is.na(ST[[i]])] <- '--'
} else {
load(paste0(path.input,SW,'.Rdata'));
sw<-get(SW)
chr.name<-strsplit(as.character(sw[[i]][,1]), split="\\,")
snps.aux<-c()
if (length(chr.name)==1){ snps.aux[1]<-chr.name[[1]]
} else {
snps.aux[1]<-chr.name[[1]]
for (m in 2:length(chr.name)){
snps.aux[m]<-chr.name[[m]][which(!(chr.name[[m]]%in%chr.name[[m-1]]))]
}
}
snps.aux <- gsub('_',':',snps.aux)
sw.model<-c()
for (h in 1:dim(sw[[i]])[1]){
if ( grepl("\\d", sw[[i]][h,2]) | is.na(sw[[i]][h,2]) ){ sw.model[h]<-snps.aux[h] }
else {sw.model[h]<-paste0(snps.aux[h],'/',sw[[i]][h,2])}
}
aux.res.sw<-as.data.frame(cbind(sw.model, sw[[i]][,3]))
aux.res.sw[,2]<-signif(as.numeric(levels(aux.res.sw$V2))[aux.res.sw$V2],digits=3)
RES.sw[[i]]<-aux.res.sw
##### MERGING RESUTLS
ST[[i]]<-RES_FM[[i]]
ST[[i]][is.na(ST[[i]])] <- '--'
if(dim(ST[[i]])[1]==1){
ST[[i]]<-cbind(RES.sw[[i]],ST[[i]])
} else if (dim(ST[[i]])[1]>dim(RES.sw[[i]])[1]) {
comp<-as.data.frame(matrix(rep('--',(dim(ST[[i]])[1]-dim(RES.sw[[i]])[1])*dim(RES.sw[[i]])[2]),nrow = dim(ST[[i]])[1]-dim(RES.sw[[i]])[1]))
colnames(comp)<-colnames(RES.sw[[i]])
RES.sw[[i]]<-rbind(RES.sw[[i]],comp)
ST[[i]]<-cbind(RES.sw[[i]],ST[[i]])
} else if (dim(ST[[i]])[1]<dim(RES.sw[[i]])[1]) {
comp<-as.data.frame(matrix(rep('--',(dim(RES.sw[[i]])[1]-dim(ST[[i]])[1])*dim(ST[[i]])[2]),nrow = dim(RES.sw[[i]])[1]-dim(ST[[i]])[1]))
colnames(comp)<-colnames(ST[[i]])
ST[[i]]<-rbind(ST[[i]],comp)
ST[[i]]<-cbind(RES.sw[[i]],ST[[i]])
} else { ST[[i]]<-cbind(RES.sw[[i]],ST[[i]]) }
}
} # END LOOP
# PREPARING XTABLE
if (stepwise==FALSE){
names(ST)<-c(ts)
ST<-data.table::rbindlist(ST,idcol = T)
colnames(ST)<-c('Traits','Model','PP','Model', 'PP')
ST$Traits[which(duplicated(ST$Traits))]<-''
cols <- colnames(ST)
addtorow <- list()
addtorow$pos <- list(0,0)
addtorow$command <- c(paste0("&\\multicolumn{2}{c}{",method,"} & \\multicolumn{2}{c}{FlashFM}\\\\\n"),
paste(paste(cols, collapse=" & "), "\\\\\n") )
TABLE<-print(xtable::xtable(ST, caption = regname,
align = c("l","l","c","c","c","c")), add.to.row=addtorow, include.colnames=F, include.rownames = F,
NA.string="-", booktabs = F)
} else {
names(ST)<-c(ts)
ST<-data.table::rbindlist(ST,idcol = T)
colnames(ST)<-c('Traits','SNP/Model','P-value','Model','PP','Model', 'PP')
ST$Traits[which(duplicated(ST$Traits))]<-''
cols <- colnames(ST)
addtorow <- list()
addtorow$pos <- list(0,0)
addtorow$command <- c(paste0("&\\multicolumn{2}{c}{Stepwise} & \\multicolumn{2}{c}{",method,"} & \\multicolumn{2}{c}{FlashFM}\\\\\n"),
paste(paste(cols, collapse=" & "), "\\\\\n") )
TABLE<-print(xtable::xtable(ST, caption = regname,
align = c("l","l","c","c","c","c","c","c")), add.to.row=addtorow, include.colnames=F, include.rownames = F,
NA.string="-", booktabs = F)
}
write.table(TABLE, paste0(path.output,'TABLE_',regname,'.txt'), col.names = F, row.names = F)
}