From noreply at r-forge.r-project.org Thu Sep 5 09:39:10 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 5 Sep 2013 09:39:10 +0200 (CEST) Subject: [Patchwork-commits] r188 - www Message-ID: <20130905073910.E216F183EE0@r-forge.r-project.org> Author: sebastian_d Date: 2013-09-05 09:39:10 +0200 (Thu, 05 Sep 2013) New Revision: 188 Modified: www/TAPS_requ.php Log: update information on homepage regarding segmentation options for taps data Modified: www/TAPS_requ.php =================================================================== --- www/TAPS_requ.php 2013-08-22 15:01:46 UTC (rev 187) +++ www/TAPS_requ.php 2013-09-05 07:39:10 UTC (rev 188) @@ -13,11 +13,12 @@ Using Nexus has the benefit of being able to use their segmentation which reduces running time of TAPS.

-If you have used Nexus, use "File -> Utilities -> Export from .ivg to.txt" to create "probes.txt", +If you have used Nexus; we recommend using the SNPRank segmentation algorithm as it is +CBS based rather than HMM, then use "File -> Utilities -> Export from .ivg to.txt" to create "probes.txt", "snps.txt" and "segments.txt". These should be in a sample folder, which is what TAPS takes as input.

-If you have used ChAS, load the file ending in "cyhd.cychp" into ChAS and create the text file ending in "cyhd.txt" +If you have used ChAS; load the file ending in "cyhd.cychp" into ChAS and create the text file ending in "cyhd.txt" by choosing Reports menu and selecting Export genotype results text file. Then locate the samples folder, which is what TAPS takes as input. It should now contain two files ending in "cyhd.txt" and "cyhd.cychp".

