[Patchwork-commits] r190 - .git .git/logs .git/logs/refs/heads .git/logs/refs/remotes/origin .git/refs/heads .git/refs/remotes/origin pkg/TAPS/R pkg/TAPS/man pkg/patchwork/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Sep 23 13:57:34 CEST 2013
Author: sebastian_d
Date: 2013-09-23 13:57:32 +0200 (Mon, 23 Sep 2013)
New Revision: 190
Modified:
.git/COMMIT_EDITMSG
.git/index
.git/logs/HEAD
.git/logs/refs/heads/master
.git/logs/refs/remotes/origin/master
.git/refs/heads/master
.git/refs/remotes/origin/master
pkg/TAPS/R/TAPS.r
pkg/TAPS/R/sysdata.rda
pkg/TAPS/man/TAPS_plot.Rd
pkg/patchwork/R/patchwork.plot.r
Log:
hg18 detection added to TAPS
Modified: .git/COMMIT_EDITMSG
===================================================================
--- .git/COMMIT_EDITMSG 2013-09-11 12:49:43 UTC (rev 189)
+++ .git/COMMIT_EDITMSG 2013-09-23 11:57:32 UTC (rev 190)
@@ -1 +1 @@
-some updates to taps homepage info
+hg18 detection added to TAPS
Modified: .git/index
===================================================================
(Binary files differ)
Modified: .git/logs/HEAD
===================================================================
--- .git/logs/HEAD 2013-09-11 12:49:43 UTC (rev 189)
+++ .git/logs/HEAD 2013-09-23 11:57:32 UTC (rev 190)
@@ -65,3 +65,5 @@
74262096bdcb8c53bcf9f4719ff9ae6b23565262 884409fb1057881cbdbd2db1c86c85d72bf477c6 Sebastian DiLorenzo <dilorenzo.sebastian at gmail.com> 1378894727 +0200 pull : Fast-forward
884409fb1057881cbdbd2db1c86c85d72bf477c6 7375bc63263a290cbfb537af8c38af2df6ba0f0c Sebastian DiLorenzo <dilorenzo.sebastian at gmail.com> 1378902806 +0200 pull : Fast-forward
7375bc63263a290cbfb537af8c38af2df6ba0f0c 6f560c07eeb2bc5a9c449af56829257933ebcf87 Sebastian DiLorenzo <dilorenzo.sebastian at gmail.com> 1378903472 +0200 pull : Fast-forward
+6f560c07eeb2bc5a9c449af56829257933ebcf87 bd3ab614a6966fa50066cad8cf9682e0a728ea4a Sebastian DiLorenzo <dilorenzo.sebastian at gmail.com> 1378904905 +0200 commit: update taps remove header from merge
+bd3ab614a6966fa50066cad8cf9682e0a728ea4a 4a0e2921f140974e7c8a12fd8fddb998c0bd3171 Sebastian DiLorenzo <dilorenzo.sebastian at gmail.com> 1379937620 +0200 commit: hg18 detection added to TAPS
Modified: .git/logs/refs/heads/master
===================================================================
--- .git/logs/refs/heads/master 2013-09-11 12:49:43 UTC (rev 189)
+++ .git/logs/refs/heads/master 2013-09-23 11:57:32 UTC (rev 190)
@@ -65,3 +65,5 @@
74262096bdcb8c53bcf9f4719ff9ae6b23565262 884409fb1057881cbdbd2db1c86c85d72bf477c6 Sebastian DiLorenzo <dilorenzo.sebastian at gmail.com> 1378894727 +0200 pull : Fast-forward
884409fb1057881cbdbd2db1c86c85d72bf477c6 7375bc63263a290cbfb537af8c38af2df6ba0f0c Sebastian DiLorenzo <dilorenzo.sebastian at gmail.com> 1378902806 +0200 pull : Fast-forward
7375bc63263a290cbfb537af8c38af2df6ba0f0c 6f560c07eeb2bc5a9c449af56829257933ebcf87 Sebastian DiLorenzo <dilorenzo.sebastian at gmail.com> 1378903472 +0200 pull : Fast-forward
+6f560c07eeb2bc5a9c449af56829257933ebcf87 bd3ab614a6966fa50066cad8cf9682e0a728ea4a Sebastian DiLorenzo <dilorenzo.sebastian at gmail.com> 1378904905 +0200 commit: update taps remove header from merge
+bd3ab614a6966fa50066cad8cf9682e0a728ea4a 4a0e2921f140974e7c8a12fd8fddb998c0bd3171 Sebastian DiLorenzo <dilorenzo.sebastian at gmail.com> 1379937620 +0200 commit: hg18 detection added to TAPS
Modified: .git/logs/refs/remotes/origin/master
===================================================================
--- .git/logs/refs/remotes/origin/master 2013-09-11 12:49:43 UTC (rev 189)
+++ .git/logs/refs/remotes/origin/master 2013-09-23 11:57:32 UTC (rev 190)
@@ -63,3 +63,5 @@
74262096bdcb8c53bcf9f4719ff9ae6b23565262 884409fb1057881cbdbd2db1c86c85d72bf477c6 Sebastian DiLorenzo <S_D at imv092.medsci.uu.se> 1378894674 +0200 fetch: fast-forward
884409fb1057881cbdbd2db1c86c85d72bf477c6 7375bc63263a290cbfb537af8c38af2df6ba0f0c Sebastian DiLorenzo <S_D at imv092.medsci.uu.se> 1378902806 +0200 pull : fast-forward
7375bc63263a290cbfb537af8c38af2df6ba0f0c 6f560c07eeb2bc5a9c449af56829257933ebcf87 Sebastian DiLorenzo <S_D at imv092.medsci.uu.se> 1378903403 +0200 pull : fast-forward
+6f560c07eeb2bc5a9c449af56829257933ebcf87 bd3ab614a6966fa50066cad8cf9682e0a728ea4a Sebastian DiLorenzo <dilorenzo.sebastian at gmail.com> 1378904932 +0200 update by push
+bd3ab614a6966fa50066cad8cf9682e0a728ea4a 4a0e2921f140974e7c8a12fd8fddb998c0bd3171 Sebastian DiLorenzo <dilorenzo.sebastian at gmail.com> 1379937639 +0200 update by push
Modified: .git/refs/heads/master
===================================================================
--- .git/refs/heads/master 2013-09-11 12:49:43 UTC (rev 189)
+++ .git/refs/heads/master 2013-09-23 11:57:32 UTC (rev 190)
@@ -1 +1 @@
-6f560c07eeb2bc5a9c449af56829257933ebcf87
+4a0e2921f140974e7c8a12fd8fddb998c0bd3171
Modified: .git/refs/remotes/origin/master
===================================================================
--- .git/refs/remotes/origin/master 2013-09-11 12:49:43 UTC (rev 189)
+++ .git/refs/remotes/origin/master 2013-09-23 11:57:32 UTC (rev 190)
@@ -1 +1 @@
-6f560c07eeb2bc5a9c449af56829257933ebcf87
+4a0e2921f140974e7c8a12fd8fddb998c0bd3171
Modified: pkg/TAPS/R/TAPS.r
===================================================================
--- pkg/TAPS/R/TAPS.r 2013-09-11 12:49:43 UTC (rev 189)
+++ pkg/TAPS/R/TAPS.r 2013-09-23 11:57:32 UTC (rev 190)
@@ -6,7 +6,17 @@
## TAPS source code reimplemented 2013 Markus (Rasmussen) Mayrhofer, Sebastian DiLorenzo
-TAPS_plot <- function(directory=NULL,#xlim=c(-1,2),ylim=c(0,1),
+######### ### ######## ###### ######## ## ####### ########
+# ## ## ## ## ## ## ## ## ## ## ## ## ##
+# ## ## ## ## ## ## ## ## ## ## ## ##
+# ## ## ## ######## ###### ######## ## ## ## ##
+# ## ######### ## ## ## ## ## ## ##
+# ## ## ## ## ## ## ## ## ## ## ##
+# ## ## ## ## ###### ## ######## ####### ##
+
+
+TAPS_plot <- function(#samples='all',
+ directory=NULL,#xlim=c(-1,2),ylim=c(0,1),
bin=400) {
#Automatically check, and if needed install, packages stats and fields
@@ -39,16 +49,22 @@
if (is.null(subs)) { ## check samples = subdirectories or a single sample = current directory
subs=thisSubdir()
setwd('..')
+ subsToSampleData <- getSubdirs()
}
- # create SampleData file if there is none.
+ # create SampleData file if there is none.
if (length(grep('SampleData.xlsx',dir()))==0) {
- sampleData <- data.frame(Sample=subs,cn1= -0.5, cn2=0, cn3=NA, loh=0.7, MAPD=NA, MHOF=NA)
+ sampleData <- data.frame(Sample=subsToSampleData,cn1= -0.5, cn2=0, cn3=NA, loh=0.7, MAPD=NA, MHOF=NA)
write.xlsx(sampleData,'SampleData.xlsx',row.names=F)
} else {
sampleData=read.xlsx('SampleData.xlsx',1)
}
-
+
+ #if (samples[1]=='all') samples=rep(T,length(subs))
+ #if (is.logical(samples)) samples=which(samples)
+ #subs=subs[samples]
+
+
for (i in 1:length(subs)) {
setwd(subs[i])
@@ -166,16 +182,27 @@
#Clear warnings generated previously so hopefully I can see what is actually causing the program to fail.
#assign("last.warning", NULL, envir = baseenv())
+ #Test if hg18 or hg19 should be used. length of (hg18 chr19) > (hg19 chr19)
+ hgtest=regs[regs$chr=="chr19",]
+ if(hgtest$end[length(hgtest$chr)] > 60000000)
+ {
+ hg18=T
+ }
+ else
+ {
+ hg18=F
+ }
+
cat('..plotting.\n')
- OverviewPlot(regs$chr,regs$start,regs$end,regs$logs,regs$scores,ideogram=NULL,
+ OverviewPlot(regs$chr,regs$start,regs$end,regs$logs,regs$scores,hg18=hg18,
as.character(Log2$Chromosome),Log2$Start,Log2$Value,as.character(alf$Chromosome),alf$Start,alf$Value,
name=name,MAPD=MAPD,MHOF=MHOF)
## Chromosome-wise plots for manual analysis
regions=allRegions$regions
- karyotype_chroms(regs$chr,regs$start,regs$end,regs$logs,regs$scores,ideogram=NULL,
+ karyotype_chroms(regs$chr,regs$start,regs$end,regs$logs,regs$scores,hg18=hg18,
as.character(Log2$Chromosome),Log2$Start,Log2$Value,as.character(alf$Chromosome),alf$Start,
alf$Value,name=name,MAPD=MAPD,MHOF=MHOF)
@@ -186,6 +213,14 @@
}
###
+######### ### ######## ###### ###### ### ## ##
+# ## ## ## ## ## ## ## ## ## ## ## ## ##
+# ## ## ## ## ## ## ## ## ## ## ##
+# ## ## ## ######## ###### ## ## ## ## ##
+# ## ######### ## ## ## ######### ## ##
+# ## ## ## ## ## ## ## ## ## ## ## ##
+# ## ## ## ## ###### ###### ## ## ######## ########
+
###
TAPS_call <- function(samples='all',directory=getwd()) {
minseg=1
@@ -266,20 +301,31 @@
## adjacent segments with idendical copy number are merged (except over centromere) and all are saved to a text file
save.txt(u$regions,file=paste(name,'_segmentCN.txt',sep=''))
regions=allRegions$regions
-<<<<<<< HEAD
+
#save(u$model,file="model.Rdata")
write.table(t(as.data.frame(u$model)),file='model.txt',row.names=T)
-=======
+
save(t,regions,file="regions_t.Rdata")
+
+ #Test if hg18 or hg19 should be used. length of (hg18 chr19) > (hg19 chr19)
+ hgtest=regions[regions$Chromosome=="chr19",]
+ if(hgtest$End[length(hgtest$Chromosome)] > 60000000)
+ {
+ hg18=T
+ }
+ else
+ {
+ hg18=F
+ }
+
#save parameters as strings
parameters=paste("Parameters given: cn2:",sampleInfo$cn2," delta:",sampleInfo$delta," loh:",sampleInfo$loh)
->>>>>>> d63069fedd7b5d39e37a64432b37a149711b9b21
- karyotype_check(regions$Chromosome,regions$Start,regions$End,regions$log2,regions$imba,regions$Cn,regions$mCn,t,ideogram=NULL,name=name)
+ karyotype_check(regions$Chromosome,regions$Start,regions$End,regions$log2,regions$imba,regions$Cn,regions$mCn,t,name=name)
karyotype_chromsCN(regions$Chromosome,regions$Start,regions$End,regions$log2,
- regions$imba,regions$Cn,regions$mCn,ideogram=NULL,
+ regions$imba,regions$Cn,regions$mCn,hg18=hg18,
as.character(Log2$Chromosome),Log2$Start,Log2$Value,as.character(alf$Chromosome),
alf$Start,alf$Value,t,name=name,xlim=c(-1,1),ylim=c(0,1),parameters=parameters)
@@ -967,12 +1013,12 @@
}
-karyotype_check <- function(chr,start,end,int,ai,Cn,mCn,t,ideogram=NULL,name='') { #xlim=c(-1.02,1.02),ylim=0:1) {
+karyotype_check <- function(chr,start,end,int,ai,Cn,mCn,t,name='') { #xlim=c(-1.02,1.02),ylim=0:1) {
## TAPS scatter plot of a full sample, used for visual quality control.
png(paste(name,'.karyotype_check.png',sep=''),width=1300,height=1300)
- ideogram=getIdeogram()
+ #ideogram=getIdeogram()
colors_p <- colorRampPalette(c("#6600FF","#9900CC"),space="rgb")
colors_q <- colorRampPalette(c("#CC0099","#CC0000"),space="rgb")
@@ -1033,28 +1079,28 @@
}
-getIdeogram <- function() {
- c=1:24
- chr=as.character(c)
- chr[23:24]=c('X','Y')
- chr=paste('chr',chr,sep='')
- length=c(249250621, 243199373, 198022430, 191154276, 180915260, 171115067, 159138663,
- 146364022, 141213431, 135534747, 135006516, 133851895, 115169878, 107349540,
- 102531392, 90354753, 81195210, 78077248, 59128983, 63025520, 48129895,
- 51304566, 155270560, 59373566)
- start=c(121500000, 90500000, 87900000, 48200000, 46100000, 58700000, 58000000,
- 43100000, 47300000, 38000000, 51600000, 33300000, 16300000, 16100000,
- 15800000, 34600000, 22200000, 15400000, 24400000, 25600000, 10900000,
- 12200000, 58100000, 11600000)
- mid=c(1.25e+08, 9.33e+07, 9.10e+07, 5.04e+07, 4.84e+07, 6.10e+07, 5.99e+07, 4.56e+07,
- 4.90e+07, 4.02e+07, 5.37e+07, 3.58e+07, 1.79e+07, 1.76e+07, 1.90e+07, 3.66e+07,
- 2.40e+07, 1.72e+07, 2.65e+07, 2.75e+07, 1.32e+07, 1.47e+07, 6.06e+07, 1.25e+07)
- end=c(128900000, 96800000, 93900000, 52700000, 50700000, 63300000, 61700000,
- 48100000, 50700000, 42300000, 55700000, 38200000, 19500000, 19100000,
- 20700000, 38600000, 25800000, 19000000, 28600000, 29400000, 14300000,
- 17900000, 63000000, 13400000)
- return(data.frame(c,chr,length,start,mid,end))
-}
+# getIdeogram <- function() {
+# c=1:24
+# chr=as.character(c)
+# chr[23:24]=c('X','Y')
+# chr=paste('chr',chr,sep='')
+# length=c(249250621, 243199373, 198022430, 191154276, 180915260, 171115067, 159138663,
+# 146364022, 141213431, 135534747, 135006516, 133851895, 115169878, 107349540,
+# 102531392, 90354753, 81195210, 78077248, 59128983, 63025520, 48129895,
+# 51304566, 155270560, 59373566)
+# start=c(121500000, 90500000, 87900000, 48200000, 46100000, 58700000, 58000000,
+# 43100000, 47300000, 38000000, 51600000, 33300000, 16300000, 16100000,
+# 15800000, 34600000, 22200000, 15400000, 24400000, 25600000, 10900000,
+# 12200000, 58100000, 11600000)
+# mid=c(1.25e+08, 9.33e+07, 9.10e+07, 5.04e+07, 4.84e+07, 6.10e+07, 5.99e+07, 4.56e+07,
+# 4.90e+07, 4.02e+07, 5.37e+07, 3.58e+07, 1.79e+07, 1.76e+07, 1.90e+07, 3.66e+07,
+# 2.40e+07, 1.72e+07, 2.65e+07, 2.75e+07, 1.32e+07, 1.47e+07, 6.06e+07, 1.25e+07)
+# end=c(128900000, 96800000, 93900000, 52700000, 50700000, 63300000, 61700000,
+# 48100000, 50700000, 42300000, 55700000, 38200000, 19500000, 19100000,
+# 20700000, 38600000, 25800000, 19000000, 28600000, 29400000, 14300000,
+# 17900000, 63000000, 13400000)
+# return(data.frame(c,chr,length,start,mid,end))
+# }
@@ -1387,7 +1433,7 @@
main=paste(comparison,'frequency'), cex.main=2,
xlab=NA,#'',#Genomic position (??????=significance)',
ylab=NA,#'Alteration frequency difference (% units)', cex.lab=2,
- xlim = c(0,sum(chroms$length)),
+ xlim = c(0,sum(as.numeric(chroms$length))),
ylim = ylim,
yaxt="n",
xaxt="n"
@@ -1424,7 +1470,7 @@
## The vertical lines
segments(
- x0=c(chroms$before,sum(chroms$length)),x1=c(chroms$before,sum(chroms$length)),
+ x0=c(chroms$before,sum(as.numeric(chroms$length))),x1=c(chroms$before,sum(as.numeric(chroms$length))),
y0= -15,y1=100,
col='#000000',
lwd=1
@@ -1432,7 +1478,7 @@
# Horizontal lines
segments(
- x0=0,x1=sum(chroms$length),
+ x0=0,x1=sum(as.numeric(chroms$length)),
y0=seq(0,80,10),y1=seq(0,80,10),
col='#00000070',
lwd=1,lty=3
@@ -1443,7 +1489,7 @@
labels=abs(seq(0,100,20)), pos=0,
cex.axis=2,tck=-0.01, las=2)
axis(4,at=seq(0,100,20),
- labels=abs(seq(0,100,20)), pos=sum(chroms$length),
+ labels=abs(seq(0,100,20)), pos=sum(as.numeric(chroms$length)),
cex.axis=2,tck=-0.01, las=2)
dev.off()
}
@@ -1565,7 +1611,7 @@
main=paste(comparison,' frequency difference, ', name1, ' (', n1, ') vs ', name2, ' (', n2, ')', sep=''), cex.main=2,
xlab=NA,#'',#Genomic position (??????=significance)',
ylab=NA,#'Alteration frequency difference (% units)', cex.lab=2,
- xlim = c(0,sum(chroms$length)),
+ xlim = c(0,sum(as.numeric(chroms$length))),
ylim = ylim,
yaxt="n",
xaxt="n"
@@ -1697,20 +1743,25 @@
# Added TAPS plot functionality
#------------------------------------------------------------
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
+# ####### ## ## ######## ######## ## ## #### ######## ## ## ######## ## ####### ########
+### ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+### ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+### ## ## ## ###### ######## ## ## ## ###### ## ## ## ######## ## ## ## ##
+### ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+### ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+# ####### ### ######## ## ## ### #### ######## ### ### ## ######## ####### ##
+OverviewPlot <- function(chr,start,end,int,ai,hg18,mchr,mpos,mval,schr,spos,sval,name='',xlim=c(-1,1.5),ylim=c(0,1),MAPD,MHOF)
+{
-OverviewPlot <- function(chr,start,end,int,ai,ideogram=NULL,mchr,mpos,mval,schr,spos,sval,name='',xlim=c(-1,1.5),ylim=c(0,1),MAPD,MHOF)
-{
- ideogram=getIdeogram()
+ if(hg18==T)
+ {
+ chroms=chroms_hg18
+ chromData=chromData_hg18
+ chroms$length=as.numeric(chroms$length)
+ }
+
+ #ideogram=getIdeogram()
colors_p <- colorRampPalette(c("#6600FF","#9900CC"),space="rgb")
colors_q <- colorRampPalette(c("#CC0099","#CC0000"),space="rgb")
@@ -1771,10 +1822,10 @@
#nchr=24; if (sum(chr=='chrY')==0) nchr=23
#Loop over and plot the 24 chromosomes
- for (c in 1:24)
+ for (c in 1:23)
{
#Pick a chromosome
- this <- ideogram[ideogram$c==c,]
+ this <- chroms[chroms$c==c,]
#Extract that chromosomes information
ix <- chr==as.character(this$chr)
x <- chr=='chrX'
@@ -1865,10 +1916,10 @@
#Calculate previous distance of whole genome so the next chromsome is added
#at the correct coordinate
- pre=rep(NA,24)
- for (c in 1:24)
+ pre=rep(NA,23)
+ for (c in 1:23)
{
- this <- ideogram[ideogram$c==c,]
+ this <- chroms[chroms$c==c,]
ix <- chr==as.character(this$chr)
mix <- mchr==as.character(this$chr) #& mval>=(-2)
six <- schr==as.character(this$chr)
@@ -1888,7 +1939,7 @@
if(c>1)
{
- prelength=prelength+ideogram$length[ideogram$c==(c-1)]
+ prelength=prelength+chroms$length[chroms$c==(c-1)]
}
else
{
@@ -1900,7 +1951,7 @@
#Start and end used for colored segment placement (Adding whole preceding genome to each position)
start[ix] = start[ix] + prelength
end[ix] = end[ix] + prelength
- #pre used to position chromsome markers. Seen bottom of plot.
+ #pre used to position chromosome markers. Seen bottom of plot.
pre[c] = prelength+(this$length/2)
#spos used later for allelic imbalance plot. Same principle as mpos.
spos[six] = spos[six] + prelength
@@ -1943,9 +1994,9 @@
lwd=1)
#Add colored segment information for each chromosome, red to blue gradient.
- for(c in 1:24)
+ for(c in 1:23)
{
- this <- ideogram[ideogram$c==c,]
+ this <- chroms[chroms$c==c,]
ix <- chr==as.character(this$chr)
col <- rep('#B0B0B030',length(chr))
col[ix & (pos < this$mid)] <- paste(colors_p(sum(ix & (pos < this$mid))), '70', sep='')
@@ -2037,7 +2088,7 @@
#Add axis to the left,right and below of AI. The below axis is the chromosome numbers 1-24.
axis(side=2,tck=-0.04,at=seq(from=0,to=1,by=0.2),cex.axis=0.6,pos=0,las=1)
- axis(side=1,at=pre,pos=0,labels=c(seq(from="1",to="22"),"X","Y"),cex.axis=0.55,lty=0)#,tck=0,col.ticks='#00000000')
+ axis(side=1,at=pre,pos=0,labels=c(seq(from="1",to="22"),"X"),cex.axis=0.55,lty=0)#,tck=0,col.ticks='#00000000')
axis(side=4,tck=-0.04,at=seq(from=0,to=1,by=0.2),cex.axis=0.6,pos=max(mpos),las=1) #
mtext("Allele frequency",side=2,line=0)
mtext("Chromosomes",side=1,line=1.5,adj=0.4)
@@ -2059,22 +2110,33 @@
}
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
+### ## ### ######## ## ## ####### ######## ## ## ######## ########
+### ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+### ## ## ## ## ## #### ## ## ## #### ## ## ##
+###### ## ## ######## ## ## ## ## ## ######## ######
+### ## ######### ## ## ## ## ## ## ## ## ##
+### ## ## ## ## ## ## ## ## ## ## ## ##
+### ## ## ## ## ## ## ####### ## ## ## ########
+
+# ###### ## ## ######## ####### ## ## ######
+### ## ## ## ## ## ## ## ### ### ## ##
+### ## ## ## ## ## ## #### #### ##
+### ######### ######## ## ## ## ### ## ######
+### ## ## ## ## ## ## ## ## ##
+### ## ## ## ## ## ## ## ## ## ## ##
+# ###### ## ## ## ## ####### ## ## ######
+
#Function for generating individual plots for TAPS_call. Gives whole genome, log-ratio, cytoband and allele frequency.
-karyotype_chroms <- function(chr,start,end,int,ai,ideogram=NULL,mchr,mpos,mval,schr,spos,sval,name='',xlim=c(-2,2),ylim=0:1,MAPD,MHOF)
+karyotype_chroms <- function(chr,start,end,int,ai,hg18,mchr,mpos,mval,schr,spos,sval,name='',xlim=c(-2,2),ylim=0:1,MAPD,MHOF)
{
-
+ if(hg18==T)
+ {
+ chroms=chroms_hg18
+ chromData=chromData_hg18
+ }
#Get ideogram
- ideogram=getIdeogram()
+ #ideogram=getIdeogram()
#Set color gradient for p and q arm of chromosome
colors_p <- colorRampPalette(c("#6600FF","#9900CC"),space="rgb")
@@ -2102,7 +2164,7 @@
{
#Select the chromosome
- this <- ideogram[ideogram$c==c,]
+ this <- chroms[chroms$c==c,]
#Initialize jpeg
jpeg(paste(name,'_karyotype.',this$chr,'.jpg',sep=''),width=11.7,height=8.3,units="in",res=300)
@@ -2149,7 +2211,7 @@
#Go to screen 4
screen(4)
-
+
#Set marginals, outer marginals and mgp(which is for xlab,ylab,ticks and axis)
par(mar = c(0, 0, 0, 0))
par(oma = c(0,0,0,0))
@@ -2359,7 +2421,7 @@
axis(side=2,tck=0.926,col.ticks='#80808080',at=seq(from=0,to=1,by=0.2),cex.axis=0.6,pos=0,las=1)
axis(side=4,tck=0,at=seq(from=0,to=1,by=0.2),cex.axis=0.6,pos=this$length,las=1)
axis(side=1,tck=0.925,col='#80808000',col.ticks='#80808040',at=seq(5e6,this$length,by=5e6),
- labels=paste(seq(5,round(this$length/1e6),5),'',sep=''),cex.axis=0.6,pos=0)
+ labels=paste(seq(5,floor(this$length/1e6),5),'',sep=''),cex.axis=0.6,pos=0)
#axis(side=1,tck=0.926,col='#80808040',at=seq(5e6,this$length,by=5e6),
# labels=FALSE,cex.axis=0.6,pos=ymin)
# axis(side=1,tck=0,pos=0,at=c(0,max(mpos)),
@@ -2377,22 +2439,32 @@
}
}
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
+### ## ### ######## ## ## ####### ######## ## ## ######## ########
+### ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
+### ## ## ## ## ## #### ## ## ## #### ## ## ##
+###### ## ## ######## ## ## ## ## ## ######## ######
+### ## ######### ## ## ## ## ## ## ## ## ##
+### ## ## ## ## ## ## ## ## ## ## ## ##
+### ## ## ## ## ## ## ####### ## ## ## ########
-karyotype_chromsCN <- function(chr,start,end,int,ai,Cn,mCn,ideogram=NULL,mchr,mpos,mval,schr,spos,sval,t,name='',xlim=c(-1.02,1.82),ylim=0:1, maxCn=8,parameters)
+# ###### ## ## ######## ####### ## ## ###### ###### ## ##
+### ## ## ## ## ## ## ## ### ### ## ## ## ## ### ##
+### ## ## ## ## ## ## #### #### ## ## #### ##
+### ######### ######## ## ## ## ### ## ###### ## ## ## ##
+### ## ## ## ## ## ## ## ## ## ## ## ####
+### ## ## ## ## ## ## ## ## ## ## ## ## ## ## ###
+# ###### ## ## ## ## ####### ## ## ###### ###### ## ##
+
+karyotype_chromsCN <- function(chr,start,end,int,ai,Cn,mCn,hg18,mchr,mpos,mval,schr,spos,sval,t,name='',xlim=c(-1.02,1.82),ylim=0:1, maxCn=8,parameters)
{
-
+ if(hg18==T)
+ {
+ chroms=chroms_hg18
+ chromData=chromData_hg18
+ }
#Get ideogram
- ideogram=getIdeogram()
+ #ideogram=getIdeogram()
#Set color gradient for p and q arm of chromosome
colors_p <- colorRampPalette(c("#6600FF","#9900CC"),space="rgb")
@@ -2434,7 +2506,7 @@
for (c in 1:23)
{
#Select the chromosome
- this <- ideogram[ideogram$c==c,]
+ this <- chroms[chroms$c==c,]
#Initialize jpeg
jpeg(paste(name,'_karyotypeCN.',this$chr,'.jpg',sep=''),width=11.7,height=8.3,units="in",res=300)
@@ -2732,7 +2804,7 @@
axis(side=2,tck=0.926,col.ticks='#808080',at=seq(from=0,to=1,by=0.2),cex.axis=0.6,pos=0,las=1)
axis(side=4,labels=F,tck=0,pos=this$length)
axis(side=1,tck=0.925,col.ticks='#808080',at=seq(5e6,this$length,by=5e6),
- labels=paste(seq(5,round(this$length/1e6),5),'',sep=''),cex.axis=0.6,pos=0)
+ labels=paste(seq(5,floor(this$length/1e6),5),'',sep=''),cex.axis=0.6,pos=0)
#Add X and Y label
mtext("Allele frequency",side=2,line=0.3)
@@ -2747,15 +2819,13 @@
}
}
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
-#------------------------------------------------------------------------------------------------------------------------#
+######### ### ######## ###### ######## ######## ###### #### ####### ## ##
+# ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ### ##
+# ## ## ## ## ## ## ## ## ## ## ## ## ## #### ##
+# ## ## ## ######## ###### ######## ###### ## #### ## ## ## ## ## ##
+# ## ######### ## ## ## ## ## ## ## ## ## ## ## ####
+# ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ###
+# ## ## ## ## ###### ## ## ######## ###### #### ####### ## ##
#------------------------------------------------------------------------------------------------------
#------------------------------------------------------------------------------------------------------
@@ -2843,7 +2913,7 @@
end = regs$end
int = regs$logs
ai = regs$scores
- ideogram=NULL
+ #ideogram=NULL
mchr = as.character(Log2$Chromosome)
mpos = Log2$Start
mval =Log2$Value
@@ -2858,6 +2928,8 @@
if(hg18==T)
{
kg = knownGene_hg18
+ chroms = chroms_hg18
+ chromData = chromData_hg18
}
else
{
@@ -2870,7 +2942,7 @@
#
#Get ideogram
- ideogram=getIdeogram()
+ #ideogram=getIdeogram()
#Set color gradient for p and q arm of chromosome
colors_p <- colorRampPalette(c("#6600FF","#9900CC"),space="rgb")
@@ -2894,7 +2966,7 @@
size[length>10000000]=4
#Select the chromosome
- this <- ideogram[ideogram$c==c,]
+ this <- chroms[chroms$c==c,]
#Extract regions start an stop
#region inputted in form start:stop
@@ -3133,7 +3205,7 @@
axis(side=2,tck=0.926,col.ticks='#808080',at=seq(from=0,to=1,by=0.2),cex.axis=0.6,pos=0,hadj=1.3,las=1)
axis(side=4,labels=F,tck=0,pos=this$length)
axis(side=1,tck=0.925,col.ticks='#808080',at=seq(5e6,this$length,by=5e6),
- labels=paste(seq(5,round(this$length/1e6),5),'',sep=''),cex.axis=0.6,pos=0)
+ labels=paste(seq(5,floor(this$length/1e6),5),'',sep=''),cex.axis=0.6,pos=0)
#Add a rectangle showing which region has been chosen
rect(xleft=Rstart,xright=Rend,ybottom=0,ytop=1,col='#E8000040',lty=0)
@@ -3333,7 +3405,7 @@
axis(side=2,tck=0.926,col.ticks='#808080',at=seq(from=0,to=1,by=0.2),cex.axis=0.6,pos=Rstart,las=1)
axis(side=4,labels=F,tck=0,pos=Rend)
#axis(side=1,tck=0.925,col.ticks='#808080',at=seq(5e6,this$length,by=5e6),
- # labels=paste(seq(5,round(this$length/1e6),5),'',sep=''),cex.axis=0.6,pos=0)
+ # labels=paste(seq(5,floor(this$length/1e6),5),'',sep=''),cex.axis=0.6,pos=0)
axis(side=1,cex.axis=0.6)
#Add X and Y label
Modified: pkg/TAPS/R/sysdata.rda
===================================================================
(Binary files differ)
Modified: pkg/TAPS/man/TAPS_plot.Rd
===================================================================
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/patchwork -r 190
More information about the Patchwork-commits
mailing list