###############################
# Multidimensional scaling
###############################
mds_nr_dim <- c(2, 3)
names(mds_nr_dim) <- c(i18n$t("2 dimensions"), i18n$t("3 dimensions"))

# 方法选项（值=内部值；显示名通过 names() + i18n$t）
mds_method <- c("metric", "non-metric")
names(mds_method) <- c(i18n$t("metric"), i18n$t("non-metric"))

## list of function arguments
mds_args <- as.list(formals(mds))

## list of function inputs selected by user
mds_inputs <- reactive({
  ## loop needed because reactive values don't allow single bracket indexing
  mds_args$data_filter <- if (input$show_filter) input$data_filter else ""
  mds_args$dataset <- input$dataset
  for (i in r_drop(names(mds_args))) {
    mds_args[[i]] <- input[[paste0("mds_", i)]]
  }
  mds_args
})

mds_plot_args <- as.list(if (exists("plot.mds")) {
  formals(plot.mds)
} else {
  formals(radiant.multivariate:::plot.mds)
})

## list of function inputs selected by user
mds_plot_inputs <- reactive({
  ## loop needed because reactive values don't allow single bracket indexing
  for (i in names(mds_plot_args)) {
    mds_plot_args[[i]] <- input[[paste0("mds_", i)]]
  }
  mds_plot_args
})

output$ui_mds_id1 <- renderUI({
  isLabel <- "character" == .get_class() | "factor" == .get_class()
  vars <- varnames()[isLabel]
  selectInput(
    inputId = "mds_id1", label = i18n$t("ID 1:"), choices = vars,
    selected = state_single("mds_id1", vars), multiple = FALSE
  )
})

output$ui_mds_id2 <- renderUI({
  isLabel <- "character" == .get_class() | "factor" == .get_class()
  vars <- varnames()[isLabel]
  if (length(vars) > 0) vars <- vars[-which(vars == input$mds_id1)]
  selectInput(
    inputId = "mds_id2", label = i18n$t("ID 2:"), choices = vars,
    selected = state_single("mds_id2", vars), multiple = FALSE
  )
})

output$ui_mds_dis <- renderUI({
  isNum <- "numeric" == .get_class() | "integer" == .get_class()
  vars <- varnames()[isNum]
  selectInput(
    inputId = "mds_dis", label = i18n$t("Dissimilarity:"), choices = vars,
    selected = state_single("mds_dis", vars), multiple = FALSE
  )
})

output$ui_mds_rev_dim <- renderUI({
  # req(input$mds_nr_dim, input$mds_fontsz)
  rev_list <- list()
  # nr_dim <- ncol(.get_data())
  rev_list[paste("dimension", 1:input$mds_nr_dim)] <- 1:input$mds_nr_dim
  checkboxGroupInput(
    "mds_rev_dim", i18n$t("Reverse:"), rev_list,
    selected = state_group("mds_rev_dim", ""),
    inline = TRUE
  )
})