From noreply at r-forge.r-project.org Wed Sep 11 14:49:44 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 11 Sep 2013 14:49:44 +0200 (CEST) Subject: [Patchwork-commits] r189 - .git .git/logs .git/logs/refs/heads .git/logs/refs/remotes/origin .git/refs/heads .git/refs/remotes/origin pkg/TAPS pkg/TAPS/R pkg/TAPS/man pkg/patchwork pkg/patchwork/R pkg/patchwork/man www Message-ID: <20130911124944.56B58183B91@r-forge.r-project.org> Author: sebastian_d Date: 2013-09-11 14:49:43 +0200 (Wed, 11 Sep 2013) New Revision: 189 Added: pkg/TAPS/man/TAPS_compare.Rd pkg/TAPS/man/TAPS_freq.Rd 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/DESCRIPTION pkg/TAPS/NAMESPACE pkg/TAPS/R/TAPS.r pkg/TAPS/R/zzz.r pkg/TAPS/man/TAPS_call.Rd pkg/patchwork/DESCRIPTION pkg/patchwork/NAMESPACE pkg/patchwork/R/karyotype.r pkg/patchwork/R/karyotype_check.r pkg/patchwork/R/karyotype_chroms.r pkg/patchwork/R/karyotype_chromsCN.r pkg/patchwork/R/patchwork.alleledata.r pkg/patchwork/R/patchwork.copynumbers.r pkg/patchwork/R/patchwork.plot.r pkg/patchwork/man/karyotype.Rd pkg/patchwork/man/karyotype_chroms.Rd pkg/patchwork/man/karyotype_chromsCN.Rd www/TAPS_inst.php www/changelog.php Log: Extensive changes to patchwork plotting. New functions, TAPS_compare and TAPS_freq, to TAPS Modified: .git/COMMIT_EDITMSG =================================================================== --- .git/COMMIT_EDITMSG 2013-09-05 07:39:10 UTC (rev 188) +++ .git/COMMIT_EDITMSG 2013-09-11 12:49:43 UTC (rev 189) @@ -1 +1 @@ -homepage info update pysam +some updates to taps homepage info Modified: .git/index =================================================================== (Binary files differ) Modified: .git/logs/HEAD =================================================================== --- .git/logs/HEAD 2013-09-05 07:39:10 UTC (rev 188) +++ .git/logs/HEAD 2013-09-11 12:49:43 UTC (rev 189) @@ -58,3 +58,10 @@ 5a2afd158f70d21ed8bf6a45f61a19dbbb6b79c2 c08551d489e8bc28692c600dfffa7e7d4cb37ca5 Sebastian DiLorenzo 1372256038 +0200 commit: Move pysam out of package c08551d489e8bc28692c600dfffa7e7d4cb37ca5 b617a63c7595a2cb1b2a85e2ed73a67eccac8b32 Sebastian DiLorenzo 1372346578 +0200 commit: homepage info update pysam b617a63c7595a2cb1b2a85e2ed73a67eccac8b32 f626f1a4b4965df8008d349712318cedf6dde9eb Sebastian DiLorenzo 1372427760 +0200 pull : Fast-forward +f626f1a4b4965df8008d349712318cedf6dde9eb 9327100077803d89d70ede58fe98f0949fe726e8 Sebastian DiLorenzo 1376640199 +0200 commit: Updated plotting procedures significantly of patchwork. +9327100077803d89d70ede58fe98f0949fe726e8 43c186b570d94002d0576a8f805be76267cf2b6a Sebastian DiLorenzo 1376644958 +0200 commit: deleted two unused pngs +43c186b570d94002d0576a8f805be76267cf2b6a d63069fedd7b5d39e37a64432b37a149711b9b21 Sebastian DiLorenzo 1377264167 +0200 commit: some changes to pw_requ to avoid missunderstandings +d63069fedd7b5d39e37a64432b37a149711b9b21 74262096bdcb8c53bcf9f4719ff9ae6b23565262 Sebastian DiLorenzo 1378892982 +0200 commit: some updates to taps homepage info +74262096bdcb8c53bcf9f4719ff9ae6b23565262 884409fb1057881cbdbd2db1c86c85d72bf477c6 Sebastian DiLorenzo 1378894727 +0200 pull : Fast-forward +884409fb1057881cbdbd2db1c86c85d72bf477c6 7375bc63263a290cbfb537af8c38af2df6ba0f0c Sebastian DiLorenzo 1378902806 +0200 pull : Fast-forward +7375bc63263a290cbfb537af8c38af2df6ba0f0c 6f560c07eeb2bc5a9c449af56829257933ebcf87 Sebastian DiLorenzo 1378903472 +0200 pull : Fast-forward Modified: .git/logs/refs/heads/master =================================================================== --- .git/logs/refs/heads/master 2013-09-05 07:39:10 UTC (rev 188) +++ .git/logs/refs/heads/master 2013-09-11 12:49:43 UTC (rev 189) @@ -58,3 +58,10 @@ 5a2afd158f70d21ed8bf6a45f61a19dbbb6b79c2 c08551d489e8bc28692c600dfffa7e7d4cb37ca5 Sebastian DiLorenzo 1372256038 +0200 commit: Move pysam out of package c08551d489e8bc28692c600dfffa7e7d4cb37ca5 b617a63c7595a2cb1b2a85e2ed73a67eccac8b32 Sebastian DiLorenzo 1372346578 +0200 commit: homepage info update pysam b617a63c7595a2cb1b2a85e2ed73a67eccac8b32 f626f1a4b4965df8008d349712318cedf6dde9eb Sebastian DiLorenzo 1372427760 +0200 pull : Fast-forward +f626f1a4b4965df8008d349712318cedf6dde9eb 9327100077803d89d70ede58fe98f0949fe726e8 Sebastian DiLorenzo 1376640199 +0200 commit: Updated plotting procedures significantly of patchwork. +9327100077803d89d70ede58fe98f0949fe726e8 43c186b570d94002d0576a8f805be76267cf2b6a Sebastian DiLorenzo 1376644958 +0200 commit: deleted two unused pngs +43c186b570d94002d0576a8f805be76267cf2b6a d63069fedd7b5d39e37a64432b37a149711b9b21 Sebastian DiLorenzo 1377264167 +0200 commit: some changes to pw_requ to avoid missunderstandings +d63069fedd7b5d39e37a64432b37a149711b9b21 74262096bdcb8c53bcf9f4719ff9ae6b23565262 Sebastian DiLorenzo 1378892982 +0200 commit: some updates to taps homepage info +74262096bdcb8c53bcf9f4719ff9ae6b23565262 884409fb1057881cbdbd2db1c86c85d72bf477c6 Sebastian DiLorenzo 1378894727 +0200 pull : Fast-forward +884409fb1057881cbdbd2db1c86c85d72bf477c6 7375bc63263a290cbfb537af8c38af2df6ba0f0c Sebastian DiLorenzo 1378902806 +0200 pull : Fast-forward +7375bc63263a290cbfb537af8c38af2df6ba0f0c 6f560c07eeb2bc5a9c449af56829257933ebcf87 Sebastian DiLorenzo 1378903472 +0200 pull : Fast-forward Modified: .git/logs/refs/remotes/origin/master =================================================================== --- .git/logs/refs/remotes/origin/master 2013-09-05 07:39:10 UTC (rev 188) +++ .git/logs/refs/remotes/origin/master 2013-09-11 12:49:43 UTC (rev 189) @@ -56,3 +56,10 @@ 5a2afd158f70d21ed8bf6a45f61a19dbbb6b79c2 c08551d489e8bc28692c600dfffa7e7d4cb37ca5 Sebastian DiLorenzo 1372256058 +0200 update by push c08551d489e8bc28692c600dfffa7e7d4cb37ca5 b617a63c7595a2cb1b2a85e2ed73a67eccac8b32 Sebastian DiLorenzo 1372346594 +0200 update by push b617a63c7595a2cb1b2a85e2ed73a67eccac8b32 f626f1a4b4965df8008d349712318cedf6dde9eb Sebastian DiLorenzo 1372427760 +0200 pull : fast-forward +f626f1a4b4965df8008d349712318cedf6dde9eb 9327100077803d89d70ede58fe98f0949fe726e8 Sebastian DiLorenzo 1376640235 +0200 update by push +9327100077803d89d70ede58fe98f0949fe726e8 43c186b570d94002d0576a8f805be76267cf2b6a Sebastian DiLorenzo 1376644972 +0200 update by push +43c186b570d94002d0576a8f805be76267cf2b6a d63069fedd7b5d39e37a64432b37a149711b9b21 Sebastian DiLorenzo 1377264183 +0200 update by push +d63069fedd7b5d39e37a64432b37a149711b9b21 74262096bdcb8c53bcf9f4719ff9ae6b23565262 Sebastian DiLorenzo 1378893000 +0200 update by push +74262096bdcb8c53bcf9f4719ff9ae6b23565262 884409fb1057881cbdbd2db1c86c85d72bf477c6 Sebastian DiLorenzo 1378894674 +0200 fetch: fast-forward +884409fb1057881cbdbd2db1c86c85d72bf477c6 7375bc63263a290cbfb537af8c38af2df6ba0f0c Sebastian DiLorenzo 1378902806 +0200 pull : fast-forward +7375bc63263a290cbfb537af8c38af2df6ba0f0c 6f560c07eeb2bc5a9c449af56829257933ebcf87 Sebastian DiLorenzo 1378903403 +0200 pull : fast-forward Modified: .git/refs/heads/master =================================================================== --- .git/refs/heads/master 2013-09-05 07:39:10 UTC (rev 188) +++ .git/refs/heads/master 2013-09-11 12:49:43 UTC (rev 189) @@ -1 +1 @@ -f626f1a4b4965df8008d349712318cedf6dde9eb +6f560c07eeb2bc5a9c449af56829257933ebcf87 Modified: .git/refs/remotes/origin/master =================================================================== --- .git/refs/remotes/origin/master 2013-09-05 07:39:10 UTC (rev 188) +++ .git/refs/remotes/origin/master 2013-09-11 12:49:43 UTC (rev 189) @@ -1 +1 @@ -f626f1a4b4965df8008d349712318cedf6dde9eb +6f560c07eeb2bc5a9c449af56829257933ebcf87 Modified: pkg/TAPS/DESCRIPTION =================================================================== --- pkg/TAPS/DESCRIPTION 2013-09-05 07:39:10 UTC (rev 188) +++ pkg/TAPS/DESCRIPTION 2013-09-11 12:49:43 UTC (rev 189) @@ -1,8 +1,8 @@ Package: TAPS Type: Package Title: Tumor Abberation Prediction Suite -Version: 1.0 -Date: 2013-05-11 +Version: 2.0 +Date: 2013-09-10 Author: Markus Mayrhofer, Hanna Goransson-Kultima, Sebastian DiLorenzo Maintainer: Sebastian DiLorenzo #Markus Mayrhofer Description: Performs a allele-specific copy number analysis of array data. Modified: pkg/TAPS/NAMESPACE =================================================================== --- pkg/TAPS/NAMESPACE 2013-09-05 07:39:10 UTC (rev 188) +++ pkg/TAPS/NAMESPACE 2013-09-11 12:49:43 UTC (rev 189) @@ -1,5 +1,7 @@ export(TAPS_plot, TAPS_call, - TAPS_region) + TAPS_region, + TAPS_freq, + TAPS_compare) Modified: pkg/TAPS/R/TAPS.r =================================================================== --- pkg/TAPS/R/TAPS.r 2013-09-05 07:39:10 UTC (rev 188) +++ pkg/TAPS/R/TAPS.r 2013-09-11 12:49:43 UTC (rev 189) @@ -16,6 +16,7 @@ suppressPackageStartupMessages(library(stats)) suppressPackageStartupMessages(library(DNAcopy)) suppressPackageStartupMessages(library(fields)) + suppressPackageStartupMessages(library(xlsx)) #list.of.packages <- c("stats", "fields") @@ -34,23 +35,25 @@ ## This function takes a directory as input, then builds short-segment TAPS scatter plots for each sample (subdirectory) in the directory. setwd(directory) subs <- getSubdirs() + subs=subs[subs!='frequencies' & subs!='frequencies_comp'] if (is.null(subs)) { ## check samples = subdirectories or a single sample = current directory subs=thisSubdir() setwd('..') } - # create SampleData file if there is none. - if (length(grep('SampleData.txt',dir()))==0) { - sampleData=data.frame(Sample=subs,cn2='',delta='',loh='', MAPD=NA, MHOF=NA, calculate.copynumbers='yes') + # 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) + write.xlsx(sampleData,'SampleData.xlsx',row.names=F) } else { - sampleData=load.txt('SampleData.txt') + sampleData=read.xlsx('SampleData.xlsx',1) } for (i in 1:length(subs)) { setwd(subs[i]) name <- subs[i] - #if (length(grep('SampleData.txt',dir()))==0) save.txt(data.frame(Sample=name,cn2='',delta='',loh='',completed.analysis='no'),file='SampleData.txt') + #if (length(grep('sampleData.csv',dir()))==0) save.txt(data.frame(Sample=name,cn2='',delta='',loh='',completed.analysis='no'),file='sampleData.csv') cat(' ..loading', subs[i]) if(length(grep("*.cyhd.cychp",dir()))==1) ##cyhd sample @@ -137,13 +140,13 @@ save.txt(segments,'_segments.txt') } - segments$Value <- segments$Value-median(Log2$Value) ## Median-centering - Log2$Value <- Log2$Value-median(Log2$Value) ## Median-centering + segments$Value <- segments$Value-mean(Log2$Value) ## Median-centering + Log2$Value <- Log2$Value-mean(Log2$Value) ## Median-centering - allRegions=NULL; try(load('allRegions.Rdata'),silent=T) + allRegions=NULL; if ('allRegions.Rdata' %in% dir()) load('allRegions.Rdata') if (is.null(allRegions)) allRegions <- makeRegions(Log2, alf, segments) ## Calculates necessary data for segments (all functions are in this file) save(allRegions,file='allRegions.Rdata') - regs=NULL; try(load('shortRegions.Rdata'),silent=T) + regs=NULL; if ('shortRegions.Rdata' %in% dir()) load('shortRegions.Rdata') if (is.null(regs)) { regs <- regsFromSegs(Log2,alf,segments,bin=bin,min=5) ## Calculates the same data for shortened segments save(regs,file='shortRegions.Rdata') @@ -151,14 +154,14 @@ ## Sample QC sampleData$MAPD[i] <- MAPD <- round(median(abs(diff(Log2$Value[Log2$Chromosome=='chr1'][order(Log2$Start[Log2$Chromosome=='chr1'])]))),2) - sampleData$MHOF[i] <- MHOF <- round(100*median(0.5+abs(0.5-alf$Value)),1) + sampleData$MHOF[i] <- MHOF <- round(100*median(0.5+abs(0.5-alf$Value[alf$Chromosome!='chrX'])),1) #round(100*median(0.5+regs$hom[regs$scores<0.5],na.rm=T),1) #MAID=round(median(abs(diff(regs$scores[!is.na(regs$scores)]))),3) #Save for TAPS_region() save(regs,Log2,alf,segments,file="TAPS_plot_output.Rdata") - save.txt(sampleData,file='../SampleData.txt') + #save.txt(sampleData,file='../sampleData.csv') #Clear warnings generated previously so hopefully I can see what is actually causing the program to fail. #assign("last.warning", NULL, envir = baseenv()) @@ -179,12 +182,16 @@ cat('..done\n') setwd('..') } + write.xlsx(sampleData,'SampleData.xlsx',row.names=F) } ### ### -TAPS_call <- function(directory=NULL,#xlim=c(-1,1),ylim=c(0,1), - minseg=1,maxCn=12) { +TAPS_call <- function(samples='all',directory=getwd()) { + minseg=1 + maxCn=12 + suppressPackageStartupMessages(library(xlsx)) + ## TAPS_call outputs the total and minor allele copy numbers of all segments as a text file, and as images for visual confirmation. ## sampleInfo_TAPS.txt must be present in each sample folder. If TAPS_plot could not make a good guess of the Log-R of copy number 2 ## and the Log-R difference to a deletion, you must interpret the scatter plots and edit sampleInfo_TAPS.txt. @@ -197,28 +204,33 @@ #directory = readline("Please supply such a directory now: ") } - setwd(directory) #subs <- getSubdirs() - if (length(grep('SampleData.txt',dir()))==1) + if (length(grep('SampleData.xlsx',dir()))==1) { - sampleData <- load.txt('SampleData.txt') + sampleData=read.xlsx('SampleData.xlsx',1) } else { - sampleData <- load.txt('../SampleData.txt') + sampleData <- read.xlsx('../SampleData.xlsx',1) } subs=as.character(sampleData$Sample) if (is.null(subs)) { subs=thisSubdir() + subs=subs[subs!='frequencies' & subs!='frequencies_comp'] setwd('..') } - for (i in 1:length(subs)) if (sampleData$calculate.copynumbers[i]=='yes') { + + 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]) name <- subs[i] - sampleInfo <- sampleData[sampleData$Sample==subs[i],] + sampleInfo <- sampleData[sampleData$Sample==subs[i],2:5] if (nrow(sampleInfo)==1) { cat(' ..loading', subs[i]) @@ -236,38 +248,47 @@ segments <- segments[!is.nan(segments$Value),] segments <- segments[!is.na(segments$Value),] - segments$Value <- segments$Value-median(Log2$Value) - Log2$Value <- Log2$Value-median(Log2$Value) + segments$Value <- segments$Value-mean(Log2$Value) + Log2$Value <- Log2$Value-mean(Log2$Value) cat(' ..processing.\n') load('allRegions.Rdata') ## These were prepared in TAPS_plot + load('shortRegions.Rdata') #allRegions <- makeRegions(Log2, alf, segments) ## estimates the Log-R and Allelic Imbalance Ration of all variants up to maxCn - t <- findCNs(Log2,alf,allRegions,dmin=0.9,maxCn=maxCn,ceiling=1,sampleInfo=sampleInfo) + t <- findCNs(Log2,alf,allRegions,regs,name,maxCn=maxCn,ceiling=1,sampleInfo=sampleInfo) + save(t,file='t.Rdata') - u <- setCNs(allRegions,t$int,t$ai,maxCn) ## Assigns copy number variant for all segments + u <- setCNs(allRegions,t$int,t$ai,t$model,maxCn) ## Assigns copy number variant for all segments allRegions$regions <- u$regions ## 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") + + #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_chromsCN(regions$Chromosome,regions$Start,regions$End,regions$log2, regions$imba,regions$Cn,regions$mCn,ideogram=NULL, 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)) + alf$Start,alf$Value,t,name=name,xlim=c(-1,1),ylim=c(0,1),parameters=parameters) cat('..done\n') - sampleData$completed.analysis[i] <- '' } else cat('Skipped',name,'\n') setwd('..') } - save.txt(sampleData,file='SampleData.txt') + #save.txt(sampleData,file='sampleData.csv') } ### regsFromSegs <- function (Log2,alf, segments, bin=200,min=1) { @@ -602,96 +623,109 @@ ## ### -findCNs <- function(Log2,alf,allRegions,name=thisSubdir(),dmin=0.9,maxCn=10,ceiling=1,sampleInfo=NULL) { - ## This function takes an estimate of the Log-R of copy number two (shift) and the difference in log-R between copy numbers 2 and 1 (delta) - ## (3 and 2 works too). Then, the Log-R and Allelic Imbalance Ratio of all possible copy number variants up to maxCn are estimated from - ## the Log-R and Allelic Imbalance Ratio of all the segments. This function will NOT be useful unless there is already a solid estimate - ## of 'shift' and 'delta'. See the previous function. +findCNs <- function(Log2,alf,allRegions,regs,name=thisSubdir(),maxCn=10,ceiling=1,sampleInfo=NULL) { + ## This function takes an estimate of the Log-R of copy numbers 1, 2 and 3. At least two of these should be entered. + ## Then, the Log-R and Allelic Imbalance Ratio of all possible copy number variants up to maxCn are estimated from + ## the Log-R and Allelic Imbalance Ratio of all the segments. + if (is.null(sampleInfo)) cat ('there was no estimation available for',name) - shift=sampleInfo$cn2 - delta=sampleInfo$delta + cns=1:maxCn; est=sampleInfo[1:3]; est[est==' ']=NA; est=as.numeric(est) + m <- lm(2^est ~ cns[1:3])$coefficients # can handle one NA in est. This model is for "ratio as a function of copy number". + est[is.na(est)] = log2(m[1]+cns[which(is.na(est))]*m[2]) # simple linear regression to fill the missing tix=NULL #temporary index + probes=NULL #number of probes at each copy number, for weighting int=NULL ## contains Log-R estimate of each (total) copy number ai=NULL ## contains Allelic Imbalance Ratio estimate of each copy number variant. regions <- allRegions$regions regions <- regions[(is.autosome(regions$Chromosome)®ions$lengthMB>1)&(!is.na(regions$imba)),] ## will use these regions - ## likely cn2 regions sit within delta/3 from shift. - expectedAt <- shift - tix$cn2 <- abs(regions$log2 - expectedAt) < (delta/3) ## index of likely cn2 regions + ## likely cn2 regions sit near the estimate. + expectedAt <- est[2] + tix$cn2 <- abs(regions$log2 - expectedAt) < diff(est)[2]/3 ## index of likely cn2 regions temp <- regions[tix$cn2,] ## cn2 regions med <- weightedMedian(temp$log2,temp$probes) ## improved value of Log-R at cn2 (returns NULL if theres nothing there) - int$cn2 <- ifelse(!is.null(med),med,expectedAt) ## saved to int. + probes[2] <- sum(temp$probes) + int[2] <- ifelse(!is.null(med),med,expectedAt) ## saved to int. - ## likely cn1 regions sit at about cn2 - delta: - d <- delta ## the (Log-R) distance to cn1 - expectedAt <- int$cn2-d ## cn1 is expected here - tix$cn1 <- abs(regions$log2 - expectedAt) < (d/3) ## index of likely cn1 regions + ## likely cn1 regions sit near estimate + expectedAt <- est[1] ## cn1 is expected here + tix$cn1 <- abs(regions$log2 - expectedAt) < diff(est)[1]/3 ## index of likely cn1 regions temp <- regions[tix$cn1,] med <- weightedMedian(temp$log2,temp$probes) - int$cn1 <- ifelse(!is.null(med),med,expectedAt) + probes[1] <- sum(temp$probes) + int[1] <- ifelse(!is.null(med),med,expectedAt) - ## likely cn0 regions sit below cn1 - delta: - d <- int$cn2-int$cn1 - expectedAt <- int$cn1-d - tix$cn0 <- regions$log2 < expectedAt - temp <- regions[tix$cn0,] - med <- weightedMedian(temp$log2,temp$probes) - int$cn0 <- ifelse(!is.null(med),med,expectedAt) - - ## likely cn3 regions sit at about cn2+delta*dmin (dmin is about 0.9, the factor by which the distance between consecutive copy numbers diminish) - d <- delta*dmin - expectedAt <- int$cn2+d - tix$cn3 <- abs(regions$log2 - expectedAt) < (d/3) + ## likely cn3 regions sit near estimate + expectedAt <- est[3] + tix$cn3 <- abs(regions$log2 - expectedAt) < diff(est)[2]/3 temp <- regions[tix$cn3,] med <- weightedMedian(temp$log2,temp$probes) - int$cn3 <- ifelse(!is.null(med),med,expectedAt) + probes[3] <- sum(temp$probes) + int[3] <- ifelse(!is.null(med),med,expectedAt) ## cn4 follows at ... - d <- dmin*(int$cn3-int$cn2) - expectedAt <- int$cn3+d - tix$cn4 <- abs(regions$log2 - expectedAt) < (d/4) + m <- lm(2^int[1:3] ~ cns[1:3], weights=probes[1:3])$coefficients ## use regression to estimate. + expectedAt <- log2(m[1]+4*m[2]) + tix$cn4 <- abs(regions$log2 - expectedAt) < mean(diff(int))/3 temp <- regions[tix$cn4,] med <- weightedMedian(temp$log2,temp$probes) - int$cn4 <- ifelse(!is.null(med),med,expectedAt) + probes[4] <- sum(temp$probes) + int[4] <- ifelse(!is.null(med),med,expectedAt) ## generalized for higher cns for (cn in 5:maxCn) { thisCn <- paste('cn',cn,sep='') prevCn <- paste('cn',cn-1,sep='') pprevCn <- paste('cn',cn-2,sep='') - d <- dmin*(int[prevCn][[1]]-int[pprevCn][[1]]) - expectedAt <- int[prevCn][[1]]+d - tix[[thisCn]] <- abs(regions$log2 - expectedAt) < (d/5) + m <- lm(2^int[1:(cn-1)] ~ cns[1:(cn-1)], weights=probes[1:(cn-1)])$coefficients + expectedAt <- log2(m[1]+cn*m[2]) + tix[[thisCn]] <- abs(regions$log2 - expectedAt) < mean(diff(int))/5 temp <- regions[tix[thisCn][[1]],] med <- weightedMedian(temp$log2,temp$probes) - int[thisCn] <- ifelse(!is.null(med),med,expectedAt) + probes[cn] <- sum(temp$probes) + int[cn] <- ifelse(!is.null(med),med,expectedAt) } + ## likely cn0 regions sit below cn1 - delta: + expectedAt <- log2(m[1]+0*m[2]) + tix$cn0 <- abs(regions$log2 - expectedAt) < 0.5*(int[2]-int[1]) + temp <- regions[tix$cn0,] + med <- weightedMedian(temp$log2,temp$probes) + int0 <- ifelse(!is.null(med),med,expectedAt) ## "int0" + + ## Estimate tumor dna content from intensity-cn relationship and average ploidy --UNRELIABLE + md <- lm(2^int ~ cns, weights=probes)$coefficients + m=NULL; m$intercept=md[1][[1]]; m$k=md[2][[1]] + probes[is.na(probes)]=0 + m$meanCn <- mean(rep(cns, probes), na.rm=T) + m$theoretical_delta=1/m$meanCn + #m$real_delta=0.57*m$theoretical_delta ## The 0.57 is empirical from cancer cell lines + #m$dnafrac=m$k/m$real_delta + #m$cellfrac=1/(1+m$meanCn/2*(1/m$dnafrac-1)) + + + + loh_exp <- as.numeric(sampleInfo[4]) ## at cn2, find the variant clusters (normal and CNNLOH) - ix <- (abs(regions$log2 - int$cn2) < 0.2*(int$cn3-int$cn2) ) # taking only closely-matching segments + ix <- (abs(regions$log2 - int[2]) < 0.2*(int[3]-int[2]) ) # taking only closely-matching segments data <- regions[ix,] data <- data[!is.na(data$imba),] # ...with a calculated allelic imbalance. - - ix <- (abs(regions$log2 - int$cn3) < 0.2*(int$cn4-int$cn3) ) - data3 <- regions[ix,] - data3 <- data[!is.na(data$imba),] - expectedAt <- 0.1 - ix <- data$imba3,] # long regions for safety ## try to find variants, starting with LOH # LOH such as 5(0) - m <- 0 + mi <- 0 thisVariant=paste(thisCn,'m',0,sep='') - c4m0 <- ai[paste(prevCn,'m',m,sep='')][[1]] # relative naming for clarity - c3m0 <- ai[paste(pprevCn,'m',m,sep='')][[1]] + c4m0 <- ai[paste(prevCn,'m',mi,sep='')][[1]] # relative naming for clarity + c3m0 <- ai[paste(pprevCn,'m',mi,sep='')][[1]] expectedAt <- ceiling-((ceiling-c4m0)*(ceiling-max(c4m0,c3m0))/(ceiling-min(c3m0,c4m0))) #ai[thisVariant] <- expectedAt @@ -792,44 +826,48 @@ ## then from balanced to less balanced minorVariants=trunc(cn/2):1 first <- T - for (m in minorVariants) { - thisVariant=paste(thisCn,'m',m,sep='') - if (m==cn/2) { + for (mi in minorVariants) { + thisVariant=paste(thisCn,'m',mi,sep='') + if (mi==cn/2) { # We have balanced variant, so rather easy. - expectedAt <- ai[paste(pprevCn,'m',m-1,sep='')][[1]] # this is a good approx, balanced at cn-2 - ix <- data$imba ai[paste(pprevCn,'m',m-1,sep='')][[1]]) ai[thisVariant] <- ai[paste(pprevCn,'m',m-1,sep='')][[1]] # don't let it sneak off.' + if (ai[thisVariant] > ai[paste(pprevCn,'m',mi-1,sep='')][[1]]) ai[thisVariant] <- ai[paste(pprevCn,'m',mi-1,sep='')][[1]] # don't let it sneak off.' first <- F } else if (first) { # its not balanced but its the most balanced of the unbalanced. something like 5(2) - expectedAt <- 0.5*( ai[paste(prevCn,'m',m,sep='')][[1]] + ai[paste(pprevCn,'m',m-1,sep='')][[1]] ) # that means between 4(2) and 3(1) - ix <- abs(data$imba-expectedAt) < ( ai[paste(prevCn,'m',m,sep='')][[1]] - ai[paste(pprevCn,'m',m-1,sep='')][[1]] ) /3 # let all "between" 4(2) and 3(1) in + expectedAt <- 0.5*( ai[paste(prevCn,'m',mi,sep='')][[1]] + ai[paste(pprevCn,'m',mi-1,sep='')][[1]] ) # that means between 4(2) and 3(1) + ix <- abs(data$imba-expectedAt) < ( ai[paste(prevCn,'m',mi,sep='')][[1]] - ai[paste(pprevCn,'m',mi-1,sep='')][[1]] ) /3 # let all "between" 4(2) and 3(1) in med <- weightedMedian(data$imba[ix],data$snps[ix]) ai[thisVariant] <- ifelse (!is.null(med),med,expectedAt) first <- F } else { # not the most balanced unbalanced variant, for example 5(1): expectedAt <- ai[paste(thisCn,'m',minorVariants[1],sep='')][[1]] + - (minorVariants[1]-m) * (ai[paste(thisCn,'m',0,sep='')][[1]] - ai[paste(thisCn,'m',minorVariants[1],sep='')][[1]]) / trunc(cn/2) # 5(2) + (which)* 5(0)-5(2) /(n) - ix <- abs(data$imba-expectedAt) < ( ai[paste(prevCn,'m',m,sep='')][[1]] - ai[paste(pprevCn,'m',m-1,sep='')][[1]] ) /3 # let all "between" 4(1) and 3(0) in + (minorVariants[1]-mi) * (ai[paste(thisCn,'m',0,sep='')][[1]] - + ai[paste(thisCn,'m',minorVariants[1],sep='')][[1]]) / trunc(cn/2) # 5(2) + (which)* 5(0)-5(2) /(n) + ix <- abs(data$imba-expectedAt) < ( ai[paste(prevCn,'m',mi,sep='')][[1]] - ai[paste(pprevCn,'m',mi-1,sep='')][[1]] ) /3 # let all "between" 4(1) and 3(0) in med <- weightedMedian(data$imba[ix],data$snps[ix]) ai[thisVariant] <- ifelse (!is.null(med),med,expectedAt) } } # done with minor variants } # done with copy numbers - - return(list('int'=int,'ai'=ai)) + int=as.list(c(int0,int)); names(int)=paste('cn',0:maxCn,sep='') + return(list('int'=int,'ai'=ai,'model'=m)) } + + + ### -setCNs <- function(allRegions,int,ai,maxCn=12) { +setCNs <- function(allRegions,int,ai,model,maxCn=12) { ## Assign total and minor copy numbers to all segments. regions <- allRegions$regions[,-4] ## This time, work on all segments available. Cn <- NULL ## Total copy number mCn <- NULL ## Minor allele copy number - fullCN <- NULL ## Variant label. ('cnXmY') + Cnx <- NULL ## Variant label. ('cnXmY') intDist <- NULL ## distance to certain Log-R imbaDist <- NULL ## distance to certain allelic imbalance @@ -839,48 +877,58 @@ # set total copy number distance <- Inf for (cn in 0:maxCn) { - t_int <- int[paste('cn',cn,sep='')][[1]] ## get Log-R of particular cn from 'int' + t_int <- int[[paste('cn',cn,sep='')]] ## get Log-R of particular cn from 'int' t_dis <- abs(regions$log2[i]-t_int) ## distance to that particular cn if (t_dis < distance) { ## nearest so far, save. distance <- t_dis -> intDist[i] Cn[i] <- cn } } - - # Y makes CN0 sit very low, this is a fix on non-Y Cn0 - #if ((Cn[i] == 1)&(intDist[i] > (int$cn2-int$cn1))) Cn[i] <- 0 ## currently not needed. - + } + + ### Calculate model based Cns + Cnx=Cn; for (cn in 0:maxCn) { + Cnx[Cn==cn]=cn + (2^regions$log2[Cn==cn]-2^int[[paste('cn',cn,sep='')]])/model$k + }; Cnx[Cnx<0]=0 + Cn=round(Cnx) + + ## Set minor CN + for (i in 1:nrow(regions)) { # set minor CN distance <- Inf if (Cn[i]<=1) { mCn[i] <- 0 - } else if (!is.na(regions$imba[i])) for (m in 0:trunc(Cn[i]/2)) { + } else if (Cn[i]<=maxCn & !is.na(regions$imba[i])) for (m in 0:trunc(Cn[i]/2)) { t_ai <- ai[paste('cn',Cn[i],'m',m,sep='')][[1]] t_dis <- abs(regions$imba[i]-t_ai) [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/patchwork -r 189 From noreply at r-forge.r-project.org Mon Sep 23 13:57:34 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 23 Sep 2013 13:57:34 +0200 (CEST) Subject: [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 Message-ID: <20130923115734.DCCF518536B@r-forge.r-project.org> 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 1378894727 +0200 pull : Fast-forward 884409fb1057881cbdbd2db1c86c85d72bf477c6 7375bc63263a290cbfb537af8c38af2df6ba0f0c Sebastian DiLorenzo 1378902806 +0200 pull : Fast-forward 7375bc63263a290cbfb537af8c38af2df6ba0f0c 6f560c07eeb2bc5a9c449af56829257933ebcf87 Sebastian DiLorenzo 1378903472 +0200 pull : Fast-forward +6f560c07eeb2bc5a9c449af56829257933ebcf87 bd3ab614a6966fa50066cad8cf9682e0a728ea4a Sebastian DiLorenzo 1378904905 +0200 commit: update taps remove header from merge +bd3ab614a6966fa50066cad8cf9682e0a728ea4a 4a0e2921f140974e7c8a12fd8fddb998c0bd3171 Sebastian DiLorenzo 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 1378894727 +0200 pull : Fast-forward 884409fb1057881cbdbd2db1c86c85d72bf477c6 7375bc63263a290cbfb537af8c38af2df6ba0f0c Sebastian DiLorenzo 1378902806 +0200 pull : Fast-forward 7375bc63263a290cbfb537af8c38af2df6ba0f0c 6f560c07eeb2bc5a9c449af56829257933ebcf87 Sebastian DiLorenzo 1378903472 +0200 pull : Fast-forward +6f560c07eeb2bc5a9c449af56829257933ebcf87 bd3ab614a6966fa50066cad8cf9682e0a728ea4a Sebastian DiLorenzo 1378904905 +0200 commit: update taps remove header from merge +bd3ab614a6966fa50066cad8cf9682e0a728ea4a 4a0e2921f140974e7c8a12fd8fddb998c0bd3171 Sebastian DiLorenzo 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 1378894674 +0200 fetch: fast-forward 884409fb1057881cbdbd2db1c86c85d72bf477c6 7375bc63263a290cbfb537af8c38af2df6ba0f0c Sebastian DiLorenzo 1378902806 +0200 pull : fast-forward 7375bc63263a290cbfb537af8c38af2df6ba0f0c 6f560c07eeb2bc5a9c449af56829257933ebcf87 Sebastian DiLorenzo 1378903403 +0200 pull : fast-forward +6f560c07eeb2bc5a9c449af56829257933ebcf87 bd3ab614a6966fa50066cad8cf9682e0a728ea4a Sebastian DiLorenzo 1378904932 +0200 update by push +bd3ab614a6966fa50066cad8cf9682e0a728ea4a 4a0e2921f140974e7c8a12fd8fddb998c0bd3171 Sebastian DiLorenzo 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 From noreply at r-forge.r-project.org Tue Sep 24 14:51:34 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 24 Sep 2013 14:51:34 +0200 (CEST) Subject: [Patchwork-commits] r191 - pkg/TAPS/R Message-ID: <20130924125134.A1B1A185D9C@r-forge.r-project.org> Author: sebastian_d Date: 2013-09-24 14:51:34 +0200 (Tue, 24 Sep 2013) New Revision: 191 Modified: pkg/TAPS/R/TAPS.r Log: update to datasamples.xlsx handling for different drive modes Modified: pkg/TAPS/R/TAPS.r =================================================================== --- pkg/TAPS/R/TAPS.r 2013-09-23 11:57:32 UTC (rev 190) +++ pkg/TAPS/R/TAPS.r 2013-09-24 12:51:34 UTC (rev 191) @@ -46,6 +46,7 @@ setwd(directory) subs <- getSubdirs() subs=subs[subs!='frequencies' & subs!='frequencies_comp'] + subsToSampleData=NULL if (is.null(subs)) { ## check samples = subdirectories or a single sample = current directory subs=thisSubdir() setwd('..') @@ -54,7 +55,14 @@ # create SampleData file if there is none. if (length(grep('SampleData.xlsx',dir()))==0) { - sampleData <- data.frame(Sample=subsToSampleData,cn1= -0.5, cn2=0, cn3=NA, loh=0.7, MAPD=NA, MHOF=NA) + if(!is.null(subsToSampleData)) + { + sampleData <- data.frame(Sample=subsToSampleData,cn1= -0.5, cn2=0, cn3=NA, loh=0.7, MAPD=NA, MHOF=NA) + } + else + { + sampleData <- data.frame(Sample=subs,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) From noreply at r-forge.r-project.org Tue Sep 24 15:05:47 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 24 Sep 2013 15:05:47 +0200 (CEST) Subject: [Patchwork-commits] r192 - pkg/TAPS/R Message-ID: <20130924130547.F3A50185EAA@r-forge.r-project.org> Author: sebastian_d Date: 2013-09-24 15:05:47 +0200 (Tue, 24 Sep 2013) New Revision: 192 Modified: pkg/TAPS/R/TAPS.r Log: Change to compare groups Modified: pkg/TAPS/R/TAPS.r =================================================================== --- pkg/TAPS/R/TAPS.r 2013-09-24 12:51:34 UTC (rev 191) +++ pkg/TAPS/R/TAPS.r 2013-09-24 13:05:47 UTC (rev 192) @@ -1601,6 +1601,9 @@ p_cutoff <- 0.05 freq_cutoff <- 0 + difcolor <- color + color <- colorRampPalette(c("#FFFFFF",color),space="rgb")(4)[2] + # Generate frequency plots pile1 <- pileup(regs1); pile1$Percent <- 100*pile1$Count / n1 pile2 <- pileup(regs2); pile2$Percent <- 100*pile2$Count / n2 @@ -1661,7 +1664,7 @@ data$e <- data$e+data$End data <- data[order(data$percent,decreasing=T),] - difcolor <- colorRampPalette(c("#FFFFFF",color),space="rgb")(4)[2] + #difcolor <- colorRampPalette(c("#FFFFFF",color),space="rgb")(4)[2] rect( xleft=data$s, xright=data$e, From noreply at r-forge.r-project.org Tue Sep 24 17:25:34 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 24 Sep 2013 17:25:34 +0200 (CEST) Subject: [Patchwork-commits] r193 - in pkg/patchwork: R man Message-ID: <20130924152534.90B9C18517C@r-forge.r-project.org> Author: sebastian_d Date: 2013-09-24 17:25:34 +0200 (Tue, 24 Sep 2013) New Revision: 193 Added: pkg/patchwork/R/patchwork.region.r pkg/patchwork/R/sysdata.rda pkg/patchwork/man/patchwork.region.Rd Log: added patchwork.region files to repository Added: pkg/patchwork/R/patchwork.region.r =================================================================== --- pkg/patchwork/R/patchwork.region.r (rev 0) +++ pkg/patchwork/R/patchwork.region.r 2013-09-24 15:25:34 UTC (rev 193) @@ -0,0 +1,578 @@ +#------------------------------------------------------------------------------------------------------ +#------------------------------------------------------------------------------------------------------ +#patchwork.region() ; a function for zooming in on a specific region and showing the regions genes. +#------------------------------------------------------------------------------------------------------ +#------------------------------------------------------------------------------------------------------ + + +patchwork.region <- function(CNfile=NULL,chr,region,hg18=F) +{ + if (is.null(CNfile)) + { + CNfile = list.files(pattern="*_copynumbers.Rdata") + if (length(CNfile)==0) + { + #cat("Could not find _copynumbers.Rdata in current working directory. Try again and supply patchwork.regions with the CNfile parameter.") + stop("Could not find _copynumbers.Rdata in current working directory. Try again and supply patchwork.regions with the CNfile parameter.") + } + if(length(CNfile)>1) + { + #cat("There seems to be more than one _copynumbers.Rdata file in the current working directory. Try again and supply patchwork.regions with the CNfile parameter.") + stop("There seems to be more than one _copynumbers.Rdata file in the current working directory. Try again and supply patchwork.regions with the CNfile parameter.") + } + } + + #Load _copynumbers.Rdata giving us segs,alf and kbsegs + load(CNfile) + + # #Set working directory and make that directorys name the samplename. If it is too long, shorten it. + # setwd(directory) + # subs <- getSubdirs() + # if (is.null(subs)) + # { ## check samples = subdirectories or a single sample = current directory + # subs=thisSubdir() + # setwd('..') + # } + + #store chr value in nchr because i made the newbie mistake of having a second variable also + #named chr. + nchr = chr + + #get sample name + tmp_name <- strsplit(CNfile,split="_") + name=tmp_name[[1]][1] + + #if sample name is too long, shorten it to 12 characters + if(nchar(name)>12) + { + name = substring(name,1,12) + } + + #If nchr has been given as character + if(is.character(nchr) == T) + { + #If chr is longer than 2 characters ("chr1" but not "12") + #take out the number and convert it to numeric + if(nchar(nchr)>2) + { + c = strsplit(nchr,"chr") + c = as.numeric(c[[1]][2]) + } + #chr has been given as character but without "chr" infront. Convert to numeric. + else + { + c = as.numeric(nchr) + } + } + #else chr has been given as a numeric and can be used directly. + else + { + c = nchr + } + + #Rename parameters of _copynumbers so we can re-use other plots as template. + chr = as.character(segs$chr) + start = segs$start + end = segs$end + int = segs$median + ai = segs$ai + mchr = as.character(kbsegs$chr) + mpos = kbsegs$pos + mval = kbsegs$ratio + schr = as.character(alf$achr) + spos = alf$apos + sval = (1-alf$amin/alf$amax) + xlim=c(0,2.5) + ylim=c(0,1) + + #check if hg18 is true + #then load hg18 knownGene list + if(hg18==T) + { + kg = knownGene_hg18 + } + else + { + kg = knownGene + } + + + # + #Here is where pretty normal plotting procedure starts + # + + #Get ideogram #In sysdata.rda + #ideogram=getIdeogram() + + #Set color gradient for p and q arm of chromosome + colors_p <- colorRampPalette(c("#6600FF","#9900CC"),space="rgb") + colors_q <- colorRampPalette(c("#CC0099","#CC0000"),space="rgb") + + #filter the data (remove NA) and set some standard parameters + ai[is.na(ai)]=0 + aix=ai!=0 + chr=chr[aix] + start=start[aix] + end=end[aix] + int=int[aix] + ai=ai[aix] + pos <- (start+end)/2 + length=end-start + + size=rep(0.5,length(chr)) + size[length>2000000]=1 + size[length>5000000]=1.5 + size[length>10000000]=2 + + #Select the chromosome + this <- ideogram[ideogram$c==c,] + + #Extract regions start an stop + #region inputted in form start:stop + Rstart = min(region) + Rend = max(region) + + #Initialize jpeg + jpeg(paste(name,'_',this$chr,'_region_',Rstart,"-",Rend,'.jpg',sep=''),width=11.7,height=8.3,units="in",res=300) + + #split plot into desired formation + split.screen(as.matrix(data.frame(left=c(rep(0.05,4),rep(0.47,3)), + right=c(0.45,rep(1,6)), + bottom=c(0.50,0.05,0.2,0.3,0.50,0.70,0.75), + top = c(0.95,0.2,0.3,0.45,0.70,0.75,0.95)))) #screen 1-5 + + + #Screen configuration overview + #------------------------------------------------------------- + #------------------------------------------------------------- + # | | + # | 7 | + # | | + # |------------------------------| + # 1 | 6 | + # |------------------------------| + # | | + # | 5 | + # | | + #-----------------------------|------------------------------| + # | + # 4 | + #------------------------------------------------------------| + # 3 | + #------------------------------------------------------------| + # | + # 2 | + #------------------------------------------------------------- + + + #------------------------------------------------------------ + #Left side of the plot (Whole genome) + #------------------------------------------------------------ + + #index of overlapping the selected chromosome region to the chr object + wix <- chr==as.character(this$chr) & (((Rstart <= start) & (Rend >= end)) | ((Rstart >= start) & (Rstart <= end)) | ((Rend <= end) & (Rend >= start))) + ix <- chr==as.character(this$chr) + + #Create an index of colors relating to the positions and lengths on this chromosome + col <- rep('#B0B0B030',length(chr)) + col[wix & (pos < this$mid)] <- paste(colors_p(sum(wix & (pos < this$mid))), '70', sep='') + col[wix & (pos > this$mid)] <- paste(colors_q(sum(wix & (pos > this$mid))), '70', sep='') + + #Go to screen 1 + screen(1) + + #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)) + par(mgp =c(0.5,0.25,0)) + + #Whole genome overview plot + #Note that we are plotting chrY in the background, despite the fact that it is not an "active" chromosome. + plot(c(int[!wix],int[wix]),c(ai[!wix],ai[wix]), + pch=16, + cex=c(size[!wix],size[wix]), + main = "", + xlab = "", + ylab = "", + axes=F, #Remove axis + col = c(col[!wix],col[wix]), + xlim = xlim, + ylim = ylim) + + #Insert Y and X axis + axis(side=2,cex.axis=0.6,tck=0.963,col.ticks='#808080',at=seq(from=0,to=1,by=0.2),las=1) + axis(side=1,cex.axis=0.6,tck=0.963,col.ticks='#808080',at=seq(from=0,to=2.5,by=0.1)) + + #Titles,date/time and axis labels + mtext(text="Normalized coverage",side=1,line=1.1,cex=1) + mtext(text="Allelic imbalance",side=2,line=1.5,cex=1) + mtext(paste("Detailed view of sample: ",name,"\n Chromosome ",c,", Region: ",Rstart,"-",Rend,sep=""),side=3) + + #------------------------------------------------------------ + #Top Right - Signal + #------------------------------------------------------------ + + #Go to screen 7 + screen(7) + + #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)) + par(mgp =c(0.5,0,0)) + par(xpd=T) + + #Select the correct chromosome and remove stuff lower than -1 + mix <- mchr==as.character(this$chr) #& mval>(-1) + + #Create an index of colors relating to the positions and lengths on this chromosome + col=rep('#000000',sum(ix)) + col[pos[ix] < this$mid] <- colors_p(sum(pos[ix] < this$mid)) + col[pos[ix] > this$mid] <- colors_q(sum(pos[ix] > this$mid)) + + #Predefine ymin ymax and sequence between them + # ymin=floor(min(int[ix]))-0.5 + # if(ymin > -1) + # { + # ymin = -1 + # } + # ymax=ceiling(max(int[ix]))+0.5 + # if(ymax < 1) + # { + # ymax = 1 + # } + ymin=0 + ymax=2.5 + seqminmax=seq(ymin,ymax,by=0.5) + + #Plot coverage over position + plot(mpos[mix],mval[mix], + pch=20, + cex=0.5, + main = "", + xlab = "", + ylab = "", + axes=F, + col = '#00000005', + xlim = c(0,this$length), + ylim = c(ymin,ymax)) + + #Add legend for red region + mtext(text=expression(bold("Selected region")),side=3,col='#E8000070',cex=0.8,adj=0.05) + + #Add colored segments based on the log-ratio data + segments(x0=start[ix],x1=end[ix], + y0=int[ix],y1=int[ix], + col=col, + lwd=4) + + #Add a rectangle showing which region has been chosen + rect(xleft=Rstart,xright=Rend,ybottom=ymin,ytop=ymax,col='#E8000040',lty=0) + + #Add X and Y axis. The (side=4) axis is just a black line showing where the data ends + axis(side=2,tck=0.926,col.ticks='#808080', + #Set axis + #at=seq(from=-1,to=1.5,by=0.5), + #labels=c("-1","-.5","0",".5","1","1.5"), + #Dynamic axis + at=seqminmax, + #labels=paste(seqminmax,'',sep=''), + cex.axis=0.6,pos=0,hadj=1.3,las=1) + + axis(side=4,labels=F,tck=0,pos=this$length, + at=seqminmax) + + axis(side=1,tck=0.926,col.ticks='#808080',at=seq(5e6,this$length,by=5e6), + labels=FALSE,cex.axis=0.6,pos=ymin) + + #Add Y axis label & date/time + mtext("Norm. coverage",side=2,line=0.3) + mtext(format(Sys.time(),"%Y-%m-%d %H:%M"),side=3,cex=0.6,adj=0.95) + + #------------------------------------------------------------ + #Middle Right - Cytobands + #------------------------------------------------------------ + + #Go to screen 6 + screen(6) + + #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)) + par(mgp =c(0.5,0,0)) + + + #Create a empty plot with the same ylim and xlim as the plot directly above it (signal) and below (AI) + plot(0,0,xlab="",ylab="",main="",type="n",axes=F,xaxt="n",ylim=c(0,0.3),xlim=c(0,max(mpos[mix]))) + + #Add Y axis label + mtext(text="Cytoband",side=2,las=1,line=-1,cex=0.8) + + #index of the chromData for this chromosome + dix = chromData$chr == as.character(this$chr) + + #Add cytoband information as differently colored rectangles + rect(xleft=chromData$chromStart[dix],xright=chromData$chromEnd[dix], + #ybottom=0.15-chromData$thickness[dix]*0.03,ytop=0.15+chromData$thickness[dix]*0.03, + ybottom=0,ytop=0.3, + col=paste(chromData$col[dix],'99',sep=''), + lty=0) + + #Add a rectangle showing which region has been chosen + rect(xleft=Rstart,xright=Rend,ybottom=0,ytop=0.3,col='#E8000040',lty=0) + + #Att text annotation to cytobands + for(j in 1:length(chromData$name[dix])) + { + #If the cytoband region is larger than 5 Mb, it can fit some text + if((chromData$chromEnd[dix][j] - chromData$chromStart[dix][j]) > 4*10^6) + { + # Text is added at x position (all of previous chromosome) + (middle of region) + # The "srt" flips the text 90 degrees + text(x=(chromData$chromStart[dix][j]+((chromData$chromEnd[dix][j]-chromData$chromStart[dix][j])/2)), + y=0.15,labels=chromData$name[dix][j], srt=90,cex = 0.5,xpd=T) + } + } + + #------------------------------------------------------------ + #Bottom Right - Allelic imbalance + #------------------------------------------------------------ + + #Go to screen 5 + screen(5) + + #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)) + par(mgp =c(0.5,0,0)) + + + #Index of correct chromsome and allele frequency not in either 0 or 1 + six <- schr==as.character(this$chr) & !(sval %in% c(0,1)) + + #plot allele frequency over position + plot(spos[six],sval[six], + pch=20, + cex=0.5, + main = "", + xlab = "", + ylab = "", + #yaxt="n", + axes=F, + col = '#00000010', + xlim = c(0,this$length), + ylim = c(0,1)) + + #Add X and Y axis as well as a line to the rightmost of the data (side=4) + 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) + + #Add a rectangle showing which region has been chosen + rect(xleft=Rstart,xright=Rend,ybottom=0,ytop=1,col='#E8000040',lty=0) + + #Add X and Y label + mtext("Allelic imbalance",side=2,line=0.3) + mtext("Position (Mb)",side=1,line=1) + + #------------------------------------------------------------ + #Top Bottom - Detailed region coverage view + #------------------------------------------------------------ + + #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)) + par(mgp =c(0.5,0,0)) + + + #Select the correct chromosome and region and remove stuff lower than -1 + mix <- mchr==as.character(this$chr) & (mpos >= Rstart) & (mpos <= Rend) #& mval>(-1) + + wix <- chr==as.character(this$chr) & (((Rstart <= start) & (Rend >= end)) | ((Rstart >= start) & (Rstart <= end)) | ((Rend <= end) & (Rend >= start))) + + cix = ((Rstart >= start) & (Rstart <= end)) + start[cix] = Rstart + cix = ((Rend <= end) & (Rend >= start)) + end[cix] = Rend + + #Predefine ymin ymax and sequence between them + ymin=0 + ymax=2.5 + seqminmax=seq(ymin,ymax,by=0.5) + + #Plot log-ratio over position + plot(mpos[mix],mval[mix], + pch=20, + cex=0.5, + main = "", + xlab = "", + ylab = "", + axes=F, + col = '#00000040', + xlim = c(Rstart,Rend), + ylim = c(ymin,ymax))#c(round(min(mval[mix]),digits=1),round(max(mval[mix]),digits=1)))#c(-1,1.5)) + + #Create an index of colors relating to the positions and lengths on this chromosome + col=rep('#000000',sum(wix)) + col[pos[wix] < this$mid] <- colors_p(sum(pos[wix] < this$mid)) + col[pos[wix] > this$mid] <- colors_q(sum(pos[wix] > this$mid)) + + #Add colored segments based on the log-ratio data + segments(x0=start[wix],x1=end[wix], + y0=int[wix],y1=int[wix], + col=col, + lwd=4) + + #Add X and Y axis. The (side=4) axis is just a black line showing where the data ends + axis(side=2,tck=0.926,col.ticks='#808080', + #Set axis + #at=seq(from=-1,to=1.5,by=0.5), + #labels=c("-1","-.5","0",".5","1","1.5") + #Dynamic axis + at=seqminmax, + #labels=paste(seqminmax,'',sep=''), + ,cex.axis=0.6,pos=Rstart,hadj=1.3,las=1) + + axis(side=4,labels=F,tck=0,pos=Rend) + #axis(side=1,tck=0.926,col.ticks='#808080',cex.axis=0.6,pos=-1) + + #Add X Y axis label + mtext("Norm. coverage",side=2,line=-0.8) + #mtext("Position (Mb)",side=1,line=1) + + #------------------------------------------------------------ + #Middle Bottom - Region Gene view + #------------------------------------------------------------ + + #Go to screen 3 + screen(3) + + #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)) + par(mgp =c(0.5,0.25,0)) + + #par(xpd=T) + + #Create a empty plot with the same ylim and xlim as the plot directly above it (signal) and below (AI) + plot(0,0,xlab="",ylab="",main="",type="n",axes=F,xaxt="n",ylim=c(0,0.48),xlim=c(Rstart,Rend)) + + kg=kg[order(kg$chr,kg$gtxEnd),] + + #Create and index of the genes within region (rstart to rend) + #gix <- kg$chr==this$chr & (((Rstart <= kg$gtxStart) & (Rend >= kg$gtxEnd)) | ((Rstart >= kg$gtxStart) & (Rstart <= kg$gtxEnd)) | ((Rend <= kg$gtxEnd) & (Rend >= kg$gtxStart))) + gix <- kg$chr==as.character(this$chr) & ((Rstart <= kg$gtxEnd) & (Rend >= kg$gtxStart)) + + #If they are only partial overlapping, remove the parts outside of the selected region + cix = ((Rstart >= kg$gtxStart) & (Rstart <= kg$gtxEnd)) + kg$gtxStart[cix] = Rstart + cix = ((Rend <= kg$gtxEnd) & (Rend >= kg$gtxStart)) + kg$gtxEnd[cix] = Rend + + # #Check if any genes are overlapping so they are shown on top of or below eachother + d1 = c(rep(0.42,length(which(gix)))) + d2 = c(rep(0.36,length(which(gix)))) + j = 1 + + for(i in min(which(gix)):max(which(gix))) + { + #if this gene overlaps with the gene infront of it + if(kg$gtxEnd[i] >= kg$gtxStart[i+1]) + { + d1[j+1] = d1[j]-0.06 + d2[j+1] = d2[j]-0.06 + } + j = j + 1 + } + + #Add the genes to plot as horizontal rectangles that cover the transcribed region + rect(xleft=kg$gtxStart[gix],xright=kg$gtxEnd[gix], + #Between 0 - 0.3 + ybottom=d2,ytop=d1, + col=rgb(kg$R[gix],kg$G[gix],kg$B[gix],maxColorValue=255),lty=1) + + #Add legend + # + text(x=Rstart+(6.2*(Rend-Rstart)/10),y=0.46,labels=expression(bold("Feature in PDB")),col=rgb(0,0,0,maxColorValue=255),cex=0.6) + text(x=Rstart+(7.6*(Rend-Rstart)/10),y=0.46,labels=expression(bold("RefSeq,Swissprot or CCDS validated")),col=rgb(12,12,120,maxColorValue=255),cex=0.6) + text(x=Rstart+(9*(Rend-Rstart)/10),y=0.46,labels=expression(bold("Other RefSeq")),col=rgb(80,80,160,maxColorValue=255),cex=0.6) + text(x=Rstart+(9.8*(Rend-Rstart)/10),y=0.46,labels=expression(bold("non-RefSeq")),col=rgb(130,130,210,maxColorValue=255),cex=0.6) + + #Add Y label + mtext("Known genes",side=2,line=-1.8,,cex=0.9,las=1) + + #legend(c(Rstart,-1),legend=c("Black","Dark blue","Medium blue","Light blue"),cex=0.4,xpd=T, + # col=c(rgb(130,130,210,maxColorValue=255), + # rgb(12,12,120,maxColorValue=255), + # rgb(0,0,0,maxColorValue=255), + # rgb(80,80,160,maxColorValue=255))) + + for(i in 1:length(kg$gAlias[gix])) + { + text(x=(kg$gtxStart[gix][i]+((kg$gtxEnd[gix][i]-kg$gtxStart[gix][i])/2)), + #This places the gAlias text at same hight level as the transcribed region rectangle. + #y=((d1[i]+d2[i])/2), + #This places the gAlias text at the bottom + y=0.08, + labels=kg$gAlias[gix][i], + #This makes the text vertical + srt=90, + cex = 0.4,xpd=T) + } + + + + #------------------------------------------------------------ + #Bottom Bottom - Detailed region allele frequency view + #------------------------------------------------------------ + + #Go to screen 2 + screen(2) + + #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)) + par(mgp =c(0.5,0.25,0)) + + + #Index of correct chromsome and allele frequency not in either 0 or 1 + six <- schr==as.character(this$chr) & !(sval %in% c(0,1)) & (spos >= Rstart) & (spos <= Rend) + + #plot allele frequency over position + plot(spos[six],sval[six], + pch=20, + cex=0.5, + main = "", + xlab = "", + ylab = "", + #yaxt="n", + axes=F, + col = '#00000040', + xlim = c(Rstart,Rend), + ylim = c(0,1)) + + #Add X and Y axis as well as a line to the rightmost of the data (side=4) + 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) + axis(side=1,cex.axis=0.6) + + #Add X and Y label + mtext("Allelic imbalance",side=2,line=-0.8) + mtext("Position (Mb)",side=1,line=1) + + + #Close all the opened split.screens and release the figure + close.screen(all.screens=T) + dev.off() +} + + + + + + Added: pkg/patchwork/R/sysdata.rda =================================================================== (Binary files differ) Property changes on: pkg/patchwork/R/sysdata.rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/patchwork/man/patchwork.region.Rd =================================================================== --- pkg/patchwork/man/patchwork.region.Rd (rev 0) +++ pkg/patchwork/man/patchwork.region.Rd 2013-09-24 15:25:34 UTC (rev 193) @@ -0,0 +1,115 @@ +\name{patchwork.region} +\alias{Patchwork.Region} +\alias{region} +\alias{patchwork.region} + + +\title{ +Detailed view of a selected regions of the genome. +} + +\description{ +Visualises a selected regions on a selected chromosome for closer inspection. Also shows known genes for selected region. +} + +\usage{ +patchwork.region(CNfile=NULL,chr,region,hg18=F) +} + +\arguments{ + \item{CNfile}{ + The _copnumbers.Rdata file generated from patchwork.plot(). If kept at default, NULL, the current working directory will be searched for it. + } + \item{chr}{ + Which chromosome you wish to view a region of. ex chr="1" + } + \item{region}{ + The region in chromosomal coordinates you wish to view. ex region=1000000:6000000 + } + \item{hg18}{ + Gene list for hg19 aligned genome is default. Set hg18=T to use hg18 gene list. + } +} + +\details{ +Walkthrough of the plot: + +\bold{TOP LEFT} \cr +Vertical axis: Allelic imbalance \cr +Horizontal axis: Normalized coverage \cr + +The selected regions segments in color, plotted agains the whole genome background in grey. + +\bold{TOP RIGHT - TOP} \cr +Vertical axis: Normalized coverage \cr +Horizontal axis: Position (Mb) \cr + +Normalized coverage of chromosome with selected region highlighted in a transparent red bar. + +\bold{TOP RIGHT - MIDDLE} \cr +Horizontal axis: Position (Mb) \cr + +Cytoband information for chromosome with selected region highlighted in a transparent red bar. + +\bold{TOP RIGHT - BOTTOM} \cr +Vertical axis: Allelic imbalance \cr +Horizontal axis: Position (Mb) \cr + +Allelic imbalance of chromosome with selected region highlighted in a transparent red bar. + +\bold{BOTTOM - TOP} \cr +Vertical axis: Normalized coverage \cr +Horizontal axis: Position (Mb) \cr + +Normalized coverage of the selected region. + +\bold{BOTTOM - MIDDLE} \cr +Horizontal axis: Position (Mb) \cr + +Known gene positions which are in the selected region. + +\bold{BOTTOM - BOTTOM} \cr +Vertical axis: Allelic imbalance \cr +Horizontal axis: Position (Mb) \cr + +Allelic imbalance of the selected region. + +} + +%\value{ +%% ~Describe the value returned +%% If it is a LIST, use +%% \item{comp1 }{Description of 'comp1'} +%% \item{comp2 }{Description of 'comp2'} +%% ... +%} + +%\references{ +%% ~put references to the literature/web site here ~ +%} + +\author{ +Markus Mayrhofer, \email{markus.mayrhofer at medsci.uu.se} +Sebastian DiLorenzo, \email{sebastian.dilorenzo at medsci.uu.se} +} +%\note{ +%% ~~further notes~~ +%} + +%% ~Make other sections like Warning with \section{Warning }{....} ~ + +% \seealso{ +% \code{\link{patchwork.copynumbers}} +% } + +%\examples{ +%##---- Should be DIRECTLY executable !! ---- +%##-- ==> Define data, use random, +%##-- or do help(data=index) for the standard data sets. +%Run examples of karyotype stuff. or not, maybe just point back to patchwork.plot. +%} + +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +%\keyword{ ~kwd1 } +%\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line \ No newline at end of file