#######################################
## Create decision tree
#######################################
dtree_example <- "name: Sign contract
variables:
    legal fees: 5000
type: decision
Sign with Movie Company:
    cost: legal fees
    type: chance
    Small Box Office:
        p: 0.3
        payoff: 200000
    Medium Box Office:
        p: 0.6
        payoff: 1000000
    Large Box Office:
        p: 0.1
        payoff: 3000000
Sign with TV Network:
    payoff: 900000"

dtree_max_min <- {
  vals <- c("max", "min")
  names(vals) <- c(
    i18n$t("Max"),
    i18n$t("Min")
  )
  vals
}

output$ui_dtree_list <- renderUI({
  dtree_list <- r_info[["dtree_list"]]
  req(dtree_list)
  selectInput(
    inputId = "dtree_list", label = NULL,
    choices = dtree_list, selected = state_init("dtree_list", dtree_list[1]),
    multiple = FALSE, selectize = FALSE, width = "110px"
  )
})

output$ui_dtree_name <- renderUI({
  dtree_name <- input$dtree_list[1]
  if (length(dtree_name) == 0) dtree_name <- dtree_name()
  if (is.empty(dtree_name)) dtree_name <- "dtree"
  textInput("dtree_name", NULL, dtree_name, width = "100px")
})

output$ui_dtree_remove <- renderUI({
  req(length(r_info[["dtree_list"]]) > 1)
  actionButton("dtree_remove", i18n$t("Remove"), icon = icon("trash", verify_fa = FALSE), class = "btn-danger")
})

dtreeIsNum <- function(x) {
  if (!grepl("[A-Za-z]+", x)) {
    x <- try(eval(parse(text = x), envir = r_data), silent = TRUE)
    if (inherits(x, "try-error")) {
      FALSE
    } else {
      if (sshhr(is.na(as.numeric(x)))) FALSE else TRUE
    }
  } else {
    FALSE
  }
}

output$ui_dtree_sense_name <- renderUI({
  dte <- dtree_run()
  mess <- HTML(i18n$t("No variables are available for sensitivity analysis. If the input file does contain a variables section, press the Calculate button to show the list of available variables."))
  if (!inherits(dte, "list")) {
    return(mess)
  }
  vars <- dte$yl$variables
  if (is.empty(vars)) {
    return(mess)
  }
  vars <- vars[!is.na(sshhr(sapply(vars, dtreeIsNum)))]
  if (length(vars) == 0) {
    return(mess)
  }
  vars[names(vars)] <- names(vars)

  selectInput(
    "dtree_sense_name",
    label = i18n$t("Sensitivity to changes in:"),
    choices = vars, multiple = FALSE,
    selected = state_single("dtree_sense_name", vars)
  )
})

output$ui_dtree_sense_decision <- renderUI({
  dte <- dtree_run()
  if (inherits(dte, "list") && !is.null(dte[["jl"]])) {
    ## all decisions in the tree
    decs <-
      dte$jl$Get(function(x) if (length(x$parent$decision) > 0) x$payoff) %>%
      na.omit() %>%
      names()
  } else {
    decs <- ""
  }

  selectizeInput(
    "dtree_sense_decision",
    label = i18n$t("Decisions to evaluate:"),
    choices = decs, multiple = TRUE,
    selected = state_multiple("dtree_sense_decision", decs, decs),
    options = list(
      placeholder = i18n$t("Select decisions to evaluate"),
      plugins = list("remove_button")
    )
  )
})

