

################################################################ median polish for gene expression 


 setwd ("final")

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

 mRNA.nonSFP.exon <- mRNA.nq[  which( rownames( mRNA.nq) %in% rownames(attile.nonSFP.exon) ),]
 #correction of probe effect
 mRNA.nonSFP.exon <- mRNA.nonSFP.exon - rowMeans(mRNA.nonSFP.exon)

 probes <- tapply( attile.nonSFP.exon$bpstart, as.character(attile.nonSFP.exon$gene), length)
 gene.list <- names(probes)[ probes >=3 ] 


 #gene median polish across probes across replicates within genotype
 mad <- matrix(NA, nr=length(gene.list), nc=4)
 rownames(mad) <- gene.list

 for (i in 1:length(gene.list) )
  { 
  probes <- which( as.character(attile.nonSFP.exon$gene) == gene.list[i] )
  gmean <- mRNA.nonSFP.exon[ probes, ]
  mad[i,] <- c( medpolish(gmean[,1:4], trace.iter=F)$overall, medpolish(gmean[,5:8], trace.iter=F)$overall, medpolish(gmean[,9:12], trace.iter=F)$overall, medpolish(gmean[, 13:16], trace.iter=F)$overall) 
  if(i/100==trunc(i/100)) cat(i, "\n")
  }
 mad <- t( apply(mad, 1, function(x) rep(x, each=4) ) )
 save(mad, file="gene.expression.mad.v2.RData", compress=T)

 q("no")







##############################################################################differential exon

 setwd("final")
 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 >=5], names(tu.num)[tu.num >=2 ] ) 


 tu.probe <- tapply( attile.nonSFP.exon$bpstart, paste(attile.nonSFP.exon$gene, attile.nonSFP.exon$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,])  #91240
 gene.list <- names( table( tu.matr[1,]) )  #19279
 gene <- tu.matr[1,]


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


 load ("gene.expression.mad.v2.RData")


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


 for (i in 1:length(tu.list) )
 {
  probes <- which( paste(attile.nonSFP.exon$gene, attile.nonSFP.exon$tu) %in% tu.list[i])
  tmean <- mRNA.nonSFP.exon[probes,]
  gmean <- mad[ which(rownames(mad) == gene[i]), ]
  #corrected value basically a log ratio   
  tmean <- t( t(tmean)-gmean )  
  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
  texpr.main[[1]][i,] <- fit[2,]
  texpr.main[[2]][i,] <- fit[3,]
  texpr.main[[3]][i,] <- fit[4,]

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


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


 q("no")





############################################################################permutation for exon

 k <- 1

 setwd("final")
 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 >=5], names(tu.num)[tu.num >=2 ] ) 


 tu.probe <- tapply( attile.nonSFP.exon$bpstart, paste(attile.nonSFP.exon$gene, attile.nonSFP.exon$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,]) )
 #the same length gene vector for tu.list
 gene <- tu.matr[1,]


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


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



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


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



 system.time
 (

   for (i in 1:length(tu.list) )

     {
     probes <- which( paste(attile.nonSFP.exon$gene, attile.nonSFP.exon$tu) %in% tu.list[i])
     tmean <- mRNA.nonSFP.exon[probes,]
     gmean <- mad[ which(rownames(mad) == gene[i]),]
     tmean <- t(t(tmean)-gmean )
     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) #leave one out

	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
	texpr.perm[[1]][i, iperm] <- pfit[k+1,1]
	texpr.perm[[2]][i, iperm] <- pfit[k+1,2]
	}


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

 ) 


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






###combined permutation data

 k <- 1

 setwd ("final")

 load ( paste("Main.tmedian.perm.v2.", k, ".set1.RData", sep="") )
 coef <- texpr.perm[[1]]
 std <- texpr.perm[[2]]

 for (j in 2:10)
  {
  load ( paste("Main.tmedian.perm.v2.", k, ".set", j, ".RData", sep="") )
  coef <- rbind(coef, texpr.perm[[1]])
  std <- rbind(std, texpr.perm[[2]])
  }

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









