Changed the code to using just one regular expression as discussed in…

… issue #133, need to fix bugs
PoonLab · Feb 20, 2018 · 52e80f6 · 52e80f6
1 parent d08c635
commit 52e80f6
Show file tree

Hide file tree

Showing 4 changed files with 24 additions and 36 deletions.
diff --git a/pkg/R/smcABC.R b/pkg/R/smcABC.R
@@ -49,7 +49,7 @@ simulate.trees <- function(workspace, theta, model, seed=NA, ...) {
 
 
 # formally 'distance'
-kernel.dist <- function(t1, t2, decay.factor, rbf.variance, sst.control, norm.mode) {
+kernel.dist <- function(t1, t2, decay.factor, rbf.variance, sst.control, norm.mode, regex, gamma) {
   if (is.null(t1$kernel)) {
     stop("t1 missing self kernel in distance()")
   }
@@ -62,7 +62,10 @@ kernel.dist <- function(t1, t2, decay.factor, rbf.variance, sst.control, norm.mo
     t2,
     lambda=decay.factor,
     sigma=rbf.variance,
-    rho=sst.control
+    rho=sst.control,
+    label1 <- gsub(regex,t1$tip.label),
+    label2 <- gsub(regex,t2$tip.label),
+    gamma=gamma
   )
 
   result <- 1. - k / sqrt(t1$kernel * t2$kernel)

diff --git a/pkg/R/smcConfig.R b/pkg/R/smcConfig.R
@@ -43,7 +43,9 @@ load.config <- function(file) {
     decay.factor=0.2,
     rbf.variance=100.0,
     sst.control=1.0,
-    norm.mode='NONE'
+    norm.mode='NONE',
+    regex= "",
+    gamma=0
   )
   class(config) <- 'smc.config'
 
@@ -119,8 +121,7 @@ load.config <- function(file) {
       config$rbf.variance <- kernel.settings$rbf.variance
       config$sst.control <- kernel.settings$sst.control
       config$norm.mode <- kernel.settings$norm.mode
-      config$label1 <- kernel.settings$label1
-      config$label2 <- kernel.settings$label2
+      config$regex <- kernel.settings$regex
       config$gamma <- kernel.settings$gamma
     }
   } else if (is.character(settings$distances)) {
@@ -146,8 +147,7 @@ load.config <- function(file) {
         config$rbf.variance <- as.numeric(values["rbf.variance"])
         config$sst.control <- as.numeric(values["sst.control"])
         config$norm.mode <- values["norm.mode"]
-        config$label1 <- values["label1"]
-        config$label2 <- values["label2"]
+        config$regex <- values["regex"]
         config$gamma <- as.numeric(values["gamma"])
       }
     }

diff --git a/pkg/R/treekernel.R b/pkg/R/treekernel.R
@@ -13,31 +13,17 @@
 # You should have received a copy of the GNU General Public License
 # along with Kaphi.  If not, see <http://www.gnu.org/licenses/>.
 
-# cache self-kernel score (only if kernel distance is desired for distance metric; specified on user-level)
-# FIXME:  this won't work for labelled kernel
-if (grepl("kernel", config$dist)) {
-  label <- gsub(config$label1,tree$tip.label) # when using different regex for label1 and label2, need to decide which one to use
-  tree$kernel <- tree.kernel(tree, tree,
-                             lambda=config$decay.factor,
-                             sigma=config$rbf.variance,
-                             rho=config$sst.control,
-                             normalize=0,
-                             label1=label,
-                             label2=label,
-                             gamma=config$gamma
-  )
-}
-
-utk <- function(t1, t2, config) {
-  # convenience wrapper for unlabelled tree shape kernel
-  result <- tree.kernel(t1, t2,
-                        lambda=config$decay.factor,
-                        sigma=config$rbf.variance,
-                        rho=as.double(config$sst.control),
-                        normalize=0
-                        )
-  return(result)
-}
+# DEPRECATED
+# utk <- function(t1, t2, config) {
+# convenience wrapper for unlabelled tree shape kernel
+#  result <- tree.kernel(t1, t2,
+#                        lambda=config$decay.factor,
+#                        sigma=config$rbf.variance,
+#                        rho=as.double(config$sst.control),
+#                        normalize=0
+#                        )
+#  return(result)
+# }
 
 tree.kernel <- function(tree1, tree2,
                         lambda,        # decay factor
@@ -52,8 +38,8 @@ tree.kernel <- function(tree1, tree2,
   use.label <- if (any(is.na(label1)) || any(is.na(label2)) || is.null(label1) || is.null(label2)) {
     FALSE
   } else {
-    label1 <- gsub(config$label1,tree$tip.label)
-    label2 <- gsub(config$label2,tree$tip.label)
+    label1 <- gsub(config$regex,tree1$tip.label)
+    label2 <- gsub(config$regex,tree2$tip.label)
     TRUE
   }
 

diff --git a/tests/fixtures/test-bisse.yaml b/tests/fixtures/test-bisse.yaml
@@ -77,7 +77,6 @@ distances:
     rbf.variance: 100.0
     sst.control: 1.0
     norm.mode: 'NONE'
-    label1: "'^.+_([01])$', '\\1'"
-    label2: "'^.+_([01])$', '\\1'"
+    regex: "'^.+_([01])$', '\\1'"
     gamma: 1