#########################################
# Perceptual map using factor analysis
#########################################
pm_nr_dim <- c(2, 3)
names(pm_nr_dim) <- c(i18n$t("2 dimensions"), i18n$t("3 dimensions"))

## list of function arguments
pm_args <- as.list(formals(prmap))

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

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

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

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

output$ui_pm_attr <- renderUI({
  vars <- varnames()
  ## can't get valid factor scores with PCA and {factor} variables
  # toSelect <- .get_class() %in% c("numeric", "integer", "date", "factor")
  toSelect <- .get_class() %in% c("numeric", "integer", "date")
  vars <- vars[toSelect]
  selectInput(
    inputId = "pm_attr", label = i18n$t("Attributes:"), choices = vars,
    selected = state_multiple("pm_attr", vars), multiple = TRUE,
    size = min(10, length(vars)), selectize = FALSE
  )
})

output$ui_pm_pref <- renderUI({
  if (not_available(input$pm_attr)) {
    return()
  }
  vars <- varnames()
  toSelect <- .get_class() %in% c("numeric", "integer", "date", "factor")
  vars <- vars[toSelect]
  if (length(vars) > 0) vars <- vars[-which(vars %in% c(input$pm_brand, input$pm_attr))]
  selectInput(
    inputId = "pm_pref", label = i18n$t("Preferences:"), choices = vars,
    selected = state_multiple("pm_pref", vars), multiple = TRUE,
    size = max(1, min(5, length(vars))), selectize = FALSE
  )
})

output$ui_pm_plots <- renderUI({
  plot_list <- c("brand", "attr")
  names(plot_list) <- c(i18n$t("Brands"), i18n$t("Attributes"))
  if (!is.empty(input$pm_pref)) {
    plot_list <- c(plot_list, "pref")
    names(plot_list)[length(plot_list)] <- i18n$t("Preferences")
  }
  checkboxGroupInput(
    "pm_plots", NULL, plot_list,
    selected = state_group("pm_plots"),
    inline = TRUE
  )
})

output$ui_pm_store_name <- renderUI({
  req(input$dataset)
  textInput("pm_store_name", i18n$t("Store factor scores:"), "", placeholder = i18n$t("Provide single variable name"))
})

## add a spinning refresh icon if the factors need to be updated
run_refresh(pm_args, "pm", init = "attr", tabs = "tabs_prmap", label = i18n$t("Estimate model"), relabel = i18n$t("Re-estimate model"))

