hc_method <- {
  v <- c("ward.D", "single", "complete", "average", "mcquitty", "median", "centroid")
  names(v) <- c(
    i18n$t("Ward's"),
    i18n$t("Single"),
    i18n$t("Complete"),
    i18n$t("Average"),
    i18n$t("McQuitty"),
    i18n$t("Median"),
    i18n$t("Centroid")
  )
  v
}

hc_distance <- {
  v <- c("sq.euclidian", "binary", "canberra", "euclidean", "gower", "manhattan", "maximum", "minkowski")
  names(v) <- c(
    i18n$t("Squared euclidean"),
    i18n$t("Binary"),
    i18n$t("Canberra"),
    i18n$t("Euclidian"),
    i18n$t("Gower"),
    i18n$t("Manhattan"),
    i18n$t("Maximum"),
    i18n$t("Minkowski")
  )
  v
}

hc_plots <- {
  v <- c("scree", "change", "dendro")
  names(v) <- c(i18n$t("Scree"), i18n$t("Change"), i18n$t("Dendrogram"))
  v
}

## list of function arguments
hc_args <- as.list(formals(hclus))

hc_inputs <- reactive({
  ## loop needed because reactive values don't allow single bracket indexing
  hc_args$data_filter <- if (input$show_filter) input$data_filter else ""
  hc_args$dataset <- input$dataset
  for (i in r_drop(names(hc_args))) {
    hc_args[[i]] <- input[[paste0("hc_", i)]]
  }
  hc_args
})


###############################################################
# Hierarchical clustering
###############################################################

output$ui_hc_vars <- renderUI({
  vars <- varnames()
  toSelect <- .get_class() %in% c("numeric", "integer", "date", "factor")
  vars <- vars[toSelect]
  selectInput(
    inputId = "hc_vars", label = i18n$t("Variables:"), choices = vars,
    selected = state_multiple("hc_vars", vars),
    multiple = TRUE, size = min(8, length(vars)), selectize = FALSE
  )
})

output$ui_hc_labels <- renderUI({
  vars <- c(None = "none", varnames())
  selectInput(
    inputId = "hc_labels", label = i18n$t("Labels:"), choices = vars,
    selected = state_single("hc_labels", vars, "none"),
    multiple = FALSE
  )
})

observeEvent(c(input$hc_vars, input$hc_labels != "none"), {
  req(input$hc_vars, input$hc_labels)
  if (input$hc_labels %in% input$hc_vars) {
    updateSelectInput(session, "hc_labels", selected = "none")
  }
})

output$ui_hc_store_name <- renderUI({
  req(input$dataset)
  textInput("hc_store_name", NULL, "", placeholder = i18n$t("Provide variable name"))
})

