[Patchwork-commits] r121 - in pkg: patchwork/R patchworkCG patchworkCG/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Apr 17 13:52:59 CEST 2012
Author: sebastian_d
Date: 2012-04-17 13:52:59 +0200 (Tue, 17 Apr 2012)
New Revision: 121
Modified:
pkg/patchwork/R/patchwork.plot.r
pkg/patchwork/R/zzz.R
pkg/patchworkCG/DESCRIPTION
pkg/patchworkCG/R/patchwork.CG.copynumbers.r
pkg/patchworkCG/R/patchwork.CG.plot.r
pkg/patchworkCG/R/zzz.R
Log:
Updating packages with new onload messages and an updated segmentation/AI procedure for patchworkCG
Modified: pkg/patchwork/R/patchwork.plot.r
===================================================================
--- pkg/patchwork/R/patchwork.plot.r 2012-04-17 08:00:34 UTC (rev 120)
+++ pkg/patchwork/R/patchwork.plot.r 2012-04-17 11:52:59 UTC (rev 121)
@@ -1,6 +1,6 @@
patchwork.plot <- function(BamFile,Pileup,reference=NULL,normal.bam=NULL,normal.pileup=NULL,Alpha=0.0001,SD=1)
{
-
+
#Attempt to read file pile.alleles, incase its already been created.
alf <- normalalf <- NULL
try( load("pile.alleles.Rdata"), silent=TRUE )
Modified: pkg/patchwork/R/zzz.R
===================================================================
--- pkg/patchwork/R/zzz.R 2012-04-17 08:00:34 UTC (rev 120)
+++ pkg/patchwork/R/zzz.R 2012-04-17 11:52:59 UTC (rev 121)
@@ -1,8 +1,12 @@
.onLoad <- function(...){
#supressMessages(library(DNAcopy))
- packageStartupMessage(
- "Patchwork loaded. \n
- If this is your first time, please see the documentation in the README file at the default\n
- installation location, the homepage (http://patchwork.r-forge.r-project.org/) or ?patchwork.\n"
- )
+ packageStartupMessage("(Above is just the startup message of DNAcopy.)")
+ packageStartupMessage("\n")
+ packageStartupMessage("Welcome to patchwork.")
+ packageStartupMessage("\n")
+ packageStartupMessage("Version: ",utils::packageDescription('patchwork')$Version)
+ packageStartupMessage("\n")
+ packageStartupMessage("If this is your first time, please see the documentation in")
+ packageStartupMessage("the README file at the default installation location, the")
+ packageStartupMessage("homepage (http://patchwork.r-forge.r-project.org/) or ?patchwork")
}
Modified: pkg/patchworkCG/DESCRIPTION
===================================================================
--- pkg/patchworkCG/DESCRIPTION 2012-04-17 08:00:34 UTC (rev 120)
+++ pkg/patchworkCG/DESCRIPTION 2012-04-17 11:52:59 UTC (rev 121)
@@ -1,7 +1,7 @@
Package: patchworkCG
Type: Package
Title: Allele-specific Copy Number Analysis of CompleteGenomics Whole Genome data
-Version: 1.0
+Version: 2.0
Date: 2012-11-01
Author: Markus Rasmussen, Sebastian DiLorenzo
Maintainer: Markus Rasmussen <Markus.Mayrhofer at medsci.uu.se>
Modified: pkg/patchworkCG/R/patchwork.CG.copynumbers.r
===================================================================
--- pkg/patchworkCG/R/patchwork.CG.copynumbers.r 2012-04-17 08:00:34 UTC (rev 120)
+++ pkg/patchworkCG/R/patchwork.CG.copynumbers.r 2012-04-17 11:52:59 UTC (rev 121)
@@ -219,9 +219,9 @@
regions <- segm[!is.na(segm$ratio),] ## This time, work on all segments available.
regions$np <- round((regions$end - regions$start)/10000)
- Cn <- NULL ## Total copy number
- mCn <- NULL ## Minor allele copy number
- fullCN <- NULL ## Variant label. ('cnXmY')
+ Cn <- rep(NA,nrow(regions)) ## Total copy number
+ mCn <- rep(NA,nrow(regions)) ## Minor allele copy number
+ fullCN <- rep(NA,nrow(regions)) ## Variant label. ('cnXmY')
intDist <- NULL ## distance to certain Log-R
imbaDist <- NULL ## distance to certain allelic imbalance
@@ -254,8 +254,10 @@
{
mCn[i] <- 0
}
- else if (!is.na(regions$ai[i]))
- if (!is.nan(regions$ai[i]))
+ else if (!is.na(regions$ai[i]))
+ {
+ if (!is.nan(regions$ai[i]))
+ {
for (m in 0:trunc(Cn[i]/2))
{
t_ai <- ai[paste('cn',Cn[i],'m',m,sep='')][[1]]
@@ -266,9 +268,13 @@
mCn[i] <- m
}
}
- else
- mCn[i] <- NA
- fullCN[i] <- paste('cn',Cn[i],'m',mCn[i],sep='') # Full description
+ }
+ }
+ else
+ {
+ mCn[i] <- NA
+ fullCN[i] <- paste('cn',Cn[i],'m',mCn[i],sep='') # Full description
+ }
}
regions$Cn <- Cn
Modified: pkg/patchworkCG/R/patchwork.CG.plot.r
===================================================================
--- pkg/patchworkCG/R/patchwork.CG.plot.r 2012-04-17 08:00:34 UTC (rev 120)
+++ pkg/patchworkCG/R/patchwork.CG.plot.r 2012-04-17 11:52:59 UTC (rev 121)
@@ -247,11 +247,104 @@
mastervar$max = apply(mastervar[,c(6,10)],1,max)
mastervar$min = mastervar$tot_count - mastervar$max
mastervar$ratio = mastervar$tot_count / mean(mastervar$tot_count)
+
+ # segm$ai <- segm$snvs <- segm$ratio <- NA
+
+ # #Generate the allelic imbalance calculation, among other things.
+ # for (i in 1:nrow(segm))
+ # {
+ # #Calculate ratio between relcov and segment lengths
+ # #segm$ratio[i] = segm$relcov[i] / (sum(as.numeric(segm$relcov*(segm$end-segm$start))) / sum(as.numeric(segm$end - segm$start)))
+ # #ix is the segment area from segm applied to the pieces from depcov on the correct chromosome.
+ # ix <- depcov$chr==segm$chr[i] & (depcov$begin>=segm$start[i] & depcov$end<=segm$end[i])
+ # segm$ratio[i] <- median(depcov$ratio[ix])
- #segm = patchwork.AI(segm,mastervar)
-
- segm$ai <- segm$snvs <- segm$ratio <- NA
-
+ # #Index of correct snp positions to pull snp data from
+ # # right chromosome
+ # ix = mastervar$chr==as.character(segm$chr[i]) &
+ # # right area (between start and end)
+ # (mastervar$begin > segm$start[i] & mastervar$begin < segm$end[i])
+ # segm$snvs[i] = sum(ix)
+ # segm$ai[i] = 1 - sum(mastervar$min[ix]) / sum(mastervar$max[ix])
+ # }
+ # segm$ai[is.nan(segm$ai)]=0
+
+ #depcov$ai <- NA
+
+ # #En snabbare ai hämtare för depcov segmentstorlek
+ # tmp_mv = mastervar[,c(1,2,11,12)]
+ # i=1
+ # for (j in chroms)
+ # {
+ # mv_ix = tmp_mv == j
+ # mv_ = tmp_mv[mv_ix,]
+
+ # while(depcov$chr[i] == j)
+ # {
+ # ix = (mv_[,2] >= depcov[i,2] & mv_[,2] <= depcov[i,3])
+ # depcov[i,6] = 1 - sum(mv_[ix,4]) / sum(mv_[ix,3])
+ # i = i + 1
+ # cat(i,"\n")
+ # }
+ # }
+
+ # depcov$ai[is.nan(depcov$ai)]=0
+
+#en segare ai hämtare för depcov segmentstorlek (typ en timme)
+# for (i in 1:nrow(depcov))
+# {
+# ix = mastervar[,1]==depcov[i,1] & (mastervar[,2] >= depcov[i,2] & mastervar[,2] <= depcov[i,3])
+# depcov[i,6] = 1 - sum(mastervar[ix,12]) / sum(mastervar[ix,11]) #1-min/max
+# cat(i ,"\n")
+# }
+
+#Assign AI to depcov segments using min/max from mastervar. (made by Markus)
+
+assignAI <- function(snp_chr,snp_pos,snp_min,snp_max,seg_chr,seg_start,seg_end) {
+ nchr <- length(chrs <- unique(seg_chr))
+ ai <- NULL
+ if (nchr>1) {
+ for (c in 1:nchr) {
+ ix <- seg_chr==chrs[c]
+ ai <- rbind(ai,cbind(chrs[c],assignAI(snp_chr,snp_pos,snp_min,snp_max,seg_chr[ix],seg_start[ix],seg_end[ix])))
+ }
+ colnames(ai) <- c('chr','begin','end','ai')
+ return(ai)
+ } else {
+ ix <- snp_chr==seg_chr[1]
+ snp_pos <- snp_pos[ix]
+ snp_min <- snp_min[ix]
+ snp_max <- snp_max[ix]
+
+ matrix <- rbind(cbind(snp_pos,snp_min,snp_max),cbind(seg_start,-1,-1),cbind(seg_end,-2,-2))
+ matrix <- matrix[order(matrix[,2]),]
+ matrix <- matrix[order(matrix[,1]),]
+ startix <- which(matrix[,2]==-1)
+ endix <- which(matrix[,2]==-2)
+
+ pos <- matrix[,1]; min <- matrix[,2]; max <- matrix[,3]
+ nseg <- length(startix)
+ ai=rep(NA,nseg)
+ for (i in 1:nseg) {
+ if (endix[i]-startix[i] > 1) {
+ ai[i] <- 1 - sum(min[ (startix[i]+1):(endix[i]-1) ]) / sum(max[ (startix[i]+1):(endix[i]-1) ])
+ #if (ai[i]>1) {
+ # cat(startix[i],endix[i],min[ (startix[i]+1):(endix[i]-1) ],max[ (startix[i]+1):(endix[i]-1) ],'\n')
+ #}
+ }
+ }
+ return(data.frame(begin=sort(seg_start),end=sort(seg_end),ai=ai))
+ }
+}
+
+object = assignAI(mastervar$chr,mastervar$begin,mastervar$min,mastervar$max,
+ depcov$chr,depcov$begin,depcov$end)
+
+depcov = merge(depcov,object,by=c("chr","begin","end"))
+
+
+segm$ai <- segm$snvs <- segm$ratio <- NA
+
#Generate the allelic imbalance calculation, among other things.
for (i in 1:nrow(segm))
{
@@ -261,16 +354,78 @@
ix <- depcov$chr==segm$chr[i] & (depcov$begin>=segm$start[i] & depcov$end<=segm$end[i])
segm$ratio[i] <- median(depcov$ratio[ix])
- #Index of correct snp positions to pull snp data from
- # right chromosome
- ix = mastervar$chr==as.character(segm$chr[i]) &
- # right area (between start and end)
- (mastervar$begin > segm$start[i] & mastervar$begin < segm$end[i])
+ #Index of correct snp positions to pull snp data from
+ # right chromosome
+ #ix = mastervar$chr==as.character(segm$chr[i]) &
+ # right area (between start and end)
+ #(mastervar$begin > segm$start[i] & mastervar$begin < segm$end[i])
segm$snvs[i] = sum(ix)
- segm$ai[i] = 1 - sum(mastervar$min[ix]) / sum(mastervar$max[ix])
+ #segm$ai[i] = 1 - sum(mastervar$min[ix]) / sum(mastervar$max[ix])
+ segm$ai[i] <- median(depcov$ai[ix],na.rm=T)
}
- segm$ai[is.nan(segm$ai)]=0
+ #DNAcopy segmentation of AI
+
+ # library(DNAcopy)
+ # data(ideogram,package="patchworkCG")
+ # chroms = as.character(unique(ideogram$chr))
+ # #chr_list=unique(mastervar$chr)
+
+ # #DNAcopy segmentation of object$ai values.
+ # aisegs=NULL
+ # for (c in chroms)
+ # {
+ # psegments <- qsegments <- NULL
+ # ix = object$chr==c & object$start < ideogram$start[ideogram$chr==c]
+ # if (sum(ix)>0)
+ # {
+ # psegments = segment(CNA(object$ai[ix], c, object$start[ix],
+ # data.type='logratio',sampleid=paste(c,'p')),
+ # undo.splits='sdundo', undo.SD=1,min.width=2, alpha=0.0001)$output[,2:6]
+ # psegments$arm='p'
+ # }
+ # ix = object$chr==c & object$start > ideogram$end[ideogram$chr==c]
+ # if (sum(ix)>0)
+ # {
+ # qsegments = segment(smooth.CNA(CNA(object$ai[ix], c, object$start[ix],
+ # data.type='logratio',sampleid=paste(c,'q')),smooth.region=40),
+ # undo.splits='sdundo', undo.SD=1,min.width=2, alpha=0.0001)$output[,2:6]
+ # qsegments$arm='q'
+ # }
+ # aisegs=rbind(aisegs,psegments,qsegments)
+ # }
+ # colnames(aisegs)=c('chr','start','end','np','mean','arm')
+
+
+ # aisegs$ai <- aisegs$snvs <- aisegs$ratio <- NA
+
+ # for (i in 1:nrow(aisegs))
+ # {
+ # #Calculate ratio between relcov and aisegsent lengths
+ # #aisegs$ratio[i] = aisegs$relcov[i] / (sum(as.numeric(aisegs$relcov*(aisegs$end-aisegs$start))) / sum(as.numeric(aisegs$end - aisegs$start)))
+ # #ix is the aisegsent area from aisegs applied to the pieces from depcov on the correct chromosome.
+ # ix <- depcov$chr==aisegs$chr[i] & (depcov$begin>=aisegs$start[i] & depcov$end<=aisegs$end[i])
+ # aisegs$ratio[i] <- median(depcov$ratio[ix])
+
+ # #Index of correct snp positions to pull snp data from
+ # # right chromosome
+ # ix = mastervar$chr==as.character(aisegs$chr[i]) &
+ # # right area (between start and end)
+ # (mastervar$begin > aisegs$start[i] & mastervar$begin < aisegs$end[i])
+ # aisegs$snvs[i] = sum(ix)
+ # aisegs$ai[i] = 1 - sum(mastervar$min[ix]) / sum(mastervar$max[ix])
+ # }
+
+ # #aisegs$ai[is.nan(aisegs$ai)]=0
+
+ # #Convert factor to character
+ # aisegs$chr = as.character(aisegs$chr)
+
+ # CG_KaCh(aisegs$chr,aisegs$start,aisegs$end,aisegs$ratio,aisegs$ai,
+ # depcov$chr,depcov$begin,depcov$ratio,(1 - mastervar$min/mastervar$max),
+ # mastervar$chr,mastervar$begin,
+ # name=name,xlim=c(0,2.4),ylim=c(0,1))
+
cat("Calculations complete \n")
cat("Saving objects to CG.Rdata \n")
Modified: pkg/patchworkCG/R/zzz.R
===================================================================
--- pkg/patchworkCG/R/zzz.R 2012-04-17 08:00:34 UTC (rev 120)
+++ pkg/patchworkCG/R/zzz.R 2012-04-17 11:52:59 UTC (rev 121)
@@ -1,8 +1,10 @@
.onLoad <- function(...){
- packageStartupMessage(
- "Welcome to patchwork for CompleteGenomics data! \n
- \n
- If this is your first time, please see the documentation in the README file at the default\n
- installation location, the homepage (http://patchwork.r-forge.r-project.org/) or ?patchwork.CG.\n"
- )
+ packageStartupMessage("\n")
+ packageStartupMessage("Welcome to patchwork for CompleteGenomics data!")
+ packageStartupMessage("\n")
+ packageStartupMessage("Version: ",utils::packageDescription('patchworkCG')$Version)
+ packageStartupMessage("\n")
+ packageStartupMessage("If this is your first time, please see the documentation in")
+ packageStartupMessage("the README file at the default installation location, the")
+ packageStartupMessage("homepage (http://patchwork.r-forge.r-project.org/) or ?patchwork.CG")
}
\ No newline at end of file
More information about the Patchwork-commits
mailing list