

##########################################################residuals from gene modeling

 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) ), ]
 mRNA.nonSFP.exon <- mRNA.nowSFP.exon- rowMeans(mRNA.nonSFP.exon)

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

 resid <- mRNA.nonSFP.exon #same dim as attile.nonSFP.exon 


 for (i in 1:length(gene.list) )
 {
  probes <- which( as.character(attile.nonSFP.exon$gene) %in% gene.list[i] )
  gene.mean <- mRNA.nonSFP.exon [ 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)

  gframe <- data.frame( gene.mean = c(gene.mean), add, dom, mat)

  #add+dom+mat to test additive and dominant
  res <- summary( lm( gene.mean~ add + dom + mat, data=gframe) )$resid
  resid [probes, ] <- matrix(res, nr=length(probes) )


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

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

 q("no")





#######################################################model residuals for each exon


 setwd("final")
 
 load ("attile.nonSFP.exon.RData")
 load ("resid.v2.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


 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 <- resid[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
  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="tmean.main.v2.RData", compress=T)

 q("no")





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

 k <- 1

 setwd("final")
 
 load ("resid.v2.RData")
 res <- resid 

 load ("attile.nonSFP.exon.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


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


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

 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 <- res[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) #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.tmean.perm.v2.", k, ".set", j, ".RData", sep=""), compress=T)
 q("no")





###combine permutation data

 setwd ("final")

 k <- 1

 load ( paste("Main.tmean.perm.v2.", k, ".set1.RData", sep="") )
 coef <- texpr.perm[[1]]
 std <- texpr.perm[[2]]
 
 for (i in 2:10)
 {
  load ( paste("Main.tmean.perm.v2.", k, ".set", i, ".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.tmean.perm.v2.", k, ".RData", sep=""), compress=T)

 q("no")






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


 setwd ("final")

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

 k <- 1

 load ( paste("Main.tmean.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     1146    12966.95        -11820.95       11.31497
0.2     545     3009.602        -2464.602       5.522206
0.3     327     986.32  -659.32 3.016269
0.4     232     429.094 -197.094        1.849543
0.5     185     229.965 -44.965 1.243054
0.6     150     141.737 8.263   0.9449133
0.7     83      94.93   -11.93  1.143735
0.8     68      66.454  1.546   0.9772647
0.9     42      48.573  -6.573  1.1565
1       33      36.343  -3.343  1.101303


0.1     641     6583.888        -5942.888       10.27128
0.2     343     1575.413        -1232.413       4.593041
0.3     185     521.743 -336.743        2.820232
0.4     123     223.994 -100.994        1.821089
0.5     99      121.202 -22.202 1.224263
0.6     82      74.817  7.183   0.9124024
0.7     37      50.171  -13.171 1.355973
0.8     31      35.606  -4.606  1.148581
0.9     23      26.371  -3.371  1.146565
1       21      20.108  0.892   0.9575238


0.1     505     6383.062        -5878.062       12.63973
0.2     202     1434.189        -1232.189       7.099946
0.3     142     464.577 -322.577        3.271669
0.4     109     205.1   -96.1   1.881651
0.5     86      108.763 -22.763 1.264686
0.6     68      66.92   1.08    0.9841176
0.7     46      44.759  1.241   0.9730217
0.8     37      30.848  6.152   0.8337297
0.9     19      22.202  -3.202  1.168526
1       12      16.235  -4.235  1.352917


k <- 2

0.1     4509    13446.12        -8937.124       2.982063
0.2     524     3313.114        -2789.114       6.322737
0.3     105     1173.273        -1068.273       11.17403
0.4     30      513.62  -483.62 17.12067
0.5     13      262.088 -249.088        20.16062
0.6     3       149.789 -146.789        49.92967
0.7     2       95.951  -93.951 47.9755
0.8     91240   66.18   91173.82        0.0007253398
0.9     91240   48.152  91191.85        0.000527751
1       91240   35.881  91204.12        0.0003932595


0.1     1851    6722.221        -4871.221       3.63167
0.2     212     1647.204        -1435.204       7.76983
0.3     70      585.203 -515.203        8.360043
0.4     29      259.258 -230.258        8.939931
0.5     13      134.459 -121.459        10.343
0.6     3       78.468  -75.468 26.156
0.7     2       51.606  -49.606 25.803
0.8     91240   36.577  91203.42        0.0004008878
0.9     91240   27.115  91212.88        0.0002971833
1       91240   20.719  91219.28        0.0002270824


0.1     2658    6723.903        -4065.903       2.529685
0.2     312     1665.91 -1353.91        5.339455
0.3     35      588.07  -553.07 16.802
0.4     1       254.362 -253.362        254.362
0.5     91240   127.629 91112.37        0.001398827
0.6     91240   71.321  91168.68        0.0007816857
0.7     91240   44.345  91195.65        0.0004860259
0.8     91240   29.603  91210.4 0.000324452
0.9     91240   21.037  91218.96        0.0002305677
1       91240   15.162  91224.84        0.0001661771


k <- 3

0.1     3939    12464.47        -8525.465       3.164373
0.2     38      2777.472        -2739.472       73.09137
0.3     11      971.89  -960.89 88.35364
0.4     4       432.532 -428.532        108.133
0.5     3       231.39  -228.39 77.13
0.6     1       137.698 -136.698        137.698
0.7     1       89.861  -88.861 89.861
0.8     1       61.098  -60.098 61.098
0.9     1       43.91   -42.91  43.91
1       91240   32.377  91207.62        0.0003548553

0.1     13      6304.182        -6291.182       484.9371
0.2     5       1446.059        -1441.059       289.2118
0.3     2       520.938 -518.938        260.469
0.4     91240   231.646 91008.35        0.002538865
0.5     91240   121.696 91118.3 0.001333801
0.6     91240   70.503  91169.5 0.0007727203
0.7     91240   44.718  91195.28        0.000490114
0.8     91240   29.632  91210.37        0.0003247698
0.9     91240   20.758  91219.24        0.0002275099
1       91240   14.939  91225.06        0.000163733

0.1     3926    6160.283        -2234.283       1.569099
0.2     33      1331.413        -1298.413       40.34585
0.3     9       450.952 -441.952        50.10578
0.4     4       200.886 -196.886        50.2215
0.5     3       109.694 -106.694        36.56467
0.6     1       67.195  -66.195 67.195
0.7     1       45.143  -44.143 45.143
0.8     1       31.466  -30.466 31.466
0.9     1       23.152  -22.152 23.152
1       91240   17.438  91222.56        0.0001911223





########################################################FDR for exon quantiles of exon probe/gene probe ratio

###the exon probe/gene probe ratio

 setwd("final")
 load ("attile.nonSFP.exon.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,]

 
 tgr <- rep(NA, length(tu.list) )
 names(tgr) <- tu.list
 for (i in 1:length(tu.list))
 {
   tprobe <- length( which( paste(attile.nonSFP.exon$gene, attile.nonSFP.exon$tu)==tu.list[i]) )
   gprobe <- length( which( as.character(attile.nonSFP.exon$gene) == gene[i]) )
   tgr [i] <- tprobe/gprobe 
 }

 save(tgr, file="tmean.tgr.RData", compress=T)





###


 k <- 1

 setwd ("final")

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

 load ("tmean.tgr.RData")



 {#separate to 10 percentiles
 quant <- quantile(tgr, seq(0.1, 1, 0.1) )
 quant <- c(0, quant)
 
 bitmap ("tmean.qq.quantile.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(-3.5, 3.5), ylim=c(-5.5, 5.5), main="" )
   abline( 0, 1)
   lines(null, null+0.3, lty=2)
   lines(null, null-0.3, lty=2)
   legend("topleft", paste( round(quant[q]*100, 2), "% - ", round(quant[q+1]*100, 2), "%", sep="" ), bty="n") 
 }
 dev.off()  }




###

 k <- 1

 setwd ("final")

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


 load ("tmean.tgr.RData")
 qcut <- names(tgr)[ tgr <= 0.25 ]    #exon probes/gene probes ratio #68022 exons in 15349 genes
 

 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), ]; rm(texpr.perm); gc()

 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     2609    11499.49        -8890.491       4.407624
0.2     861     2093.169        -1232.169       2.431091
0.3     477     559.008 -82.008 1.171925
0.4     306     205.133 100.867 0.6703693
0.5     236     96.73   139.27  0.4098729
0.6     178     54.865  123.135 0.3082303
0.7     146     34.216  111.784 0.2343562
0.8     111     23.047  87.953  0.2076306
0.9     71      16.195  54.805  0.2280986
1       57      11.667  45.333  0.2046842


0.1     1139    5887.118        -4748.118       5.168673
0.2     457     1110.784        -653.784        2.430600
0.3     287     302.47  -15.47  1.053902
0.4     177     109.948 67.052  0.6211751
0.5     127     52.581  74.419  0.4140236
0.6     92      29.726  62.274  0.3231087
0.7     77      18.808  58.192  0.2442597
0.8     57      12.823  44.177  0.2249649
0.9     32      9.175   22.825  0.2867188
1       28      6.756   21.244  0.2412857


0.1     1470    5612.373        -4142.373       3.817941
0.2     404     982.385 -578.385        2.431646
0.3     190     256.538 -66.538 1.3502
0.4     129     95.185  33.815  0.7378682
0.5     109     44.149  64.851  0.4050367
0.6     86      25.139  60.861  0.2923140
0.7     69      15.408  53.592  0.2233043
0.8     54      10.224  43.776  0.1893333
0.9     39      7.02    31.98   0.18
1       29      4.911   24.089  0.1693448




k <- 2
0.1     99      11685.76        -11586.76       118.038
0.2     8       2294.129        -2286.129       286.7661
0.3     5       698.428 -693.428        139.6856
0.4     5       265.883 -260.883        53.1766
0.5     3       117.696 -114.696        39.232
0.6     1       60.772  -59.772 60.772
0.7     1       34.602  -33.602 34.602
0.8     1       22.53   -21.53  22.53
0.9     1       15.594  -14.594 15.594
1       68022   11.324  68010.68        0.0001664756



0.1     92      5823.253        -5731.253       63.29623
0.2     7       1144.254        -1137.254       163.4649
0.3     4       349.144 -345.144        87.286
0.4     4       135.433 -131.433        33.85825
0.5     2       61.521  -59.521 30.7605
0.6     68022   32.477  67989.52        0.0004774485
0.7     68022   19.914  68002.09        0.0002927582
0.8     68022   13.435  68008.57        0.0001975096
0.9     68022   9.5     68012.5 0.0001396607
1       68022   7.03    68014.97        0.0001033489



0.1     7       5862.509        -5855.509       837.5013
0.2     1       1149.875        -1148.875       1149.875
0.3     1       349.284 -348.284        349.284
0.4     1       130.45  -129.45 130.45
0.5     1       56.175  -55.175 56.175
0.6     1       28.295  -27.295 28.295
0.7     1       14.688  -13.688 14.688
0.8     1       9.095   -8.095  9.095
0.9     1       6.094   -5.094  6.094
1       68022   4.294   68017.7 6.312664e-05


k <- 3

0.1     13343   11070.2 2272.799        0.8296636
0.2     704     1857.892        -1153.892       2.639051
0.3     5       535.617 -530.617        107.1234
0.4     1       206.577 -205.577        206.577
0.5     68022   98.117  67923.88        0.001442430
0.6     68022   53.674  67968.33        0.0007890682
0.7     68022   32.15   67989.85        0.0004726412
0.8     68022   20.812  68001.19        0.0003059598
0.9     68022   14.116  68007.88        0.0002075211
1       68022   10      68012   0.0001470113


0.1     5309    5560.587        -251.587        1.047389
0.2     68022   967.027 67054.97        0.01421639
0.3     68022   293.404 67728.6 0.004313369
0.4     68022   113.794 67908.2 0.0016729
0.5     68022   52.2    67969.8 0.0007673988
0.6     68022   27.498  67994.5 0.0004042516
0.7     68022   15.636  68006.36        0.0002298668
0.8     68022   9.734   68012.27        0.0001431008
0.9     68022   6.492   68015.51        9.543971e-05
1       68022   4.451   68017.55        6.543471e-05


0.1     8034    5509.614        2524.386        0.6857872
0.2     704     890.865 -186.865        1.265433
0.3     5       242.213 -237.213        48.4426
0.4     1       92.783  -91.783 92.783
0.5     68022   45.917  67976.08        0.0006750316
0.6     68022   26.176  67995.82        0.0003848167
0.7     68022   16.514  68005.49        0.0002427744
0.8     68022   11.078  68010.92        0.0001628591
0.9     68022   7.624   68014.38        0.0001120814
1       68022   5.549   68016.45        8.157655e-05




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

 setwd ("final")

 load ("tmean.main.v2.RData")
 tu.list <- rownames(texpr.main[[1]]) 

 load ("tmean.tgr.RData")
 qcut <- names(tgr)[ tgr <= 0.25 ]    #exon probes/gene probes ratio #68022 exons in 15349 genes

 
 k <- 1
 load ( paste("Main.tmean.perm.v2.", k, ".RData", sep="") )
 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), ]; rm(texpr.perm); gc()
 s0 <- quantile( tperm2, 0.5)
 main <- tmain[,1]/ (tmain[,2]+s0)
 main.add <- 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.add <- rowMeans(perm.mat)
 

 k <- 2
 load ( paste("Main.tmean.perm.v2.", k, ".RData", sep="") )
 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), ]; rm(texpr.perm); gc()
 s0 <- quantile( tperm2, 0.5)
 main <- tmain[,1]/ (tmain[,2]+s0)
 main.dom <- 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.dom <- rowMeans(perm.mat)
 


 k <- 3
 load ( paste("Main.tmean.perm.v2.", k, ".RData", sep="") )
 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), ]; rm(texpr.perm); gc()
 s0 <- quantile( tperm2, 0.5)
 main <- tmain[,1]/ (tmain[,2]+s0)
 main.mat <- 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.mat <- rowMeans(perm.mat)




 pdf("tmean.qq.pdf", width=5, height=15)
  par( mfrow=c(3, 1), mai=c(0.8, 0.8, 0.5, 0.42) )

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

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

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


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

 dev.off()



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


 setwd ("final")

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


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

 #287 190 = 477
 #57 54 = 111


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

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

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






