
#############################################################################for intron

 setwd("final")
 load ("attile.nonSFP.RData")
 load ("attile.nonSFP.exon.RData")
 load ("mRNA.sc.nq.RData")


 gene.probe <- tapply(attile.nonSFP.exon$bpstart, as.character( attile.nonSFP.exon$gene), length )
 tu.num <- tapply( as.character(attile.nonSFP.exon$tu), as.character( attile.nonSFP.exon$gene), function(x)nlevels( factor(x)) )
 gene.list <- intersect( names(gene.probe) [gene.probe >=3], names(tu.num)[tu.num >=2 ] ) 


 attile.nonSFP.intron <- attile.nonSFP[ - which( rownames(attile.nonSFP) %in% rownames(attile.nonSFP.exon) ), ]
 mRNA.nonSFP.intron <- mRNA.nq[ which(rownames(mRNA.nq) %in% rownames(attile.nonSFP.intron) ),]
 mRNA.nonSFP.intron <- mRNA.nonSFP.intron - rowMeans(mRNA.nonSFP.intron)


 tu.probe <- tapply(attile.nonSFP.intron$bpstart, paste(attile.nonSFP.intron$gene, attile.nonSFP.intron$tu), length) 
 tu.list <- names(tu.probe) [tu.probe >=2 ] 
 tu.matr <- sapply(tu.list, function(x) unlist( strsplit(x, " ") ) )
 tu.matr <- tu.matr[, which(tu.matr[1,] %in% gene.list) ]  
 tu.list <- paste(tu.matr[1,], tu.matr[2,]) # 62859 intron, 235661 probes

 gene.list <- names( table( tu.matr[1,]) ) 

 matr <- matrix(NA, nc=4, nr=length(tu.list))
 rownames(matr) <- tu.list
 iexpr.main <- list(add=matr, dom=matr, mat=matr)


 for (i in 1:length(tu.list) )
 {
 probes <- which( paste(attile.nonSFP.intron$gene, attile.nonSFP.intron$tu) %in% tu.list[i])
 tmean <- mRNA.nonSFP.intron[probes,]
 n <- length(probes)


 add <- rep( c(1, -1, 0, 0), each=4*n)
 dom <- rep( c(0, 0, 1, 1), each=4*n)
 mat <- rep( c(0, 0, -1, 1), each=4*n)

 tframe <- data.frame( tmean = c(tmean), add, dom, mat)

 fit <- summary(lm(tmean~add+dom+mat, data=tframe))$coef
 iexpr.main[[1]][i,] <- fit[2,]
 iexpr.main[[2]][i,] <- fit[3,]
 iexpr.main[[3]][i,] <- fit[4,]


 if(i/100== trunc(i/100) ) cat(i, "\n")
 }


 save(iexpr.main, file="iexpr.main.v2.RData", compress=T)

 q("no")






