--- a
+++ b/R/registration.R
@@ -0,0 +1,2385 @@
+####
+# Main Shiny App ####
+####
+
+#' registerSpatialData
+#'
+#' A mini shiny app to for registering images and spatial coordinates of multiple consequtive spatial datasets
+#'
+#' @param object_list a list of VoltRon (or Seurat) objects
+#' @param reference_spatdata a reference spatial data set, used only if \code{object_list} is \code{NULL}
+#' @param query_spatdata a query spatial data set, used only if \code{object_list} is \code{NULL}
+#' @param keypoints (DEPRECATED) a list of tables, each points to matching keypoints from registered images.
+#' @param mapping_parameters for manual image registration, a list of tables, each points to matching keypoints from registered images, and for automated image registration, a set of mapping parameters
+#' @param interactive if TRUE, the shiny application for image registration will be triggered, otherwise 'mapping_parameters' or 'keypoints' should be defined.
+#' @param shiny.options a list of shiny options (launch.browser, host, port etc.) passed \code{options} arguement of \link{shinyApp}. For more information, see \link{runApp}
+#'
+#' @import shiny
+#' @importFrom shinyjs useShinyjs show hide
+#' @importFrom stats median
+#' @importFrom magick image_read
+#'
+#' @export
+registerSpatialData <- function(object_list = NULL, reference_spatdata = NULL, query_spatdata = NULL, keypoints = NULL, mapping_parameters = list(), interactive = TRUE,
+                                shiny.options = list(launch.browser = getOption("shiny.launch.browser", interactive()))) {
+
+  ## Importing images ####
+
+  # if the input is not a list, switch to reference vs query mode
+  if(!is.null(object_list)){
+    spatdata_list <- object_list
+    centre <- floor(stats::median(seq_len(length(spatdata_list))))
+    register_ind <- setdiff(seq_len(length(spatdata_list)), centre)
+  } else {
+    spatdata_list <- list(reference_spatdata, query_spatdata)
+    centre <- 1
+    register_ind <- 2
+  }
+
+  # get images from the list of objects
+  orig_image_query_list_full <- lapply(spatdata_list, function(spat){
+    assayname <- vrAssayNames(spat)
+    channel_names <- vrImageChannelNames(spat[[assayname]])
+    sapply(channel_names, function(chan){
+      img <- vrImages(spat[[assayname]], channel = chan, as.raster = TRUE)
+      if(!inherits(img, "Image_Array")){
+        img <- magick::image_read(img)
+      }
+      img
+    }, USE.NAMES = TRUE)
+  })
+  orig_image_query_list <- lapply(orig_image_query_list_full, function(spat_img) {
+    return(spat_img[[1]])
+  })
+  orig_image_channelname_list <- lapply(spatdata_list, function(spat){
+    assayname <- vrAssayNames(spat)
+    vrImageChannelNames(spat[[assayname]])
+  })
+  
+  ## Parameters ####
+  if(!is.null(keypoints)){
+    message("The use of 'keypoints' is deprecated, please use 'mapping_parameters' instead!")
+    mapping_parameters[["keypoints"]] <- keypoints
+  }
+  if(!"keypoints" %in% names(mapping_parameters) && !all(is.null(names(mapping_parameters)))){
+    if(all(grepl("[0-9]-[0-9]", names(mapping_parameters)))){
+      mapping_parameters[["keypoints"]] <- mapping_parameters
+    } else {
+      stop("'mapping_parameters' does not include keypoints")
+    }
+  }
+  
+  ## Non-interactive Registration ####
+  if(!interactive){
+    return(getNonInteractiveRegistration(obj_list = spatdata_list, 
+                                         centre = centre, 
+                                         register_ind = register_ind, 
+                                         mapping_parameters = mapping_parameters, 
+                                         image_list = orig_image_query_list,
+                                         image_list_full = orig_image_query_list_full,
+                                         channel_names = orig_image_channelname_list))
+  }
+
+  ## UI and Server ####
+  ui <- fluidPage(
+    
+    # use javascript extensions for Shiny
+    shinyjs::useShinyjs(),
+    
+    # side bar
+    sidebarLayout(position = "left",
+                  
+                  # Side bar
+                  sidebarPanel(
+                    tags$style(make_css(list('.well', 'margin', '7%'))),
+                    
+                    # # specific settings for dealing with simultaneous click and brush events
+                    # # https://jokergoo.github.io/2021/02/20/differentiate-brush-and-click-event-in-shiny/
+                    tags$script(HTML("
+                        $('#plot').mousedown(function(e) {
+                            var parentOffset = $(this).offset();
+                            var relX = e.pageX - parentOffset.left;
+                            var relY = e.pageY - parentOffset.top;
+                            Shiny.setInputValue('x1', relX);
+                            Shiny.setInputValue('y1', relY);
+                        }).mouseup(function(e) {
+                            var parentOffset = $(this).offset();
+                            var relX = e.pageX - parentOffset.left;
+                            var relY = e.pageY - parentOffset.top;
+                            Shiny.setInputValue('x2', relX);
+                            Shiny.setInputValue('y2', relY);
+                            Shiny.setInputValue('action', Math.random());
+                        });
+                    ")),
+                    
+                    # side bar for configuration
+                    getSideBar(params = mapping_parameters),
+                    
+                    # panel options
+                    width = 3,
+                  ),
+                  
+                  mainPanel(
+                    
+                    # Interface for the reference image
+                    br(),
+                    column(6,
+                           
+                           # Reference Images
+                           getImageTabPanels(length(orig_image_query_list), 
+                                             orig_image_channelname_list, 
+                                             type = "ref", 
+                                             params = mapping_parameters),
+                           
+                           br(),
+                           
+                           # Matching Alignment
+                           getAlignmentTabPanel(length(orig_image_query_list), centre, register_ind),
+                    ),
+                    
+                    # Interface for the query images
+                    column(6,
+                           
+                           # Query Images
+                           getImageTabPanels(length(orig_image_query_list), 
+                                             orig_image_channelname_list, 
+                                             type = "query", 
+                                             params = mapping_parameters),
+                           
+                           br(),
+                           
+                           # Registered Query Images
+                           getRegisteredImageTabPanels(length(orig_image_query_list), 
+                                                       centre, 
+                                                       register_ind)
+                    ),
+                    
+                    # panel options
+                    width = 9
+                  )
+    )
+  )
+  
+  server <- function(input, output, session) {
+    
+    ## Manage interface ####
+    updateParameterPanels(length(orig_image_query_list), mapping_parameters, input, output, session)
+    updateTabPanels(centre, register_ind, input, output, session)
+    # initiateParameterPanels(mapping_parameters, length(orig_image_query_list), input, output, session)
+    
+    ## Transform images ####
+    trans_image_query_list <- transformImageQueryList(orig_image_query_list, input)
+    
+    ## get image and zoom info ####
+    orig_image_query_info_list <- getImageInfoList(orig_image_query_list)
+    zoom_list <- initiateZoomOptions(orig_image_query_info_list)
+    manageImageZoomOptions(centre, register_ind, zoom_list, orig_image_query_list, orig_image_query_info_list, input, output, session)
+    
+    ## Manage reference and query keypoints ####
+    # xyTable_list <- initateKeypoints(length(orig_image_query_list), keypoints)
+    xyTable_list <- initateKeypoints(length(orig_image_query_list), mapping_parameters$keypoints)
+    manageKeypoints(centre, register_ind, xyTable_list, orig_image_query_list, orig_image_query_info_list, zoom_list, input, output, session)
+    
+    ## Image registration ####
+    registration_mapping_list <- initiateMappings(length(spatdata_list))
+    getManualRegisteration(registration_mapping_list, spatdata_list, orig_image_query_list, xyTable_list,
+                           centre, register_ind, input, output, session)
+    getAutomatedRegisteration(registration_mapping_list, spatdata_list, orig_image_query_list_full, orig_image_channelname_list,
+                              centre, register_ind, input, output, session)
+    
+    ## Main observable ####
+    observe({
+      
+      # output the list of query images
+      getImageOutput(orig_image_query_list_full, orig_image_query_info_list, xyTable_list, zoom_list, centre, input, output, session)
+      
+    })
+    
+    ## Return values for the shiny app ####
+    observeEvent(input$done, {
+      
+      # keypoints and mapping
+      keypoints <- reactiveValuesToList(xyTable_list)
+      mapping <- reactiveValuesToList(registration_mapping_list)
+      
+      # mapping parameters
+      mapping_parameters <- transferParameterInput(input, 
+                                                   image_list = orig_image_query_list)
+      
+      # get keypoints and registered spatial datasets
+      stopApp(
+        list(keypoints = keypoints,
+             mapping_parameters = c(as.list(mapping_parameters), 
+                                    list(keypoints = keypoints, 
+                                         mapping = mapping)),
+             registered_spat = getRegisteredObject(spatdata_list,
+                                                   registration_mapping_list,
+                                                   register_ind,
+                                                   centre,
+                                                   input,
+                                                   reg_mode = ifelse(input$automatictag, "auto", "manual"),
+                                                   image_list = orig_image_query_list))
+      )
+    })
+  }
+  
+  # configure options
+  shiny.options <- configure_shiny_options(shiny.options)
+  
+  # run app
+  shiny::runApp(
+    shiny::shinyApp(ui, server, options = list(host = shiny.options[["host"]], port = shiny.options[["port"]], launch.browser = shiny.options[["launch.browser"]]),
+                    onStart = function() {
+                      onStop(function() {
+                      })
+                    })
+  )
+}
+
+####
+# User Interface ####
+####
+
+#' getSideBar
+#'
+#' The UI for the app side bar
+#'
+#' @param params mapping parameters
+#' 
+#' @import shiny
+#' 
+#' @noRd
+getSideBar <- function(params = NULL){
+  list(
+    h4("Spatial Data Alignment"),
+    fluidRow(
+      column(12,shiny::checkboxInput("automatictag", "Automated", value = params[["automatictag"]])),
+      br(),
+      column(12,selectInput("Method", "Method", 
+                            choices = c("Homography", "Non-Rigid", "Homography + Non-Rigid"), 
+                            # selected = "Homography")),
+                            selected = ifelse(is.null(params[["Method"]]), "Homography", params[["Method"]]))),
+      br(),
+      column(12,selectInput("Matcher", "Matcher", 
+                            choices = c("FLANN", "BRUTE-FORCE"), 
+                            # selected = "FLANN")),
+                            selected = ifelse(is.null(params[["Matcher"]]), "FLANN", params[["Matcher"]]))),
+      br(),
+      column(12,textInput("GOOD_MATCH_PERCENT", "Match %", 
+                          # value = "0.20", 
+                          value = ifelse(is.null(params[["GOOD_MATCH_PERCENT"]]), "0.20", params[["GOOD_MATCH_PERCENT"]]),
+                          width = "80%", placeholder = NULL)),
+      column(12,textInput("MAX_FEATURES", "# of Features", 
+                          # value = "1000", 
+                          value = ifelse(is.null(params[["MAX_FEATURES"]]), "1000", params[["MAX_FEATURES"]]),
+                          width = "80%", placeholder = NULL)),
+      br(),
+      column(12,shiny::actionButton("register", "Register!")),
+      br(),
+    ),
+    br(),
+    fluidRow(
+      column(12,shiny::htmlOutput("summary"))
+    ),
+    br(),
+    fluidRow(
+      column(12,shiny::actionButton("done", "Done")),
+      br()
+    ),
+    br(),
+    h4("How to use"),
+    p(style="font-size: 12px;", strong("Single-L-click:"), "Select point"),
+    p(style="font-size: 12px;", strong("Single-L-hold-drag:"), "Select area"),
+    p(style="font-size: 12px;", strong("Double-L-click (selected area):"), "Zoom in"),
+    p(style="font-size: 12px;", strong("Double-L-click (no area):"), "Zoom out")
+  )
+}
+
+#' getImageTabPanels
+#'
+#' The UI for a set of reference/query spatial slides
+#'
+#' @param len_images the number of query images
+#' @param channel_names the list of channel names for each image
+#' @param type Either reference (ref) or query (query) image
+#' @param params mapping parameters
+#'
+#' @noRd
+getImageTabPanels <- function(len_images, channel_names, type, params = NULL){
+
+  # get panel label
+  label <- ifelse(type == "ref", "Ref. ", "Query ")
+
+  # call panels
+  do.call(tabsetPanel, c(id=paste0('image_tab_panel_',type), lapply(seq_len(len_images), function(i) {
+    tabPanel(paste0(label,i),
+             br(),
+             fluidRow(
+               column(4, selectInput(paste0("rotate_", type, "_image",i), 
+                                     "Rotate (ClockWise):", 
+                                     choices = c(0,90,180,270), 
+                                     # selected = 0)),
+                                     selected = ifelse(is.null(params[[paste0("rotate_", type, "_image",i)]]), 0, params[[paste0("rotate_", type, "_image",i)]]))),
+               column(4, selectInput(paste0("flipflop_", type, "_image",i), 
+                                     "Transform:", 
+                                     choices = c("None", "Flip", "Flop"), 
+                                     # selected = "None")),
+                                     selected = ifelse(is.null(params[[paste0("flipflop_", type, "_image",i)]]), "None", params[[paste0("flipflop_", type, "_image",i)]]))),
+               column(4, selectInput(paste0("negate_", type, "_image",i), 
+                                     "Negate Image:", 
+                                     choices = c("No", "Yes"), 
+                                     # selected = "No"))
+                                     selected = ifelse(is.null(params[[paste0("negate_", type, "_image",i)]]), "No", params[[paste0("negate_", type, "_image",i)]])))
+             ),
+             fluidRow(
+               column(4, selectInput(paste0("channel_", type, "_image",i), 
+                                     "Channel:", 
+                                     choices = channel_names[[i]])),
+               column(4, sliderInput(paste0("scale_", type, "_image",i), 
+                                     "Scale Parameter", 
+                                     min = 0, 
+                                     max = 1,  
+                                     # value = 1)),
+                                     value = ifelse(is.null(params[[paste0("scale_", type, "_image",i)]]), "1", params[[paste0("scale_", type, "_image",i)]]))),
+               textOutput(paste0("scaleinfo_", type, "_image",i))
+             ),
+             fluidRow(imageOutput(paste0("plot_", type, i), 
+                                  click = paste0("click_plot_", type, i),
+                                  dblclick = paste0("dblclick_plot_", type, i),
+                                  brush = brushOpts(paste0("brush_plot_", type, i), fill = "green", resetOnNew = TRUE))),
+             br(),
+             fluidRow(
+               shiny::actionButton(paste0("remove_", type, i), "Remove Point")
+             ),
+    )
+  })))
+}
+
+#' getRegisteredImageTabPanels
+#'
+#' The UI for a set of query spatial slides
+#'
+#' @param len_images the number of query images
+#' @param centre center image index
+#' @param register_ind query image indices
+#'
+#' @noRd
+getAlignmentTabPanel <- function(len_images, centre, register_ind){
+
+  # tab panels
+  do.call(tabsetPanel, c(id='image_tab_panel_alignment',lapply(register_ind, function(i) {
+    tabPanel(paste0("Ali. ",i, "->", centre),
+             br(),
+             fluidRow(imageOutput(paste0("plot_alignment",i)))
+    )
+  })))
+}
+
+#' getRegisteredImageTabPanels
+#'
+#' The UI for a set of query spatial slides
+#'
+#' @param len_images the number of query images
+#' @param centre center image index
+#' @param register_ind query image indices
+#'
+#' @return tabsetpanel
+#'
+#' @noRd
+getRegisteredImageTabPanels <- function(len_images, centre, register_ind){
+
+  # tab panels
+  do.call(tabsetPanel, c(id='image_tab_panel_reg_query',lapply(register_ind, function(i) {
+    tabPanel(paste0("Reg. ",i, "->", centre),
+             br(),
+             fluidRow(
+               column(12, align="center",
+                      imageOutput(paste0("plot_query_reg",i))
+               )
+             )
+    )
+  })))
+}
+
+#' updateTabPanels
+#'
+#' A function for automatized selection of reference/query tab panels
+#'
+#' @param centre center image index
+#' @param register_ind query image indices
+#' @param input input
+#' @param output output
+#' @param session session
+#'
+#' @noRd
+updateTabPanels <- function(centre, register_ind, input, output, session){
+
+  # number of panels
+  npanels <- length(register_ind) + 1
+
+  # observe changes in the reference tab panel
+  observeEvent(input$image_tab_panel_ref,{
+    selected_panel <- input$image_tab_panel_ref
+    selected_panel_ind <- as.numeric(strsplit(selected_panel, split = " ")[[1]][2])
+
+    query_panel_ind <- (selected_panel_ind + 1)
+    if(query_panel_ind == 1) query_panel_ind <- npanels
+    updateTabsetPanel(session, "image_tab_panel_query", paste0("Query ", query_panel_ind))
+    updateTabsetPanel(session, "image_tab_panel_reg_query", paste0("Reg. ",selected_panel_ind, "->", centre))
+
+    if(selected_panel_ind == npanels)
+      updateTabsetPanel(session, "image_tab_panel_ref", paste0("Ref. ", selected_panel_ind-1))
+  })
+
+  # observe changes in the query tab panel
+  observeEvent(input$image_tab_panel_query,{
+    selected_panel <- input$image_tab_panel_query
+    selected_panel_ind <- as.numeric(strsplit(selected_panel, split = " ")[[1]][2])
+
+    query_panel_ind <- (selected_panel_ind - 1)
+    if(query_panel_ind == 0) query_panel_ind <- 1
+    updateTabsetPanel(session, "image_tab_panel_ref", paste0("Ref. ", query_panel_ind))
+
+    if(selected_panel_ind == 1){
+      updateTabsetPanel(session, "image_tab_panel_query", paste0("Query ", selected_panel_ind+1))
+      updateTabsetPanel(session, "image_tab_panel_reg_query", paste0("Reg. ",selected_panel_ind+1, "->", centre))
+    } else {
+      query_panel_ind <- selected_panel_ind
+      updateTabsetPanel(session, "image_tab_panel_reg_query", paste0("Reg. ",query_panel_ind, "->", centre))
+    }
+  })
+
+  # observe changes in the registered query tab panel
+  observeEvent(input$image_tab_panel_reg_query,{
+    selected_panel <- input$image_tab_panel_reg_query
+    selected_panel_ind <- strsplit(selected_panel, split = " ")[[1]][2]
+    selected_panel_ind <- as.numeric(strsplit(selected_panel_ind, split = "->")[[1]][1])
+    updateTabsetPanel(session, "image_tab_panel_query", paste0("Query ", selected_panel_ind))
+    selected_panel_ali <- gsub("Reg.", "Ali.", selected_panel)
+    updateTabsetPanel(session, "image_tab_panel_alignment", selected_panel_ali)
+  })
+
+  # observe changes in the registered query tab panel
+  observeEvent(input$image_tab_panel_alignment,{
+    selected_panel <- input$image_tab_panel_alignment
+    selected_panel_reg <- gsub("Ali.", "Reg.", selected_panel)
+    updateTabsetPanel(session, "image_tab_panel_reg_query", selected_panel_reg)
+  })
+}
+
+#' updateParameterPanels
+#'
+#' A function for managing which parameter panels or input boxes to appear on UI
+#'
+#' @param len_images the length of images
+#' @param params mapping parameters
+#' @param input input
+#' @param output output
+#' @param session session
+#' 
+#' @importFrom shinyjs hide show
+#' @import shiny
+#'
+#' @noRd
+updateParameterPanels <- function(len_images, params, input, output, session){
+
+  # done event
+  shinyjs::hide(id = "done")
+  observeEvent(input$register, {
+    shinyjs::show(id = "done")
+  })
+
+  # registration panels/buttons
+  shinyjs::hide(id = "GOOD_MATCH_PERCENT")
+  shinyjs::hide(id = "MAX_FEATURES")
+
+  # hide scale parameters
+  for(i in seq_len(len_images)){
+    shinyjs::hide(id = paste0("scale_ref_image",i))
+    shinyjs::hide(id = paste0("scale_query_image",i))
+    shinyjs::hide(id = paste0("scaleinfo_ref_image",i))
+    shinyjs::hide(id = paste0("scaleinfo_query_image",i))
+  }
+
+  observeEvent(input$automatictag, {
+    if(input$automatictag){
+      
+      # Method and Matcher
+      choices <- c("Homography", "Homography + Non-Rigid")
+      selected <- ifelse(is.null(params[["Method"]]), choices[1],
+                         ifelse(!params[["Method"]] %in% choices, choices[1], params[["Method"]]))
+      # selected <- choices[1]
+      updateSelectInput(session, 
+                        "Method", 
+                        choices = choices, 
+                        # selected = "Homography")
+                        selected = selected)
+      shinyjs::show(id = "Matcher")
+
+      # show automatic registration parameters of BRUTE-FORCE
+      if(input$Matcher == "BRUTE-FORCE"){
+        shinyjs::show(id = "GOOD_MATCH_PERCENT")
+        shinyjs::show(id = "MAX_FEATURES")
+      } 
+      if(input$Matcher == "FLANN"){
+        shinyjs::hide(id = "GOOD_MATCH_PERCENT")
+        shinyjs::hide(id = "MAX_FEATURES")
+      }
+
+      # show scale parameters
+      for(i in seq_len(len_images)){
+        shinyjs::show(id = paste0("scale_ref_image",i))
+        shinyjs::show(id = paste0("scale_query_image",i))
+        shinyjs::show(id = paste0("scaleinfo_ref_image",i))
+        shinyjs::show(id = paste0("scaleinfo_query_image",i))
+      }
+
+    } else {
+      
+      # Method and Matcher
+      choices <- c("Non-Rigid", "Homography + Non-Rigid")
+      selected <- ifelse(is.null(params[["Method"]]), choices[1],
+                         ifelse(!params[["Method"]] %in% choices, choices[1], params[["Method"]]))
+      # selected <- choices[1]
+      updateSelectInput(session, "Method", 
+                        choices = choices, 
+                        # selected = "Non-Rigid")
+                        selected = selected)
+      shinyjs::hide(id = "Matcher")
+
+      # hide automatic registration parameters of BRUTE-FORCE
+      if(input$Matcher == "FLANN"){
+        shinyjs::hide(id = "GOOD_MATCH_PERCENT")
+        shinyjs::hide(id = "MAX_FEATURES")
+      }
+
+      # hide scale parameters
+      for(i in seq_len(len_images)){
+        shinyjs::hide(id = paste0("scale_ref_image",i))
+        shinyjs::hide(id = paste0("scale_query_image",i))
+        shinyjs::hide(id = paste0("scaleinfo_ref_image",i))
+        shinyjs::hide(id = paste0("scaleinfo_query_image",i))
+      }
+    }
+  })
+
+  observeEvent(input$Method, {
+    if(grepl("FLANN", input$Matcher)){
+      shinyjs::hide(id = "GOOD_MATCH_PERCENT")
+      shinyjs::hide(id = "MAX_FEATURES")
+    } else {
+      shinyjs::show(id = "GOOD_MATCH_PERCENT")
+      shinyjs::show(id = "MAX_FEATURES")
+      if(grepl("Non-Rigid", input$Method)){
+        updateSelectInput(session, "Method", selected = "Homography") 
+        showNotification("Brute-Force Matching can't be used with Non-Rigid Registration\n")
+      }
+    }
+  })
+  
+  observeEvent(input$Matcher, {
+    if(grepl("FLANN", input$Matcher)){
+      shinyjs::hide(id = "GOOD_MATCH_PERCENT")
+      shinyjs::hide(id = "MAX_FEATURES")
+    } else {
+      shinyjs::show(id = "GOOD_MATCH_PERCENT")
+      shinyjs::show(id = "MAX_FEATURES")
+      if(grepl("Non-Rigid", input$Method)){
+        updateSelectInput(session, "Method", selected = "Homography") 
+        showNotification("Brute-Force Matching can't be used with Non-Rigid Registration\n")
+      }
+    }
+  })
+}
+
+#' initiateParameterPanels
+#'
+#' A function for managing which initialized parameters
+#'
+#' @param mapping_parameters mapping parameters
+#' @param len_images the length of images
+#' @param input input
+#' @param output output
+#' @param session session
+#' 
+#' @import shiny
+#'
+#' @noRd
+initiateParameterPanels <- function(mapping_parameters, len_images, input, output, session){
+
+  # update image specific parameters
+  lapply(c("ref", "query"), function(t){
+    lapply(seq_len(len_images), function(i){
+      lapply(c("rotate", "flipflop", "negate", "channel"), function(c){
+          updateSelectInput(session = session, paste0(c, "_", t, "_image",i), selected = mapping_parameters[[paste0(c, "_", t, "_image",i)]])
+      })
+      updateSliderInput(session = session, paste0("scale_", t, "_image",i), value = mapping_parameters[[paste0("scale_", t, "_image",i)]])
+    })
+  })
+  
+  # update alignment parameters
+  updateCheckboxInput(session = session, "automatictag", value = mapping_parameters[["automatictag"]])
+  updateTextInput(session = session, "GOOD_MATCH_PERCENT", value = mapping_parameters[["GOOD_MATCH_PERCENT"]])
+  updateTextInput(session = session, "MAX_FEATURES", value = mapping_parameters[["MAX_FEATURES"]])
+  updateSelectInput(session = session, "Method", selected = mapping_parameters[["Method"]])
+  updateSelectInput(session = session, "Matcher", selected = mapping_parameters[["Matcher"]])
+}
+
+####
+# Registering Objects ####
+####
+
+#' getRegisteredObject
+#'
+#' Get registered list of VoltRon objects
+#'
+#' @param obj_list a list of VoltRon objects
+#' @param mapping_list a list of transformation matrices
+#' @param register_ind the indices of query images/spatialdatasets
+#' @param centre the index of the central reference image/spatialdata
+#' @param input input
+#' @param reg_mode the registration mode, either "auto" or "manual"
+#' @param image_list the list of query/ref images
+#' @param aligned_image_list the list of aligned query/ref images
+#'
+#' @noRd
+getRegisteredObject <- function(obj_list, mapping_list, register_ind, centre, input, reg_mode = "manual", image_list = NULL, aligned_image_list = NULL){
+
+  # initiate registered VoltRon objects
+  ref_ind <- centre
+  registered_sr <- list()
+
+  # the original reference object
+  registered_sr[[ref_ind]] <- obj_list[[ref_ind]]
+
+  # waiter start
+  withProgress(message = 'Register Coordinates (and Segments)', value = 0, {
+
+    # register all assays
+    for(i in register_ind){
+  
+      # choose image query and ref order
+      if(i > ref_ind){
+        ref_extension = paste0("ref_image",ref_ind)
+        query_extension = paste0("query_image",i)
+      } else {
+        ref_extension = paste0("query_image",ref_ind)
+        query_extension = paste0("ref_image",i)
+      }
+  
+      # register the VoltRon object
+      for(assy in vrAssayNames(obj_list[[i]], assay = "all")){
+  
+        # Increment the progress bar, and update the detail text.
+        incProgress(1/length(register_ind), detail = paste("Register", assy, "of Layer", i, sep = " "))
+  
+        # register assay
+        obj_list[[i]] <- applyPerspectiveTransform(obj_list[[i]],
+                                                   assay = assy,
+                                                   mapping = mapping_list[[paste0(i)]],
+                                                   reference_image = image_list[[ref_ind]],
+                                                   input = input,
+                                                   reg_mode = reg_mode,
+                                                   ref_extension = ref_extension,
+                                                   query_extension = query_extension)
+  
+      }
+      registered_sr[[i]] <- obj_list[[i]]
+  
+    }
+
+  })
+  return(registered_sr)
+}
+
+#' getRegisteredObjectNonShiny
+#'
+#' Get registered list of VoltRon objects, without shiny
+#'
+#' @param obj_list a list of VoltRon objects
+#' @param mapping_list a list of transformation matrices
+#' @param register_ind the indices of query images/spatialdatasets
+#' @param centre the index of the central reference image/spatialdata
+#' @param input input
+#' @param reg_mode the registration mode, either "auto" or "manual"
+#' @param image_list the list of query/ref images
+#' @param aligned_image_list the list of aligned query/ref images
+#'
+#' @noRd
+getRegisteredObjectNonShiny <- function(obj_list, mapping_list, register_ind, centre, input, reg_mode = "manual", image_list = NULL, aligned_image_list = NULL){
+  
+  # initiate registered VoltRon objects
+  ref_ind <- centre
+  registered_sr <- list()
+  
+  # the original reference object
+  registered_sr[[ref_ind]] <- obj_list[[ref_ind]]
+  
+  # message
+  message('Register Coordinates (and Segments)')
+  
+  # register all assays
+  for(i in register_ind){
+    
+    # choose image query and ref order
+    if(i > ref_ind){
+      ref_extension = paste0("ref_image",ref_ind)
+      query_extension = paste0("query_image",i)
+    } else {
+      ref_extension = paste0("query_image",ref_ind)
+      query_extension = paste0("ref_image",i)
+    }
+    
+    # register the VoltRon object
+    for(assy in vrAssayNames(obj_list[[i]], assay = "all")){
+      
+      # message
+      message("Register ", assy, " of Layer ", i)
+
+      # register assay
+      obj_list[[i]] <- applyPerspectiveTransform(obj_list[[i]],
+                                                 assay = assy,
+                                                 mapping = mapping_list[[paste0(i)]],
+                                                 reference_image = image_list[[ref_ind]],
+                                                 input = input,
+                                                 reg_mode = reg_mode,
+                                                 ref_extension = ref_extension,
+                                                 query_extension = query_extension)
+      
+    }
+    registered_sr[[i]] <- obj_list[[i]]
+    
+  }
+  return(registered_sr)
+}
+
+#' applyPerspectiveTransform
+#'
+#' Applying a perspective transformation to the VoltRon object
+#'
+#' @param object a VoltRon objects
+#' @param mapping a list of transformation matrices
+#' @param reference_image the reference image
+#' @param input input
+#' @param reg_mode the registration mode, either "auto" or "manual"
+#' @param ref_extension the shiny extension of reference image
+#' @param query_extension the shiny extension of query image
+#'
+#' @importFrom magick image_info
+#'
+#' @noRd
+applyPerspectiveTransform <- function(object,
+                                      assay = NULL,
+                                      mapping,
+                                      reference_image,
+                                      input,
+                                      reg_mode,
+                                      ref_extension,
+                                      query_extension){
+
+  # check assay
+  if(is.null(assay))
+    assay <- vrAssayNames(object)
+
+  # get coordinates, segments and spatial points
+  coords <- vrCoordinates(object, assay = assay)
+  segments <- vrSegments(object, assay = assay)
+
+  if(reg_mode == "manual"){
+
+    # get the multiplication of all homography matrices
+    # cur_mapping <- Reduce("%*%", mapping)
+    mapping <- manageMapping(mapping)
+    
+    # get registered coordinates
+    coords_reg <- as.matrix(as(coords, "dgCMatrix"))
+    coords_reg[,c("x", "y")] <- applyMapping(coords[,c("x", "y")], mapping)
+    rownames(coords_reg) <- rownames(coords)
+    colnames(coords_reg) <- colnames(coords)
+
+    # get registered segments
+    if(length(segments) > 0){
+      segments_reg <- do.call(rbind, segments)
+      segments_reg[,colnames(segments_reg) %in% c("x", "y")] <- applyMapping(as.matrix(segments_reg[,colnames(segments_reg) %in% c("x", "y")]), mapping)
+      segments_reg <- split(segments_reg, segments_reg[,1])
+      names(segments_reg) <- names(segments)
+    } else {
+      segments_reg <- segments
+    }
+
+    # get registered image (including all channels)
+    image_reg_list <- sapply(vrImageChannelNames(object[[assay]]), function(x) NULL, USE.NAMES = TRUE)
+    for(channel_ind in names(image_reg_list)){
+      query_image <- vrImages(object[[assay]], channel = channel_ind, as.raster = TRUE)
+      if(!inherits(query_image, "Image_Array")){
+        query_image <- magick::image_read(query_image)
+      }
+      warped_image <- getRcppWarpImage(ref_image = reference_image,
+                                       query_image = query_image,
+                                       mapping = mapping)
+      image_reg_list[[channel_ind]] <- warped_image
+    }
+
+  } else if(reg_mode == "auto"){
+
+    # get the multiplication of all homography matrices
+    mapping <- manageMapping(mapping)
+    
+    # images
+    ref_image <- transformImage(reference_image, ref_extension, input)
+    query_image <- vrImages(object[[assay]], as.raster = TRUE)
+    if(!inherits(query_image, "Image_Array")){
+      query_image <- magick::image_read(query_image)
+    }
+    query_image <- transformImage(query_image, query_extension, input)
+
+    # image info
+    query_info <- getImageInfo(query_image)
+    ref_info <- getImageInfo(ref_image)
+
+    # get registered coordinates
+    coords_reg <- as.data.frame(as.matrix(as(coords, "dgCMatrix")))
+    coords_reg <- transformImageKeypoints(query_image, coords_reg[,c("x","y")], query_extension, input)$keypoints
+
+    coords_reg[,2] <- query_info$height - coords_reg[,2]
+    coords_reg <- as.matrix(coords_reg)
+    coords_reg <- applyMapping(coords_reg, mapping)
+    coords_reg <- as.data.frame(coords_reg)
+    coords_reg[,2] <- ref_info$height - coords_reg[,2]
+
+    colnames(coords_reg) <- c("x", "y")
+    coords_reg <- transformKeypoints(ref_image, coords_reg, ref_extension, input)
+    coords_reg <- as.matrix(coords_reg)
+    rownames(coords_reg) <- rownames(coords)
+    
+    # fix 3rd dimension 
+    coords[,c("x", "y")] <- coords_reg[,c("x", "y")]
+    coords_reg <- coords
+
+    # get registered segments
+    if(length(segments) > 0){
+      segments_reg <- do.call(rbind, segments)
+      segments_reg <- as.data.frame(segments_reg)
+      segments_reg <- transformImageKeypoints(query_image, segments_reg, query_extension, input)$keypoints
+      segments_reg[,colnames(segments_reg) %in% c("y")] <- query_info$height - segments_reg[,colnames(segments_reg) %in% c("y")]
+      segments_reg[,colnames(segments_reg) %in% c("x", "y")] <- applyMapping(as.matrix(segments_reg[,colnames(segments_reg) %in% c("x", "y")]), mapping)
+      segments_reg[,colnames(segments_reg) %in% c("y")]  <- ref_info$height - segments_reg[,colnames(segments_reg) %in% c("y")]
+      segments_reg <- transformKeypoints(ref_image, segments_reg, ref_extension, input)
+      segments_reg <- split(segments_reg, segments_reg[,1])
+      names(segments_reg) <- names(segments)
+    } else {
+      segments_reg <- segments
+    }
+
+    # get registered image (including all channels)
+    image_reg_list <- sapply(vrImageChannelNames(object[[assay]]), function(x) NULL, USE.NAMES = TRUE)
+    for(channel_ind in names(image_reg_list)){
+
+      # rotate, flip and flop before warping in C++
+      ref_image <- transformImage(reference_image, ref_extension, input)
+      query_image <- vrImages(object[[assay]], channel = channel_ind, as.raster = TRUE)
+      if(!inherits(query_image, "Image_Array")){
+        query_image <- magick::image_read(query_image)
+      }
+      query_image <- transformImage(query_image, query_extension, input)
+      query_image <- getRcppWarpImage(ref_image, query_image, mapping = mapping)
+      query_image <- transformImageReverse(query_image, ref_extension, input)
+
+      image_reg_list[[channel_ind]] <- query_image
+    }
+  }
+
+  # make new image object
+  vrImages(object[[assay]], reg = TRUE) <- formImage(coords = coords_reg, segments = segments_reg, image = image_reg_list)
+  
+  # set up the spatial coordinate name 
+  vrMainSpatial(object[[assay]]) <- paste0(vrMainSpatial(object[[assay]]), "_reg")
+
+  # return object
+  return(object)
+}
+
+####
+# Managing Mappings ####
+####
+
+manageMapping <- function(mappings){
+  
+  # check if all transformations are homography
+  allHomography <- suppressWarnings(all(lapply(mappings, function(map){
+    nrow(map[[1]] > 0) && is.null(map[[2]])
+  })))
+  
+  # change the mapping
+  new_mappings <- list()
+  if(allHomography){
+    mappings <- lapply(mappings, function(map) map[[1]])
+    new_mappings <- list(
+      list(Reduce("%*%", mappings),
+           NULL)
+    )
+  } else {
+    new_mappings <- mappings
+  }
+  
+    
+  # return
+  return(new_mappings)
+}
+  
+####
+# Managing Parameters ####
+####
+
+#' initateKeypoints
+#'
+#' Initiate shiny reactive values for keypoint dataframes for pairwise reference and query images
+#'
+#' @param len_images the length of images
+#' @param keypoints_list the list of keypoint pairs
+#' @param input shiny input
+#' @param output shiny output
+#' @param session shiny session
+#'
+#' @importFrom dplyr tibble
+#'
+#' @noRd
+initateKeypoints <- function(len_images, keypoints_list, input, output, session){
+
+  # initiate keypoints
+  if(is.null(keypoints_list)){
+    keypoints_list <- lapply(seq_len(len_images-1), function(i) {
+      list(ref = dplyr::tibble(KeyPoint = numeric(), x = numeric(), y = numeric()),
+           query = dplyr::tibble(KeyPoint = numeric(), x = numeric(), y = numeric()))
+    })
+
+    # set names for keypoints
+    names(keypoints_list) <- paste0(seq_len(len_images-1),"-",2:len_images)
+  }
+
+  # return keypoints as reactive values
+  do.call("reactiveValues", keypoints_list)
+}
+
+#' manageKeypoints
+#'
+#' A list of shiny observe events for tables and auxiliary operations for pairwise reference and query image
+#'
+#' @param centre center image index
+#' @param register_ind query image indices
+#' @param xyTable_list a list of keypoints x,y coordinates for each magick image
+#' @param image_list a lost of magick image
+#' @param info_list a list of magick image info on width and height
+#' @param zoom_list a list of x,y ranges of query and ref images
+#' @param input shiny input
+#' @param output shiny output
+#' @param session shiny session
+#'
+#' @noRd
+manageKeypoints <- function(centre, register_ind, xyTable_list, image_list, info_list, zoom_list, input, output, session){
+
+  # get image types
+  image_types <- c("ref","query")
+
+  # get the length of tables
+  len_tables <- length(xyTable_list)
+
+  # set click operations for reference and query points
+  lapply(seq_len(len_tables), function(i){
+    lapply(image_types, function(type){
+
+      # listen to click operations for reference/query plots
+      observeEvent(input[[paste0("click_plot_", type ,i)]], {
+
+        # get brush information
+        brush <- input[[paste0("brush_plot_", type ,i)]]
+        limits <- cbind(zoom_list[[paste0(i)]][[type]]$x, zoom_list[[paste0(i)]][[type]]$y)
+        if (is.null(brush)) {
+
+          # get image
+          image <- image_list[[i]]
+
+          # get and transform keypoints
+          keypoint <- data.frame(x = input[[paste0("click_plot_",type,i)]]$x,
+                                 y = input[[paste0("click_plot_",type,i)]]$y)
+          
+          # get the transformed zoom info first and calculate width, then record transformed image
+          limits_trans <- data.frame(x = limits[,1], y = limits[,2])
+          limits_trans <- transformImageKeypoints(image, limits_trans, paste0(type, "_image",i), input)
+          image_trans <- limits_trans$image
+          limits_trans <- data.frame(x = range(limits_trans$keypoints[,1]), y = range(limits_trans$keypoints[,2]))
+          
+          # correct for scaling, scale factor = 1000
+          width <- limits_trans[2,1]-limits_trans[1,1]
+          height <- limits_trans[2,2]-limits_trans[1,2]
+          if(max(height,width) > 1000){
+            if(inherits(image_trans, "Image_Array")){
+              n.series <- ImageArray::len(image_trans)
+              cur_width <- width
+              cur_height <- height
+              for(ii in 2:n.series){
+                cur_width <- width/(2^(ii-1))
+                cur_height <- height/(2^(ii-1))
+                if(max(cur_height, cur_width) <= 1000){
+                  break
+                }
+              }
+              keypoint <- keypoint*width/ceiling(cur_width)
+            } else {
+              keypoint <- keypoint*width/1000 
+            }
+          }
+          
+          # correct for zoom information
+          keypoint <- keypoint + limits_trans[1,]
+          
+          # correct for flipflop and rotate
+          keypoint <- transformKeypoints(image_trans, keypoint, paste0(type, "_image",i), input)
+          
+          # insert keypoint to associated table
+          ref_ind <- ifelse(type == "ref", i, i-1) # select reference image
+          
+          # insert keypoint to associated table
+          temp <- xyTable_list[[paste0(ref_ind, "-", ref_ind+1)]][[type]]
+          temp <- temp %>%
+            add_row(KeyPoint = nrow(temp)+1, x = keypoint$x, y = keypoint$y)
+          xyTable_list[[paste0(ref_ind, "-", ref_ind+1)]][[type]] <- temp
+
+        }
+      })
+    })
+  })
+
+  # remove keypoints from images
+  lapply(seq_len(len_tables), function(i){
+    lapply(image_types, function(type){
+      observeEvent(input[[paste0("remove_", type, i)]], {
+        ref_ind <- ifelse(type == "ref", i, i-1) # select reference image
+        temp <- xyTable_list[[paste0(ref_ind, "-", ref_ind+1)]][[type]]
+        if(nrow(temp) > 0){
+          temp <- temp %>% filter(KeyPoint != nrow(temp))
+          xyTable_list[[paste0(ref_ind, "-", ref_ind+1)]][[type]] <- temp
+        }
+      })
+    })
+  })
+}
+
+#' transformImageKeypoints
+#'
+#' Apply given transformations to a magick image and keypoints for plotting
+#'
+#' @param image magick image
+#' @param extension name extension for the shiny input parameter
+#' @param keypoints a set of keypoints
+#' @param input shiny input
+#' @param session shiny session
+#'
+#' @importFrom magick image_negate image_rotate image_flip image_flop image_info
+#'
+#' @noRd
+transformImageKeypoints <- function(image, keypoints, extension, input, session){
+
+  if(is.null(keypoints))
+    return(list(image = image, keypoints = keypoints))
+
+  # negate image
+  input_negate <- input[[paste0("negate_", extension)]]
+  if(input_negate == "Yes"){
+    image <- negateImage(image)
+  }
+
+  # get unrotated image info
+  image_limits <- unlist(getImageInfo(image)[1,c("width", "height")])
+  image_origin <- image_limits/2
+
+  # rotate image and keypoints
+  input_rotate <- as.numeric(input[[paste0("rotate_", extension)]])
+  image <- rotateImage(image, input_rotate)
+
+  # get rotated image info
+  rotated_image_limits <- unlist(getImageInfo(image)[1,c("width", "height")])
+  rotated_image_origin <- rotated_image_limits/2
+
+  # rotate keypoints
+  keypoints <- rotateKeypoint(keypoints, input_rotate, image_origin, image_limits, rotated_image_origin, rotated_image_limits)
+
+  # flip flop image and keypoints
+  input_flipflop <- input[[paste0("flipflop_", extension)]]
+  if(input_flipflop == "Flip"){
+    # image <- magick::image_flip(image)
+    image <- flipImage(image)
+  } else if(input_flipflop == "Flop"){
+    # image <- magick::image_flop(image)
+    image <- flopImage(image)
+  }
+
+  # flipflop keypoints
+  keypoints <- flipflopKeypoint(keypoints, rotated_image_limits, input_flipflop)
+
+  # return both the image and the keypoints
+  return(list(image = image, keypoints = keypoints))
+}
+
+#' transformKeypoints
+#'
+#' Apply transformations to keypoints given transformed images to find the keypoints locations in the original image
+#'
+#' @param image magick image
+#' @param keypoints keypoints visualized on image
+#' @param extension name extension for the shiny input parameter
+#' @param input shiny input
+#'
+#' @importFrom magick image_flip image_flop image_rotate
+#'
+#' @noRd
+transformKeypoints <- function(image, keypoints, extension, input){
+
+  # get unrotated image info
+  image_limits <- unlist(getImageInfo(image)[1,c("width", "height")])
+  image_origin <- image_limits/2
+
+  # flip flop image and keypoints
+  input_flipflop <- input[[paste0("flipflop_", extension)]]
+  if(input_flipflop == "Flip"){
+    image <- flipImage(image)
+  } else if(input_flipflop == "Flop"){
+    image <- flopImage(image)
+  }
+  keypoints <- flipflopKeypoint(keypoints, image_limits, input_flipflop)
+
+  # rotate image (reverse) and keypoints
+  input_rotate <- 360 - as.numeric(input[[paste0("rotate_", extension)]])
+  image <- rotateImage(image, input_rotate)
+
+  # get rotated image info
+  rotated_image_limits <- unlist(getImageInfo(image)[1,c("width", "height")])
+  rotated_image_origin <- rotated_image_limits/2
+
+  # rotate keypoints
+  keypoints <- rotateKeypoint(keypoints, input_rotate, image_origin, image_limits, rotated_image_origin, rotated_image_limits)
+
+  return(keypoints)
+}
+
+#' rotateKeypoint
+#'
+#' Find transformations of keypoints under clockwise rotations of the image
+#'
+#' @param keypoints dataset of keypoints
+#' @param angle angle of rotation [0,360]
+#' @param origin center of the image
+#' @param limits limits of the image
+#' @param rotated_origin center of the rotated image
+#' @param rotated_limits limits of the rotated image
+#'
+#' @noRd
+rotateKeypoint <- function(keypoints, angle, origin, limits, rotated_origin, rotated_limits){
+
+  # if there are no points, return
+  if(nrow(keypoints) == 0)
+    return(keypoints)
+
+  # get coordinates from the keypoints dataset
+  points <- keypoints[,c("x","y")]
+
+  # set rotation matrix for angles
+  radii <- ((360-angle)*pi/180)
+  s = sin(radii);
+  c = cos(radii);
+  rotation_mat <- matrix(c(c, s, -s, c), nrow = 2, byrow = F)
+
+  # rotate point
+  points <- points - matrix(rep(origin, nrow(points)), nrow = nrow(points), byrow = T)
+  points <- points * matrix(rep(1/limits, nrow(points)), nrow = nrow(points), byrow = T)
+  rotated_points <- t(rotation_mat %*% t(points))
+  rotated_points <- rotated_points * matrix(rep(rotated_limits, nrow(points)), nrow = nrow(rotated_points), byrow = T)
+  rotated_points <- rotated_points + matrix(rep(rotated_origin, nrow(points)), nrow = nrow(rotated_points), byrow = T)
+
+  # put rotated points back to keypoints
+  keypoints[,c("x","y")] <- rotated_points
+
+  return(keypoints)
+}
+
+#' flipflopKeypoint
+#'
+#' Find transformed keypoints on image given any flip or flop action by magick
+#'
+#' @param keypoints dataset of keypoints
+#' @param image_limits limits of the images
+#' @param flipflop a flip or flop action as string
+#'
+#' @noRd
+flipflopKeypoint <- function(keypoints, image_limits, flipflop){
+
+  if(nrow(keypoints) == 0)
+    return(keypoints)
+
+  if(grepl("Flop", flipflop))
+    keypoints$x = image_limits[1] - keypoints$x
+
+  if(grepl("Flip", flipflop))
+    keypoints$y = image_limits[2] - keypoints$y
+
+  return(keypoints)
+}
+
+#' imageKeypoint
+#'
+#' add keypoints as points on ggplot object
+#'
+#' @param image magick image
+#' @param keypoints keypoints to draw on image
+#'
+#' @noRd
+imageKeypoint <- function(image, keypoints){
+
+  if(is.null(keypoints))
+    return(image)
+
+  # select keypoints and texts on image
+  image <- image +
+    geom_point(mapping = aes(x = x, y = y), keypoints, size = 8, shape = 21, fill = "white") +
+    geom_text(mapping = aes(x = x, y = y, label = KeyPoint), keypoints, size = 5)
+}
+
+#' checkKeypoints
+#'
+#' check keypoints list
+#'
+#' @param keypoints_list list of matching keypoints
+#'
+#' @noRd
+checkKeypoints <- function(keypoints_list){
+  keypoints_check_flag <- sapply(keypoints_list, function(key_list){
+    nrow(key_list$ref) > 0 | nrow(key_list$query) > 0
+  })
+  if(!all(unlist(keypoints_check_flag))){
+    showNotification("Please select keypoints for all images\n")
+    return(NULL)
+  }
+
+  keypoints_check_flag <- sapply(keypoints_list, function(key_list){
+    nrow(key_list$ref) == nrow(key_list$query)
+  })
+  if(!all(unlist(keypoints_check_flag))){
+    showNotification("The number of reference and query keypoints should be equal! \n")
+    return(NULL)
+  }
+}
+
+transferParameterInput <- function(params, image_list){
+  
+  # the number of registrations
+  len_image <- length(image_list)
+  
+  # transfer params
+  input <- list()
+  input[["automatictag"]] <- params[["automatictag"]]
+  input[["GOOD_MATCH_PERCENT"]] <- params[["GOOD_MATCH_PERCENT"]]
+  input[["MAX_FEATURES"]] <- params[["MAX_FEATURES"]]
+  input[["Method"]] <- params[["Method"]]
+  input[["Matcher"]] <- params[["Matcher"]]
+  for(i in seq_len(len_image)){
+    for(imgtype in c("ref","query")){
+      input[[paste0("rotate_", imgtype, "_image", i)]] <-  params[[paste0("rotate_", imgtype, "_image", i)]]
+      input[[paste0("flipflop_", imgtype, "_image", i)]] <-  params[[paste0("flipflop_", imgtype, "_image", i)]]
+      input[[paste0("negate_", imgtype, "_image", i)]] <-  params[[paste0("negate_", imgtype, "_image", i)]]
+      input[[paste0("scale_", imgtype, "_image", i)]] <-  params[[paste0("scale_", imgtype, "_image", i)]]
+      input[[paste0("channel_", imgtype, "_image", i)]] <-  params[[paste0("channel_", imgtype, "_image", i)]]
+    }
+  }
+  
+  input
+}
+
+####
+# Managing Zoom Options ####
+####
+
+#' imageZoom
+#'
+#' zoom image
+#'
+#' @param image magick image
+#' @param zoom_info zoom info to draw on image
+#'
+#' @importFrom magick image_info
+#' 
+#' @noRd
+imageZoom <- function(image, zoom_info = NULL){
+  
+  if(is.null(zoom_info))
+    return(image)
+  
+  # get image info
+  imageinfo <- getImageInfo(image)
+  
+  # get info of zoom
+  zoom_info <- FromBoxToCrop(as.data.frame(zoom_info), imageinfo)
+  
+  # return
+  return(zoom_info)
+}
+
+#' initiateZoomOptions
+#'
+#' Initiate shiny reactive values for capturing zoom/brush limits
+#'
+#' @param info_list the list of image information
+#' @param input shiny input
+#' @param output shiny output
+#' @param session shiny session
+#'
+#' @noRd
+initiateZoomOptions <- function(info_list, input, output, session){
+  
+  # length of images
+  len_images <- length(info_list)
+  
+  # initiate zoom options list
+  zoom_list <- lapply(seq_len(len_images), function(i) {
+    list(ref = list(x = c(0, info_list[[i]][1]), y = c(0, info_list[[i]][2])),
+         query = list(x = c(0, info_list[[i]][1]), y = c(0, info_list[[i]][2])))
+  })
+  
+  # set names for keypoints
+  names(zoom_list) <- paste0(seq_len(len_images))
+  
+  # return keypoints as reactive values
+  do.call("reactiveValues", zoom_list)
+}
+
+#' manageImageZoomOptions
+#'
+#' A list of shiny observe events for handling zoom options of image outputs
+#'
+#' @param centre center image index
+#' @param register_ind query image indices
+#' @param zoom_list a list of x,y ranges of query and ref images
+#' @param image_list a list of transformed magick image
+#' @param info_list the list of image information
+#' @param input shiny input
+#' @param output shiny output
+#' @param session shiny session
+#'
+#' @noRd
+manageImageZoomOptions <- function(centre, register_ind, zoom_list, image_list, info_list, input, output, session){
+
+  # get image types
+  image_types <- c("ref","query")
+  
+  # get the length of tables
+  len_tables <- length(zoom_list)
+  
+  # set click operations for reference and query points
+  lapply(seq_len(len_tables), function(i){
+    lapply(image_types, function(type){
+      
+      # listen to click operations for reference/query plots
+      observeEvent(input[[paste0("dblclick_plot_", type ,i)]], {
+        
+        # get brush information
+        brush <- input[[paste0("brush_plot_", type ,i)]]
+        limits <- cbind(zoom_list[[paste0(i)]][[type]]$x, zoom_list[[paste0(i)]][[type]]$y)
+        if (!is.null(brush)) {
+          
+          # get brush variables
+          brush_mat <- data.frame(x = c(brush$xmin, brush$xmax), 
+                                  y = c(brush$ymin, brush$ymax))
+
+          # get image
+          image <- image_list[[i]]
+          
+          # get the transformed limits first and calculate width, then record transformed image
+          limits_trans <- data.frame(x = limits[,1], y = limits[,2])
+          limits_trans <- transformImageKeypoints(image, limits_trans, paste0(type, "_image",i), input)
+          image_trans <- limits_trans$image
+          limits_trans <- data.frame(x = range(limits_trans$keypoints[,1]), y = range(limits_trans$keypoints[,2]))
+
+          # if width is large, then correct the brush event for the downsize effect
+          width <- limits_trans[2,1]-limits_trans[1,1]
+          height <- limits_trans[2,2]-limits_trans[1,2]
+          if(max(height,width) > 1000){
+            if(inherits(image_trans, "Image_Array")){
+              n.series <- ImageArray::len(image_trans)
+              cur_width <- width
+              cur_height <- height
+              for(ii in 2:n.series){
+                cur_width <- width/(2^(ii-1))
+                cur_height <- height/(2^(ii-1))
+                if(max(cur_height, cur_width) <= 1000){
+                  break
+                }
+              }
+              brush_mat <- brush_mat*width/ceiling(cur_width)
+            } else {
+              brush_mat <- brush_mat*width/1000
+            }
+          }
+
+          # correct brush for the zoom effect
+          brush_mat[,1] <- brush_mat[,1] + limits_trans[1,1]
+          brush_mat[,2] <- brush_mat[,2] + limits_trans[1,2]
+
+          # correct for flipflop and rotate using the transformed image from above
+          brush_mat <- transformKeypoints(image_trans, as.data.frame(brush_mat), paste0(type, "_image",i), input)
+          brush_mat <- data.frame(x = range(brush_mat[,1]), y = range(brush_mat[,2]))
+          brush_mat <- as.matrix(brush_mat)
+
+          # make new zoom information
+          zoom_list[[paste0(i)]][[type]]$x <- brush_mat[,1]
+          zoom_list[[paste0(i)]][[type]]$y <- brush_mat[,2]
+        
+        } else {
+          zoom_list[[paste0(i)]][[type]]$x <- c(0, info_list[[i]][1])
+          zoom_list[[paste0(i)]][[type]]$y <- c(0, info_list[[i]][2])
+        }
+      })
+    })
+  })
+}
+
+####
+# Managing Images ####
+####
+
+#' getImageOutput
+#'
+#' Shiny outputs for a set of magick images with keypoints
+#'
+#' @param image_list a list of magick images
+#' @param info_list a list of magick image info on width and height
+#' @param keypoints_list a list of data frames, each having a set of keypoints
+#' @param zoom_list a list of x,y ranges of query and ref images
+#' @param centre the center image index
+#' @param input shiny input
+#' @param output shiny output
+#' @param session shiny session
+#'
+#' @importFrom magick image_ggplot image_resize image_crop geometry_size_percent
+#'
+#' @noRd
+getImageOutput <- function(image_list, info_list, keypoints_list = NULL, zoom_list, centre, input, output, session){
+
+  # get image types
+  image_types <- c("ref","query")
+
+  # get the length of images
+  len_images <- length(image_list)
+
+  # output query images
+  lapply(seq_len(len_images), function(i){
+    lapply(image_types, function(type){
+
+      # image output
+      output[[paste0("plot_", type, i)]] <- renderPlot({
+
+        # select keypoints
+        ref_ind <- ifelse(type == "ref", i, i-1) # select reference image
+        keypoints <- keypoints_list[[paste0(ref_ind, "-", ref_ind+1)]][[type]]
+        
+        # transform image and keypoints
+        img <- image_list[[i]][[input[[paste0("channel_", type, "_image", i)]]]]
+        img_trans <- transformImageKeypoints(img, keypoints, paste0(type, "_image",i), input, session)
+        
+        # zoom images and keypoints
+        limits <- as.data.frame(zoom_list[[paste0(i)]][[type]])
+        img_limits <- transformImageKeypoints(img, limits, paste0(type, "_image",i), input, session)
+        img_limits$keypoints <- data.frame(x = range(img_limits$keypoints[,1]), y = range(img_limits$keypoints[,2]))
+        imgzoom <- imageZoom(img_trans$image, zoom_info = img_limits$keypoints)
+        if(!is.null(img_trans$keypoints)){
+          if(nrow(img_trans$keypoints) > 0){
+            temp <- as.matrix(img_trans$keypoints[,c("x","y")])
+            temp <- temp - matrix(unlist(rep(img_limits$keypoints[1,], nrow(img_trans$keypoints))), nrow = nrow(img_trans$keypoints), byrow = T)
+            img_trans$keypoints[,c("x","y")] <- temp
+          }
+        }
+        
+        # img_trans$image <- magick::image_crop(img_trans$image, geometry = imgzoom)
+        img_trans$image <- cropImage(img_trans$image, geometry = imgzoom)
+        
+        # lower resolution
+        width <- img_limits$keypoints[2,1]-img_limits$keypoints[1,1]
+        height <- img_limits$keypoints[2,2]-img_limits$keypoints[1,2]
+        if(max(height, width) > 1000){
+          
+          # scale keypoints
+          if(inherits(img_trans$image, "Image_Array")){
+            n.series <- ImageArray::len(img_trans$image)
+            cur_width <- width
+            cur_height <- height
+            for(ii in 2:n.series){
+              cur_width <- width/(2^(ii-1))
+              cur_height <- height/(2^(ii-1))
+              if(max(cur_height, cur_width) <= 1000){
+                break
+              }
+            }
+            img_trans$keypoints[,c("x","y")] <- img_trans$keypoints[,c("x","y")]*(cur_width/width)
+          } else {
+            img_trans$keypoints[,c("x","y")] <- img_trans$keypoints[,c("x","y")]*(1000/width)
+          }
+        } 
+
+
+        # visualize
+        img_ggplot <- plotImage(img_trans$image, max.pixel.size = 1000)
+        img_ggplot <- imageKeypoint(img_ggplot, img_trans$keypoints)
+        
+        # return
+        return(img_ggplot)
+      })
+
+      # update info
+      output[[paste0("scaleinfo_", type, "_image", i)]] <- renderText({
+        cur_info <- info_list[[i]] * input[[paste0("scale_", type, "_image", i)]]
+        paste(cur_info, collapse = "x")
+      })
+    })
+  })
+}
+
+#' plotImage
+#'
+#' plot image
+#'
+#' @param image a magick image or DelayedArray object
+#' 
+#' @importFrom magick image_ggplot
+#'
+#' @noRd
+plotImage <- function(image, max.pixel.size = NULL){
+  
+  if(inherits(image, "magick-image")){
+    imageinfo <- getImageInfo(image)
+    if(!is.null(max.pixel.size)){
+      if(max(imageinfo$width, imageinfo$height) > max.pixel.size){
+        image <- magick::image_resize(image, geometry = as.character(max.pixel.size))
+      } 
+    }
+    imgggplot <- magick::image_ggplot(image)
+  } else if(inherits(image, "Image_Array")){
+    img_raster <- as.raster(image, max.pixel.size = max.pixel.size)
+    info <- list(width = dim(img_raster)[2], height = dim(img_raster)[1])
+    imgggplot <- ggplot2::ggplot(data.frame(x = 0, y = 0), ggplot2::aes_string("x", "y")) + 
+      ggplot2::geom_blank() + 
+      ggplot2::theme_void() + 
+      ggplot2::coord_fixed(expand = FALSE, 
+                           xlim = c(0, info$width), 
+                           ylim = c(0, info$height)) + 
+      ggplot2::annotation_raster(img_raster, 0, info$width, info$height, 0, interpolate = FALSE)
+  }
+  imgggplot
+}
+
+#' getImageInfoList
+#'
+#' get information on list of images
+#'
+#' @param image_list a list of magick images or DelayedArray objects
+#'
+#' @noRd
+getImageInfoList <- function(image_list){
+  lapply(image_list, function(x){
+    imginfo <- getImageInfo(x)
+    c(imginfo$width, imginfo$height)
+  })
+}
+
+#' getImageInfo
+#'
+#' get information on images
+#'
+#' @param image a magick image or DelayedArray object
+#'
+#' @importFrom magick image_info
+#'
+#' @noRd
+getImageInfo <- function(image){
+  
+  if(inherits(image, "magick-image")){
+    imginfo <- magick::image_info(image)
+  } else if(inherits(image, "Image_Array")){
+    imginfo <- ImageArray::getImageInfo(image)
+  }
+  as.data.frame(imginfo)
+}
+
+#' rotateImage
+#'
+#' rotate images
+#'
+#' @param image a magick image or DelayedArray object
+#' @param degrees value between 0 and 360 for how many degrees to rotate
+#'
+#' @importFrom magick image_rotate
+#'
+#' @noRd
+rotateImage <- function(image, degrees){
+  
+  if(inherits(image, "magick-image")){
+    image <- magick::image_rotate(image, degrees = degrees)
+  } else if(inherits(image, "Image_Array")){
+    image <- ImageArray::rotate(image, degrees)
+  }
+  image
+}
+
+#' negateImage
+#'
+#' negate images
+#'
+#' @param image a magick image or DelayedArray object
+#' 
+#' @importFrom magick image_negate
+#'
+#' @noRd
+negateImage <- function(image){
+  
+  if(inherits(image, "magick-image")){
+    image <- magick::image_negate(image)
+  } else if(inherits(image, "Image_Array")){
+    image <- ImageArray::negate(image)
+  }
+  image
+}
+
+#' flipImage
+#'
+#' flip images
+#'
+#' @param image a magick image or DelayedArray object
+#' 
+#' @importFrom magick image_negate
+#'
+#' @noRd
+flipImage <- function(image){
+  
+  if(inherits(image, "magick-image")){
+    image <- magick::image_flip(image)
+  } else if(inherits(image, "Image_Array")){
+    image <- ImageArray::flip(image)
+  }
+  image
+}
+
+#' flopImage
+#'
+#' flop images
+#'
+#' @param image a magick image or DelayedArray object
+#' 
+#' @importFrom magick image_negate
+#'
+#' @noRd
+flopImage <- function(image){
+  
+  if(inherits(image, "magick-image")){
+    image <- magick::image_flop(image)
+  } else if(inherits(image, "Image_Array")){
+    image <- ImageArray::flop(image)
+  }
+  image
+}
+
+#' cropImage
+#'
+#' crop images
+#'
+#' @param image a magick image or DelayedArray object
+#' @param geometry a geometry string specifying area (for cropping) or size (for resizing).
+#' 
+#' @importFrom magick image_crop
+#'
+#' @noRd
+cropImage <- function(image, geometry){
+  
+  if(inherits(image, "magick-image")){
+    image <- magick::image_crop(image, geometry = geometry)
+  } else if(inherits(image, "Image_Array")){
+    crop_info_int <- as.integer(strsplit(geometry, split = "[x|+]")[[1]])
+    image <- ImageArray::crop(image, ind = list(crop_info_int[3]:(crop_info_int[3]+crop_info_int[1]), crop_info_int[4]:(crop_info_int[4]+crop_info_int[2])))
+  }
+  image
+}
+
+#' resizeImage
+#'
+#' resize images
+#'
+#' @param image a magick image or DelayedArray object
+#' @param geometry a geometry string specifying area (for cropping) or size (for resizing).
+#' 
+#' @importFrom magick image_resize image_info image_read geometry_size_percent
+#'
+#' @noRd
+resize_Image <- function(image, geometry){
+  
+  # get image info
+  image_info_large <- getImageInfo(image)
+  
+  if(inherits(image, "magick-image")){
+    image <- magick::image_resize(image, geometry = geometry)
+  } else if(inherits(image, "Image_Array")){
+    
+    # get scale factor 
+    if(grepl("%$", geometry)){
+      scale_factor <- as.numeric(gsub("%$", "", geometry))/100
+    } else if(grepl("x$", geometry)){
+      scale_factor <- (as.numeric(gsub("x$", "", geometry))/image_info_large$width)
+    }
+
+    # get scaled array 
+    scaled_image_info <- ceiling(image_info_large*scale_factor)
+    image <- as.array(image, min.pixel.size = max(scaled_image_info))
+    
+    # convert to magick image
+    image <- magick::image_read(array(as.raw(image), dim = dim(image)))
+    image_info <- magick::image_info(image)
+    image <- magick::image_resize(image, geometry = geometry_size_percent(100*scaled_image_info[1]/image_info$width))
+  }
+  image
+}
+
+#' transformImage
+#'
+#' Apply given transformations to a magick image
+#'
+#' @param image magick image
+#' @param extension name extension for the shiny input parameter
+#' @param input shiny input
+#'
+#' @importFrom magick image_flip image_flop image_rotate
+#'
+#' @noRd
+transformImage <- function(image, extension, input){
+
+  # rotate image and keypoints
+  input_rotate <- as.numeric(input[[paste0("rotate_", extension)]])
+  image <- rotateImage(image, input_rotate)
+  
+  # flip flop image and keypoints
+  input_flipflop <- input[[paste0("flipflop_", extension)]]
+  if(input_flipflop == "Flip"){
+    image <- flipImage(image)
+  } else if(input_flipflop == "Flop"){
+    image <- flopImage(image)
+  }
+
+  # return image
+  image
+}
+
+#' transformImageReverse
+#'
+#' Apply given transformations to a magick image in reverse fashion
+#'
+#' @param image magick image
+#' @param extension name extension for the shiny input parameter
+#' @param input shiny input
+#'
+#' @importFrom magick image_flip image_flop image_rotate
+#'
+#' @noRd
+transformImageReverse <- function(image, extension, input){
+
+  # flip flop image and keypoints
+  input_flipflop <- input[[paste0("flipflop_", extension)]]
+  if(input_flipflop == "Flip"){
+    image <- flipImage(image)
+  } else if(input_flipflop == "Flop"){
+    image <- flopImage(image)
+  }
+
+  # rotate image and keypoints
+  input_rotate <- 360 - as.numeric(input[[paste0("rotate_", extension)]])
+  image <- rotateImage(image, input_rotate)
+
+  # return image
+  image
+}
+
+#' transformImageQueryList
+#'
+#' Apply given transformations to a list of magick image and return shiny reactive
+#'
+#' @param image_list magick image
+#' @param input shiny input
+#'
+#' @noRd
+transformImageQueryList <- function(image_list, input){
+
+  # length of images
+  len_register <- length(image_list) - 1
+
+  trans_query_list <- lapply(seq_len(len_register), function(i){
+    reactive({
+      list(ref = transformImage(image_list[[i]], paste0("ref_image",i), input),
+           query = transformImage(image_list[[i+1]], paste0("query_image",i+1), input))
+    })
+  })
+
+  ####
+  names(trans_query_list) <- paste0(seq_len(length(image_list)-1),"-",2:length(image_list)) # REMOVE LATER, or decide not to
+  ####
+
+  return(trans_query_list)
+}
+
+#' getRcppWarpImage
+#'
+#' Warping a query image given a homography image
+#'
+#' @param ref_image reference image
+#' @param query_image query image
+#' @param mapping a list of the homography matrices and TPS keypoints 
+#'
+#' @importFrom magick image_read image_data
+#' 
+#' @export
+getRcppWarpImage <- function(ref_image, query_image, mapping){
+  
+  # ref image
+  if(inherits(ref_image, "Image_Array")){
+    ref_image <- as.array(ref_image)
+    ref_image <- array(as.raw(ref_image), dim = dim(ref_image))
+  } else {
+    ref_image <- magick::image_data(ref_image, channels = "rgb")
+  }
+  
+  # query image
+  if(inherits(query_image, "Image_Array")){
+    query_image <- as.array(query_image)
+    query_image <- array(as.raw(query_image), dim = dim(query_image))
+  } else {
+    query_image <- magick::image_data(query_image, channels = "rgb")
+  }
+  
+  # warp image
+  query_image <- warpImage(ref_image = ref_image, 
+                           query_image = query_image, 
+                           mapping = mapping,
+                           width1 = dim(ref_image)[2], height1 = dim(ref_image)[3],
+                           width2 = dim(query_image)[2], height2 = dim(query_image)[3])
+  magick::image_read(query_image)
+}
+
+####
+# Manual Image Registration ####
+####
+
+#' initiateMappings
+#'
+#' Initiate shiny reactive values for registration matrices
+#'
+#' @param len_images the number of query images
+#' @param input shiny input
+#' @param output shiny output
+#' @param session shiny session
+#'
+#' @noRd
+initiateMappings <- function(len_images, input, output, session){
+
+  # initiate matrices
+  matrix_list <- lapply(seq_len(len_images), function(i) return(NULL))
+  names(matrix_list) <- seq_len(len_images)
+
+  # return matrices as reactive values
+  do.call("reactiveValues", matrix_list)
+}
+
+#' getManualRegisteration
+#'
+#' Manual registration of images using manually entered keypoints
+#'
+#' @param registration_mapping_list a list of mapping matrices used for registering VoltRon objects
+#' @param spatdata_list a list of Spatial data object of the query images
+#' @param image_list the list of query images
+#' @param keypoints_list a list of keypoints x,y coordinates for query image
+#' @param centre center image index
+#' @param register_ind query image indices
+#' @param input shiny input
+#' @param output shiny output
+#' @param session shiny session
+#'
+#' @import ggplot2
+#' @importFrom magick image_write image_join image_read image_resize
+#' @importFrom shiny reactiveValuesToList
+#'
+#' @noRd
+getManualRegisteration <- function(registration_mapping_list, spatdata_list, image_list, keypoints_list,
+                                   centre, register_ind, input, output, session){
+
+  # the number of registrations
+  len_register <- length(image_list) - 1
+
+  # Registration events
+  observeEvent(input$register, {
+
+    # get key points as list
+    keypoints_list <- shiny::reactiveValuesToList(keypoints_list)
+    
+    # Manual Registration
+    if(!input$automatictag){
+
+      # waiter start
+      withProgress(message = paste0('Manual Registration (', input$Method, ')'), value = 0, {
+
+        # Check keypoints
+        checkKeypoints(keypoints_list)
+  
+        # Register keypoints
+        aligned_image_list <- list()
+        for(i in register_ind){
+  
+          # Increment the progress bar, and update the detail text.
+          incProgress(1/length(register_ind), detail = paste("Registering Image", i, sep = " "))
+  
+          # get a sequential mapping between a query and reference image
+          results <- computeManualPairwiseTransform(image_list, keypoints_list, query_ind = i, ref_ind = centre, input = input)
+  
+          # save transformation mapping
+          registration_mapping_list[[paste0(i)]] <- results$mapping
+  
+          # save matches
+          aligned_image_list[[i]] <- results$aligned_image
+        }
+
+      })
+
+      # Plot registered images
+      lapply(register_ind, function(i){
+        output[[paste0("plot_query_reg",i)]] <- renderImage({
+
+          # get image list
+          image_view_list <- list(rep(resize_Image(image_list[[centre]], geometry = "400x"),5),
+                                  rep(resize_Image(aligned_image_list[[i]], geometry = "400x"),5))
+
+          # make slide show
+          image_view_list <- image_view_list %>%
+            magick::image_join() %>%
+            magick::image_write(tempfile(fileext='gif'), format = 'gif')
+          list(src = image_view_list, contentType = "image/gif")
+        }, deleteFile = TRUE)
+      })
+
+      # Output summary
+      output[["summary"]] <- renderUI({
+        str1 <- paste0(" Registration Summary:")
+        str2 <- paste0("# of Images: ", length(image_list))
+        str3 <- paste0("# of Registrations: ", len_register)
+        all_str <- c(str1, str2, str3)
+        shiny::HTML(paste(all_str, collapse = '<br/>'))
+      })
+    }
+  })
+}
+
+#' computeManualPairwiseTransform
+#'
+#' Computing transformation matrix of manual registration
+#'
+#' @param image_list the list of images
+#' @param keypoints_list the list of keypoint matrices
+#' @param query_ind the index of the query image
+#' @param ref_ind the index of the reference image
+#' @param input input
+#'
+#' @noRd
+computeManualPairwiseTransform <- function(image_list, keypoints_list, query_ind, ref_ind, input){
+
+  # determine the number of transformation to map from query to the reference
+  indices <- query_ind:ref_ind
+  mapping_mat <- rep(indices,c(1,rep(2,length(indices)-2),1))
+  mapping_mat <- matrix(mapping_mat,ncol=2,byrow=TRUE)
+
+  # reference and target landmarks/keypoints
+  mapping <- list()
+  aligned_image <- image_list[[query_ind]]
+  for(kk in seq_len(nrow(mapping_mat))){
+    cur_map <- mapping_mat[kk,]
+    ref_image <- image_list[[cur_map[2]]]
+    if(which.min(cur_map) == 1){
+      key_ind <- paste0(cur_map[1], "-", cur_map[2])
+      keypoints <- keypoints_list[[key_ind]]
+      target_landmark <- as.matrix(keypoints[["ref"]][,c("x","y")])
+      reference_landmark <- as.matrix(keypoints[["query"]][,c("x","y")])
+    } else {
+      key_ind <- paste0(cur_map[2], "-", cur_map[1])
+      keypoints <- keypoints_list[[key_ind]]
+      reference_landmark <- as.matrix(keypoints[["ref"]][,c("x","y")])
+      target_landmark <- as.matrix(keypoints[["query"]][,c("x","y")])
+    }
+
+    if(which.max(cur_map) == 1){
+      ref_label = "ref"
+      query_label = "query"
+    } else {
+      ref_label = "query"
+      query_label = "ref"
+    }
+
+    # get registered image (including all channels)
+    reg <- getRcppManualRegistration(aligned_image, ref_image, target_landmark, reference_landmark, 
+                                         method = input$Method)
+    
+    # return transformation matrix and images
+    mapping[[kk]] <- list(reg$transmat[[1]], 
+                          list(reference = reg$transmat[[2]][[1]],
+                               query = reg$transmat[[2]][[2]]))
+    aligned_image <- reg$aligned_image
+  }
+
+  return(list(mapping = mapping, 
+              aligned_image = aligned_image))
+}
+
+#' getRcppManualRegistration
+#'
+#' Manual registration workflow with Rcpp
+#'
+#' @param query_image query image
+#' @param ref_image reference image
+#' @param query_landmark query landmark points
+#' @param reference_landmark refernece landmark points
+#' @param method the automated registration method, either TPS or Homography+TPS
+#'
+#' @importFrom magick image_read image_data
+#'
+#' @export
+getRcppManualRegistration <- function(query_image, ref_image, query_landmark, reference_landmark, 
+                                      method = "TPS") {
+  
+  # ref image
+  if(inherits(ref_image, "Image_Array")){
+    ref_image <- as.array(ref_image)
+    ref_image <- array(as.raw(ref_image), dim = dim(ref_image))
+  } else {
+    ref_image <- magick::image_data(ref_image, channels = "rgb")
+  }
+  
+  # query image
+  if(inherits(query_image, "Image_Array")){
+    query_image <- as.array(query_image)
+    query_image <- array(as.raw(query_image), dim = dim(query_image))
+  } else {
+    query_image <- magick::image_data(query_image, channels = "rgb")
+  }
+  
+  reference_landmark[,2] <- dim(ref_image)[3] - reference_landmark[,2]
+  query_landmark[,2] <- dim(query_image)[3] - query_landmark[,2]
+  reg <- manual_registeration_rawvector(ref_image = ref_image, query_image = query_image,
+                                        reference_landmark = reference_landmark, query_landmark = query_landmark,
+                                        width1 = dim(ref_image)[2], height1 = dim(ref_image)[3],
+                                        width2 = dim(query_image)[2], height2 = dim(query_image)[3], 
+                                        method = method)
+  return(list(transmat = reg[[1]], 
+              aligned_image = magick::image_read(reg[[2]])))
+}
+
+####
+# Automated Image Registration ####
+####
+
+#' getManualRegisteration
+#'
+#' Manual registeration of images using manually entered keypoints
+#'
+#' @param registration_mapping_list a list of mapping matrices used for registering VoltRon objects
+#' @param spatdata_list a list of Spatial data object of the query images
+#' @param image_list the list of query images
+#' @param channel_names the list of channel names for each image
+#' @param centre center image index
+#' @param register_ind query image indices
+#' @param input shiny input
+#' @param output shiny output
+#' @param session shiny session
+#'
+#' @importFrom magick image_info image_ggplot image_write image_join image_resize
+#' @importFrom grid rasterGrob
+#' @importFrom ggplot2 ggplot coord_fixed annotation_raster annotation_custom
+#'
+#' @noRd
+getAutomatedRegisteration <- function(registration_mapping_list, spatdata_list, image_list, channel_names, centre, register_ind,
+                                      input, output, session){
+
+  # the number of registrations
+  len_register <- length(image_list) - 1
+
+  # Registration events
+  observeEvent(input$register, {
+    
+    # Automated registration
+    if(input$automatictag){
+
+      # waiter start
+      withProgress(message = paste0('Automated Registration (', input$Method,')'), value = 0, {
+
+        # Register keypoints
+        dest_image_list <- list()
+        overlayed_image_list <- list()
+        aligned_image_list <- list()
+        alignment_image_list <- list()
+        for(i in register_ind){
+  
+          # Increment the progress bar, and update the detail text.
+          incProgress(1/length(register_ind), detail = paste("Registering Image", i, sep = " "))
+  
+          # get a sequential mapping between a query and reference image
+          results <- computeAutomatedPairwiseTransform(image_list, channel_names, query_ind = i, ref_ind = centre, input)
+  
+          # save transformation matrix
+          registration_mapping_list[[paste0(i)]] <- results$mapping
+  
+          # destination image
+          dest_image_list[[i]] <- results$dest_image
+  
+          # save aligned images
+          aligned_image_list[[i]] <- results$aligned_image
+  
+          # save alignment
+          overlayed_image_list[[i]] <- results$overlay_image
+  
+          # save matches
+          alignment_image_list[[i]] <- results$alignment_image
+        }
+
+      })
+
+      # Plot registered images
+      lapply(register_ind, function(i){
+        output[[paste0("plot_query_reg",i)]] <- renderImage({
+
+          # get images
+          image_view_list <- list(rep(magick::image_resize(dest_image_list[[i]], geometry = "400x"),5),
+                                  rep(magick::image_resize(overlayed_image_list[[i]], geometry = "400x"),5))
+
+          # make slide show
+          image_view_list <- image_view_list %>%
+            magick::image_join() %>%
+            magick::image_write(tempfile(fileext='gif'), format = 'gif')
+          list(src = image_view_list, contentType = "image/gif")
+        }, deleteFile = TRUE)
+      })
+
+      # Plot Alignment
+      lapply(register_ind, function(i){
+        cur_alignment_image <- alignment_image_list[[i]]
+        output[[paste0("plot_alignment",i)]] <- renderPlot({
+          magick::image_ggplot(cur_alignment_image)
+        })
+      })
+
+      # Output summary
+      output[["summary"]] <- renderUI({
+        str1 <- paste0(" Registration Summary:")
+        str2 <- paste0("# of Images: ", length(image_list))
+        str3 <- paste0("# of Registrations: ", len_register)
+        all_str <- c(str1, str2, str3)
+        shiny::HTML(paste(all_str, collapse = '<br/>'))
+      })
+    }
+  })
+}
+
+#' computeAutomatedPairwiseTransform
+#'
+#' Computing the registration matrix necessary for automated registration
+#'
+#' @param image_list the list of images
+#' @param channel_names the list of channel names for each image
+#' @param query_ind the index of the query image
+#' @param ref_ind the index of the reference image
+#' @param input input
+#'
+#' @noRd
+computeAutomatedPairwiseTransform <- function(image_list, channel_names, query_ind, ref_ind, input){
+
+  # determine the number of transformation to map from query to the reference
+  indices <- query_ind:ref_ind
+  mapping_mat <- rep(indices,c(1,rep(2,length(indices)-2),1))
+  mapping_mat <- matrix(mapping_mat,ncol=2,byrow=TRUE)
+
+  # reference and target landmarks/keypoints
+  mapping <- list()
+  query_image <- image_list[[query_ind]]
+  for(kk in seq_len(nrow(mapping_mat))){
+    cur_map <- mapping_mat[kk,]
+    ref_image <- image_list[[cur_map[2]]]
+
+    # compute and get transformation matrix
+    if(which.max(cur_map) == 1){
+      ref_label = "ref"
+      query_label = "query"
+    } else {
+      ref_label = "query"
+      query_label = "ref"
+    }
+
+    # get channels 
+    query_image <- query_image[[input[[paste0("channel_", query_label, "_image", cur_map[1])]]]]
+    ref_image <- ref_image[[input[[paste0("channel_", ref_label, "_image", cur_map[2])]]]]
+    
+    # scale parameters
+    query_scale <- input[[paste0("scale_", query_label, "_image", cur_map[1])]]
+    ref_scale <- input[[paste0("scale_", ref_label, "_image", cur_map[2])]]
+
+    # scale images
+    query_image <- resize_Image(query_image, geometry = magick::geometry_size_percent(100*query_scale))
+    ref_image <- resize_Image(ref_image, geometry = magick::geometry_size_percent(100*ref_scale))
+
+    # register images with OpenCV
+    reg <- getRcppAutomatedRegistration(ref_image = ref_image, query_image = query_image,
+                                        GOOD_MATCH_PERCENT = as.numeric(input$GOOD_MATCH_PERCENT), MAX_FEATURES = as.numeric(input$MAX_FEATURES),
+                                        invert_query = input[[paste0("negate_", query_label, "_image", cur_map[1])]] == "Yes",
+                                        invert_ref = input[[paste0("negate_", ref_label, "_image", cur_map[2])]] == "Yes",
+                                        flipflop_query = input[[paste0("flipflop_", query_label, "_image", cur_map[1])]],
+                                        flipflop_ref = input[[paste0("flipflop_", ref_label, "_image", cur_map[2])]],
+                                        rotate_query = input[[paste0("rotate_", query_label, "_image", cur_map[1])]],
+                                        rotate_ref = input[[paste0("rotate_", ref_label, "_image", cur_map[2])]],
+                                        matcher = input$Matcher, method = input$Method)
+
+    # update transformation matrix
+    reg[[1]][[1]] <- solve(diag(c(ref_scale,ref_scale,1))) %*% reg[[1]][[1]] %*% diag(c(query_scale,query_scale,1))
+
+    # return transformation matrix and images
+    mapping[[kk]] <- reg[[1]]
+    dest_image <- reg$dest_image
+    aligned_image <- reg$aligned_image
+    alignment_image <- reg$alignment_image
+    overlay_image <- reg$overlay_image
+  }
+
+  return(list(mapping = mapping, 
+              dest_image = dest_image, 
+              aligned_image = aligned_image, 
+              alignment_image = alignment_image, 
+              overlay_image = overlay_image))
+}
+
+#' getRcppAutomatedRegistration
+#'
+#' Automated registration workflos with Rcpp
+#'
+#' @param ref_image reference image
+#' @param query_image query image
+#' @param GOOD_MATCH_PERCENT the percentage of good matching keypoints, used by "Brute force" method
+#' @param MAX_FEATURES maximum number of detected features, i.e. keypoints, used by "Brute force" method
+#' @param invert_query invert query image?
+#' @param invert_ref invert reference image
+#' @param flipflop_query flip or flop the query image
+#' @param flipflop_ref flip or flop the reference image
+#' @param rotate_query rotation of query image
+#' @param rotate_ref rotation of reference image
+#' @param matcher the matching method for landmarks/keypoints FLANN or BRUTE-FORCE
+#' @param method the automated registration method, Homography or Homography+TPS
+#'
+#' @importFrom magick image_read image_data
+#'
+#' @export
+getRcppAutomatedRegistration <- function(ref_image, query_image,
+                                         GOOD_MATCH_PERCENT = 0.15, MAX_FEATURES = 500,
+                                         invert_query = FALSE, invert_ref = FALSE,
+                                         flipflop_query = "None", flipflop_ref = "None",
+                                         rotate_query = "0", rotate_ref = "0", 
+                                         matcher = "FLANN", method = "Homography") {
+  ref_image_rast <- magick::image_data(ref_image, channels = "rgb")
+  query_image_rast <- magick::image_data(query_image, channels = "rgb")
+  reg <- automated_registeration_rawvector(ref_image = ref_image_rast, query_image = query_image_rast,
+                                           width1 = dim(ref_image_rast)[2], height1 = dim(ref_image_rast)[3],
+                                           width2 = dim(query_image_rast)[2], height2 = dim(query_image_rast)[3],
+                                           GOOD_MATCH_PERCENT = GOOD_MATCH_PERCENT, MAX_FEATURES = MAX_FEATURES,
+                                           invert_query = invert_query, invert_ref = invert_ref,
+                                           flipflop_query = flipflop_query, flipflop_ref = flipflop_ref,
+                                           rotate_query = rotate_query, rotate_ref = rotate_ref,
+                                           matcher = matcher, method = method)
+  
+  # check for null keypoints
+  if(suppressWarnings(all(lapply(reg[[1]][[2]], is.null)))){
+    reg[[1]] <- list(reg[[1]][[1]], NULL)
+  }
+  
+  return(list(transmat = reg[[1]],
+              dest_image = magick::image_read(reg[[2]]),
+              aligned_image = magick::image_read(reg[[3]]),
+              alignment_image = magick::image_read(reg[[4]]),
+              overlay_image = magick::image_read(reg[[5]])))
+}
+
+####
+# Non-interactive Image Registration ####
+####
+
+#' getNonInteractiveRegistration
+#'
+#' Non-interactive registration of spatial data 
+#'
+#' @param obj_list a list of VoltRon objects
+#' @param centre the index of the central reference image/spatialdata
+#' @param register_ind the indices of query images/spatialdatasets
+#' @param mapping_parameters mapping parameters
+#' @param image_list the list of query/ref images (with main channel)
+#' @param image_list_full the list of query/ref images (with all channels)
+#' @param channel_names the list of channel names for each image
+#' 
+#' @noRd
+getNonInteractiveRegistration <- function(obj_list, 
+                                          centre, 
+                                          register_ind, 
+                                          mapping_parameters = NULL,
+                                          image_list = NULL,
+                                          image_list_full = NULL, 
+                                          channel_names = NULL){
+  
+  # check mapping parameters 
+  if(is.null(mapping_parameters)){
+    stop("'mapping_parameters' is not provided, please run registerSpatialData once and save contents of 'mapping_parameters' for later use.")
+    
+  }
+  
+  # Register images
+  registration_mapping_list <- list()
+  for(i in register_ind){
+    
+    # Increment the progress bar, and update the detail text.
+    message("Registering Image ", i)
+
+    # get a sequential mapping between a query and reference image
+    results <- switch(mapping_parameters$automatictag, 
+           "auto" = {
+             computeAutomatedPairwiseTransform(image_list = image_list_full, 
+                                               channel_names = channel_names, 
+                                               query_ind = i, 
+                                               ref_ind = centre, 
+                                               input = mapping_parameters)
+           }, 
+           "manual" = {
+             checkKeypoints(mapping_parameters$keypoints)
+             computeManualPairwiseTransform(image_list = image_list, 
+                                            keypoints_list = mapping_parameters$keypoints, 
+                                            query_ind = i, 
+                                            ref_ind = centre, 
+                                            input = mapping_parameters)
+           })
+    
+    # save transformation matrix
+    registration_mapping_list[[paste0(i)]] <- results$mapping
+  }
+  
+  # return the list of registered voltron objects
+  return(
+    list(keypoints = mapping_parameters$keypoints,
+         mapping_parameters = mapping_parameters,
+         registered_spat = getRegisteredObjectNonShiny(obj_list,
+                                                       registration_mapping_list,
+                                                       register_ind,
+                                                       centre,
+                                                       input = mapping_parameters,
+                                                       reg_mode = ifelse(mapping_parameters$automatictag, "auto", "manual"),
+                                                       image_list = image_list)) 
+  )
+}
+
+