

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

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

 #length( which( as.character(attile.nonSFP.exon$gene) %in% gene.list)  )
#[1] 625240



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

 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
  fit <- summary( lm( gene.mean~ add + dom + mat, data=gframe) )$coef
  expr.main[[1]][i,] <- fit[2,]
  expr.main[[2]][i,] <- fit[3,]
  expr.main[[3]][i,] <- fit[4,]

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

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

 q("no")





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

 setwd ("final")
 nperm <- 1000
 nsample <- 16
 samp.matrix <- matrix(NA, nc=nsample, nr=nperm)
 for (i in 1:nperm) samp.matrix[i,] <- sample(nsample)
 save(samp.matrix, file=paste("samp.matrix", nsample, ".RData", sep=""), compress=T)




###perm for add, dom, mat use grid

 k <- 1

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


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



 nperm <- 1000

 j <- 1
 gene.list <- gene.list[ 1:5000]


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

 nsample=16
 load ( paste("samp.matrix", nsample, ".RData", sep="") )


 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( gmean = c(gene.mean), add, dom, mat)


	for (iperm in 1:nperm)
	{
	#leave one out 
	rfit <- lm( gmean~ as.matrix( gframe[, c(-1, -(k+1) ) ] ), data=gframe)
	resid <- matrix( rfit$resid, nr=n) [, samp.matrix[iperm,] ]
	predict <-  as.matrix( gframe[, 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
	expr.perm[[1]][i, iperm] <- pfit[k+1,1]
	expr.perm[[2]][i, iperm] <- pfit[k+1,2]
	}


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

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





###

 k <- 3

 setwd ("final")


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

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

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







#####################################################################################fdr


 setwd ("final")


 load ("expr.main.RData")


 k <- 3


 load ( paste("Main.expr.perm.v2.", k, ".RData", sep="") )
 s0 <- quantile( expr.perm[[2]], 0.5)
 main <- expr.main[[k]][,1]/ (expr.main[[k]][,2]+s0)
 names(main) <- rownames(expr.main[[k]])
 main <- sort(main)
 perm.mat <- expr.perm[[1]]/ (expr.perm[[2]]+s0); rm(expr.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(1.5, 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(1.5, 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(1.5, 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")
 }



###plot loci

 gene <- names( sort(main) ) [1:676]
 gene <- c(gene, names(sort(main, decreasing=T) )[1:1226])
 source("plotgene.R")

 effect <- c("add", "dom", "mat")
 plot.gene(gene,  paste("expr.", effect[k], sep="") ) 

###

k <- 1

0.5     8878    901.238 7976.762        0.1015136
1       4410    215.1   4194.9  0.04877551
1.5     2549    70.393  2478.607        0.02761593
1.6     2326    57.368  2268.632        0.0246638
1.7     2132    47.241  2084.759        0.02215807
1.8     1925    39.127  1885.873        0.02032571
1.9     1802    32.645  1769.355        0.01811598
2       1626    27.401  1598.599        0.01685178
2.5     1024    12.707  1011.293        0.01240918
3       642     6.177   635.823 0.009621495
3.5     434     3.224   430.776 0.007428571
4       296     1.752   294.248 0.005918919



0.5     4911    459.475 4451.525        0.09356037
1       2674    109.665 2564.335        0.04101159
1.5     1626    35.764  1590.236        0.02199508
1.6     1500    29.045  1470.955        0.01936333
1.7     1368    23.925  1344.075        0.01748904
1.8     1249    19.946  1229.054        0.01596958
1.9     1166    16.744  1149.256        0.01436021
2       1048    14.28   1033.72 0.01362595
2.5     690     6.968   683.032 0.01009855
3       418     3.525   414.475 0.008433014
3.5     274     2.01    271.99  0.007335766
4       174     1.093   172.907 0.006281609


0.5     3967    441.763 3525.237        0.1113595
1       1736    105.435 1630.565        0.06073445
1.5     923     34.629  888.371 0.03751788
1.6     826     28.323  797.677 0.03428935
1.7     764     23.316  740.684 0.03051832
1.8     676     19.181  656.819 0.02837426
1.9     636     15.901  620.099 0.02500157
2       578     13.121  564.879 0.02270069
2.5     334     5.739   328.261 0.01718263
3       224     2.652   221.348 0.01183929
3.5     160     1.214   158.786 0.0075875
4       122     0.659   121.341 0.005401639



k <- 2


0.5     4701    766.786 3934.214        0.1631113
1       1926    185.797 1740.203        0.0964678
1.5     968     67.035  900.965 0.06925103
1.6     848     56.29   791.71  0.06637972
1.7     742     47.315  694.685 0.06376685
1.8     667     39.933  627.067 0.05986957
1.9     602     33.954  568.046 0.05640199
2       538     29.086  508.914 0.0540632
2.5     311     14.476  296.524 0.04654662
3       176     7.719   168.281 0.04385795
3.5     86      4.179   81.821  0.04859302
4       38      2.303   35.697  0.06060526

0.5     1511    386.515 1124.485        0.2558008
1       405     95.281  309.719 0.2352617
1.5     157     35.28   121.72  0.2247134
1.6     141     29.777  111.223 0.2111844
1.7     104     25.151  78.849  0.2418365
1.8     92      21.384  70.616  0.2324348
1.9     78      18.318  59.682  0.2348462
2       70      15.829  54.171  0.2261286
2.5     41      8.174   32.826  0.1993659
3       36      4.522   31.478  0.1256111
3.5     21      2.624   18.376  0.1249524
4       9       1.524   7.476   0.1693333

0.5     3190    380.271 2809.729        0.1192072
1       1521    90.516  1430.484        0.05951085
1.5     811     31.755  779.245 0.03915536
1.6     707     26.513  680.487 0.03750071
1.7     638     22.164  615.836 0.03473981
1.8     575     18.549  556.451 0.03225913
1.9     524     15.636  508.364 0.02983969
2       468     13.257  454.743 0.02832692
2.5     270     6.302   263.698 0.02334074
3       140     3.197   136.803 0.02283571
3.5     65      1.555   63.445  0.02392308
4       29      0.779   28.221  0.02686207


k <- 3


0.5     6093    734.607 5358.393        0.1205657
1       2054    151.444 1902.556        0.07373126
1.5     480     49.393  430.607 0.1029021
1.6     357     40.676  316.324 0.1139384
1.7     229     33.777  195.223 0.1474978
1.8     163     28.254  134.746 0.1733374
1.9     128     23.578  104.422 0.1842031
2       100     19.774  80.226  0.19774
2.5     41      9.365   31.635  0.2284146
3       17      4.502   12.498  0.2648235
3.5     13      2.351   10.649  0.1808462
4       10      1.274   8.726   0.1274


0.5     5998    386.464 5611.536        0.06443214
1       2046    78.376  1967.624        0.03830694
1.5     480     23.985  456.015 0.04996875
1.6     357     19.541  337.459 0.0547367
1.7     229     16.001  212.999 0.06987336
1.8     163     13.174  149.826 0.08082209
1.9     128     10.941  117.059 0.08547656
2       100     9.038   90.962  0.09038
2.5     41      3.983   37.017  0.09714634
3       17      1.832   15.168  0.1077647
3.5     13      0.879   12.121  0.06761538
4       10      0.513   9.487   0.0513



0.5     95      348.143 -253.143        3.664663
1       8       73.068  -65.068 9.1335
1.5     24756   25.408  24730.59        0.001026337
1.6     24756   21.135  24734.87        0.0008537324
1.7     24756   17.776  24738.22        0.0007180481
1.8     24756   15.08   24740.92        0.0006091453
1.9     24756   12.637  24743.36        0.0005104621
2       24756   10.736  24745.26        0.0004336726
2.5     24756   5.382   24750.62        0.0002174018
3       24756   2.67    24753.33        0.0001078526
3.5     24756   1.472   24754.53        5.946033e-05
4       24756   0.761   24755.24        3.074002e-05










###
#s0=0.5, delta=1.8
#add   dom   mat
#1249  92    163
#676   575    0



 
 b <- matrix( scan("test.txt", what=1, skip=1),  byrow=T, nr=2)
 col <- heat.colors(18)[ c(6, 10, 14)]

 pdf ("gene.inheritance1.pdf")
  par (mai=c(0.8, 1.2, 0.6, 0.6))
  barplot( b,  beside=T, col=rep(c(col[1], col[2], col[3]), each=2), cex.lab=0.6, ylab="number of genes", cex.lab=1, space=c(0, 3), cex.lab=1.5 )
  mtext (c("Col > Van", "Van > Col", "F1s > Parents", "Parents > F1s", "F1c > F1v", "F1v > F1c"), line=-16, las=2, at=c(3.5, 4.5,  8.5, 9.5,  13.5, 14.5), font=4, cex=1.5 )
  mtext (c("Col.vs.Van", "parents.vs.F1s", "F1c.vs.F1v"), side=1, at=c(4, 9, 14), line=2, cex=1.3 )
 dev.off()







#########################################################################################check inheritance





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

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

 mea <- matrix(NA, nr=length(gene.list), nc=4)
 rownames(mea) <- 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, ]
  mea[i,] <- c( mean(gmean[, 1:4]), mean(gmean[,5:8]), mean(gmean[,9:12]), mean(gmean[,13:16]) ) 

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

 save(mea, file="expression.gene.mean.RData", compress=T)

 q("no")





###

 setwd ("final")


 load ("expr.main.RData")


 k <- 1
 effect <- expr.main[[k]][,1]
 names(effect) <- rownames(expr.main[[k]])




 #92	575 =667
 #163	0 =163


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


 gene.dom <- names( sort(main) )[1:575]
 gene.dom <- c(gene.dom, names( sort(main, decreasing=T) )[1:92])
 effect.ad <- effect[ match(gene.dom, names(effect) ) ]
 effect.dom <- expr.main[[k]][,1][ match(gene.dom, rownames(expr.main[[k]]) ) ]

 k <- 3
 load ( paste("Main.expr.perm", k, ".RData", sep="") )
 s0 <- quantile( expr.perm[[2]], 0.5); rm(expr.perm); gc()
 main <- expr.main[[k]][,1]/ (expr.main[[k]][,2]+s0)
 names(main) <- rownames(expr.main[[k]])
 gene.mat <-  names( sort(main, decreasing=T) )[1:163]
 effect.am <- effect[ match(gene.mat, names(effect) ) ]
 effect.mat <- expr.main[[k]][,1][ match(gene.mat, rownames(expr.main[[k]]) ) ]



 library(cluster)
 load ("expression.gene.mean.RData")

 mea.dom <- mea[ match(gene.dom, rownames(mea) ), ]
 label.dom <- t( apply(mea.dom, 1, function(x) kmeans(x, 2)$cluster ) )
 label.dom <- apply(label.dom, 1, function(x) paste(x, collapse="") )
 table(label.dom)
 #1112 1121 1122 1211 1212 1221 1222 2111 2112 2121 2122 2211 2212 2221
 #  9   35   91    9    2    7  189  195    7    1    4   77   36    5






 mea.mat <- mea[ match(gene.mat, rownames(mea) ), ]
 label.mat <- t( apply(mea.mat, 1, function(x) kmeans(x, 2)$cluster ) )
 label.mat <- apply(label.mat, 1, function(x) paste(x, collapse="") )
 table(label.mat)
 #1112 1121 1212 1221 1222 2111 2112 2121 2122 2212 2221
 #  8   32    7   37    2    5   33    5    1   26    7









###

 source("plotgene.R")


 col.dom <- names(label.dom)[ c( which(  ( label.dom == "1211" | label.dom=="2122") & effect.ad > 0), which(  ( label.dom == "1211" | label.dom=="2122") & effect.ad < 0)  ) ]   
 van.dom <- names(label.dom)[ c( which(  ( label.dom == "2111" | label.dom=="1222") & effect.ad < 0), which(  ( label.dom == "2111" | label.dom=="1222") & effect.ad > 0)  ) ]
 over.dom <- names(label.dom)[ c( which(  ( label.dom == "2211" | label.dom=="1122") & effect.dom > 0), which(  ( label.dom == "2211" | label.dom=="1122") & effect.dom < 0) ) ] 
 over.F1c <- names(label.dom)[ c( which(  ( label.dom == "2221" | label.dom=="1112") & effect.dom > 0), which(  ( label.dom == "2221" | label.dom=="1112") & effect.dom < 0) ) ]
 over.F1v <- names(label.dom)[ c( which(  ( label.dom == "2212" | label.dom=="1121") & effect.dom > 0), which(  ( label.dom == "2212" | label.dom=="1121") & effect.dom < 0) ) ]
 mat <- names(label.dom)[ c( which(label.dom == "1221"), which(label.dom=="2112"))  ]
 pat <- names(label.dom)[ c( which(label.dom == "1212"), which(label.dom=="2121"))  ]

 #plot.gene (col.dom, "col.dom")
 #plot.gene (van.dom, "van.dom")
 #plot.gene (over.dom, "over.dom")
 #plot.gene (over.F1c, "over.F1c")
 #plot.gene (over.F1v, "over.F1v")
 #plot.gene (mat, "mat")
 #plot.gene (pat, "pat")

 col.dom <- c( length( which(  ( label.dom == "1211" | label.dom=="2122") & effect.ad > 0) ),  length( which(  ( label.dom == "1211" | label.dom=="2122") & effect.ad < 0) )   ) 
 van.dom <- c( length( which(  ( label.dom == "2111" | label.dom=="1222") & effect.ad < 0) ),  length( which(  ( label.dom == "2111" | label.dom=="1222") & effect.ad > 0) )   )
 over.dom <- c( length( which(  ( label.dom == "2211" | label.dom=="1122") & effect.dom > 0) ), length( which(  ( label.dom == "2211" | label.dom=="1122") & effect.dom < 0)  ) )
 over.F1c <- c( length( which(  ( label.dom == "2221" | label.dom=="1112") & effect.dom > 0) ), length( which(  ( label.dom == "2221" | label.dom=="1112") & effect.dom < 0)  ) )
 over.F1v <- c( length( which(  ( label.dom == "2212" | label.dom=="1121") & effect.dom > 0) ), length( which(  ( label.dom == "2212" | label.dom=="1121") & effect.dom < 0)  ) )



 maternal <-  names(label.mat)[ c( which( (label.mat == "1221" | label.mat=="2112") & effect.mat > 0 ), which( (label.mat == "1221" | label.mat=="2112") & effect.mat < 0 ) )]  
 paternal <-  names(label.mat)[ c( which( (label.mat == "1212" | label.mat=="2121") & effect.mat > 0 ), which( (label.mat == "1212" | label.mat=="2121") & effect.mat < 0 ) )] 

 #plot.gene (maternal, "maternal")
 #plot.gene (paternal, "paternal") 

 maternal <- c(  length( which( (label.mat == "1221" | label.mat == "2112") & effect.mat > 0)  ), length( which( (label.mat == "1221" | label.mat == "2112") & effect.mat < 0)  )   )
 paternal <- c(  length( which( (label.mat == "1212" | label.mat == "2121") & effect.mat > 0)  ), length( which( (label.mat == "1212" | label.mat == "2121") & effect.mat < 0)  )   )



 test <- cbind( col.dom, van.dom, over.dom, over.F1c, over.F1v, maternal, paternal) 
 colnames(test) <- c( "col.dom", "van.dom", "overdom", "over.F1c", "over.F1v", "maternal", "paternal") 
 #    col.dom van.dom overdom over.F1c over.F1v maternal paternal
 #[1,]       3      54      26        3        6       70       12
 #[2,]      10     337     142       13       56        0        0






 test <- matrix(scan("test.txt", skip=1, what=1), byrow=T, nr=2)
 pdf ("gene.inheritance2.pdf", height=6, width=8)
 par( mai=c( 0.82, 1, 0.9, 0.3) )

  col <- heat.colors(18)
  barplot( test, beside=T, col=rep( c( col[6], col[7], col[10], col[12], col[13], col[16], col[17]), each=2),  ylim=c(-6, 300), ylab="number of genes", cex.lab=1.5  )
  rect( 1, -6, 15, -2, col="black")
  rect( 16, -6, 21, -2, col="black")
  mtext (c("Col > Van", "Col < Van", "Van > Col", "Van < Col", "F1s > Parents", "F1s < Parents", "F1c > others", "F1c < others", "F1v > others", "F1v < others", "Col > Van", "Col < Van", "Col > Van", "Col < Van"), line=-12, las=2, at=c(1.5, 2.5, 4.5, 5.5, 7.5, 8.5, 10.5, 11.5, 13.5, 14.5, 16.5,17.5, 19.5,20.5), font=4, cex=1.5 )
  mtext ( c("Col.dom",  "Van.dom",  "overdom",  "F1c",  "F1v",  "maternal",  "paternal"), side=1, line=2,  at=c(2, 5, 8, 11, 14, 17, 20), cex=1.3)

 dev.off()




####################################################plot figure

 setwd ("final")
 gene <- c("AT5G42230", "AT5G10140", "AT3G14210", "AT3G21720")

 source("plotgene.figure.R")
 plot.gene(gene, "gene.figure")






############################################################qq plot



 setwd ("final")


 load ("expr.main.RData")


 k <- 1
 load ( paste("Main.expr.perm", k, ".RData", sep="") )
 s0 <- quantile( expr.perm[[2]], 0.5)
 main <- expr.main[[k]][,1]/ (expr.main[[k]][,2]+s0)
 names(main) <- rownames(expr.main[[k]])
 main.add <- sort(main)
 perm.mat <- expr.perm[[1]]/ (expr.perm[[2]]+s0); rm(expr.perm); 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.expr.perm", k, ".RData", sep="") )
 s0 <- quantile( expr.perm[[2]], 0.5)
 main <- expr.main[[k]][,1]/ (expr.main[[k]][,2]+s0)
 names(main) <- rownames(expr.main[[k]])
 main.dom <- sort(main)
 perm.mat <- expr.perm[[1]]/ (expr.perm[[2]]+s0); rm(expr.perm); 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.expr.perm", k, ".RData", sep="") )
 s0 <- quantile( expr.perm[[2]], 0.5)
 main <- expr.main[[k]][,1]/ (expr.main[[k]][,2]+s0)
 names(main) <- rownames(expr.main[[k]])
 main.mat <- sort(main)
 perm.mat <- expr.perm[[1]]/ (expr.perm[[2]]+s0); rm(expr.perm); gc()

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



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


  xlim=c(-8, 8)
  ylim=c(-30, 30)

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

 dev.off()













##########################################################null distribution


 setwd ("final")




 k <- 1
 load ( paste("Main.expr.perm", k, ".RData", sep="") )
 s0 <- quantile( expr.perm[[2]], 0.5)
 perm.mat <- expr.perm[[1]]/ (expr.perm[[2]]+s0); rm(expr.perm); 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.expr.perm", k, ".RData", sep="") )
 s0 <- quantile( expr.perm[[2]], 0.5)
 perm.mat <- expr.perm[[1]]/ (expr.perm[[2]]+s0); rm(expr.perm); 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.expr.perm", k, ".RData", sep="") )
 s0 <- quantile( expr.perm[[2]], 0.5)
 perm.mat <- expr.perm[[1]]/ (expr.perm[[2]]+s0); rm(expr.perm); gc()
 perm.num <- 1000
 for (i in 1:perm.num) perm.mat[,i] <- sort(perm.mat[,i])
 null.mat <- rowMeans(perm.mat)


 pdf ("null.expression.pdf")
 plot( density(null.add), col=1, ylim=c(0, 0.6), main="", xlab="null d")
 lines( density(null.dom), col=2)
 lines( density(null.mat), col=3)
 legend( "topright", c("additive", "dominant", "maternal"), col=c(1:3), lty=1,  bty="n" )
 dev.off()













##################################################################d/a ratio


thres 	pos	neg
1.8	1249	676	
1.8	92	575	
1.8	163	0	



 setwd ("final")


 load ("expr.main.RData")


 k <- 1
 load ( paste("Main.expr.perm", k, ".RData", sep="") )
 s0 <- quantile( expr.perm[[2]], 0.5)
 main <- expr.main[[k]][,1]/ (expr.main[[k]][,2]+s0)
 names(main) <- rownames(expr.main[[k]])
 add.d <- main
 add.effect <- expr.main[[k]][,1]
 
 k <- 2
 load ( paste("Main.expr.perm", k, ".RData", sep="") )
 s0 <- quantile( expr.perm[[2]], 0.5)
 main <- expr.main[[k]][,1]/ (expr.main[[k]][,2]+s0)
 names(main) <- rownames(expr.main[[k]])
 dom.d <- main
 dom.effect <- expr.main[[k]][,1]


 k <- 3
 load ( paste("Main.expr.perm", k, ".RData", sep="") )
 s0 <- quantile( expr.perm[[2]], 0.5)
 main <- expr.main[[k]][,1]/ (expr.main[[k]][,2]+s0)
 names(main) <- rownames(expr.main[[k]])
 mat.d <- main
 mat.effect <- expr.main[[k]][,1]


 add.t1 <- quantile( add.d, 676/length(add.d) )
 add.t2 <- quantile( add.d, (length(add.d)-1249+1)/length(add.d) )


 dom.t1 <- quantile( dom.d, 575/length(dom.d) )
 dom.t2 <- quantile( dom.d, (length(dom.d)-92+1)/length(dom.d) )


 #mat.t1 <- quantile( mat.d, 0/length(mat.d) )
 #mat.t2 <- quantile( mat.d, (length(mat.d)-163+1)/length(mat.d) )


 tA <- c(-Inf, add.t1, add.t2, Inf) #might have rounding error
 tD <- c(-Inf, dom.t1, dom.t2, Inf) #might have rounding error
 

 add <- cut(add.d, tA ) #making the calls
 dom <- cut(dom.d, tD )
 
 table(add,dom)  # the 3x3 table
 #table(add,mat)




              dom
add            (-Inf,-3.69] (-3.69,5.14] (5.14, Inf]
  (-Inf,-3.73]            5          626          45
  (-3.73,3.32]          273        22517          42
  (3.32, Inf]           297          947           4
> table(add,mat)
              mat
add            (-Inf,-7.84] (-7.84,4.58] (4.58, Inf]
  (-Inf,-3.73]            0          671           5
  (-3.73,3.32]            0        22746          86
  (3.32, Inf]             1         1176          71



sA <- add!= "(-3.73,3.32]"
sD <- dom!= "(-3.69,5.14]" #TF for which ones are significant
AD <- pmax(pmin((dom.effect/add.effect)[sA|sD],3),-3) # truncate the outliers with small add.d and select the union of sig add and sig dom, CHANGED!!!


pdf ("da.pdf")
par (mai=c(1, 1, 0.82, 0.3) )

hist1 <- hist(AD,breaks=50, xlab= "Dominance/Additive ratio", ylab = "Number of Genes", main ="", cex.lab=1.3 )

# determine the down regulated set add.d < 0
nAD <- pmax(pmin((dom.effect/add.effect) [(sA|sD) & add.d > 0], 3),-3)
neg.add <- table(cut(nAD,hist1$breaks))

lines(hist1$mids, neg.add, col="red",type="h")
legend(0.6,150,c("all genes","Col higher"),lty=1,col = c("black","red"), cex=1.2)

dev.off()







###

load("d.RData")

add.t1 <- quantile( add.d, 676/length(add.d) )
add.t2 <- quantile( add.d, (length(add.d)-1249+1)/length(add.d) )


dom.t1 <- quantile( dom.d, 575/length(dom.d) )
dom.t2 <- quantile( dom.d, (length(dom.d)-92+1)/length(dom.d) )

tD <- c(-Inf, dom.t1, dom.t2, Inf) #might have rounding error
tA <- c(-Inf, add.t1, add.t2, Inf) #might have rounding error
add <- cut(add.d,tA) #making the calls
dom <- cut(dom.d,tD)
table(add,dom) # the 3x3 table
sD <- dom!= "(-3.69,5.14]" #TF for which ones are significant
sA <- add!= "(-3.73,3.32]"
AD <- pmax(pmin((dom.effect/add.effect)[sA|sD],3),-3) # truncate the outliers with small add.d and select the union of sig add and sig dom, CHANGED!!!


pdf ("da.pdf")
par (mai=c(1, 1, 0.82, 0.3) )

hist1 <- hist(AD,breaks=50, xlab= "Dominance/Additive ratio", ylab = "Number of Genes", main ="", cex.lab=1.3)

# determine the down regulated set add.d < 0
nAD <- pmax(pmin((dom.effect/add.effect) [(sA|sD) & add.d > 0], 3),-3)
neg.add <- table(cut(nAD,hist1$breaks))

lines(hist1$mids, neg.add, col="red",type="h")
legend(0.6,150,c("all genes","Col higher"),lty=1,col = c("black","red"), cex=1.2)

dev.off()




