## add a spinning refresh icon if the map needs to be (re)created
run_refresh(mds_args, "mds", init = "id1", tabs = "tabs_mds", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model"))

output$ui_mds <- renderUI({
  req(input$dataset)
  tagList(
    conditionalPanel(
      condition = "input.tabs_mds == 'Summary'",
      wellPanel(
        actionButton("mds_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success")
      )
    ),
    wellPanel(
      conditionalPanel(
        condition = "input.tabs_mds == 'Summary'",
        uiOutput("ui_mds_id1"),
        uiOutput("ui_mds_id2"),
        uiOutput("ui_mds_dis"),
        radioButtons(
          inputId = "mds_method", label = NULL, mds_method,
          selected = state_init("mds_method", "metric"),
          inline = TRUE
        ),
        radioButtons(
          inputId = "mds_nr_dim", label = NULL, mds_nr_dim,
          selected = state_init("mds_nr_dim", 2),
          inline = TRUE
        )
      ),
      conditionalPanel(
        condition = "input.tabs_mds == 'Plot'",
        numericInput("mds_fontsz", i18n$t("Font size:"), state_init("mds_fontsz", 5), 1, 30, 1),
        uiOutput("ui_mds_rev_dim")
      )
    ),
    help_and_report(
      modal_title = i18n$t("(Dis)similarity based brand maps (MDS)"),
      fun_name = "mds",
      help_file = inclMD(file.path(getOption("radiant.path.multivariate"), "app/tools/help/mds.md"))
    )
  )
})

mds_plot <- eventReactive(input$mds_run, {
  req(input$mds_nr_dim)
  nrDim <- .mds() %>%
    (function(x) if (is.list(x)) ncol(x$res$points) else as.numeric(input$mds_nr_dim))
  nrPlots <- (nrDim * (nrDim - 1)) / 2
  list(plot_width = 650, plot_height = 650 * nrPlots)
})

mds_plot_width <- function() {
  mds_plot() %>%
    (function(x) if (is.list(x)) x$plot_width else 650)
}

mds_plot_height <- function() {
  mds_plot() %>%
    (function(x) if (is.list(x)) x$plot_height else 650)
}

output$mds <- renderUI({
  register_print_output("summary_mds", ".summary_mds")
  register_plot_output(
    "plot_mds", ".plot_mds",
    width_fun = "mds_plot_width",
    height_fun = "mds_plot_height"
  )

  mds_output_panels <- tabsetPanel(
    id = "tabs_mds",
    tabPanel(
      i18n$t("Summary"), value = "Summary",
      download_link("dl_mds_coord"), br(),
      verbatimTextOutput("summary_mds")
    ),
    tabPanel(
      i18n$t("Plot"), value = "Plot",
      download_link("dlp_mds"),
      plotOutput("plot_mds", height = "100%")
    )
  )

  stat_tab_panel(
    menu = i18n$t("Multivariate > Maps"),
    tool = i18n$t("(Dis)similarity"),
    tool_ui = "ui_mds",
    output_panels = mds_output_panels
  )
})

.mds_available <- reactive({
  if (not_pressed(input$mds_run)) {
    i18n$t("** Press the Estimate button to generate maps **")
  } else if (not_available(input$mds_id1) || not_available(input$mds_id2) || not_available(input$mds_dis)) {
    i18n$t("This analysis requires two id-variables of type character or factor and a measure\nof dissimilarity of type numeric or interval. Please select another dataset") %>%
      suggest_data("city")
  } else {
    "available"
  }
})

.mds <- eventReactive(input$mds_run, {
  req(input$mds_id1)
  withProgress(message = i18n$t("Generating MDS solution"), value = 1, {
    mdsi <- mds_inputs()
    mdsi$envir <- r_data
    do.call(mds, mdsi)
  })
})

.summary_mds <- reactive({
  if (.mds_available() != "available") {
    return(.mds_available())
  }
  .mds() %>%
    {
      if (is.character(.)) . else summary(., dec = 2)
    }
})

.plot_mds <- reactive({
  if (.mds_available() != "available") {
    return(.mds_available())
  }
  req("mds_rev_dim" %in% names(input))
  robj <- .mds()
  if (is.character(robj)) {
    return(robj)
  }
  withProgress(message = i18n$t("Generating brand maps"), value = 1, {
    do.call(plot, c(list(x = robj), mds_plot_inputs(), shiny = TRUE))
  })
})

mds_report <- function() {
  outputs <- c("summary", "plot")
  inp_out <- list(list(dec = 2), "")
  inp <- mds_inputs()
  inp$nr_dim <- as.integer(inp$nr_dim)
  mpi <- mds_plot_inputs()
  if (length(mpi$rev_dim) > 0) mpi$rev_dim <- as.integer(mpi$rev_dim)
  inp_out[[2]] <- clean_args(mpi, mds_plot_args[-1])
  update_report(
    inp_main = clean_args(inp, mds_args),
    fun_name = "mds",
    inp_out = inp_out,
    fig.width = mds_plot_width(),
    fig.height = mds_plot_height()
  )
}

dl_mds_coord <- function(path) {
  if (pressed(input$mds_run)) {
    .mds()$res$points %>%
      (function(x) set_colnames(x, paste0("Dimension", 1:ncol(x)))) %>%
      write.csv(file = path, row.names = FALSE)
  } else {
    cat(i18n$t("No output available. Press the Estimate button to generate results"), file = path)
  }
}

download_handler(
  id = "dl_mds_coord",
  fun = dl_mds_coord,
  fn = function() paste0(input$dataset, "_mds_coordinates"),
  type = "csv",
  caption = i18n$t("Save MDS coordinates")
)

download_handler(
  id = "dlp_mds",
  fun = download_handler_plot,
  fn = function() paste0(input$dataset, "_mds"),
  type = "png",
  caption = i18n$t("Save MDS plot"),
  plot = .plot_mds,
  width = mds_plot_width,
  height = mds_plot_height
)

observeEvent(input$mds_report, {
  r_info[["latest_screenshot"]] <- NULL
  mds_report()
})

observeEvent(input$mds_screenshot, {
  r_info[["latest_screenshot"]] <- NULL
  radiant_screenshot_modal("modal_mds_screenshot")
})

observeEvent(input$modal_mds_screenshot, {
  mds_report()
  removeModal() ## remove shiny modal after save
})