###################################################################enrichment



 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 ("tmean.main.v2.RData")  
 load ( paste("Main.tmean.perm.v2.", k, ".RData", sep="") )  

 load ("tmean.tgr.RData")
 qcut <- names(tgr)[ tgr <= 0.25 ]    #exon probes/gene probes ratio
 tu.list <- rownames(texpr.main[[k]])
  
 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); rm(tperm2); gc()
 main <- tmain[,1] / (tmain[,2] + s0)
 names (main) <- rownames(tmain)


 #287 190 = 477
 #57 54 = 111


 tu.list <- names( sort(main) ) [1:190]
 tu.list <- c(tu.list, names(sort(main, decreasing=T) )[1:287])
 #tu.list <- names( sort(main) ) [1:54]
 #tu.list <- c(tu.list, names(sort(main, decreasing=T) )[1:57])

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


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



 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,]

 print(tab)

                nosplice       splice predicted.nosplice predicted.splice
selected   3.970000e+02 2.800000e+01       5.200000e+01                0
total      5.554200e+04 1.019000e+03       1.143300e+04               28
percentage 7.147744e-03 2.747792e-02       4.548238e-03                0

               nosplice      splice predicted.nosplice predicted.splice
selected   9.000000e+01 7.00000e+00       1.400000e+01                0
total      5.554200e+04 1.01900e+03       1.143300e+04               28
percentage 1.620395e-03 6.86948e-03       1.224525e-03                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")







 ###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.670000e+02 7.400000e+01       4.000000e+01                0
