Browse code

don't delete the scoring matrix when echoCommand

Ge Tan authored on 24/11/2016 18:59:53
Showing 1 changed files

... ...
@@ -3,35 +3,38 @@
3 3
 ### Exported!
4 4
 scoringMatrix <- function(distance=c("far", "medium", "near")){
5 5
   distance <- match.arg(distance)
6
-  lastzMatrix <- list(medium=matrix(c(91, -114, -31, -123,
7
-                                      -114, 100, -125, -31,
8
-                                      -31, -125, 100,-114,
9
-                                      -123, -31, -114, 91),
10
-                                    nrow=4, ncol=4,
11
-                                    dimnames=list(c("A", "C", "G", "T"),
12
-                                                  c("A", "C", "G", "T"))
13
-  ),
14
-  far=matrix(c(91, -90, -25, -100,
15
-               -90, 100, -100, -25,
16
-               -25, -100, 100, -90,
17
-               -100, -25, -90, 91),
18
-             nrow=4, ncol=4,
19
-             dimnames=list(c("A", "C", "G", "T"),
20
-                           c("A", "C", "G", "T"))
21
-  ),
22
-  near=matrix(c(90, -330, -236, -356,
23
-                -330, 100, -318, -236,
24
-                -236, -318, 100, -330,
25
-                -356, -236, -330, 90),
26
-              nrow=4, ncol=4,
27
-              dimnames=list(c("A", "C", "G", "T"),
28
-                            c("A", "C", "G", "T"))
29
-  )
6
+  lastzMatrix <- list(
7
+    # Default
8
+    medium=matrix(c(91, -114, -31, -123,
9
+                    -114, 100, -125, -31,
10
+                    -31, -125, 100,-114,
11
+                    -123, -31, -114, 91),
12
+                  nrow=4, ncol=4,
13
+                  dimnames=list(c("A", "C", "G", "T"),
14
+                                c("A", "C", "G", "T"))
15
+                  ),
16
+    ## HOXD55
17
+    far=matrix(c(91, -90, -25, -100,
18
+                 -90, 100, -100, -25,
19
+                 -25, -100, 100, -90,
20
+                 -100, -25, -90, 91),
21
+               nrow=4, ncol=4,
22
+               dimnames=list(c("A", "C", "G", "T"),
23
+                             c("A", "C", "G", "T"))
24
+    ),
25
+    ## human-chimp
26
+    near=matrix(c(90, -330, -236, -356,
27
+                  -330, 100, -318, -236,
28
+                  -236, -318, 100, -330,
29
+                  -356, -236, -330, 90),
30
+                nrow=4, ncol=4,
31
+                dimnames=list(c("A", "C", "G", "T"),
32
+                              c("A", "C", "G", "T"))
33
+    )
30 34
   )
31 35
   return(lastzMatrix[[distance]])
32 36
 }
33 37
 
34
-
35 38
 ### -----------------------------------------------------------------
36 39
 ### lastz wrapper
37 40
 ### Exported!
... ...
@@ -54,7 +57,10 @@ lastz <- function(assemblyTarget, assemblyQuery,
54 57
   }
55 58
   
56 59
   matrixFile <- tempfile(fileext=".lastzMatrix")
57
-  on.exit(unlink(matrixFile))
60
+  if(!isTRUE(echoCommand)){
61
+    ## If echo the command, we keep the scoring matrix file.
62
+    on.exit(unlink(matrixFile))
63
+  }
58 64
   write.table(scoringMatrix(distance), file=matrixFile, quote=FALSE,
59 65
               sep=" ", row.names=FALSE, col.names=TRUE)
60 66
   ## The options used here is taken from RunLastzChain_sh.txt 
... ...
@@ -117,7 +123,6 @@ lastz <- function(assemblyTarget, assemblyQuery,
117 123
                matrixFile)
118 124
   )
119 125
   
120
-  message("Starting lastz")
121 126
   if(is.null(chrsTarget)){
122 127
     chrsTarget <- seqnames(seqinfo(TwoBitFile(assemblyTarget)))
123 128
   }else{