output$ui_prmap <- renderUI({
  req(input$dataset)
  tagList(
    conditionalPanel(
      condition = "input.tabs_prmap == 'Summary'",
      wellPanel(
        actionButton("pm_run", i18n$t("Estimate model"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success")
      )
    ),
    wellPanel(
      conditionalPanel(
        condition = "input.tabs_prmap == 'Summary'",
        uiOutput("ui_pm_brand"),
        uiOutput("ui_pm_attr"),
        uiOutput("ui_pm_pref"),
        radioButtons(
          inputId = "pm_nr_dim", label = NULL, pm_nr_dim,
          selected = state_init("pm_nr_dim", 2),
          inline = TRUE
        ),
        # checkboxInput("pm_hcor", "Adjust for {factor} variables", value = state_init("pm_hcor", FALSE)),
        numericInput(
          "pm_cutoff",
          label = i18n$t("Loadings cutoff:"), min = 0,
          max = 1, state_init("pm_cutoff", 0), step = .05
        ),
        conditionalPanel(
          condition = "input.pm_attr != null",
          tags$table(
            tags$td(uiOutput("ui_pm_store_name")),
            tags$td(actionButton("pm_store", i18n$t("Store"), icon = icon("plus", verify_fa = FALSE)), class = "top")
          )
        )
      ),
      conditionalPanel(
        condition = "input.tabs_prmap == 'Plot'",
        uiOutput("ui_pm_plots"),
        tags$table(
          tags$td(numericInput("pm_scaling", i18n$t("Attribute scale:"), state_init("pm_scaling", 2), .5, 4, .1, width = "117px")),
          tags$td(numericInput("pm_fontsz", i18n$t("Font size:"), state_init("pm_fontsz", 5), 1, 20, 1, width = "117px")),
          width = "100%"
        )
      )
    ),
    help_and_report(
      modal_title = i18n$t("Attribute based brand maps"),
      fun_name = "prmap",
      help_file = inclMD(file.path(getOption("radiant.path.multivariate"), "app/tools/help/prmap.md"))
    )
  )
})

pm_plot <- eventReactive(input$pm_run, {
  req(input$pm_nr_dim)
  nrDim <- as.numeric(input$pm_nr_dim)
  nrPlots <- (nrDim * (nrDim - 1)) / 2
  list(plot_width = 650, plot_height = 650 * nrPlots)
})

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

pm_plot_height <- function() {
  pm_plot() %>%
    {
      if (is.list(.)) .$plot_height else 650
    }
}

output$prmap <- renderUI({
  register_print_output("summary_prmap", ".summary_prmap")
  register_plot_output(
    "plot_prmap", ".plot_prmap",
    width_fun = "pm_plot_width",
    height_fun = "pm_plot_height"
  )

  pm_output_panels <- tabsetPanel(
    id = "tabs_prmap",
    tabPanel(
      i18n$t("Summary"), value = "Summary",
      download_link("dl_pm_loadings"), br(),
      verbatimTextOutput("summary_prmap")
    ),
    tabPanel(
      i18n$t("Plot"), value = "Plot",
      download_link("dlp_prmap"),
      plotOutput("plot_prmap", height = "100%")
    )
  )

  stat_tab_panel(
    menu = i18n$t("Multivariate > Maps"),
    tool = i18n$t("Attributes"),
    tool_ui = "ui_prmap",
    output_panels = pm_output_panels
  )
})

.prmap_available <- reactive({
  if (not_pressed(input$pm_run)) {
    i18n$t("** Press the Estimate button to generate perceptual maps **")
  } else if (not_available(input$pm_brand) || not_available(input$pm_attr)) {
    i18n$t("This analysis requires a brand variable of type factor or character and multiple attribute variables\nof type numeric or integer. If these variables are not available please select another dataset.") %>%
      suggest_data("retailers")
  } else if (length(input$pm_attr) < 2) {
    i18n$t("Please select two or more attribute variables")
  } else {
    # brand <- .get_data()[[input$pm_brand]]
    # if (length(unique(brand)) < length(brand)) {
    # "Number of observations and unique IDs for the brand variable do not match.\nPlease choose another brand variable or another dataset.\n\n" %>%
    # suggest_data("retailers")
    # } else {
    "available"
    # }
  }
})

.prmap <- eventReactive(input$pm_run, {
  withProgress(message = i18n$t("Generating perceptual map"), value = 1, {
    pmi <- pm_inputs()
    pmi$envir <- r_data
    do.call(prmap, pmi)
  })
})

.summary_prmap <- reactive({
  if (.prmap_available() != "available") {
    return(.prmap_available())
  }
  validate(
    need(
      input$pm_cutoff >= 0 && input$pm_cutoff <= 1,
      i18n$t("Provide a correlation cutoff value in the range from 0 to 1")
    )
  )
  summary(.prmap(), cutoff = input$pm_cutoff)
})

.plot_prmap <- eventReactive(
  {
    c(input$pm_run, pm_plot_inputs())
  },
  {
    if (.prmap_available() != "available") {
      return(.prmap_available())
    }
    req("pm_plots" %in% names(input))
    robj <- .prmap()
    if (is.character(robj)) {
      return(robj)
    }
    withProgress(message = i18n$t("Generating brand maps"), value = 1, {
      do.call(plot, c(list(x = robj), pm_plot_inputs(), shiny = TRUE))
    })
  }
)

prmap_report <- function() {
  outputs <- c("summary", "plot")
  inp_out <- list(list(cutoff = input$pm_cutoff, dec = 2), "")
  inp_out[[2]] <- clean_args(pm_plot_inputs(), pm_plot_args[-1])
  inp <- clean_args(pm_inputs(), pm_args)
  if (!is.empty(inp$nr_dim)) inp$nr_dim <- as_integer(inp$nr_dim)
  if (!is.empty(input$pm_store_name)) {
    fixed <- fix_names(input$pm_store_name)
    updateTextInput(session, "pm_store_name", value = fixed)
    xcmd <- glue('{input$dataset} <- store({input$dataset}, result, name = "{fixed}")')
  } else {
    xcmd <- ""
  }
  update_report(
    inp_main = inp,
    fun_name = "prmap",
    inp_out = inp_out,
    fig.width = pm_plot_width(),
    fig.height = pm_plot_height(),
    xcmd = xcmd
  )
}

## store factor scores
observeEvent(input$pm_store, {
  req(input$pm_store_name, input$pm_run)
  fixed <- fix_names(input$pm_store_name)
  updateTextInput(session, "pm_store_name", value = fixed)
  robj <- .prmap()
  if (!is.character(robj)) {
    withProgress(
      message = i18n$t("Storing factor scores"), value = 1,
      r_data[[input$dataset]] <- store(r_data[[input$dataset]], robj, name = fixed)
    )
  }
})

dl_pm_loadings <- function(path) {
  if (pressed(input$pm_run)) {
    .prmap() %>%
      {
        if (is.list(.)) .$fres$loadings else return()
      } %>%
      clean_loadings(input$pm_cutoff, fsort = FALSE) %>%
      write.csv(file = path)
  } else {
    cat(i18n$t("No output available. Press the Estimate button to generate the factor analysis results"), file = path)
  }
}

download_handler(
  id = "dl_pm_loadings",
  fun = dl_pm_loadings,
  fn = function() paste0(input$dataset, "_prmap_loadings"),
  type = "csv",
  caption = i18n$t("Save factor loadings")
)

download_handler(
  id = "dlp_prmap",
  fun = download_handler_plot,
  fn = function() paste0(input$dataset, "_prmap"),
  type = "png",
  caption = i18n$t("Save preceptual map plot"),
  plot = .plot_prmap,
  width = pm_plot_width,
  height = pm_plot_height
)

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

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

observeEvent(input$modal_prmap_screenshot, {
  prmap_report()
  removeModal() ## remove shiny modal after save
})