total      1.246700e+04 1.548000e+03       2.882000e+03               42
percentage 2.943772e-02 4.780362e-02       1.387925e-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,]   74  1474
[2,]  367 12100
 fold enrichment          1.655212
 fisher'test pval        0.0002620439




##############################################################################################verification



 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 ("tmean.main.v2.RData")  
 load ( paste("Main.tmean.perm.v2.", k, ".RData", sep="") )  

 
 load ("tmean.tgr.RData")
 qcut <- names(tgr)[ tgr <= 0.25 ]    #exon probes/gene probes ratio
 tu.list <- rownames(texpr.main[[k]])
  
 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); rm(tperm2); gc()
 main <- tmain[,1] / (tmain[,2] + s0)
 names (main) <- rownames(tmain)


 #287 190 = 477
 #57 54 = 111


 tu.list <- names( sort(main) ) [1:190]
 tu.list <- c(tu.list, names(sort(main, decreasing=T) )[1:287])
 #tu.list <- names( sort(main) ) [1:54]
 #tu.list <- c(tu.list, names(sort(main, decreasing=T) )[1:57])
 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") 





###############################################plotting figure

 setwd ("final")
 source("plottu.figure.R")


 tu.list <- "AT1G34180 tu1"
 plot.tu(tu.list, "tu.figure", c(12449675, 12450796))


 tu.list <- "AT1G28100 tu1"
 plot.tu(tu.list, "tu.figure", c(12449675, 12450796))


 tu.list <- "AT1G51350 intron8"
 plot.tu(tu.list, "intron.figure", c(19042373,19042930))