output$ui_dtree_sense <- renderUI({
  req(input$dtree_sense_name)
  req(input$dtree_sense_decision)
  tagList(
    HTML(i18n$t("<label>Add variable: <i id='dtree_sense_add' title='Add variable' href='#' class='action-button fa fa-plus-circle'></i>
          <i id='dtree_sense_del' title='Remove variable' href='#' class='action-button fa fa-minus-circle'></i></label>")),
    with(tags, table(
      td(numericInput("dtree_sense_min", i18n$t("Min:"), value = state_init("dtree_sense_min"))),
      td(numericInput("dtree_sense_max", i18n$t("Max:"), value = state_init("dtree_sense_max"))),
      td(numericInput("dtree_sense_step", i18n$t("Step:"), value = state_init("dtree_sense_step")))
    )),
    textinput_maker(id = "sense", lab = i18n$t("Add variable"), rows = 3, pre = "dtree_")
  )
})

observeEvent(input$dtree_sense_add, {
  var_updater(
    input$dtree_sense_add, "dtree_sense",
    input$dtree_sense_name, c(input$dtree_sense_min, input$dtree_sense_max, input$dtree_sense_step),
    fix = FALSE
  )
})

observeEvent(input$dtree_sense_del, {
  var_remover("dtree_sense")
})

output$dtree <- renderUI({
  tabsetPanel(
    id = "tabs_dtree",
    tabPanel(
      i18n$t("Model"),
      with(
        tags,
        table(
          td(help_modal(i18n$t("Decision analysis"), "dtree_help1", help_file = inclRmd(file.path(getOption("radiant.path.model"), "app/tools/help/dtree.Rmd")))),
          td(HTML("&nbsp;&nbsp;")),
          td(HTML(i18n$t("<i title='Report results' class='fa fa-edit action-button' href='#dtree_report1' id='dtree_report1'></i>"))),
          td(HTML(i18n$t("<i title='Report results & Screenshot' class='fa fa-camera action-button aligncenter' href='#dtree_screenshot1' id='dtree_screenshot1' onclick='generate_screenshot();'></i>"))),
          td(HTML("&nbsp;&nbsp;")),
          td(
            radioButtons(
              inputId = "dtree_opt", label = NULL,
              dtree_max_min, selected = state_init("dtree_opt", "max"), inline = TRUE
            ),
            style = "padding-top:10px;"
          ),
          td(actionButton("dtree_run", i18n$t("Calculate tree"), icon = icon("play", verify_fa = FALSE), class = "btn-success"), class = "top_mini"),
          td(uiOutput("ui_dtree_name"), class = "top_mini"),
          td(uiOutput("ui_dtree_list"), class = "top_mini"),
          td(uiOutput("ui_dtree_remove"), class = "top_mini"),
          td(file_upload_button(
            "dtree_load_yaml",
            label = NULL, accept = ".yaml",
            buttonLabel = i18n$t("Load input"), title = i18n$t("Load decision tree input file (.yaml)"),
            class = "btn-primary"
          ), class = "top_mini"),
          td(download_button("dtree_save_yaml", i18n$t("Save input"), class = "btn-primary"), class = "top_mini"),
          td(download_button("dtree_save", i18n$t("Save output")), class = "top_mini")
        )
      ),
      shinyAce::aceEditor(
        "dtree_edit",
        mode = "yaml",
        theme = getOption("radiant.ace_theme", default = "tomorrow"),
        wordWrap = TRUE,
        debounce = -1,
        height = "auto",
        value = state_init("dtree_edit", dtree_example) %>% gsub("\t", "    ", .),
        placeholder = i18n$t("Provide structured input for a decision tree. Then click the 'Calculate tree' button to generate results. Click the ? icon on the top left of your screen for help and examples"),
        vimKeyBinding = getOption("radiant.ace_vim.keys", default = FALSE),
        hotkeys = list(hotkey = list(win = "CTRL-ENTER|SHIFT-ENTER", mac = "CMD-ENTER|SHIFT-ENTER")),
        tabSize = 4,
        showInvisibles = TRUE,
        useSoftTabs = TRUE,
        autoComplete = "live",
        setBehavioursEnabled = FALSE
      ),
      verbatimTextOutput("dtree_print")
    ),
    tabPanel(
      i18n$t("Plot"),
      HTML(i18n$t("<i title='Save plot' class='fa fa-download action-button alignright' href='#dtree_screenshot3' id='dtree_screenshot3' onclick='generate_dtree_plot();'></i>")),
      with(tags, table(
        td(help_modal(i18n$t("Decision analysis"), "dtree_help2", help_file = inclRmd(file.path(getOption("radiant.path.model"), "app/tools/help/dtree.Rmd"))), style = "padding-top:30px;"),
        td(HTML("&nbsp;&nbsp;")),
        td(HTML(i18n$t("<i title='Report results' class='fa fa-edit action-button' href='' id='dtree_report2'></i>")), style = "padding-top:30px;"),
        td(HTML(i18n$t("<i title='Report results & Screenshot' class='fa fa-camera action-button aligncenter' href='#dtree_screenshot2' id='dtree_screenshot2' onclick='generate_screenshot();'></i>")), style = "padding-top:30px;"),
        td(HTML("&nbsp;&nbsp;&nbsp;")),
        td(
          radioButtons(
            inputId = "dtree_final", label = i18n$t("Plot decision tree:"),
            choices = setNames(c(FALSE, TRUE), c(i18n$t("Initial"), i18n$t("Final"))),
            selected = state_init("dtree_final", FALSE), inline = TRUE
          ),
          class = "top_small"
        ),
        td(HTML("&nbsp;&nbsp;&nbsp;")),
        td(
          radioButtons(
            inputId = "dtree_orient", label = i18n$t("Plot direction:"),
            choices = setNames(c("LR", "TD"), c(i18n$t("Left-right"), i18n$t("Top-down"))),
            inline = TRUE
          ),
          class = "top_small"
        ),
        td(actionButton("dtree_run_plot", i18n$t("Calculate tree"), icon = icon("play", verify_fa = FALSE), class = "btn-success"), class = "top"),
        td(numericInput(
          "dtree_dec", i18n$t("Decimals"),
          value = state_init("dtree_dec", 2),
          min = 0, max = 10, width = "70px"
        )),
        td(textInput("dtree_symbol", i18n$t("Symbol"), state_init("dtree_symbol", "$"), width = "70px"))
      )),
      DiagrammeR::DiagrammeROutput(
        "dtree_plot",
        width = isolate(ifelse(length(input$get_screen_width) == 0, "1600px", paste0(input$get_screen_width - 80, "px"))),
        height = "100%"
      )
    ),
    tabPanel(
      i18n$t("Sensitivity"),
      sidebarLayout(
        sidebarPanel(
          conditionalPanel(
            condition = "input.dtree_sense_name == null",
            wellPanel(
              actionButton("dtree_run_sense", i18n$t("Calculate tree"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success")
            )
          ),
          conditionalPanel(
            condition = "input.dtree_sense_name != null",
            wellPanel(
              actionButton("dtree_run_sensitivity", i18n$t("Evaluate sensitivity"), width = "100%", icon = icon("play", verify_fa = FALSE), class = "btn-success")
            )
          ),
          wellPanel(
            ## vary one 'variable' value through some range
            ## select a payoff or only the final payoff?
            uiOutput("ui_dtree_sense_decision"),
            uiOutput("ui_dtree_sense_name"),
            uiOutput("ui_dtree_sense")
          ),
          help_and_report(
            modal_title = i18n$t("Decision analysis"), fun_name = "dtree",
            help_file = inclRmd(file.path(getOption("radiant.path.model"), "app/tools/help/dtree.Rmd"))
          )
        ),
        mainPanel(
          download_link("dlp_dtree_sensitivity"),
          plotOutput("plot_dtree_sensitivity")
        )
      )
    )
  )
})

tree_types <- c("name:", "variables:", "type:", "cost:", "payoff:", "p:")
## Create auto complete list
observe({
  req(input$dtree_name, input$dtree_edit)
  comps <- list(
    `tree-input` = c("name:", "variables:", "type: decision", "type: chance", "cost: 0", "payoff: 0", "p: 0.5")
  )

  trees <- r_info[["dtree_list"]]
  if (length(trees) < 2) {
    trees <- input$dtree_name
  } else {
    comps[["dtree_list"]] <- paste0("dtree('", trees, "')")
  }

  ## update active tree when session is stopped
  session$onSessionEnded(function() {
    isolate({
      r_data[[input$dtree_name]] <- input$dtree_edit
    })
  })

  for (tree in trees) {
    rows <- strsplit(input$dtree_edit, "\n")[[1]]
    comps[[tree]] <- gsub("\\s*([^#]+:).*", "\\1", rows) %>%
      gsub("^\\s+", "", .) %>%
      unique() %>%
      .[!. %in% tree_types] %>%
      gsub(":$", "", .) %>%
      .[!grepl("^#", .)]
  }

  ## only using 'static' auto-completion (i.e., not local ('text') or R-language ('rlang'))
  shinyAce::updateAceEditor(
    session, "dtree_edit",
    autoCompleters = "static",
    autoCompleteList = comps
  )
})

vals_dtree <- reactiveValues(dtree_edit_hotkey = 0)

observe({
  input$dtree_edit_hotkey
  input$dtree_run_plot
  input$dtree_run_sense
  if (!is.null(input$dtree_run)) isolate(vals_dtree$dtree_edit_hotkey %<>% add(1))
})

dtree_name <- function() {
  isolate({
    dtree_name <- input$dtree_name
    if (is.empty(dtree_name)) {
      dtree_name <- stringr::str_match(input$dtree_edit, "^\\s*name:\\s*(.*)\\n")[2]
      if (is.na(dtree_name)) {
        dtree_name <- "dtree"
      }
    }
    fix_names(dtree_name)
  })
}

dtree_run <- eventReactive(vals_dtree$dtree_edit_hotkey > 1, {
  req(vals_dtree$dtree_edit_hotkey != 1)
  validate(
    need(!is.empty(input$dtree_edit), i18n$t("No decision tree input available"))
  )

  ## update settings and get data.tree name
  dtree_name <- dtree_namer()

  ## ensure correct spacing
  yl <- gsub(":([^ $])", ": \\1", input$dtree_edit) %>%
    gsub(":[ ]{2,}", ": ", .) %>%
    gsub(":[ ]+\\n", ":\n", .) %>%
    gsub("\\n[ ]*\\n", "\n", .) %>%
    gsub(":\\s*([-]{0,1})(\\.[0-9]+\\s*\\n)", ": \\10\\2", ., perl = TRUE) %>%
    gsub("(\\n[ ]+)([0-9]+)", "\\1_\\2", .)

  shinyAce::updateAceEditor(session, "dtree_edit", value = yl)

  if (input$dtree_edit != "") {
    withProgress(message = i18n$t("Creating decision tree"), value = 1, {
      dtree(yl, opt = input$dtree_opt, envir = r_data)
    })
  }
})

output$dtree_print <- renderPrint({
  dtree_run() %>%
    (function(x) if (is.null(x)) cat(i18n$t("** Click the calculate button to generate results **")) else summary(x, input = FALSE, output = TRUE))
})

dtree_plot_args <- as.list(if (exists("plot.dtree")) {
  formals(plot.dtree)
} else {
  formals(radiant.model:::plot.dtree)
})

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

output$dtree_plot <- DiagrammeR::renderDiagrammeR({
  req(input$dtree_final)
  dt <- dtree_run()
  if (is.null(dt)) {
    invisible()
  } else {
    pinp <- dtree_plot_inputs()
    do.call(plot, c(list(x = dt), pinp))
  }
})

## Evaluate tree sensitivity
.plot_dtree_sensitivity <- eventReactive(input$dtree_run_sensitivity, {
  if (is.empty(input$dtree_sense_decision)) {
    i18n$t("At least one decision should be selected for evaluation")
  } else if (is.empty(input$dtree_sense)) {
    i18n$t("No variables were specified for evaluation.\nClick the + icon to add variables for sensitivity evaluation")
  } else {
    withProgress(
      message = i18n$t("Conducting sensitivity analysis"), value = 1,
      sensitivity(dtree_run(), gsub("\n+", "", input$dtree_sense), input$dtree_sense_decision, envir = r_data, shiny = TRUE)
    )
  }
})

dtree_sense_width <- reactive({
  650
})

dtree_sense_height <- eventReactive(input$dtree_run_sensitivity, {
  if (is.empty(input$dtree_sense, "")) {
    650
  } else {
    strsplit(input$dtree_sense, ";\\s*") %>%
      unlist() %>%
      unique() %>%
      length() * 400
  }
})

output$plot_dtree_sensitivity <- renderPlot(
  {
    req(input$dtree_run_sensitivity, cancelOutput = TRUE)
    req(input$dtree_sense_name, cancelOutput = TRUE)
    isolate({
      .plot_dtree_sensitivity() %>%
        {
          if (is.character(.)) {
            plot(
              x = 1, type = "n", main = paste0("\n\n\n\n\n\n\n\n", .),
              axes = FALSE, xlab = "", ylab = ""
            )
          } else {
            withProgress(message = i18n$t("Making plot"), value = 1, print(.))
          }
        }
    })
  },
  width = dtree_sense_width,
  height = dtree_sense_height,
  res = 96
)

observeEvent(input$dtree_load_yaml, {
  ## loading yaml file from disk
  if (getOption("radiant.shinyFiles", FALSE)) {
    path <- shinyFiles::parseFilePaths(sf_volumes, input$dtree_load_yaml)
    if (inherits(path, "try-error") || is.empty(path$datapath)) {
      return()
    } else {
      path <- path$datapath
    }
    inFile <- data.frame(
      name = basename(path),
      datapath = path,
      stringsAsFactors = FALSE
    )
  } else {
    inFile <- input$dtree_load_yaml
  }

  yaml_file <- paste0(readLines(inFile$datapath), collapse = "\n")

  ## remove characters that may cause problems in shinyAce
  yaml_file <- stringi::stri_trans_general(yaml_file, "latin-ascii") %>%
    gsub("\r", "\n", .)

  dtree_name <- sub(paste0(".", tools::file_ext(inFile$name)), "", inFile$name) %>%
    fix_names()
  r_data[[dtree_name]] <- yaml_file
  if (!bindingIsActive(as.symbol(dtree_name), env = r_data)) {
    shiny::makeReactiveBinding(dtree_name, env = r_data)
  }
  if (is.empty(input$dtree_list)) {
    r_info[["dtree_list"]] <- dtree_name
  } else {
    r_data[[input$dtree_list]] <- input$dtree_edit
    r_info[["dtree_list"]] <- c(dtree_name, r_info[["dtree_list"]]) %>% unique()
  }
  updateSelectInput(session = session, inputId = "dtree_list", selected = dtree_name, choices = r_info[["dtree_list"]])
})

observeEvent(input$dtree_list, {
  dtree_name <- fix_names(input$dtree_name)
  if (is.empty(dtree_name)) dtree_name <- dtree_name()
  r_data[[dtree_name]] <- input$dtree_edit

  yl <- r_data[[input$dtree_list[1]]]
  if (is.list(yl)) {
    yl <- yaml::as.yaml(yl, indent = 4)
  }

  shinyAce::updateAceEditor(session, "dtree_edit", value = gsub("\t", "    ", yl))
})

observeEvent(input$dtree_edit, {
  if (!is.empty(input$dtree_edit)) r_state$dtree_edit <<- input$dtree_edit
})

dtree_namer <- reactive({
  dtree_name_org <- input$dtree_name

  if (is.empty(dtree_name_org)) {
    dtree_name <- input$dtree_list[1]
    if (is.empty(dtree_name)) {
      dtree_name <- dtree_name()
    } else {
      dtree_name <- fix_names(dtree_name)
    }
  } else {
    dtree_name <- fix_names(dtree_name_org)
  }

  r_data[[dtree_name]] <- input$dtree_edit
  r_info[["dtree_list"]] <- c(dtree_name, setdiff(r_info[["dtree_list"]], dtree_name_org)) %>% unique()
  if (!bindingIsActive(as.symbol(dtree_name), env = r_data)) {
    shiny::makeReactiveBinding(dtree_name, env = r_data)
  }
  updateSelectInput(session = session, inputId = "dtree_list", selected = dtree_name, choices = r_info[["dtree_list"]])
  dtree_name
})

## remove yaml input
observeEvent(input$dtree_remove, {
  dtree_name <- input$dtree_list[1]
  r_info[["dtree_list"]] <- base::setdiff(r_info[["dtree_list"]], dtree_name)
  r_data[[dtree_name]] <- NULL
})

dtree_report <- function() {
  isolate({
    outputs <- c("summary")
    inp_out <- list(list(input = TRUE, output = FALSE), "")
    figs <- FALSE
    if (!is.empty(input$dtree_sense) && !is_not(input$dtree_sense_decision)) {
      vars <- strsplit(input$dtree_sense, ";\\s*")[[1]] %>% gsub("\n+", "", .)
      inp_out[[2]] <- list(
        vars = vars,
        decs = input$dtree_sense_decision,
        custom = FALSE
      )
      outputs <- c(outputs, "sensitivity")
      figs <- TRUE
    }

    ## update settings and get data.tree name
    dtree_name <- dtree_namer()
    xcmd <- clean_args(dtree_plot_inputs(), dtree_plot_args[-1]) %>%
      deparse(control = getOption("dctrl"), width.cutoff = 500L) %>%
      {
        if (. == "list()") {
          "plot(result) %>% render()"
        } else {
          paste0(sub("list(", "plot(result, ", ., fixed = TRUE), " %>% render()")
        }
      } %>%
      gsub("[\"\']TRUE[\'\"]", "TRUE", .)

    inp <- list(yl = dtree_name)
    if (input$dtree_opt == "min") inp$opt <- "min"

    ret <- update_report(
      inp_main = inp,
      fun_name = "dtree",
      inp_out = inp_out,
      outputs = outputs,
      figs = figs,
      fig.width = dtree_sense_width(),
      fig.height = dtree_sense_height(),
      xcmd = xcmd
    )

    ret
  })
}

dl_dtree_save <- function(path) {
  capture.output(dtree(input$dtree_edit, envir = r_data) %>%
    summary(input = FALSE, output = TRUE)) %>%
    cat(file = path, sep = "\n")
}

download_handler(
  id = "dtree_save",
  label = i18n$t("Save output"),
  fun = dl_dtree_save,
  fn = function() {
    ifelse(
      is.empty(input$dtree_name),
      "dtree",
      paste0(input$dtree_name, "_dtree_output")
    )
  },
  type = "txt",
  caption = i18n$t("Save decision tree output"),
  btn = "button",
)

dl_dtree_save_yaml <- function(path) {
  cat(paste0(input$dtree_edit, "\n"), file = path)
}

download_handler(
  id = "dtree_save_yaml",
  label = i18n$t("Save input"),
  fun = dl_dtree_save_yaml,
  fn = function() {
    ifelse(
      is.empty(input$dtree_name),
      "dtree",
      paste0(input$dtree_name, "_dtree_input")
    )
  },
  type = "yaml",
  caption = i18n$t("Save decision tree input"),
  btn = "button",
  class = "btn-primary"
)

download_handler(
  id = "dlp_dtree_sensitivity",
  fun = download_handler_plot,
  fn = function() {
    ifelse(
      is.empty(input$dtree_name),
      "dtree_sensitivity",
      paste0(input$dtree_name, "_dtree_sensitivity")
    )
  },
  type = "png",
  caption = i18n$t("Save decision tree sensitivity plot"),
  plot = .plot_dtree_sensitivity,
  width = dtree_sense_width,
  height = dtree_sense_height
)

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

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

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

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

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

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

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

observeEvent(input$modal_dtree_screenshot, {
  dtree_report()
  removeModal()
})

observeEvent(input$modal_dtree_screenshot1, {
  dtree_report()
  removeModal()
})

observeEvent(input$modal_dtree_screenshot2, {
  dtree_report()
  removeModal()
})

observeEvent(input$modal_dtree_screenshot3, {
  dtree_report()
  removeModal()
})