####################################################################permutation for intron

 k <- 1

 setwd("final")
 load ("attile.nonSFP.RData")
 load ("attile.nonSFP.exon.RData")
 load ("mRNA.sc.nq.RData")


 gene.probe <- tapply(attile.nonSFP.exon$bpstart, as.character( attile.nonSFP.exon$gene), length )
 tu.num <- tapply( as.character(attile.nonSFP.exon$tu), as.character( attile.nonSFP.exon$gene), function(x)nlevels( factor(x)) )
 gene.list <- intersect( names(gene.probe) [gene.probe >=3], names(tu.num)[tu.num >=2 ] ) 


 attile.nonSFP.intron <- attile.nonSFP[ - which( rownames(attile.nonSFP) %in% rownames(attile.nonSFP.exon) ), ]
 mRNA.nonSFP.intron <- mRNA.nq[ which(rownames(mRNA.nq) %in% rownames(attile.nonSFP.intron) ),]
 mRNA.nonSFP.intron <- mRNA.nonSFP.intron - rowMeans(mRNA.nonSFP.intron)


 tu.probe <- tapply(attile.nonSFP.intron$bpstart, paste(attile.nonSFP.intron$gene, attile.nonSFP.intron$tu), length) 
 tu.list <- names(tu.probe) [tu.probe >=2 ] 
 tu.matr <- sapply(tu.list, function(x) unlist( strsplit(x, " ") ) )
 tu.matr <- tu.matr[, which(tu.matr[1,] %in% gene.list) ]  
 tu.list <- paste(tu.matr[1,], tu.matr[2,]) 
 gene.list <- names( table( tu.matr[1,]) ) 

 nperm <- 1000
 nsample=16
 load ( paste("samp.matrix", nsample, ".RData", sep="") )


 j <- 1 ###CHANGE
 tu.list <- tu.list[1:10000] ###CHANGE



 matr <- matrix(NA, nr=length(tu.list), nc=nperm)
 iexpr.perm <- list(coef=matr, std=matr)


 system.time
 (

  for (i in 1:length(tu.list) )
  {
  probes <- which( paste(attile.nonSFP.intron$gene, attile.nonSFP.intron$tu) %in% tu.list[i])
  tmean <- mRNA.nonSFP.intron[probes,]
  n <- length(probes)


  add <- rep( c(1, -1, 0, 0), each=4*n)
  dom <- rep( c(0, 0, 1, 1), each=4*n)
  mat <- rep( c(0, 0, -1, 1), each=4*n)

  tframe <- data.frame( tmean=c(tmean), add, dom, mat)

  rfit <- lm(tmean~ as.matrix( tframe[, c(-1, -(k+1) )] ), data=tframe) 

	for( iperm in 1:nperm) 
	{
	resid <- matrix( rfit$resid, nr=n) [, samp.matrix[iperm,] ]
	predict <-  as.matrix( tframe[, c(-1,-(k+1) )]) %*% t( t( rfit$coef[c(2,3)] ) ) +  rfit$coef[1] + c(resid) 
	
	pframe <- data.frame( predict, add, dom, mat)
	pfit <- summary ( lm( predict~ add+dom+mat, data=pframe) )$coef
	iexpr.perm[[1]][i, iperm] <- pfit[k+1,1]
	iexpr.perm[[2]][i, iperm] <- pfit[k+1,2]
	}


  if(i/100 == trunc(i/100) ) cat(i, "\n" )
  }
 )

 save(iexpr.perm, file=paste("Main.iexpr.perm.v2.", k, ".set", j, ".RData", sep=""), compress=T)
 q("no")




####combine permutation result
 setwd ("final")

 k <- 3

 load ( paste("Main.iexpr.perm.v2.", k, ".set1", ".RData", sep="") )
 coef <- iexpr.perm[[1]]
 std <- iexpr.perm[[2]]
 
 for (i in 2:7)
 {
  load ( paste("Main.iexpr.perm.v2.", k, ".set", i, ".RData", sep=""))
  coef <- rbind(coef, iexpr.perm[[1]])
  std <- rbind(std, iexpr.perm[[2]])
 }

 iexpr.perm <- list(coef, std)
 save(iexpr.perm, file=paste("Main.iexpr.perm.v2.", k, ".RData", sep=""), compress=T)
 q("no")



