update the jellyfish optimiser

R/search-jellyfish.R

@@ -3,18 +3,18 @@
 #' @param current starting projection, a list of basis of class "multi-bases"
 #' @param index index function
 #' @param tries the counter of the outer loop of the opotimiser
-#' @param max.tries maximum number of iteration before giving up
+#' @param max.tries the maximum number of iteration before giving up
 #' @param ... other arguments being passed into the \code{search_jellyfish()}
 #' @keywords optimize
 #' @export
 #' @examples
 #' res <- animate_xy(flea[, 1:6], guided_tour(holes(), search_f = search_jellyfish))
 #' res
-search_jellyfish <- function(current, index, tries, max.tries = Inf, min.tries = 1, ...) {
+search_jellyfish <- function(current, index, tries, max.tries = 50, ...) {
  rcd_env <- parent.frame(n = 4)
  if (is.null(rcd_env[["record"]])) rcd_env <- parent.frame(n = 1)
  best_jelly <- current[[attr(current, "best_id")]]
- current_idx <- index(best_jelly)
+ current_idx <- sapply(current, index)
 
  c_t = abs((1 - tries / max.tries) * (2 * runif(1) - 1))
 
@@ -26,7 +26,7 @@ search_jellyfish <- function(current, index, tries, max.tries = Inf, min.tries =
  } else if (runif(1) > (1 - c_t)) {
  # type A passive
  target = lapply(current, function(x) {
- orthonormalise(x + 0.1 * runif(1) * 2)
+ orthonormalise(x + 0.1 * runif(1))
  }) # eq 12
  } else {
  # type B active
@@ -47,8 +47,13 @@ search_jellyfish <- function(current, index, tries, max.tries = Inf, min.tries =
  target <- purrr::map2(current, target, correct_orientation)
  target_idx <- sapply(target, index)
 
+ # if the target is worse than current, use current
+ worse_id <- current_idx > target_idx
+ target[worse_id] <- current[worse_id]
+ target_idx[worse_id] <- current_idx[worse_id]
+
  best_id <- which.max(target_idx)
- message("Target: ", sprintf("%.3f", max(target_idx)))
+ #message("Target: ", sprintf("%.3f", max(target_idx)))
  attr(target, "best_id") <- best_id
  class(target) <- c("multi-bases", class(target))
 
@@ -63,9 +68,7 @@ search_jellyfish <- function(current, index, tries, max.tries = Inf, min.tries =
  info = ifelse(tries == max(tries) & loop == best_id, "current_best", info)
  )
 
-
- if (abs(max(target_idx) - current_idx) < 0.05 &&
- tries >= max.tries) {
+ if (tries >= max.tries) {
  print_final_proj(target[[attr(target, "best_id")]])
  rcd_env[["record"]] <- dplyr::mutate(
  rcd_env[["record"]],

R/tour-guided.r

@@ -42,9 +42,9 @@
 #' f <- flea_std[, 1:3]
 #' tries <- replicate(5, save_history(f, guided_tour(holes())), simplify = FALSE)
 #' }
-guided_tour <- function(index_f, d = 2, alpha = 0.5, cooling = 0.99, max.tries = 25,
- max.i = Inf, search_f = search_geodesic, n_jellies = 30,
- n_sample = 100, ...) {
+guided_tour <- function(index_f, d = 2, cooling = 0.99, max.tries = 25,
+ max.i = Inf, search_f = search_geodesic,
+ n_jellies = 30, n_sample = 100, alpha = 0.5,...) {
  generator <- function(current, data, tries, ...) {
  index <- function(proj) {
  index_f(as.matrix(data) %*% proj)
@@ -123,8 +123,9 @@ guided_tour <- function(index_f, d = 2, alpha = 0.5, cooling = 0.99, max.tries =
  }
 
  # current, alpha = 1, index, max.tries = 5, n = 5, delta = 0.01, cur_index = NA, ..
- basis <- search_f(current, alpha, index = index, tries = tries, max.tries = max.tries,
- cur_index = cur_index, frozen = frozen, n_sample = n_sample, ...)
+ basis <- search_f(
+ current, alpha = alpha, index = index, tries = tries, max.tries = max.tries,
+ cur_index = cur_index, frozen = frozen, n_sample = n_sample, ...)
 
  if (method == "search_posse") {
  if (!is.null(basis$h)) {