git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@48930 bc3139a8-67e5-0310-9ffc-ced21a209358
... | ... |
@@ -957,25 +957,20 @@ fit.lm1 <- function(idxBatch, |
957 | 957 |
phiA[phiA[, J] < MIN.PHI, J] <- MIN.PHI |
958 | 958 |
phiB[phiB[, J] < MIN.PHI, J] <- MIN.PHI |
959 | 959 |
} |
960 |
- ## formerly polymorphic(): calculate copy number |
|
961 |
- cA[, k] <- matrix((1/phiA[, J]*(A-nuA[, J])), nrow(A), ncol(A)) |
|
962 |
- cB[, k] <- matrix((1/phiB[, J]*(B-nuB[, J])), nrow(B), ncol(B)) |
|
960 |
+## cA[, k] <- matrix((1/phiA[, J]*(A-nuA[, J])), nrow(A), ncol(A)) |
|
961 |
+## cB[, k] <- matrix((1/phiB[, J]*(B-nuB[, J])), nrow(B), ncol(B)) |
|
963 | 962 |
rm(G, A, B, NORM, wA, wB, YA,YB, res, negA, negB, Np, Ns) |
964 | 963 |
gc() |
965 | 964 |
} |
966 |
- cA[cA < 0.05] <- 0.05 |
|
967 |
- cB[cB < 0.05] <- 0.05 |
|
968 |
- cA[cA > 5] <- 5 |
|
969 |
- cB[cB > 5] <- 5 |
|
970 |
- cA <- matrix(as.integer(cA*100), nrow(cA), ncol(cA)) |
|
971 |
- cB <- matrix(as.integer(cB*100), nrow(cB), ncol(cB)) |
|
965 |
+## cA[cA < 0.05] <- 0.05 |
|
966 |
+## cB[cB < 0.05] <- 0.05 |
|
967 |
+## cA[cA > 5] <- 5 |
|
968 |
+## cB[cB > 5] <- 5 |
|
969 |
+## cA <- matrix(as.integer(cA*100), nrow(cA), ncol(cA)) |
|
970 |
+## cB <- matrix(as.integer(cB*100), nrow(cB), ncol(cB)) |
|
971 |
+## CA(object)[snps, ] <- cA |
|
972 |
+## CB(object)[snps, ] <- cB |
|
972 | 973 |
|
973 |
- |
|
974 |
- |
|
975 |
- CA(object)[snps, ] <- cA |
|
976 |
- CB(object)[snps, ] <- cB |
|
977 |
- |
|
978 |
- |
|
979 | 974 |
snpflags[snps, ] <- flags |
980 | 975 |
lapply(lM(object), open) |
981 | 976 |
|
... | ... |
@@ -2,7 +2,6 @@ |
2 | 2 |
all: illumina_copynumber copynumber |
3 | 3 |
|
4 | 4 |
copynumber: copynumber.Rnw |
5 |
-## echo "Sweave(\"$1.Rnw\"); library(tools); texi2dvi(\"$1.tex\", pdf=TRUE)" | R --no-save --no-restore; |
|
6 | 5 |
echo "Stangle(\"copynumber.Rnw\")" | R --no-save --no-restore; |
7 | 6 |
cat ~/bin/cluster.template | perl -pe "s/Rprog/copynumber.R/" > copynumber.R.sh |
8 | 7 |
qsub -m e -r y -cwd -l mem_free=12G,h_vmem=16G copynumber.R.sh |
... | ... |
@@ -129,6 +129,7 @@ if(!file.exists(file.path(outdir, "cnSet.rda"))){ |
129 | 129 |
batch=batch[1:20]) |
130 | 130 |
class(calls(gtSet.assayData_matrix)) |
131 | 131 |
} |
132 |
+q("no") |
|
132 | 133 |
@ |
133 | 134 |
|
134 | 135 |
Next, we estimate copy number for the 20 CEL files. The copy number |
... | ... |
@@ -140,11 +141,6 @@ will load \Robject{cnSet.assayData_matrix} from disk if this |
140 | 141 |
computation had already been performed as part of the batch job. |
141 | 142 |
|
142 | 143 |
<<copynumber>>= |
143 |
-stop() |
|
144 |
-tms1 <- system.time(tmp <- crlmmCopynumber(gtSet.assayData_matrix)) |
|
145 |
-reload_pkg("crlmm") |
|
146 |
-trace(nuphiAllele, browser) |
|
147 |
-tms2 <- system.time(tmp <- crlmmCopynumber(gtSet.assayData_matrix)) |
|
148 | 144 |
cnSet.assayData_matrix <- checkExists("cnSet.assayData_matrix", |
149 | 145 |
.path=outdir, |
150 | 146 |
.FUN=crlmmCopynumber, |