#################################################################################################################################
#################################################################################################################################
##########################################################################################################################ASE




##################################################################################################normalization


setwd("final")
load("attile1V7anno.RData")
load ("gDNA.sc.nq.RData")


#the 5% weakest probes
col.mean <- rowMeans( gDNA.nq[, 1:4])
weak.cut <- quantile(col.mean, 0.05)
weak.cut <- which(col.mean < weak.cut)

#the SFPs at 5% FDR
load("SFP.samout.RData")
library(siggenes)
cut.low <- sort(sam.out@d)[6662]
cut.high <- sort(sam.out@d)[1565240]
sfp.cut <- which( sam.out@d <= cut.low | sam.out@d >= cut.high )

#the indels
ind <- c(1:nrow(attile1))
load ("segment/aic.RData")
indel.cut <- c()
for (chrom in 1:5)
{
 ind.chr <- ind[ attile1$chr==chrom]
 attile <- attile1[ attile1$chr==chrom,]
 mid <- as.numeric(attile$bpstart) - 12

 col.seg.bp <- col[[chrom]]
 van.seg.bp <- van[[chrom]]
 seg.bp <- rbind(col.seg.bp, van.seg.bp)
 
 for (i in 1:nrow(seg.bp) )
  {
   probe <- which( mid >= seg.bp[i,1] & mid <=seg.bp[i,2])
   indel.cut <- c(indel.cut, ind.chr[probe]) 
  }
}




 attile <- attile1[ attile1$flank == "noflank" & attile1$RNA == "mRNA" & attile1$multiTranscript == "unique",]
 attile <- attile[- which( rownames(attile) %in% as.character( weak.cut ) ), ]
 attile$gene <- as.character( attile$gene )
 attile$tu <- as.character(attile$tu)
 attile.exon <- attile[grep( "tu", attile$tu ), ]
 maxclone <- tapply (attile.exon$expressedClones, attile.exon$gene, max )
 attile.exon$maxClone <- maxclone[ match( attile.exon$gene, names(maxclone) ) ]
 attile.exon <- attile.exon[ attile.exon$expressedClones/attile.exon$maxClone >= 0.5, ] 

 attile.nonSFP.exon <- attile.exon[ - which( rownames(attile.exon) %in% as.character(sfp.cut) ), ]
 sfp.cut <- which( sam.out@d >= cut.high )
 attile.SFP.exon <- attile.exon[ which( rownames(attile.exon) %in% as.character(sfp.cut) ), ]		      
 write.table( attile.nonSFP.exon, "table.csv")
 attile.nonSFP.exon <- read.table( "table.csv", header=T)
 save( attile.nonSFP.exon, file="fix2/ase.attile.nonSFP.exon.RData", compress=T)
 write.table( attile.SFP.exon, "table.csv")
 attile.SFP.exon <- read.table( "table.csv", header=T)
 save( attile.SFP.exon, file="fix2/ase.attile.SFP.exon.RData", compress=T)




### quantile normalization

 library(affy)

 load ("mRNA.sc.RData")
 mprobe.mean <- mprobe.mean[ which ( rownames( mprobe.mean) %in% rownames(attile.exon) ), ]
 mRNA.nq <- normalize.quantiles(mprobe.mean)
 rownames(mRNA.nq) <- rownames(attile.exon)
 save (mRNA.nq, file="fix2/ase.mRNA.sc.nq.RData", compress=T)


 q("no")