############################################################################################################see differential start, splicing or stop

 setwd("final")
 load ("attile1V7anno.RData")


 load ("tmean.tgr.RData")
 tu.list <- names(tgr)[ tgr <= 0.25 ]    #exon probes/gene probes ratio #68022 exons in 15349 genes

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


 tu.stop <- tapply( as.character(attile1$tu), as.character(attile1$gene), function(x) { a <- x[grep("tu", x)]; b <- as.numeric(sub("tu", "", a)); c <- b[which.max(b)]; return( paste("tu", c, sep="")) } ) 
 tu.stop <- paste(names(tu.stop), tu.stop)
 tu.stop <- tu.stop[ which(tu.stop %in% tu.list) ]



 k <- 1
 load ("tmean.main.v2.RData")
 load ( paste("Main.tmean.perm.v2.", k, ".RData", sep="") )

 tmain <- texpr.main[[k]] [ which( rownames(texpr.main[[k]]) %in% tu.list), ]
 tperm1  <- texpr.perm[[1]] [ which( rownames(texpr.main[[k]]) %in% tu.list), ]
 tperm2  <- texpr.perm[[2]] [ which( rownames(texpr.main[[k]]) %in% tu.list), ]; rm(texpr.perm); gc()

 s0 <- quantile( tperm2, 0.5)
 main <- tmain[,1]/ (tmain[,2]+s0)
 names(main) <- tu.list



 #287	190	477
 exon.list <- names( sort(main) ) [1:190]
 exon.list <- c(exon.list, names(sort(main, decreasing=T) )[1:287] )

 
 sig.start <- exon.list[ which(exon.list %in% tu.start) ]
 sig.stop <- exon.list[ which(exon.list %in% tu.stop) ]
 sig.else <- exon.list[- which( exon.list %in% tu.start | exon.list %in% tu.stop ) ]

 tu.else <- tu.list[ - which(tu.list %in% tu.start | tu.list %in% tu.stop) ]
 
 start <- tu.start[ - which(tu.start %in% sig.start) ]
 stop <- tu.stop [ - which(tu.stop %in% sig.stop) ]
 elsem <- tu.else[ - which(tu.else %in% sig.else) ]

 tab <- rbind( c( length(sig.start), length(sig.stop), length(sig.else) ), c( length(start), length(stop), length(elsem) ) )
 tab <- rbind( tab, tab[1,]/tab[2,])
 print (tab)

 