######################################################################################## exon fdr


 setwd ("final")

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

 k <- 3

 load ( paste("Main.tmedian.perm.v2.", k, ".RData", sep="") )
 s0 <- quantile( texpr.perm[[2]], 0.5)
 main <- texpr.main[[k]][,1]/ (texpr.main[[k]][,2]+s0)
 main <- sort(main)
 perm.mat <- texpr.perm[[1]]/ (texpr.perm[[2]]+s0); rm(texpr.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     3615    12876.97        -9261.967       3.562093
0.2     1316    2947.463        -1631.463       2.239714
0.3     747     966.854 -219.854        1.294316
0.4     465     423.041 41.959  0.9097656
0.5     270     226.774 43.226  0.8399037
0.6     215     139.307 75.693  0.6479395
0.7     177     93.5    83.5    0.5282486
0.8     114     65.501  48.499  0.5745702
0.9     89      47.613  41.387  0.5349775
1       58      35.888  22.112  0.6187586

0.1     2524    6524.442        -4000.442       2.584961
0.2     986     1543.728        -557.728        1.565647
0.3     561     507.566 53.434  0.9047522
0.4     338     219.962 118.038 0.6507751
0.5     207     118.765 88.235  0.573744
0.6     158     73.032  84.968  0.4622278
0.7     131     49.362  81.638  0.3768092
0.8     84      34.927  49.073  0.4157976
0.9     69      25.739  43.261  0.373029
1       50      19.746  30.254  0.39492

0.1     1091    6352.525        -5261.525       5.822663
0.2     330     1403.735        -1073.735       4.253742
0.3     186     459.288 -273.288        2.469290
0.4     127     203.079 -76.079 1.599047
0.5     63      108.009 -45.009 1.714429
0.6     57      66.275  -9.275  1.162719
0.7     46      44.138  1.862   0.9595217
0.8     30      30.574  -0.574  1.019133
0.9     20      21.874  -1.874  1.0937
1       8       16.142  -8.142  2.01775


k <- 2

0.1     194     13270.37        -13076.37       68.40399
0.2     15      3239.842        -3224.842       215.9895
0.3     6       1146.432        -1140.432       191.072
0.4     2       500.522 -498.522        250.261
0.5     2       252.94  -250.94 126.47
0.6     2       143.985 -141.985        71.9925
0.7     1       91.538  -90.538 91.538
0.8     1       63.579  -62.579 63.579
0.9     1       45.777  -44.777 45.777
1       1       34.063  -33.063 34.063

0.1     123     6686.086        -6563.086       54.35842
0.2     11      1613.58 -1602.58        146.6891
0.3     4       570.526 -566.526        142.6315
0.4     91240   253.312 90986.69        0.002776326
0.5     91240   130.43  91109.57        0.001429527
0.6     91240   75.656  91164.34        0.0008291977
0.7     91240   49.711  91190.29        0.0005448378
0.8     91240   35.402  91204.6 0.0003880096
0.9     91240   25.953  91214.05        0.0002844476
1       91240   19.763  91220.24        0.0002166046

0.1     71      6584.288        -6513.288       92.73645
0.2     4       1626.262        -1622.262       406.5655
0.3     2       575.906 -573.906        287.953
0.4     2       247.21  -245.21 123.605
0.5     2       122.51  -120.51 61.255
0.6     2       68.329  -66.329 34.1645
0.7     1       41.827  -40.827 41.827
0.8     1       28.177  -27.177 28.177
0.9     1       19.824  -18.824 19.824
1       1       14.3    -13.3   14.3


k <- 3

0.1     25198   12667.01        12530.99        0.5026992
0.2     2013    2800.569        -787.569        1.391241
0.3     91240   977.677 90262.32        0.01071544
0.4     91240   431.955 90808.04        0.004734272
0.5     91240   228.039 91011.96        0.002499331
0.6     91240   135.121 91104.88        0.001480940
0.7     91240   87.478  91152.52        0.000958768
0.8     91240   60.059  91179.94        0.000658253
0.9     91240   42.815  91197.18        0.0004692569
1       91240   31.531  91208.47        0.0003455831

0.1     10195   6387.274        3807.726        0.6265104
0.2     91240   1462.708        89777.3 0.01603143
0.3     91240   523.219 90716.78        0.005734535
0.4     91240   231.775 91008.23        0.002540278
0.5     91240   119.748 91120.25        0.001312451
0.6     91240   69.205  91170.8 0.0007584941
0.7     91240   43.729  91196.27        0.0004792744
0.8     91240   29.303  91210.7 0.0003211640
0.9     91240   20.449  91219.55        0.0002241232
1       91240   14.728  91225.27        0.0001614204

0.1     15003   6279.741        8723.259        0.4185657
0.2     2013    1337.861        675.139 0.6646105
0.3     91240   454.458 90785.54        0.004980907
0.4     91240   200.18  91039.82        0.002193994
0.5     91240   108.291 91131.7 0.001186881
0.6     91240   65.916  91174.08        0.0007224463
0.7     91240   43.749  91196.25        0.0004794936
0.8     91240   30.756  91209.24        0.000337089
0.9     91240   22.366  91217.63        0.0002451337
1       91240   16.803  91223.2 0.0001841626



####################################FDR for exons with exon probe number/gene probe number <=0.25


 k <- 3

 setwd ("final")

 load ("tmedian.main.v2.RData")
 load ( paste("Main.tmedian.perm.v2.", k, ".RData", sep="") )
 tu.list <- rownames(texpr.main[[k]])

 #the ratio of exon probe number/gene probe number 
 load ("tmean.tgr.RData")



 {#separated to 10 percentiles based on tgr
 quant <- quantile(tgr, seq(0.1, 1, 0.1) )
 quant <- c(0, quant)
 
 bitmap ("tmedian.quantile.qq.png", width=24, height=18)
 par( mfrow=c(3, 4) )
 for (q in 1:10)
 {
   qcut <- names(tgr)[ tgr > quant[q] & tgr <= quant[q+1] ]   
   tmain <- texpr.main[[k]] [ which( tu.list %in% qcut), ]
   tperm1  <- texpr.perm[[1]] [ which( tu.list %in% qcut), ]
   tperm2  <- texpr.perm[[2]] [ which( tu.list %in% qcut), ]

   s0 <- quantile( tperm2, 0.5)
   main <- tmain[,1]/ (tmain[,2]+s0)
   main <- sort(main)
   perm.mat <- tperm1 / (tperm2 +s0); rm(tperm1, tperm2); gc()

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

   plot(null, main, "p", pch=16, cex=0.2, col="orange", xlab="null d", ylab="d", xlim=c(-4.5, 4.5), ylim=c(-5.5, 5.5), main="" )
   abline( 0, 1)
   lines(null, null+0.4, lty=2)
   lines(null, null-0.4, lty=2)
   legend("topleft", paste( round(quant[q]*100, 2), "% - ", round(quant[q+1]*100, 2), "%", sep="" ), bty="n") 
 }
 dev.off()  }






  {#FDR for 0.25 cut
  qcut <- names(tgr)[ tgr <= 0.25 ]    #exon probes/gene probes ratio
 
  tmain <- texpr.main[[k]] [ which( tu.list %in% qcut), ]
  tperm1  <- texpr.perm[[1]] [ which( tu.list %in% qcut), ]
  tperm2  <- texpr.perm[[2]] [ which( tu.list %in% qcut), ]

  s0 <- quantile( tperm2, 0.5)
  main <- tmain[,1]/ (tmain[,2]+s0)
  main <- sort(main)
  perm.mat <- tperm1 / (tperm2 +s0); rm(tperm1, tperm2); 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     5392    11454.74        -6062.736       2.124395
0.2     1552    2080.592        -528.592        1.340588
0.3     803     555.663 247.337 0.6919838
0.4     500     203.088 296.912 0.406176
0.5     343     96.071  246.929 0.2800904
0.6     230     54.083  175.917 0.2351435
0.7     175     33.827  141.173 0.1932971
0.8     148     23.027  124.973 0.1555878
0.9     103     16.091  86.909  0.1562233
1       84      11.57   72.43   0.1377381

0.1     2730    5855.018        -3125.018       2.144695
0.2     939     1102.728        -163.728        1.174364
0.3     523     299.627 223.373 0.5729006
0.4     328     108.056 219.944 0.329439
0.5     223     51.822  171.178 0.2323857
0.6     154     29.315  124.685 0.1903571
0.7     123     18.572  104.428 0.1509919
0.8     101     12.763  88.237  0.1263663
0.9     71      9.168   61.832  0.1291268
1       56      6.697   49.303  0.1195893

0.1     2662    5599.718        -2937.718       2.103576
0.2     613     977.864 -364.864        1.595210
0.3     280     256.036 23.964  0.9144143
0.4     172     95.032  76.968  0.5525116
0.5     120     44.249  75.751  0.3687417
0.6     76      24.768  51.232  0.3258947
0.7     52      15.255  36.745  0.2933654
0.8     47      10.264  36.736  0.218383
0.9     32      6.923   25.077  0.2163438
1       28      4.873   23.127  0.1740357


k <- 2

0.1     73      11670.33        -11597.33       159.8675
0.2     25      2261.337        -2236.337       90.45348
0.3     19      690.431 -671.431        36.33847
0.4     14      261.431 -247.431        18.67364
0.5     14      115.377 -101.377        8.241214
0.6     9       58.716  -49.716 6.524
0.7     9       33.063  -24.063 3.673667
0.8     7       21.464  -14.464 3.066286
0.9     5       14.708  -9.708  2.9416
1       3       10.581  -7.581  3.527

0.1     51      5838.976        -5787.976       114.4897
0.2     13      1131.433        -1118.433       87.0333
0.3     13      343.705 -330.705        26.43885
0.4     11      132.973 -121.973        12.08845
0.5     11      60.201  -49.201 5.472818
0.6     6       31.53   -25.53  5.255
0.7     6       19.089  -13.089 3.1815
0.8     5       12.749  -7.749  2.5498
0.9     3       9.025   -6.025  3.008333
1       1       6.643   -5.643  6.643

0.1     22      5831.352        -5809.352       265.0615
0.2     12      1129.904        -1117.904       94.15867
0.3     6       346.726 -340.726        57.78767
0.4     3       128.458 -125.458        42.81933
0.5     3       55.176  -52.176 18.392
0.6     3       27.186  -24.186 9.062
0.7     3       13.974  -10.974 4.658
0.8     2       8.715   -6.715  4.3575
0.9     2       5.683   -3.683  2.8415
1       2       3.938   -1.938  1.969



k <- 3

0.1     24069   11224.02        12844.98        0.466327
0.2     5329    1874.771        3454.229        0.3518054
0.3     589     545.779 43.221  0.9266197
0.4     11      207.777 -196.777        18.88882
0.5     5       97.11   -92.11  19.422
0.6     3       53.019  -50.019 17.673
0.7     3       31.496  -28.496 10.49867
0.8     1       20.465  -19.465 20.465
0.9     68022   13.749  68008.25        0.0002021258
1       68022   9.819   68012.18        0.0001443504

0.1     11045   5597.494        5447.506        0.5067899
0.2     2121    978.195 1142.805        0.4611952
0.3     16      297.143 -281.143        18.57144
0.4     3       114.845 -111.845        38.28167
0.5     3       51.808  -48.808 17.26933
0.6     1       27.082  -26.082 27.082
0.7     1       15.505  -14.505 15.505
0.8     68022   9.68    68012.32        0.0001423069
0.9     68022   6.395   68015.6 9.40137e-05
1       68022   4.486   68017.51        6.594925e-05

0.1     13024   5626.531        7397.469        0.4320125
0.2     3208    896.576 2311.424        0.2794813
0.3     573     248.636 324.364 0.4339197
0.4     8       92.932  -84.932 11.6165
0.5     2       45.302  -43.302 22.651
0.6     2       25.937  -23.937 12.9685
0.7     2       15.991  -13.991 7.9955
0.8     1       10.785  -9.785  10.785
0.9     68022   7.354   68014.65        0.0001081121
1       68022   5.333   68016.67        7.84011e-05




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

 k <- 1

 setwd ("final")

 load ("tmedian.main.v2.RData")  
 load ( paste("Main.tmedian.perm.v2.", k, ".RData", sep="") )  
 tu.list <- rownames(texpr.main[[k]])

 load ("tmean.tgr.RData")
 qcut <- names(tgr)[ tgr <= 0.25 ] 
  
 tmain <- texpr.main[[k]] [ which( tu.list %in% qcut), ]
 tperm2  <- texpr.perm[[2]] [ which( tu.list %in% qcut), ]; rm(texpr.perm); gc()
 s0 <- quantile( tperm2, 0.5)
 main <- tmain[,1]/ (tmain[,2]+s0)
 names(main) <- rownames(tmain)
 main <- sort(main)
 
 #328 172 = 500
 #71 32 = 103

 exon <- names( sort(main) ) [1:172]
 exon <- c(exon, names(sort(main, decreasing=T) )[1:328])


 effect <- c("additive", "dominant", "maternal")

 source("plottu.R")
 plot.tu(exon,  paste("tmedian.", effect[k], sep="") ) 



############################################################enrichment for known alternative exon



 setwd ("final")

 load ("attile.nonSFP.exon.RData")

 
 #maxClone==0.001, 0.002, 0.003,0.004 and each expressedClones/maxClones
 maxclone <- as.numeric( as.character(attile.nonSFP.exon$maxClone) )
 expressedclone <- as.numeric( as.character(attile.nonSFP.exon$expressedClones) )
 
 predicted.splice <- attile.nonSFP.exon[ (maxclone == 0.002 | maxclone==0.003 | maxclone==0.004) & ( expressedclone/maxclone <1 ), ]
 #predicted.splice <- paste(predicted.splice$gene, predicted.splice$tu)
 pre.splice.gene <- names( table( as.character(predicted.splice$gene) ) )


 predicted.nosplice <- attile.nonSFP.exon[ (maxclone==0.001 | maxclone == 0.002 | maxclone==0.003 | maxclone==0.004) & ( expressedclone/maxclone ==1 ), ]
 #predicted.nosplice <- paste(predicted.nosplice$gene, predicted.nosplice$tu)
 pre.nosplice.gene <- names( table( as.character(predicted.nosplice$gene) ) )

 splice <- attile.nonSFP.exon [ (maxclone != 0.001 & maxclone != 0.002 & maxclone != 0.003 & maxclone != 0.004) & (expressedclone/maxclone <1), ]
 #splice <- paste(splice$gene, splice$tu)
 splice.gene <- names( table( as.character(splice$gene) ) )

 nosplice <- attile.nonSFP.exon[ (maxclone != 0.001 & maxclone != 0.002 & maxclone != 0.003 & maxclone != 0.004) & (expressedclone/maxclone == 1), ]
 #nosplice <- paste(nosplice$gene, nosplice$tu)
 nosplice.gene <- names( table( as.character(nosplice$gene) ) )


 k <- 1
 load ("tmedian.main.v2.RData")  
 load ( paste("Main.tmedian.perm.v2.", k, ".RData", sep="") )  
 tu.list <- rownames(texpr.main[[k]])

 load ("tmean.tgr.RData")
 qcut <- names(tgr)[ tgr <= 0.25 ]    

 tmain <- texpr.main[[k]] [ which( tu.list %in% qcut), ]
 tperm2  <- texpr.perm[[2]] [ which( tu.list %in% qcut), ]; rm(texpr.perm); gc()
 s0 <- quantile( tperm2, 0.5)
 main <- tmain[,1] / (tmain[,2] + s0)
 names (main) <- rownames(tmain)



 #328 172 = 500
 #71 32 = 103


 tu.list <- names( sort(main) ) [1:172]
 tu.list <- c(tu.list, names(sort(main, decreasing=T) )[1:328])
 #tu.list <- names( sort(main) ) [1:32]
 #tu.list <- c(tu.list, names(sort(main, decreasing=T) )[1:71])


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

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



 ###for splicing exons
 tab <- matrix(NA, nr=3, nc=4)
 rownames(tab) <- c("selected", "total", "percentage")
 colnames(tab) <- c("nosplice", "splice", "predicted.nosplice", "predicted.splice")

 tab [1,1] <- length( intersect(tu.list, nosplice ) )
 tab [1,2] <- length( intersect(tu.list, splice) )
 tab [1,3] <- length( intersect(tu.list, predicted.nosplice) )
 tab [1,4] <- length( intersect(tu.list, predicted.splice) )
 tab [2,1] <- length( intersect(total.list, nosplice ) )
 tab [2,2] <- length( intersect(total.list, splice) )
 tab [2,3] <- length( intersect(total.list, predicted.nosplice) )
 tab [2,4] <- length( intersect(total.list, predicted.splice) )
 tab [3,] <- tab[1,]/tab[2,]


 tab1 <- matrix( c(tab[1,2], tab[2,2]-tab[1,2], tab[1,1], tab[2,1]-tab[1,1]), byrow=T, nc=2)
 print(tab1)
 cat( "fold enrichment", "\t", (tab1[1,1]/tab1[2,1]) / (tab1[1,2]/tab1[2,2]), "\n", "fisher'test pval", "\t", fisher.test(tab1, "l")$p.value, "\n")





 ###for splicing genes
 tab <- matrix(NA, nr=3, nc=4)
 rownames(tab) <- c("selected", "total", "percentage")
 colnames(tab) <- c("nosplice", "splice", "predicted.nosplice", "predicted.splice")

 tab [1,1] <- length( intersect(tu.gene, nosplice.gene ) )
 tab [1,2] <- length( intersect(tu.gene, splice.gene) )
 tab [1,3] <- length( intersect(tu.gene, pre.nosplice.gene) )
 tab [1,4] <- length( intersect(tu.gene, pre.splice.gene) )
 tab [2,1] <- length( intersect(total.gene, nosplice.gene ) )
 tab [2,2] <- length( intersect(total.gene, splice.gene) )
 tab [2,3] <- length( intersect(total.gene, pre.nosplice.gene) )
 tab [2,4] <- length( intersect(total.gene, pre.splice.gene) )
 tab [3,] <- tab[1,]/tab[2,]
 print(tab)
               nosplice       splice predicted.nosplice predicted.splice
selected   3.990000e+02 6.900000e+01       3.900000e+01                0
total      1.246700e+04 1.548000e+03       2.882000e+03               42
percentage 3.200449e-02 4.457364e-02       1.353227e-02                0


 tab1 <- matrix( c(tab[1,2], tab[2,2]-tab[1,2], tab[1,1], tab[2,1]-tab[1,1]), byrow=T, nc=2)
 print(tab1)
 cat( "fold enrichment", "\t", (tab1[1,1]/tab1[2,1]) / (tab1[1,2]/tab1[2,2]), "\n", "fisher'test pval", "\t", fisher.test(tab1, "l")$p.value, "\n")

      [,1]  [,2]
[1,]   69  1479
[2,]  399 12068

fold enrichment          1.411053
 fisher'test pval        0.01304829






########################################################################### verifications

 setwd ("final")

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

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


 k <- 1
 load ("tmedian.main.v2.RData")  
 load ( paste("Main.tmedian.perm.v2.", k, ".RData", sep="") )  
 tu.list <- rownames(texpr.main[[k]])

 load ("tmean.tgr.RData")
 qcut <- names(tgr)[ tgr <= 0.25 ]    
  
 tmain <- texpr.main[[k]] [ which( tu.list %in% qcut), ]
 tperm2  <- texpr.perm[[2]] [ which( tu.list %in% qcut), ]; rm(texpr.perm); gc()
 s0 <- quantile( tperm2, 0.5)
 main <- tmain[,1] / (tmain[,2] + s0)
 names (main) <- rownames(tmain) 
 

 #328 172 = 500
 #71 32 = 103


 #tu.list <- names( sort(main) ) [1:172]
 #tu.list <- c(tu.list, names(sort(main, decreasing=T) )[1:328])
 tu.list <- names( sort(main) ) [1:32]
 tu.list <- c(tu.list, names(sort(main, decreasing=T) )[1:71])

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


 test <- exon.gene[ which( exon.gene %in% tu.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

 setwd ("final")

 load ("tmedian.main.v2.RData")
 tu.list <- rownames(texpr.main[[1]])
 
 load ("tmean.tgr.RData")
 qcut <- names(tgr)[tgr <=0.25]


 k <- 1
 load ( paste("Main.tmedian.perm.v2.", k, ".RData", sep="") )
 tperm1 <- texpr.perm[[1]][ which(tu.list %in% qcut), ]
 tperm2 <- texpr.perm[[2]][ which(tu.list %in% qcut), ]; rm(texpr.perm); gc()
 s0 <- quantile( tperm2, 0.5)
 perm.mat <- tperm1/(tperm2+s0); rm(tperm1, tperm2); gc()
 for (i in 1:ncol(perm.mat) ) perm.mat[,i] <- sort( perm.mat[,i])
 null.add <- rowMeans(perm.mat)
 tmain <- texpr.main[[k]][ which(tu.list %in% qcut),]
 main <- tmain[,1] / (tmain[,2] + s0) 
 main.add <- sort(main)


 k <- 2
 load ( paste("Main.tmedian.perm.v2.", k, ".RData", sep="") )
 tperm1 <- texpr.perm[[1]][ which(tu.list %in% qcut), ]
 tperm2 <- texpr.perm[[2]][ which(tu.list %in% qcut), ]; rm(texpr.perm); gc()
 s0 <- quantile( tperm2, 0.5)
 perm.mat <- tperm1/(tperm2+s0); rm(tperm1, tperm2); gc()
 for (i in 1:ncol(perm.mat) ) perm.mat[,i] <- sort( perm.mat[,i])
 null.dom <- rowMeans(perm.mat)
 tmain <- texpr.main[[k]][ which(tu.list %in% qcut),]
 main <- tmain[,1] / (tmain[,2] + s0) 
 main.dom <- sort(main)


 k <- 3
 load ( paste("Main.tmedian.perm.v2.", k, ".RData", sep="") )
 tperm1 <- texpr.perm[[1]][ which(tu.list %in% qcut), ]
 tperm2 <- texpr.perm[[2]][ which(tu.list %in% qcut), ]; rm(texpr.perm); gc()
 s0 <- quantile( tperm2, 0.5)
 perm.mat <- tperm1/(tperm2+s0); rm(tperm1, tperm2); gc()
 for (i in 1:ncol(perm.mat) ) perm.mat[,i] <- sort( perm.mat[,i])
 null.mat <- rowMeans(perm.mat)
 tmain <- texpr.main[[k]][ which(tu.list %in% qcut),]
 main <- tmain[,1] / (tmain[,2] + s0) 
 main.mat <- sort(main)



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

  xlim=c(-4.5, 4.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.4, lty=2)
  lines(null.add, null.add-0.4, 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.4, lty=2)
  lines(null.dom, null.dom-0.4, 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.4, lty=2)
  lines(null.mat, null.mat-0.4, lty=2)
  abline(0, 1)
  legend("topleft", "maternal", bty="n", cex=3)

 dev.off()