#####################################################################################################################################
###################################################################################### correction of expression difference at log scale



 setwd ("final/fix2")
 

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


 gene.nonSFP  <- tapply( attile.nonSFP.exon$bpstart, as.character(attile.nonSFP.exon$gene), length)
 gene.nonSFP <- gene.nonSFP[ which(gene.nonSFP >=5) ]
 gene.SFP <- tapply( attile.SFP.exon$bpstart, as.character(attile.SFP.exon$gene), length)
 gene.SFP <- gene.SFP[ which(gene.SFP >=1) ]

 gene.list <- intersect( names(gene.nonSFP), names(gene.SFP)  ) #9745 genes


 ase.correct <- matrix( numeric(), nc=16)
 names <- c()
 

 
 for (i in 1:length(gene.list) )                
 {              
  probes.nonSFP <- rownames(attile.nonSFP.exon) [which ( as.character(attile.nonSFP.exon$gene) %in% gene.list[i]  ) ]
  mRNA.nonSFP <- mRNA.nq [ which(rownames(mRNA.nq) %in% probes.nonSFP), ]
  mRNA.nonSFP <- mRNA.nonSFP - rowMeans(mRNA.nonSFP)
        
  n <- length(probes.nonSFP)
  add <- rep( c(1, -1, 0, 0), each=4*n)
  dom <- rep( c(-1, -1, 1, 1), each=4*n)
  mat <- rep( c(0, 0, -1, 1), each=4*n)

  fit <- summary( lm( gmean~ add+dom+mat, data=data.frame( gmean=c(mRNA.nonSFP), add, dom, mat)  ) )$coef

  probes.SFP <- rownames(attile.SFP.exon)[ which( as.character(attile.SFP.exon$gene) %in% gene.list[i]  )  ]
  mRNA.SFP <- mRNA.nq[ which(rownames(mRNA.nq) %in% probes.SFP), ]

  n <- length(probes.SFP)      
  add <- rep( c(1, -1, 0, 0), each=4*n)
  dom <- rep( c(-1, -1, 1, 1), each=4*n)
  mat <- rep( c(0, 0, -1, 1), each=4*n)
  mRNA.SFP <- matrix(  c(mRNA.SFP) - cbind( add, dom, mat) %*% matrix(fit[-1,1], nc=1), nc=16)

            
  ase.correct <- rbind( ase.correct, mRNA.SFP)
  names <- c(names, rep(gene.list[i], length(probes.SFP) )  )

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

 rownames(ase.correct) <- names
 save(ase.correct, file="ase.correct.RData", compress=T)  #SFP probe corrected for expression, in log scale

 q("no")









################################################################################################################################### mid-parent value by gDNA




 setwd ("final")
 load ("gDNA.sc.nq.RData") 
 rownames(gDNA.nq) <- as.character( 1:nrow(gDNA.nq) )


 setwd ("fix2")
 
 load ("ase.attile.nonSFP.exon.RData")
 load ("ase.attile.SFP.exon.RData")
 
 gene.nonSFP  <- tapply( attile.nonSFP.exon$bpstart, as.character(attile.nonSFP.exon$gene), length)
 gene.nonSFP <- gene.nonSFP[ which(gene.nonSFP >=5) ]
 gene.SFP <- tapply( attile.SFP.exon$bpstart, as.character(attile.SFP.exon$gene), length)
 gene.SFP <- gene.SFP[ which(gene.SFP >=1) ]

 gene.list <- intersect( names(gene.nonSFP), names(gene.SFP)  ) #9745 genes


 ase.mid <- matrix( numeric(), nc=16)
 names <- c()


 
 load ("ase.correct.RData")


 for (i in 1:length(gene.list) )                
 {              
  probes.SFP <- rownames(attile.SFP.exon)[ which( as.character(attile.SFP.exon$gene) %in% gene.list[i]  )  ]
  gDNA.SFP <- matrix( gDNA.nq[  which(rownames(gDNA.nq) %in% probes.SFP), ], nc=16)
  mRNA.SFP <- matrix( ase.correct [ which(rownames(ase.correct) == gene.list[i]), ], nc=16)
 
 
  r <-  mRNA.SFP[,1:4] + mRNA.SFP[,5:8] -  gDNA.SFP[,1:4]-gDNA.SFP[,5:8] 
  tmp <- gDNA.SFP[,9:16] + 1/2*( rowMeans( matrix(r, nc=4)) )



  tmp <- cbind( matrix(tmp, nc=8), matrix( mRNA.SFP[,9:16], nc=8)  )
  ase.mid <- rbind( ase.mid, matrix(tmp, nc=16)  )

            
  names <- c(names, rep(gene.list[i], length(probes.SFP) )  )
        
  if (i/100 == trunc(i/100)) cat (i,"\n")	
 }
	    

 rownames(ase.mid) <- names
 save(ase.mid, file="ase.correct.mid.RData", compress=T)  
 q("no")









#####################################################################################################################ASE parametric test



 setwd ("final/fix2")
 load ("ase.correct.mid.RData")
 

 gene.list <- names( table( rownames(ase.mid))  ) 


 ase <- matrix(NA, nr=length(gene.list), nc=4)
 rownames(ase) <- gene.list

 
 for (i in 1:length(gene.list) )                
 {              
  probes <- which( rownames(ase.mid) %in% gene.list[i])

  m <- matrix( ase.mid[ probes,], nc=16)  
  m <- m- rowMeans(m)
  n <- length(probes)
  g <- rep( rep( c(0,1), c(8, 8) ), each=n) 


  mframe <- data.frame( m = c(m), g)
  fit <- lm( m~g, data=mframe)
  ase[i,] <- summary(fit)$coef[2,]

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

 save(ase, file="ase.main.correct.mid.RData", compress=T)
 





######################################################################################################## permutation


 
 setwd ("final/fix2")
 load ("ase.correct.mid.RData")

 

 gene.list <- names( table( rownames(ase.mid) ) )



 load ("../samp.matrix16.RData")
 
 nperm <- nrow(samp.matrix)
 matr <- matrix(NA, nr=length(gene.list), nc=nperm )
 ase.perm <- list( coef=matr, std=matr)

 
 for (i in 1:length(gene.list) )        
 {              
  probes <- which(  rownames(ase.mid) %in% gene.list[i] )
  m <- matrix( ase.mid[probes,], nc=16)
  m <- m- rowMeans(m)
  n <- length(probes)
  g <- rep( rep( c(0,1), c(8, 8) ), each=n) 

 
  for (iperm in 1:nperm)
  {
   pframe <- data.frame( m = c(m[, order( samp.matrix[iperm,])  ]), g)
   pfit <- summary(lm( m~g, data=pframe) )$coef
   ase.perm[[1]][i,iperm] <- pfit[2,1]
   ase.perm[[2]][i,iperm] <- pfit[2,2]
  }

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

 save(ase.perm, file="ase.main.perm.correct.mid.RData", compress=T) 
 


 q("no")






##############################################################################################################FDR


 setwd ("final/fix2")

 load ( "ase.main.correct.mid.RData" )
 load ( "ase.main.perm.correct.mid.RData" )



 coef <- ase.perm[[1]]
 std <- ase.perm[[2]]
 s0 <- quantile( std, 0.5)


 main <- ase[,1]/ (ase[,2]+s0)
 main <- sort(main)


 perm.mat <- coef/(std+s0)
 perm.num <- ncol(coef)
 for (i in 1:perm.num)	perm.mat[,i] <- sort (perm.mat[,i]) 
 null <- rowMeans(perm.mat)


 for (j in seq(0.1, 2, 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, 2, 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, 2, 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")
 }



0.1     8137    2933.103        5203.897        0.3604649
0.2     6521    408.262 6112.738        0.06260727
0.3     4909    89.843  4819.157        0.01830169
0.4     3614    23.836  3590.164        0.006595462
0.5     2321    9.05    2311.95 0.003899181
0.6     1554    3.882   1550.118        0.002498069
0.7     1068    1.773   1066.227        0.001660112
0.8     671     1.059   669.941 0.001578241
0.9     478     0.753   477.247 0.001575314
1       352     0.545   351.455 0.001548295
1.1     246     0.381   245.619 0.001548780
1.2     185     0.25    184.75  0.001351351
1.3     128     0.176   127.824 0.001375
1.4     103     0.114   102.886 0.001106796
1.5     81      0.088   80.912  0.001086420
1.6     67      0.059   66.941  0.000880597
1.7     57      0.049   56.951  0.0008596491
1.8     49      0.032   48.968  0.0006530612
1.9     39      0.026   38.974  0.0006666667
2       27      0.017   26.983  0.0006296296


0.1     2002    1480.042        521.958 0.7392817
0.2     1520    200.675 1319.325        0.1320230
0.3     1059    45.512  1013.488        0.04297639
0.4     791     12.85   778.15  0.01624526
0.5     540     4.984   535.016 0.00922963
0.6     394     2.15    391.85  0.005456853
0.7     308     0.959   307.041 0.003113636
0.8     213     0.508   212.492 0.002384977
0.9     175     0.377   174.623 0.002154286
1       143     0.282   142.718 0.001972028
1.1     117     0.196   116.804 0.001675214
1.2     105     0.119   104.881 0.001133333
1.3     85      0.089   84.911  0.001047059
1.4     70      0.062   69.938  0.0008857143
1.5     59      0.045   58.955  0.0007627119
1.6     52      0.033   51.967  0.0006346154
1.7     42      0.029   41.971  0.0006904762
1.8     39      0.018   38.982  0.0004615385
1.9     32      0.015   31.985  0.00046875
2       26      0.01    25.99   0.0003846154


0.1     6135    1453.061        4681.939        0.2368478
0.2     5001    207.587 4793.413        0.0415091
0.3     3850    44.331  3805.669        0.01151455
0.4     2823    10.986  2812.014        0.003891605
0.5     1781    4.066   1776.934        0.002282987
0.6     1160    1.732   1158.268        0.001493103
0.7     760     0.814   759.186 0.001071053
0.8     458     0.551   457.449 0.001203057
0.9     303     0.376   302.624 0.001240924
1       209     0.263   208.737 0.001258373
1.1     129     0.185   128.815 0.001434109
1.2     80      0.131   79.869  0.0016375
1.3     43      0.087   42.913  0.002023256
1.4     33      0.052   32.948  0.001575758
1.5     22      0.043   21.957  0.001954545
1.6     15      0.026   14.974  0.001733333
1.7     15      0.02    14.98   0.001333333
1.8     10      0.014   9.986   0.0014
1.9     7       0.011   6.989   0.001571429
2       1       0.007   0.993   0.007






 setwd ("final/fix2")
 load ( "ase.main.correct.mid.RData" )
 load ( "ase.main.perm.correct.mid.RData" )
 std <- ase.perm[[2]]
 s0 <- quantile( std, 0.5)
 main <- ase[,1]/ (ase[,2]+s0)
 names(main) <- rownames(ase)
 cis <- names( sort(main))[1:209]
 cis <- c(cis, names( sort(main, decreasing=T) )[1:540])
 
 vgene <- scan("test.txt", what="a")
 which(cis %in% vgene)





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

 setwd ("final")
 load ("expr.main.RData")
 load ("Main.expr.perm1.RData")
 s0 <- quantile(expr.perm[[2]], 0.5)
 expr.main <- expr.main[[1]]
 e.d <- expr.main[,1]/(expr.main[,2]+s0)
 names(e.d) <- rownames(expr.main)
 #emain <- names( sort(e.d) ) [1:224]
 #emain <- names( sort(e.d) ) [1:334]
 #emain <- names( sort(e.d) ) [1:578] 
 #emain <- names( sort(e.d) ) [1:923]
 emain <- names( sort(e.d) ) [1:1736]


 #emain <- c(emain, names(sort(e.d, decreasing=T)) [1:418])
 #emain <- c(emain, names(sort(e.d, decreasing=T))[1:690])
 #emain <- c(emain, names(sort(e.d, decreasing=T))[1:1048])
 #emain <- c(emain, names(sort(e.d, decreasing=T))[1:1626])
 emain <- c(emain, names(sort(e.d, decreasing=T))[1:2674])



 setwd ("fix2")
 load ( "ase.main.correct.mid.RData" )
 load ( "ase.main.perm.correct.mid.RData" )
 s0 <- quantile( ase.perm[[2]], 0.5)
 a.d <- ase[,1]/ (ase[,2]+s0)
 names(a.d) <- rownames(ase)
 

 #amain <- names( sort(a.d))[1:209]
 #amain <- names( sort(a.d))[1:129]
 #amain <- names( sort(a.d))[1:80]
 #amain <- names( sort(a.d))[1:43]
 #amain <- names( sort(a.d))[1:33]
 amain <- names( sort(a.d))[1:22]
 #amain <- c(amain, names( sort(a.d, decreasing=T))[1:540])
 #amain <- c(amain, names( sort(a.d, decreasing=T))[1:394])
 #amain <- c(amain, names( sort(a.d, decreasing=T))[1:308])
 #amain <- c(amain, names( sort(a.d, decreasing=T))[1:213])
 #amain <- c(amain, names( sort(a.d, decreasing=T))[1:175])
 amain <- c(amain, names( sort(a.d, decreasing=T))[1:143])

 
 
 gene.list <- intersect( names(e.d), names(a.d) )
 egene  <- emain[ which(emain %in% gene.list)] 
 agene  <- amain[ which(amain %in% gene.list)] 
 eagene <- length( intersect(egene, agene))
 egene <- length(egene)
 agene <- length(agene)


 tab <- matrix(NA, nc=2, nr=2)
 colnames(tab) <- c("a", "not.a")
 rownames(tab) <- c("e", "not.e")
 tab [,1] <-  c( eagene, agene-eagene) 
 tab [,2] <-  c( egene-eagene, length(gene.list)-egene-agene + eagene) 


 
 cat(tab[1,1], tab[1,2], tab[2,1], tab[2,2], (tab[1,1]/tab[2,1]) / (tab[1,2]/tab[2,2]), sep="\t")




###
 
 a <- matrix( scan("ase.fold.txt", what=1), byrow=T, nc=3 )

 col <- heat.colors(10)[ c(1, 3, 5, 7, 9)] 
 xlim=range( a[,2])
 ylim=range( a[,3]) 


 pdf ("ase.fold.pdf", width=5, height=5)
 plot ( xlim[1], ylim[1], xlim=xlim, ylim=ylim, "p", pch=".", col="transparent", xlab="numbers of significant ASE genes", ylab="fold enrichment of ASE in differential genes" )

 for (i in 1:5)
 {
  idx <- (i-1)*6+1
  b <- a[ idx:(idx+5) ,]

  points ( b[,2], b[,3], "p", pch="+", col= col[i] )
  lines( b[,2], b[,3], col=col[i])
 }

 legend ("topright", "#of significant differential genes:", bty="n")
 legend ( 500, 4.9, as.character(a[seq(1,30,6),1]) , lty=1, col=col, bty="n") 


 dev.off()




###




AT1G04470
AT1G30270
AT2G36760
AT2G15390
AT2G20670
AT2G04810
AT2G17650
AT2G05720
AT2G19490
AT2G23940
AT2G22720
AT3G29430
AT3G25870
AT3G25760
AT3G21470
AT3G32040
AT3G56470
AT3G29575
AT3G46900
AT3G25700
AT3G42565
AT3G26030
AT3G30230




##############################################################################################################################################
###############################################################################################################plot allele specific



 setwd ("final/fix2")


 load ( "ase.main.correct.mid.RData")
 load ( "ase.main.perm.correct.mid.RData" )
 s0 <- quantile (ase.perm[[2]], 0.5); rm(ase.perm);gc() 
 a.d <- ase[,1]/ (ase[,2]+s0)
 names(a.d) <- rownames(ase)
 cis <- names( sort(a.d))[1:458]
 cis <- c(cis, names( sort(a.d, decreasing=T))[1:213])



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


 
 load ("ase.correct.mid.RData")
 

 
 pdf ("ase.pdf", width=5, height=5)
 
 #for (i in 1:length(cis) ) 
 i <- which( cis == "AT4G29950")  
            
 {              
  probes.nonSFP <- rownames(attile.nonSFP.exon) [which ( as.character(attile.nonSFP.exon$gene) %in% cis[i]  ) ]
  mRNA.nonSFP <- mRNA.nq [ which(rownames(mRNA.nq) %in% probes.nonSFP), ]
  mRNA.nonSFP <- mRNA.nonSFP - rowMeans(mRNA.nonSFP)        
  n <- length(probes.nonSFP)
  add <- rep( c(1, -1, 0, 0), each=4*n)
  dom <- rep( c(-1, -1, 1, 1), each=4*n)
  mat <- rep( c(0, 0, -1, 1), each=4*n)
  fit <- summary( lm( gmean~ add+dom+mat, data=data.frame( gmean=c(mRNA.nonSFP), add, dom, mat)  ) )$coef
  mRNA.nonSFP <- matrix( c(mRNA.nonSFP) - cbind( add, dom, mat) %*% matrix(fit[-1,1], nc=1), nc=16)




  gene.mean <- cbind( rowMeans(mRNA.nonSFP[,1:4]), rowMeans(mRNA.nonSFP[,5:8]), rowMeans(mRNA.nonSFP[,9:16]) )
  gene.var <- t( apply(mRNA.nonSFP, 1, function(x) c( sqrt(var(x[1:4])), sqrt(var(x[5:8])), sqrt(var(x[9:16]))   )  ) )
  gene.var.upper <- gene.mean + gene.var
  gene.var.lower <- gene.mean-gene.var



  probes.SFP <- rownames(attile.SFP.exon)[ which( as.character(attile.SFP.exon$gene) %in% cis[i]  )  ]
  mRNA.SFP <- mRNA.nq[ which(rownames(mRNA.nq) %in% probes.SFP), ]
  n <- length(probes.SFP)      
  add <- rep( c(1, -1, 0, 0), each=4*n)
  dom <- rep( c(-1, -1, 1, 1), each=4*n)
  mat <- rep( c(0, 0, -1, 1), each=4*n)
  mRNA.SFP <- matrix(  c(mRNA.SFP) - cbind( add, dom, mat) %*% matrix(fit[-1,1], nc=1), nc=16)
 
            

  mid <- matrix( ase.mid[ which( rownames(ase.mid) %in% cis[i]), 1:8], nc=8)     
  rmean <- rowMeans( cbind(mRNA.SFP, mid))

 
  mRNA.SFP <- mRNA.SFP-rmean
  sfp.mean <- cbind(  rowMeans( matrix( mRNA.SFP[,1:4], nc=4)), rowMeans( matrix(mRNA.SFP[,5:8], nc=4)),  rowMeans( matrix(mRNA.SFP[,9:16], nc=8)) )
  sfp.var <- t( apply( matrix(mRNA.SFP, nc=16), 1, function(x) c( sqrt(var(x[1:4])), sqrt(var(x[5:8])), sqrt(var(x[9:16]))   )  ) )
  sfp.var.upper <- sfp.mean + sfp.var
  sfp.var.lower <- sfp.mean- sfp.var


  mid <-  mid- rmean
  mid.mean <- rowMeans(mid)
  mid.var <-  apply( mid, 1, function(x) sqrt(var(x))  ) 
  mid.var.upper <- mid.mean + mid.var
  mid.var.lower <- mid.mean- mid.var






  xpos1 <- attile.nonSFP.exon$bpstart [ which(rownames(attile.nonSFP.exon) %in% probes.nonSFP )]
  xpos2 <- attile.SFP.exon$bpstart [ which( rownames(attile.SFP.exon) %in% probes.SFP) ] 
  col3 <- c ("red", "blue","orange")

  gene.std <- rbind( cbind(gene.var.upper[,1], gene.var.lower[,1]), cbind(gene.var.upper[,2], gene.var.lower[,2]), cbind(gene.var.upper[,3], gene.var.lower[,3])  )
  bpmat.gene <-  cbind( rep(xpos1, 3), rep(xpos1, 3) )
  colk.gene <- rep(col3, each=length(probes.nonSFP))

  sfp.std <- rbind( cbind(sfp.var.upper[,1], sfp.var.lower[,1]), cbind(sfp.var.upper[,2], sfp.var.lower[,2]), cbind(sfp.var.upper[,3], sfp.var.lower[,3])  )
  bpmat.sfp <-  cbind( rep(xpos2, 3), rep(xpos2, 3) )
  colk.sfp <- rep(col3, each=length(probes.SFP))

  mid.std <- cbind( mid.var.upper, mid.var.lower )
  bpmat.mid <-  cbind( xpos2, xpos2)
 
  
  #matplot(xpos1, gene.mean, col = col3, type="l", lty=1, xlab="probe position", ylab="log intensity difference", xlim=range( c(xpos1, xpos2) ), ylim=range( c(gene.mean, sfp.mean, mid.mean) ), main="")
  matplot(xpos1, gene.mean, col = col3, type="l", lty=1, xlab="bp", ylab="log intensity difference", xlim=range( c(xpos1, xpos2) ), ylim=range(-1.5, 1.5),  main="" )
  matpoints(xpos1, gene.mean, col = col3, pch=20 )

  for (k in 1:nrow(bpmat.gene) )   lines( bpmat.gene[k,], gene.std[k,], "l", col=colk.gene[k])

  matpoints(xpos2, sfp.mean, col = col3, pch=13)
  for (k in 1:nrow(bpmat.sfp) )   lines( bpmat.sfp[k,], sfp.std[k,], "l", col=colk.sfp[k])

  points(xpos2, mid.mean, col = "black", pch=13)
  for (k in 1:nrow(bpmat.mid) )   lines( bpmat.mid[k,], mid.std[k,], "l", col="black")
  legend( "topright",  cis[i], bty="n")
  legend( "topleft",c( paste( rep( c("Col", "Van", "F1"),2), rep( c("NonSFP-probes", "SFP-probes"), each=3) ), "mid-parent"), pch=c(20,20,20, 13, 13, 13, 13), col=c(rep(col3,2), "black"), cex=0.7, bty="n"  ) 

 }

 dev.off()









##############################################################################################################################################
############################################################################################################################median polish the expression intensity

 setwd ("final/fix2")


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


 mRNA.nq <- exp(mRNA.nq)


 gene.nonSFP  <- tapply( attile.nonSFP.exon$bpstart, as.character(attile.nonSFP.exon$gene), length)
 gene.nonSFP <- gene.nonSFP[ which(gene.nonSFP >=5) ]
 gene.SFP <- tapply( attile.SFP.exon$bpstart, as.character(attile.SFP.exon$gene), length)
 gene.SFP <- gene.SFP[ which(gene.SFP >=1) ]

 gene.list <- intersect( names(gene.nonSFP), names(gene.SFP)  ) #9745 genes


 ase.correct <- matrix( numeric(), nc=16)
 names <- c()
 

 
 for (i in 1:length(gene.list) )                
 {              
  probes.nonSFP <- rownames(attile.nonSFP.exon) [which ( as.character(attile.nonSFP.exon$gene) %in% gene.list[i]  ) ]
  mRNA.nonSFP <- mRNA.nq [ which(rownames(mRNA.nq) %in% probes.nonSFP), ]
  expr <- c( medpolish(mRNA.nonSFP[,1:4], trace.iter=F)$overall, medpolish(mRNA.nonSFP[,5:8], trace.iter=F)$overall, medpolish(mRNA.nonSFP[,9:12], trace.iter=F)$overall, medpolish(mRNA.nonSFP[,13:16], trace.iter=F)$overall )
  expr <- rep(expr, each=4)        
 
  probes.SFP <- rownames(attile.SFP.exon)[ which( as.character(attile.SFP.exon$gene) %in% gene.list[i]  )  ]
  mRNA.SFP <- matrix( mRNA.nq[ which(rownames(mRNA.nq) %in% probes.SFP), ], nc=16)

  n <- length(probes.SFP)      
  expr <- matrix( rep( expr, n), byrow=T, nc=16) 
  mRNA.SFP <- mRNA.SFP / expr

            
  ase.correct <- rbind( ase.correct, matrix(mRNA.SFP, nc=16) )
  names <- c(names, rep(gene.list[i], n )  )

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

 rownames(ase.correct) <- names
 save(ase.correct, file="ase.correct.med.RData", compress=T)  

 q("no")








################################################################################################################ASE


 setwd ("final/fix2")

 
 load ("ase.correct.med.RData")

 gene.list <- names( table (rownames(ase.correct) ) )
 ase <- matrix(NA, nc=4, nr=length(gene.list))
 rownames(ase) <- gene.list


 for (i in 1:length(gene.list) )                
 {              
      
  mRNA.SFP <- matrix( ase.correct[ which(rownames(ase.correct) %in% gene.list[i]), ], nc=16)
  m <- cbind(   matrix( (mRNA.SFP[,1:4]+mRNA.SFP[,5:8])/2,nc=4), matrix( mRNA.SFP[,9:16], nc=8)  ) 
  m <- log(m)  
  g <- rep( rep( c(0,1), c(4, 8) ), each=nrow(m) ) 
  mframe <- data.frame( m = c(m), g)
  fit <- lm( m~g, data=mframe)
  ase[i,] <- summary(fit)$coef[2,]

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

 save(ase, file="ase.main.correct.med.RData", compress=T)








############################################################################################## permutation


  
 setwd ("final/fix2")
 

 choose(12,8) 
 samp.1 <- expand.grid(0:1,0:1,0:1,0:1,0:1,0:1,0:1,0:1,0:1,0:1,0:1,0:1) 
 samp.1 <- samp.1[apply(samp.1,1,sum)==8,]
 samp.1 <- as.matrix(samp.1)



 load ("ase.correct.med.RData") 


 gene.list <- names( table( rownames(ase.correct) ) )

 


 nperm <- nrow(samp.1)
 matr <- matrix(NA, nr=length(gene.list), nc=nperm )
 ase.perm <- list( coef=matr, std=matr)

 
 for (i in 1:length(gene.list) )                
 {              
  probes <- which(  rownames(ase.correct) %in% gene.list[i] )
  m <- matrix( ase.correct[ probes,], nc=16)
  m<- cbind( matrix( (m[,1:4]+m[,5:8])/2, nc=4), matrix(m[,9:16], nc=8) )

  m <- log(m)
  g <- rep( rep( c(0,1), c(4, 8) ), each=length(probes) ) 

 
  for (iperm in 1:nperm)
  {
   pframe <- data.frame( m = c(m[, order( samp.1[iperm,])  ]), g)
   pfit <- summary(lm( m~g, data=pframe) )$coef
   ase.perm[[1]][i,iperm] <- pfit[2,1]
   ase.perm[[2]][i,iperm] <- pfit[2,2]
  }

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

 save(ase.perm, file="ase.main.perm.correct.med.RData", compress=T)
 

 q("no")








#######################################################################################################FDR


 setwd ("final/fix2")

 load ( "ase.main.correct.med.RData" )
 load ( "ase.main.perm.correct.med.RData" )


 coef <- ase.perm[[1]]
 std <- ase.perm[[2]]
 s0 <- quantile( std, 0.5)


 main <- ase[,1]/ (ase[,2]+s0)
 main <- sort(main)


 perm.mat <- coef/(std+s0)
 perm.num <- ncol(coef)
 for (i in 1:perm.num)	perm.mat[,i] <- sort (perm.mat[,i]) 
 null <- rowMeans(perm.mat)


 for (j in seq(0.1, 2, 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, 2, 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, 2, 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")
 }


0.1     360     363.6222        -3.622222       1.010062
0.2     54      38.23232        15.76768        0.708006
0.3     30      10.26667        19.73333        0.3422222
0.4     14      3.723232        10.27677        0.2659452
0.5     4       1.781818        2.218182        0.4454545
0.6     3       1.008081        1.991919        0.3360269
0.7     2       0.5838384       1.416162        0.2919192
0.8     2       0.3515152       1.648485        0.1757576
0.9     2       0.2141414       1.785859        0.1070707
1       2       0.1535354       1.846465        0.07676768
1.1     2       0.0909091       1.909091        0.04545455
1.2     2       0.06868687      1.931313        0.03434343
1.3     2       0.05252525      1.947475        0.02626263
1.4     2       0.02828283      1.971717        0.01414141
1.5     2       0.02424242      1.975758        0.01212121
1.6     2       0.02424242      1.975758        0.01212121
1.7     2       0.02222222      1.977778        0.01111111
1.8     2       0.02222222      1.977778        0.01111111
1.9     1       0.02020202      0.979798        0.02020202


0.1     122     192.1838        -70.18384       1.575277
0.2     38      18.97374        19.02626        0.4993089
0.3     26      5.644444        20.35556        0.217094
0.4     12      1.967677        10.03232        0.1639731
0.5     2       0.9010101       1.09899 0.4505051
0.6     1       0.5535354       0.4464646       0.5535354



0.1     238     171.4384        66.56162        0.7203293
0.2     16      19.25859        -3.258586       1.203662
0.3     4       4.622222        -0.6222222      1.155556
0.4     2       1.755556        0.2444444       0.8777778
0.5     2       0.880808        1.119192        0.440404
0.6     2       0.4545455       1.545455        0.2272727
0.7     2       0.2707071       1.729293        0.1353535
0.8     2       0.1616162       1.838384        0.08080808
0.9     2       0.0989899       1.90101 0.04949495
1       2       0.06666667      1.933333        0.03333333
1.1     2       0.04242424      1.957576        0.02121212
1.2     2       0.03434343      1.965657        0.01717172
1.3     2       0.03232323      1.967677        0.01616162
1.4     2       0.02626263      1.973737        0.01313131
1.5     2       0.02424242      1.975758        0.01212121
1.6     2       0.02424242      1.975758        0.01212121
1.7     2       0.02222222      1.977778        0.01111111
1.8     2       0.02222222      1.977778        0.01111111
1.9     1       0.02020202      0.979798        0.02020202






 setwd ("final/fix2")

 load ( "ase.main.correct.med.RData" )
 load ( "ase.main.perm.correct.med.RData" )
 std <- ase.perm[[2]]
 s0 <- quantile( std, 0.5)
 main <- ase[,1]/ (ase[,2]+s0)
 names(main) <- rownames(ase)
 ulog <- names( sort(main) )[1:4]
 ulog <- c(ulog, names( sort(main, decreasing=T))[1:26])
 

##########################################################################################################################################intensity and variance




### for log scale 

 setwd ("final/fix2")


 pdf ("ase.correct.pdf", width=8, height=4)
 par (mfrow=c(1,2))
 
 load ("ase.correct.mid.RData")
 tmp <- ase.mid
 x <- rowMeans(tmp)
 plot( density(x), xlab="log intensity", main="")

 y <- apply(tmp, 1, var)
 plot(x, y, pch=".", "p",  xlab="log intensity", ylab="variance of log intensity", cex=0.7)
 
 dev.off()



### for unlog scale

 setwd ("final/fix2")

 pdf ("ase.correct2.pdf", width=8, height=4)
 par( mfrow=c(1,2))

 load ("ase.correct.med.RData")
 tmp <- ase.correct
 x <-  rowMeans( log(tmp) )
 plot( density(x), xlab="intensity", main="")

 y <- apply(log(tmp), 1, var)
 plot(x, y, pch=".", "p",  xlab="intensity", ylab="variance of intensity", cex=0.7)

 dev.off()






### for unequal cutoff

 setwd ("final/fix2")
 load ( "ase.main.correct.mid.RData" )
 load ( "ase.main.perm.correct.mid.RData" )
 std <- ase.perm[[2]]
 s0 <- quantile( std, 0.5)
 main <- ase[,1]/ (ase[,2]+s0)
 names(main) <- rownames(ase)
 

 load ("ase.correct.mid.RData")
 

 #pdf ("ase.correct.mid.pdf", width=10, height=5)
 #par ( mfrow=c(1,2))


 pdf ("ase.correct.mid.pdf", width=5, height=5)
 tmp <- ase.mid
 x <-  rowMeans(tmp[,1:8])
 y <-  rowMeans(tmp[,9:16])

 cis <- names( sort(main))[1:458]
 cis.point <- ase.mid[ which(rownames(ase.mid) %in% cis), ]
 cis.x <- rowMeans(cis.point[,1:8])
 cis.y <- rowMeans(cis.point[,9:16])
 plot(x, y, pch=".", "p", xlim=range(c(x,y)), ylim=range( c(x,y)), xlab="log intensity of mid parent", ylab="log intensity of F1 hybrids", cex=0.7)
 points (cis.x, cis.y, pch=".", col="red", cex=0.7)
 abline(0, 1)

 #cis <- names( sort(main, decreasing=T) )[1:540]
 #cis.point <- ase.mid[ which(rownames(ase.mid) %in% cis), ]
 #cis.x <- rowMeans(cis.point[,1:8])
 #cis.y <- rowMeans(cis.point[,9:16])
 #plot(x, y, pch=".", "p", xlim=range(c(x,y)), ylim=range( c(x,y)), xlab="log intensity of mid parent", ylab="log intensity of F1 hybrids", cex=0.7)
 #points (cis.x, cis.y, pch=".", col="red", cex=0.7)
 #abline(0, 1)



 dev.off()





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

 setwd ("final/fix2")



 load ("ase.correct.mid.RData")


 pdf ("ase.correct.mid2.pdf", width=5, height=5)

 tmp <- ase.mid
 x <- rowMeans(tmp)
 y <- apply(tmp, 1, var)
 plot(x, y, pch=".", "p", xlab="log intensity", ylab="variance")

 dev.off()