###

 load ("tmedian.main.v2.RData")
 load ( paste("Main.tmedian.perm.v2.", k, ".RData", sep="") )

 tmain <- texpr.main[[k]] [ which( rownames(texpr.main[[k]]) %in% tu.list), ]
 tperm1  <- texpr.perm[[1]] [ which( rownames(texpr.main[[k]]) %in% tu.list), ]
 tperm2  <- texpr.perm[[2]] [ which( rownames(texpr.main[[k]]) %in% tu.list), ]; rm(texpr.perm); gc()

 s0 <- quantile( tperm2, 0.5)
 main <- tmain[,1]/ (tmain[,2]+s0)
 names(main) <- tu.list

 
 #328	172	500

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

 
 sig.start <- exon.list[ which(exon.list %in% tu.start) ]
 sig.stop <- exon.list[ which(exon.list %in% tu.stop) ]
 sig.else <- exon.list[- which( exon.list %in% tu.start | exon.list %in% tu.stop ) ]

 tu.else <- tu.list[ - which(tu.list %in% tu.start | tu.list %in% tu.stop) ]  

 start <- tu.start[ - which(tu.start %in% sig.start) ]
 stop <- tu.stop [ - which(tu.stop %in% sig.stop) ]
 elsem <- tu.else[ - which(tu.else %in% sig.else) ]

 tab <- rbind( c( length(sig.start), length(sig.stop), length(sig.else) ), c( length(start), length(stop), length(elsem) ) )
 tab <- rbind( tab, tab[1,]/tab[2,])
 print (tab)