## add a spinning refresh icon if the tabel needs to be (re)calculated
run_refresh(hc_args, "hc", init = "vars", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model"))

output$ui_hclus <- renderUI({
  req(input$dataset)
  tagList(
    wellPanel(
      actionButton("hc_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success")
    ),
    wellPanel(
      uiOutput("ui_hc_labels"),
      uiOutput("ui_hc_vars"),
      selectInput(
        "hc_distance",
        label = i18n$t("Distance measure:"), choices = hc_distance,
        selected = state_single("hc_distance", hc_distance, "sq.euclidean"),
        multiple = FALSE
      ),
      selectInput(
        "hc_method",
        label = i18n$t("Method:"), choices = hc_method,
        selected = state_single("hc_method", hc_method, "ward.D"), multiple = FALSE
      ),
      selectizeInput(
        "hc_plots",
        label = i18n$t("Plot(s):"), choices = hc_plots,
        selected = state_multiple("hc_plots", hc_plots, c("scree", "change")),
        multiple = TRUE,
        options = list(
          placeholder = i18n$t("Select plot(s)"),
          plugins = list("remove_button", "drag_drop")
        )
      ),
      with(tags, table(
        tr(
          td(numericInput(
            "hc_cutoff", i18n$t("Plot cutoff:"),
            min = 0, max = 1,
            value = state_init("hc_cutoff", 0.05), step = .02
          ), width = "50%"),
          td(numericInput(
            "hc_max_cases", i18n$t("Max cases:"),
            min = 100, max = 100000, step = 100,
            value = state_init("hc_max_cases", 5000)
          ), width = "50%")
        ),
        width = "100%"
      )),
      checkboxInput("hc_standardize", i18n$t("Standardize"), state_init("hc_standardize", TRUE))
    ),
    wellPanel(
      conditionalPanel(
        condition = "input.hc_vars != null",
        numericInput(
          "hc_nr_clus", i18n$t("Number of clusters:"),
          min = 2,
          value = state_init("hc_nr_clus", 2)
        ),
        HTML(paste0("<label>", i18n$t("Store cluster membership:"), "</label>")),
        tags$table(
          tags$td(uiOutput("ui_hc_store_name")),
          tags$td(actionButton("hc_store", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top_mini")
        )
      )
    ),
    help_and_report(
      modal_title = i18n$t("Hierarchical cluster analysis"),
      fun_name = "hclus",
      help_file = inclMD(file.path(getOption("radiant.path.multivariate"), "app/tools/help/hclus.md"))
    )
  )
})

## reset
observeEvent(input$hc_plots, {
  if (length(input$hc_plots) > 1 && "dendro" %in% input$hc_plots) {
    updateSelectInput(session = session, inputId = "hc_plots", selected = "dendro")
  }
})

hc_plot <- reactive({
  plots <- input$hc_plots
  req(plots)
  ph <- plots %>%
    {
      if (length(.) == 1 && . == "dendro") 800 else 400
    }
  pw <- if (!is.empty(plots) && length(plots) == 1 && plots == "dendro") 900 else 650
  list(plot_width = pw, plot_height = ph * length(plots))
})

hc_plot_width <- function() {
  hc_plot() %>%
    {
      if (is.list(.)) .$plot_width else 650
    }
}

hc_plot_height <- function() {
  hc_plot() %>%
    {
      if (is.list(.)) .$plot_height else 400
    }
}

## output is called from the main radiant ui.R
output$hclus <- renderUI({
  register_print_output("summary_hclus", ".summary_hclus")
  register_plot_output(
    "plot_hclus", ".plot_hclus",
    width_fun = "hc_plot_width",
    height_fun = "hc_plot_height"
  )

  ## one output with components stacked
  hc_output_panels <- tagList(
    tabPanel(i18n$t("Summary"), value = "Summary", verbatimTextOutput("summary_hclus")),
    tabPanel(
      i18n$t("Plot"), value = "Plot",
      download_link("dlp_hclus"),
      plotOutput("plot_hclus", height = "100%")
    )
  )

  stat_tab_panel(
    menu = i18n$t("Multivariate > Cluster"),
    tool = i18n$t("Hierarchical"),
    tool_ui = "ui_hclus",
    output_panels = hc_output_panels
  )
})

.hclus <- eventReactive(input$hc_run, {
  req(input$hc_vars)
  withProgress(message = i18n$t("Estimating cluster solution"), value = 1, {
    hci <- hc_inputs()
    hci$envir <- r_data
    do.call(hclus, hci)
  })
})

.summary_hclus <- reactive({
  if (not_available(input$hc_vars)) {
    i18n$t("This analysis requires one or more variables of type integer or numeric.\nIf these variable types are not available please select another dataset.") %>%
      suggest_data("toothpaste")
  } else if (not_pressed(input$hc_run)) {
    i18n$t("** Press the Estimate button to generate cluster solution **")
  } else {
    summary(.hclus())
  }
})

.plot_hclus <- eventReactive(
  {
    c(input$hc_run, input$hc_plots, input$hc_cutoff)
  },
  {
    if (length(input$hc_plots) > 1 && "dendro" %in% input$hc_plots) {
      invisible()
    } else {
      withProgress(
        message = i18n$t("Generating cluster plot"), value = 1,
        capture_plot(plot(.hclus(), plots = input$hc_plots, cutoff = input$hc_cutoff))
      )
    }
  }
)

hclus_report <- function() {
  if (length(input$hc_plots) > 0) {
    if (input$hc_cutoff != 0.05) {
      inp_out <- list("", list(plots = input$hc_plots, cutoff = input$hc_cutoff, custom = FALSE))
    } else {
      inp_out <- list("", list(plots = input$hc_plots, custom = FALSE))
    }
    outputs <- c("summary", "plot")
    figs <- TRUE
  } else {
    outputs <- c("summary")
    inp_out <- list("", "")
    figs <- FALSE
  }

  if (!is.empty(input$hc_store_name)) {
    fixed <- fix_names(input$hc_store_name)
    updateTextInput(session, "hc_store_name", value = fixed)
    nr_clus <- ifelse(is.empty(input$hc_nr_clus), 2, input$hc_nr_clus)
    xcmd <- glue('{input$dataset} <- store({input$dataset}, result, nr_clus = {nr_clus}, name = "{fixed}")')
  } else {
    xcmd <- ""
  }

  update_report(
    inp_main = clean_args(hc_inputs(), hc_args),
    fun_name = "hclus",
    inp_out = inp_out,
    outputs = outputs,
    figs = figs,
    fig.width = hc_plot_width(),
    fig.height = hc_plot_height(),
    xcmd = xcmd
  )
}

## store cluster membership
observeEvent(input$hc_store, {
  req(input$hc_store_name, input$hc_run)
  fixed <- fix_names(input$hc_store_name)
  nr_clus <- ifelse(is.empty(input$hc_nr_clus), 2, input$hc_nr_clus)
  updateTextInput(session, "hc_store_name", value = fixed)
  robj <- .hclus()
  if (!is.character(robj)) {
    withProgress(
      message = i18n$t("Storing cluster membership"), value = 1,
      r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, nr_clus = nr_clus, name = fixed)
    )
  }
})

download_handler(
  id = "dlp_hclus",
  fun = download_handler_plot,
  fn = function() paste0(input$dataset, "_hclustering"),
  type = "png",
  caption = i18n$t("Save hierarchical cluster plots"),
  plot = .plot_hclus,
  width = hc_plot_width,
  height = hc_plot_height
)

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

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

observeEvent(input$modal_hclus_screenshot, {
  hclus_report()
  removeModal() ## remove shiny modal after save
})