#####################################################################intron fdr


 setwd ("final")

 load ("iexpr.main.v2.RData")

 k <- 3


 load ( paste("Main.iexpr.perm.v2.", k, ".RData", sep="") )
 s0 <- quantile( iexpr.perm[[2]], 0.5)
 main <- iexpr.main[[k]][,1]/ (iexpr.main[[k]][,2]+s0)
 main <- sort(main)
 perm.mat <- iexpr.perm[[1]]/ (iexpr.perm[[2]]+s0); rm(iexpr.perm); gc()


 perm.num <- 1000
 for (i in 1:perm.num) perm.mat[,i] <- sort(perm.mat[,i])
 null <- rowMeans(perm.mat)


 for (j in seq(0.1, 1, 0.1)) 
 { 
     real.vec <- main > null + j | main < null - j     
     threshold.mat <- matrix(FALSE, nr=length(main), nc=perm.num)
	for (i in 1:perm.num) threshold.mat[,i] <- perm.mat[,i] > null + j | perm.mat[,i] < null - j
     sam.tab <- cbind(table(real.vec), table(factor(threshold.mat ,c(FALSE,TRUE)))/perm.num) 
     cat(j,sam.tab[2,],sam.tab[2,1]-sam.tab[2,2],sam.tab[2,2]/sam.tab[2,1],"\n",sep="\t")
 }



 for (j in seq(0.1, 1, 0.1)) 
 { 
     real.vec <- main > null + j 
     threshold.mat <- matrix(FALSE, nr=length(main), nc=perm.num)
	for (i in 1:perm.num) threshold.mat[,i] <- perm.mat[,i] > null + j 
     sam.tab <- cbind(table(real.vec), table(factor(threshold.mat ,c(FALSE,TRUE)))/perm.num) 
     cat(j,sam.tab[2,],sam.tab[2,1]-sam.tab[2,2],sam.tab[2,2]/sam.tab[2,1],"\n",sep="\t")
 }



 for (j in seq(0.1, 1, 0.1)) 
 { 
     real.vec <-  main < null - j     
     threshold.mat <- matrix(FALSE, nr=length(main), nc=perm.num)
	for (i in 1:perm.num) threshold.mat[,i] <- perm.mat[,i] < null - j
     sam.tab <- cbind(table(real.vec), table(factor(threshold.mat ,c(FALSE,TRUE)))/perm.num) 
     cat(j,sam.tab[2,],sam.tab[2,1]-sam.tab[2,2],sam.tab[2,2]/sam.tab[2,1],"\n",sep="\t")
 }



###
k <- 1

0.1     31697   18399.96        13297.04        0.5804954
0.2     4662    2248.936        2413.064        0.4823973
0.3     1595    331.981 1263.019        0.2081386
0.4     928     85.085  842.915 0.09168642
0.5     668     28.445  639.555 0.04258234
0.6     459     11.962  447.038 0.026061
0.7     357     6.825   350.175 0.01911765
0.8     296     4.514   291.486 0.01525
0.9     234     3.067   230.933 0.01310684
1       195     2.242   192.758 0.01149744

0.1     1904    9317.846        -7413.846       4.893827
0.2     950     990.177 -40.177 1.042292
0.3     561     134.076 426.924 0.2389947
0.4     405     37.255  367.745 0.09198765
0.5     316     13.84   302.16  0.04379747
0.6     239     6.319   232.681 0.02643933
0.7     202     3.642   198.358 0.01802970
0.8     176     2.376   173.624 0.0135
0.9     140     1.57    138.43  0.01121429
1       120     1.146   118.854 0.00955

0.1     29793   9082.118        20710.88        0.3048407
0.2     3712    1258.759        2453.241        0.3391053
0.3     1034    197.905 836.095 0.1913975
0.4     523     47.83   475.17  0.09145315
0.5     352     14.605  337.395 0.04149148
0.6     220     5.643   214.357 0.02565
0.7     155     3.183   151.817 0.02053548
0.8     120     2.138   117.862 0.01781667
0.9     94      1.497   92.503  0.01592553
1       75      1.096   73.904  0.01461333


k <- 2

0.1     50909   18537.46        32371.54        0.3641293
0.2     17607   2764.377        14842.62        0.1570044
0.3     1527    480.656 1046.344        0.3147714
0.4     295     99.767  195.233 0.3381932
0.5     122     27.665  94.335  0.2267623
0.6     87      11.566  75.434  0.1329425
0.7     63      6.333   56.667  0.1005238
0.8     53      4.121   48.879  0.07775472
0.9     40      2.829   37.171  0.070725
1       29      2.079   26.921  0.07168966

0.1     50448   9166.588        41281.41        0.1817037
0.2     17391   1340.302        16050.70        0.07706871
0.3     1401    259.814 1141.186        0.1854490
0.4     216     57.65   158.35  0.2668981
0.5     50      15.632  34.368  0.31264
0.6     41      6.333   34.667  0.1544634
0.7     27      3.337   23.663  0.1235926
0.8     25      2.214   22.786  0.08856
0.9     22      1.503   20.497  0.06831818
1       19      1.112   17.888  0.05852632