###


 load ("sindex.RData")
 tu.list <- rownames(index); rm(index); gc()
 

 load ("tindex.main.RData")  
 load ( paste("Main.tindex.perm", k, ".RData", sep="") )  
 add <- rep( c(1,-1,0, 0), each=4)
 dom <- rep( c(0, 0, 1, 1), each=4)
 mat <- rep( c(0, 0, -1, 1), each=4)
 denom <- c(  sqrt( sum( (add-mean(add) )^2) ),  sqrt( sum( (add-mean(add) )^2) ), sqrt( sum( (dom-mean(dom) )^2) ), sqrt( sum( (mat-mean(mat) )^2) )  )
 s0 <- quantile( texpr.perm[[2]], 0.5); rm(texpr.perm); gc()
 std <- sqrt( colSums( texpr.main[[2]]^2)/12 ) / denom[k+1]
 main <- texpr.main[[1]][k+1,] / (std + s0)
 names(main) <- tu.list


  #310	172	482
 exon.list <- names( sort(main) ) [1:172]
 exon.list <- c(exon.list, names(sort(main, decreasing=T) )[1:310])

 
 sig.start <- exon.list[ which(exon.list %in% tu.start) ]
 sig.stop <- exon.list[ which(exon.list %in% tu.stop) ]
 sig.else <- exon.list[- which( exon.list %in% tu.start | exon.list %in% tu.stop ) ]

 tu.else <- tu.list[ - which(tu.list %in% tu.start | tu.list %in% tu.stop) ]  

 start <- tu.start[ - which(tu.start %in% sig.start) ]
 stop <- tu.stop [ - which(tu.stop %in% sig.stop) ]
 elsem <- tu.else[ - which(tu.else %in% sig.else) ]

 tab <- rbind( c( length(sig.start), length(sig.stop), length(sig.else) ), c( length(start), length(stop), length(elsem) ) )
 tab <- rbind( tab, tab[1,]/tab[2,])
 print (tab)







#########################################################################why there is FDR > 100%


 setwd ("final")


 k <- 1

 load ("tmean.main.v2.RData")
 tu.list <- rownames(texpr.main[[1]]) 

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

 tmain <- texpr.main[[k]] [ which( tu.list %in% qcut), ]
 

 

 load ( paste("Main.tmean.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)
 main <- tmain[,1]/ (tmain[,2]+s0)
 perm.mat <- tperm1 / (tperm2 +s0); rm(tperm1, tperm2); gc()



 pdf ("dscore.dist.pdf")
 
 plot( density( main), col="red", lwd=0.1, xlim=c(-5, 5), ylim=c(0, 0.8), xlab="d score", main="")
 lines ( density (perm.mat), lwd=0.1)
 legend ("topleft", c("real", "permutation"), col=c("red", "black"), lty=1, bty="n")


 dev.off()











