Update of lgp()

The lgp() function now can connect the same emulator in a chain with different linking information specified by set_linked_idx().

Author: mingdeyu

NEWS.md

@@ -17,6 +17,7 @@
 - The `check_point` argument is removed from `design()` and replaced by `autosave`.
 - Automatic saving of emulators during the sequential design is added to `design()` through the new argument `autosave`.
 - When a customized evaluation function is provided to `design()` via `eval`, the design information in previous waves will be retained as long as the previous waves of the sequential design also use customized evaluation functions. If different customized evaluation functions are supplied to `design()` in different waves, the trace plot of RMSEs produced by `draw()` will show RMSEs from different evaluation functions in different waves.
+- One can now link the same emulator multiple times in a chain via `lgp()` by setting different linking information for the emulator via `set_linked_idx()`.
 - Updates of documentations and vignettes.
 
 # dgpsi 2.3.0

R/dgp.R

@@ -110,9 +110,11 @@
 #'     generated by the linked emulators in the preceding layers. Defaults to `NULL`. This argument is only used when `struc = NULL`.
 #' @param linked_idx either a vector or a list of vectors:
 #' * If `linked_idx` is a vector, it gives indices of columns in the pooled output matrix (formed by column-combined outputs of all
-#'   emulators in the feeding layer) that feed into the DGP emulator. If the DGP emulator is in the first layer of a linked emulator system,
-#'   the vector gives the column indices of the global input (formed by column-combining all input matrices of emulators in the first layer)
-#'   that the DGP emulator will use. The length of the vector shall equal to the length of `internal_input_idx` when `internal_input_idx` is not `NULL`.
+#'   emulators in the feeding layer) that feed into the DGP emulator. The length of the vector shall equal to the length of `internal_input_idx`
+#'   when `internal_input_idx` is not `NULL`. If the DGP emulator is in the first layer of a linked emulator system, the vector gives the column indices of the global
+#'   input (formed by column-combining all input matrices of emulators in the first layer) that the DGP emulator will use. If the DGP emulator is to be used in both the first
+#'   and subsequent layers, one should initially set `linked_idx` to the appropriate values for the situation where the emulator is not in the first layer. Then, use the
+#'   function [set_linked_idx()] to reset the linking information when the emulator is in the first layer.
 #' * When the DGP emulator is not in the first layer of a linked emulator system, `linked_idx` can be a list that gives the information on connections
 #'   between the DGP emulator and emulators in all preceding layers. The length of the list should equal to the number of layers before
 #'   the DGP emulator. Each element of the list is a vector that gives indices of columns in the pooled output matrix (formed by column-combined outputs

R/gp.R

@@ -47,9 +47,11 @@
 #'     generated by the linked emulators in the preceding layers. Defaults to `NULL`. This argument is only used when `struc = NULL`.
 #' @param linked_idx either a vector or a list of vectors:
 #' * If `linked_idx` is a vector, it gives indices of columns in the pooled output matrix (formed by column-combined outputs of all
-#'   emulators in the feeding layer) that feed into the GP emulator. If the GP emulator is in the first layer of a linked emulator system,
-#'   the vector gives the column indices of the global input (formed by column-combining all input matrices of emulators in the first layer)
-#'   that the GP emulator will use. The length of the vector shall equal to the length of `internal_input_idx` when `internal_input_idx` is not `NULL`.
+#'   emulators in the feeding layer) that feed into the GP emulator. The length of the vector shall equal to the length of `internal_input_idx` when `internal_input_idx`
+#'   is not `NULL`. If the GP emulator is in the first layer of a linked emulator system, the vector gives the column indices of the global
+#'   input (formed by column-combining all input matrices of emulators in the first layer) that the GP emulator will use. If the GP emulator is to be used in both the first
+#'   and subsequent layers, one should initially set `linked_idx` to the appropriate values for the situation where the emulator is not in the first layer. Then, use the
+#'   function [set_linked_idx()] to reset the linking information when the emulator is in the first layer.
 #' * When the GP emulator is not in the first layer of a linked emulator system, `linked_idx` can be a list that gives the information on connections
 #'   between the GP emulator and emulators in all preceding layers. The length of the list should equal to the number of layers before
 #'   the GP emulator. Each element of the list is a vector that gives indices of columns in the pooled output matrix (formed by column-combined outputs

R/lgp.R

@@ -97,10 +97,33 @@ lgp <- function(struc, B = 10, id = NULL) {
     layer <- list()
     K <- length(struc[[l]])
     for (k in 1:K) {
-      cont <- struc[[l]][[k]]$container_obj
+      cont <- pkg.env$copy$deepcopy(struc[[l]][[k]]$container_obj)
       if ( is.null(cont$local_input_idx) ){
         stop(sprintf("Emulator %i in Layer %i has no 'linked_idx' specified. Use set_linked_idx() to specify this attribute.", k, l), call. = FALSE)
       }
+      if ( l==1 ){
+        if (cont$type=='gp'){
+          if ( !is.null(cont$structure$connect) ){
+            inverse_order <- order(c(cont$structure$input_dim, cont$structure$connect) + 1)
+            cont$structure$input <- cbind(cont$structure$input, cont$structure$global_input)[,inverse_order,drop=F]
+            cont$structure$global_input <- NULL
+            cont$structure$input_dim <- (1:length(inverse_order))-1
+            cont$structure$connect <- NULL
+            if (length(cont$structure$length)!=1) cont$structure$length <- cont$structure$length[inverse_order]
+          }
+        } else {
+          for (item in cont$structure[[1]]){
+            if ( !is.null(item$connect) ){
+              inverse_order <- order(c(item$input_dim, item$connect) + 1)
+              item$input <- cbind(item$input, item$global_input)[,inverse_order,drop=F]
+              item$global_input <- NULL
+              item$input_dim <- (1:length(inverse_order))-1
+              item$connect <- NULL
+              if (length(item$length)!=1) item$length <- item$length[inverse_order]
+            }
+          }
+        }
+      }
       layer[[k]] <- cont
     }
     extracted_struc[[l]] <- layer
@@ -109,7 +132,7 @@ lgp <- function(struc, B = 10, id = NULL) {
   res[['id']] <- if (is.null(id)) uuid::UUIDgenerate() else id
   seed <- sample.int(100000, 1)
   set_seed(seed)
-  obj <- pkg.env$dgpsi$lgp(all_layer = pkg.env$copy$deepcopy(extracted_struc), N = B)
+  obj <- pkg.env$dgpsi$lgp(all_layer = extracted_struc, N = B)
   res[['emulator_obj']] <- obj
   res[['specs']][['seed']] <- seed
   res[['specs']][['B']] <- B