[Wavetiling-commits] r5 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Dec 8 19:01:27 CET 2011
Author: kdbeuf
Date: 2011-12-08 19:01:27 +0100 (Thu, 08 Dec 2011)
New Revision: 5
Modified:
pkg/R/methods-Wfm.R
Log:
fixed error in methods-Wfm.R
Modified: pkg/R/methods-Wfm.R
===================================================================
--- pkg/R/methods-Wfm.R 2011-12-08 17:59:22 UTC (rev 4)
+++ pkg/R/methods-Wfm.R 2011-12-08 18:01:27 UTC (rev 5)
@@ -532,140 +532,6 @@
return(annoOver)
})
-getATGPolynomWavelet <- function(bgCorrData,mapFilter,chromosome,strand,tair9GffFile,FCRegions,FCFit,thresh,aboveLim)
-{
- thresh <- thresh
- threshdensity <- 0.005
-
- cat("Filter extreme outliers.\n")
-
- aboveid <- (1:dim(Y)[2])[apply(Y,2,function(x) max(x)>aboveLim)]
- above_IR <- IRanges(aboveid,aboveid)
-
- cat("Select differentially expressed genes (Compare).\n")
-
- FCpair_regions.mix <- FCRegions
- FCpair_EB_median <- FCFit
- FCpair_regionsCompare <- vector("list",15)
- spuriousID <- vector("list",15)
- filterID <- vector("list",15)
- ATG <- vector("list",15)
- for (j in 1:15)
- {
- FCpair_regions <- as.data.frame(FCpair_regions.mix[[j]])
- FCpairreg_probe <- IRanges(start=FCpair_regions[,1],end=FCpair_regions[,2])
- names(FCpair_regions) <- c("start","end")
- FCpair_regions$no_probes <- width(FCpairreg_probe)
- FCpair_regions[,1] <- Gloc[FCpair_regions.mix[[j]][,1]]
- FCpair_regions[,2] <- Gloc[FCpair_regions.mix[[j]][,2]]
- FCpair_regions$meanmedianFC <- sapply(1:dim(FCpair_regions)[1],function(x)
- {
- xx <- mean(FCpair_EB_median[j,FCpair_regions.mix[[j]][x,1]:FCpair_regions.mix[[j]][x,2]])
- })
- nreg <- dim(FCpair_regions)[1]
- FCpairreg <- IRanges(start=FCpair_regions[,1],end=FCpair_regions[,2])
- FCpair_regions$length <- width(FCpairreg)
- FCpair_regions$density <- FCpair_regions$no_probes/FCpair_regions$length
- exprOverlap_ana <- findOverlaps(t9chr_IR_expr_ana,FCpairreg)
- exprOverlap_ana150 <- findOverlaps(t9chr_IR_expr_ana,FCpairreg,maxgap=150)
- exprOverlap_opp <- findOverlaps(t9chr_IR_expr_opp,FCpairreg)
- exprnames <- t9chr_ana$attributes[exprID_ana[matchMatrix(exprOverlap_ana)[,1]]]
- exprnames_opp <- t9chr_opp$attributes[exprID_opp[matchMatrix(exprOverlap_opp)[,1]]]
- exon <- rep("",nreg)
- exonBis <- rep("",nreg)
- mRNA <- rep("",nreg)
- miRNA <- rep("",nreg)
- ncRNA <- rep("",nreg)
- pseudogenic_exon <- rep("",nreg)
- rRNA <- rep("",nreg)
- snoRNA <- rep("",nreg)
- snRNA <- rep("",nreg)
- transposable_element_gene <- rep("",nreg)
- tRNA <- rep("",nreg)
- feature <- rep("",nreg)
- opp_strand <- rep("",nreg)
- match150 <- rep(NA,nreg)
- noverlap <- length(exprnames)
- noverlap_opp <- length(exprnames_opp)
- for (i in 1:nreg)
- {
- match <- (1:noverlap)[matchMatrix(exprOverlap_ana)[,2]==i]
- matchFeature <- tair9gff_expr_ana$feature[matchMatrix(exprOverlap_ana)[match,1]]
- match_opp <- (1:noverlap_opp)[matchMatrix(exprOverlap_opp)[,2]==i]
- matchFeature_opp <- tair9gff_expr_opp$feature[matchMatrix(exprOverlap_opp)[match_opp,1]]
- exon[i] <- paste(unique(exprnames[match][matchFeature=="exon"]),collapse=", ")
- exonBis[i] <- paste(unique(exprnames[match][matchFeature=="exon"]),collapse="")
- opp_strand[i] <- paste(unique(exprnames_opp[match_opp][matchFeature_opp=="exon"]),collapse=", ")
- mRNA[i] <- paste(unique(exprnames[match][matchFeature=="mRNA"]),collapse=", ")
- miRNA[i] <- paste(unique(exprnames[match][matchFeature=="miRNA"]),collapse=", ")
- ncRNA[i] <- paste(unique(exprnames[match][matchFeature=="ncRNA"]),collapse=", ")
- pseudogenic_exon[i] <- paste(unique(exprnames[match][matchFeature=="pseudogenic_exon"]),collapse=", ")
- rRNA[i] <- paste(unique(exprnames[match][matchFeature=="rRNA"]),collapse=", ")
- snoRNA[i] <- paste(unique(exprnames[match][matchFeature=="snoRNA"]),collapse=", ")
- snRNA[i] <- paste(unique(exprnames[match][matchFeature=="snRNA"]),collapse=", ")
- transposable_element_gene[i] <- paste(unique(exprnames[match][matchFeature=="transposable_element_gene"]),collapse=", ")
- tRNA[i] <- paste(unique(exprnames[match][matchFeature=="tRNA"]),collapse=", ")
- featureID <- (1:9)[c(mRNA[i],miRNA[i],ncRNA[i],pseudogenic_exon[i],rRNA[i],snoRNA[i],snRNA[i],transposable_element_gene[i],tRNA[i])!=""]
- feature[i] <- ifelse(length(featureID)==0,"no strand annotation",paste(c("mRNA","miRNA","ncRNA","pseudogenic_exon","rRNA","snoRNA","snRNA","transposable_element_gene","tRNA")[featureID],collapse=", "))
- match150[i] <- i %in% matchMatrix(exprOverlap_ana150)[,2]
- }
- FCpair_regions <- data.frame(FCpair_regions,as.character(exon),as.character(feature),as.character(opp_strand),match150)
- names(FCpair_regions)[7:10] <- c("exon","feature","opp_strand","flankingAnno")
- spurious <- (1:nreg)[abs(FCpair_regions$meanmedian)<thresh]
- sparse <- (1:nreg)[FCpair_regions$density<threshdensity]
- overlapAbove <- findOverlaps(FCpairreg_probe,above_IR)
- Regoverlap <- FCpairreg_probe[matchMatrix(overlapAbove)[,1]]
- outid1 <- (1:length(Regoverlap))[width(Regoverlap)<9]
- outid2 <- matchMatrix(overlapAbove)[outid1,1]
- spsp <- unique(c(spurious,sparse,outid2))
- spuriousID[[j]] <- spsp
- #further prosprocessing
- FCpair_regionsNew <- FCpair_regions[-spsp,]
- FCpair_regionsNewIR <- IRanges(start=FCpair_regionsNew[,1],end=FCpair_regionsNew[,2])
- nReg <- length(FCpair_regionsNewIR)
- #select short regions
- lowwidth_id <- (1:nReg)[width(FCpair_regionsNewIR)<300]
- #select stand-alone regions
- hlp <- matchMatrix(findOverlaps(FCpair_regionsNewIR,FCpair_regionsNewIR,maxgap=300))
- nOver <- dim(hlp)[1]
- hlpid <- (1:nOver)[hlp[,1]!=hlp[,2]]
- notalone_id <- hlp[hlpid,1]
- alone_id <- (1:nOver)[!(1:nOver %in% notalone_id)]
- suspect_id <- (1:nOver)[(1:nOver %in% lowwidth_id)&(1:nOver %in% alone_id)]
- suspectReg <- FCpair_regionsNewIR[suspect_id]
- suspectProbe <- GReg2id(suspectReg,Gloc)
- gap <- rep(0,length(suspectProbe))
- for (i in 1:length(suspectProbe))
- {
- dat <- as.numeric(Y[,(max(1,(start(suspectProbe)[i]-8))):(min(end(suspectProbe)[i]+8,length(Gloc)))])
- ll <- length(dat)
- sdata <- sort(dat,decreasing=TRUE)
- gap[i] <- max(sdata[1:(ll-1)]-sdata[2:ll])
- }
- filter_id <- suspect_id[(1:length(suspectProbe))[gap > 1.5]]
- filterID[[j]] <- filter_id
- FCpair_regionsClean <- FCpair_regionsNew[-filter_id,]
- highFC_id <- order(abs(FCpair_regionsClean$meanmedianFC),decreasing=TRUE)
- FCpair_regionsOrd <- FCpair_regionsClean[highFC_id,]
- FCpair_regionsCompare[[j]] <- FCpair_regionsOrd
- exonBis <- exonBis[-spsp]
- exonBis <- exonBis[-filter_id]
- tt <- strsplit(exonBis,"Parent=")
- tt <- unlist(tt)
- tt <- tt[tt!=""]
- ATG[[j]] <- unique(tt)
- }
- for (i in 1:15)
- {
- FCpair_regions.mix[[i]] <- FCpair_regions.mix[[i]][-spuriousID[[i]],]
- FCpair_regions.mix[[i]] <- FCpair_regions.mix[[i]][-filterID[[i]],]
- }
- out$AtgCompareSplice <- ATG
- out$AdaptedFCPairRegions <- FCpair_regions.mix
- out$FCPairRegionsInfo <- FCpair_regionsCompare
- out$Gloc <- Gloc
- return(out)
-}
More information about the Wavetiling-commits
mailing list