0.1     461     9370.87 -8909.87        20.32727
0.2     216     1424.075        -1208.075       6.59294
0.3     126     220.842 -94.842 1.752714
0.4     79      42.117  36.883  0.5331266
0.5     72      12.033  59.967  0.167125
0.6     46      5.233   40.767  0.1137609
0.7     36      2.996   33.004  0.08322222
0.8     28      1.907   26.093  0.06810714
0.9     18      1.326   16.674  0.07366667
1       10      0.967   9.033   0.0967


k <- 3

0.1     55553   22128.37        33424.63        0.3983289
0.2     39843   3631.902        36211.1 0.09115533
0.3     19460   531.481 18928.52        0.02731146
0.4     6204    90.632  6113.368        0.01460864
0.5     1333    19.457  1313.543        0.0145964
0.6     143     7.137   135.863 0.04990909
0.7     8       3.736   4.264   0.467
0.8     2       2.378   -0.378  1.189
0.9     1       1.607   -0.607  1.607
1       1       1.095   -0.095  1.095

0.1     638     11079.73        -10441.73       17.36635
0.2     261     1863.421        -1602.421       7.139544
0.3     138     308.773 -170.773        2.237486
0.4     90      51.634  38.366  0.5737111
0.5     22      9.558   12.442  0.4344545
0.6     13      3.443   9.557   0.2648462
0.7     6       1.844   4.156   0.3073333
0.8     62859   1.124   62857.88        1.788129e-05
0.9     62859   0.762   62858.24        1.212237e-05
1       62859   0.527   62858.47        8.383843e-06

0.1     54915   11048.63        43866.37        0.2011952
0.2     39582   1768.481        37813.52        0.04467892
0.3     19322   222.708 19099.29        0.01152614
0.4     6114    38.998  6075.002        0.006378476
0.5     1311    9.899   1301.101        0.007550725
0.6     130     3.694   126.306 0.02841538
0.7     2       1.892   0.108   0.946
0.8     2       1.254   0.746   0.627
0.9     1       0.845   0.155   0.845
1       1       0.568   0.432   0.568
















############################################################plot loci

 k <- 1

 setwd ("final")

 load ("iexpr.main.v2.RData")
 load ( paste("Main.iexpr.perm.v2.", k, ".RData", sep="") )  
 s0 <- quantile( iexpr.perm[[2]], 0.5); rm(iexpr.perm); gc()
 main <- iexpr.main[[k]][,1]/ (iexpr.main[[k]][,2]+s0)
 names (main) <- rownames(iexpr.main[[k]])


 #239	220	459
 #202	155 =357
 #120	75 =195



 intron <- names( sort(main) ) [1:220]
 intron <- c(intron, names(sort(main, decreasing=T) )[1:239])

 intron <- sort(intron)
 source("plottu.R")

 effect <- c("additive", "dominant", "maternal")
 plot.tu(intron,  paste("intron1.", effect[k], sep="") ) 







##########################################################introns verification 


 setwd ("final")
 intron <- scan("verify.intron.txt", what="a")
 intron <- matrix(intron , byrow=T, nc=2)
 intron  <- paste(intron [,1], intron [,2])
 intron.gene <- matrix( unlist(strsplit(intron, " ") ), byrow=T, nc=2)[,1]

 conf <- scan ("confirmed.intron.txt", what="a")


 k <- 1
 load ("iexpr.main.v2.RData")  
 load ( paste("Main.iexpr.perm.v2.", k, ".RData", sep="") )  
 s0 <- quantile( iexpr.perm[[2]], 0.5); rm(iexpr.perm); gc()
 main <- iexpr.main[[k]][,1] / (iexpr.main[[k]][,2] + s0)
 names (main) <- rownames(iexpr.main[[k]])
 
#239	220	459

 #202	155 =357
 #120 75 = 195

 intron.list <- names( sort(main) ) [1:220]
 intron.list <- c(intron.list, names(sort(main, decreasing=T) )[1:239] )
 #intron.list <- names( sort(main) ) [1:75]
 #intron.list <- c(intron.list, names(sort(main, decreasing=T) )[1:120] )


 intron.list.gene <- matrix( unlist(strsplit(intron.list, " ") ), byrow=T, nc=2)[,1]

 
 test <- intron.gene[ which( intron.gene %in% intron.list.gene) ]
 length(test)

 true <- test[which(test %in% conf) ]
 length(true)
 
 cat(length(test), "\t", length(true), "\t", length(true)/length(test)*100, "\n") 










###############################################################################qq plot and null 

 setwd ("final")

 load ("iexpr.main.v2.RData")


 k <- 1
 load ( paste("Main.iexpr.perm.v2.", k, ".RData", sep="") )
 s0 <- quantile( iexpr.perm [[2]], 0.5)
 perm.mat <- iexpr.perm[[1]]/(iexpr.perm[[2]]+s0); rm(iexpr.perm); gc()
 for (i in 1:ncol(perm.mat) ) perm.mat[,i] <- sort( perm.mat[,i])
 null.add <- rowMeans(perm.mat)
 main <- iexpr.main[[k]][,1] / (iexpr.main[[k]][,2] + s0)  
 main.add <- sort(main)


 k <- 2
 load ( paste("Main.iexpr.perm.v2.", k, ".RData", sep="") )
 s0 <- quantile( iexpr.perm [[2]], 0.5)
 perm.mat <- iexpr.perm[[1]]/(iexpr.perm[[2]]+s0); rm(iexpr.perm); gc()
 for (i in 1:ncol(perm.mat) ) perm.mat[,i] <- sort( perm.mat[,i])
 null.dom <- rowMeans(perm.mat)
 main <- iexpr.main[[k]][,1] / (iexpr.main[[k]][,2] + s0)  
 main.dom <- sort(main)


 k <- 3
 load ( paste("Main.iexpr.perm.v2.", k, ".RData", sep="") )
 s0 <- quantile( iexpr.perm [[2]], 0.5)
 perm.mat <- iexpr.perm[[1]]/(iexpr.perm[[2]]+s0); rm(iexpr.perm); gc()
 for (i in 1:ncol(perm.mat) ) perm.mat[,i] <- sort( perm.mat[,i])
 null.mat <- rowMeans(perm.mat)
 main <- iexpr.main[[k]][,1] / (iexpr.main[[k]][,2] + s0)  
 main.mat <- sort(main)



 bitmap ("intron.qq.png", width=18, height=6)
  par( mfrow=c(1, 3), mai=c(1, 1, 0.5, 0.5) )

  xlim=c(-3.5, 3.5)
  ylim=c(-10, 10)

  plot(null.add, main.add, "p", pch=16, col="orange", cex=0.8, main="", xlab="null d", ylab="d", cex.lab=3, cex.axis=2, xlim=xlim, ylim=ylim)
  abline(0, 1)
  lines(null.add, null.add+0.7, lty=2)
  lines(null.add, null.add-0.7, lty=2)
  legend("topleft", "additive", bty="n", cex=3)

  plot(null.dom, main.dom, "p", pch=16,  col="orange", cex=0.8, main="", xlab="null d", ylab="d", cex.lab=3, cex.axis=2, xlim=xlim, ylim=ylim)
  lines(null.dom, null.dom+0.7, lty=2)
  lines(null.dom, null.dom-0.7, lty=2)
  abline(0, 1)
  legend("topleft", "dominant", bty="n", cex=3)


  plot(null.mat, main.mat, "p", pch=16,  col="orange", cex=0.8, main="", xlab="null d", ylab="d", cex.lab=3, cex.axis=2, xlim=xlim, ylim=ylim)
  lines(null.mat, null.mat+0.7, lty=2)
  lines(null.mat, null.mat-0.7, lty=2)
  abline(0, 1)
  legend("topleft", "maternal", bty="n", cex=3)

 dev.off()







############################################################################################################






















