# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# REPORTS ####
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# * Name of dataset in report ####
dataName <- reactive({
  dataset$name
})

observe({
  updateTextInput(
    session = session,
    inputId = "reportDataName",
    value = paste(dataName(), "dataset")
  )
})

# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# * VALIDITY ####
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# * Criterion present ####
criterionPresent <- reactive({
  (any(dataset$criterion != "missing") | is.null(dataset$criterion))
})

# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# * IRT MODELS ####
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# ** Model ####
report_IRT_binary_model <- reactive({
  if (input$report_IRT_binary_model == "none") {
    fit <- NULL
  } else {
    fit <- switch(input$report_IRT_binary_model,
      "Rasch" = IRT_binary_model_rasch(),
      "1PL" = IRT_binary_model_1pl(),
      "2PL" = IRT_binary_model_2pl(),
      "3PL" = IRT_binary_model_3pl(),
      "4PL" = IRT_binary_model_4pl()
    )
  }
  fit
})

# ** ICC equation ####
# so far it takes parametrization setting from the IRT section
report_IRT_binary_equation <- reactive({
  if (input$IRT_binary_summary_parametrization == "irt") {
    txt1 <- switch(input$report_IRT_binary_model,
      "none" = "",
      "Rasch" = "{(\\theta_p - b_i)}",
      "1PL" = "{a(\\theta_p - b_i)}",
      "2PL" = "{a_i(\\theta_p - b_i)}",
      "3PL" = "{a_i(\\theta_p - b_i)}",
      "4PL" = "{a_i(\\theta_p - b_i)}"
    )
  } else {
    txt1 <- switch(input$report_IRT_binary_model,
      "none" = "",
      "Rasch" = "{\\beta_{i0} + \\theta_p}",
      "1PL" = "{\\beta_{i0} + \\beta_{1} \\theta_p}",
      "2PL" = "{\\beta_{i0} + \\beta_{i1} \\theta_p}",
      "3PL" = "{\\beta_{i0} + \\beta_{i1} \\theta_p}",
      "4PL" = "{\\beta_{i0} + \\beta_{i1} \\theta_p}"
    )
  }

  txt2 <- switch(input$report_IRT_binary_model,
    "none" = "",
    "Rasch" = "",
    "1PL" = "",
    "2PL" = "",
    "3PL" = "c_i + (1 - c_i)",
    "4PL" = "c_i + (d_i - c_i)"
  )

  if (input$report_IRT_binary_model == "none") {
    txt <- ""
  } else {
    txt <- paste0(
      "$$\\mathrm{P}(Y_{pi} = 1|\\theta_p) = \\pi_{pi} = ", txt2,
      "\\frac{e^", txt1, "}{1 + e^", txt1, "}$$"
    )
  }
  txt
})

# ** Wright map ####
# in reports there is Wright map based on 1PL model, does not matter which
# IRT model is selected
report_IRT_binary_wrightmap <- reactive({
  if (input$report_IRT_binary_model == "none") {
    g <- ""
  } else {
    fit <- IRT_binary_model_1pl()
    fscore <- as.vector(fscores(fit))
    b <- coef(fit, IRTpars = TRUE, simplify = TRUE)$items[, "b"]

    g <- ggWrightMap(fscore, b, item.names = item_names())
  }
  g
})

# ** Plot of ICC ####
report_IRT_binary_icc <- reactive({
  fit <- report_IRT_binary_model()

  if (is.null(fit)) {
    g <- ""
  } else {
    mod_item_names <- fit@Data$data %>% colnames()

    d <- map2_dfr(
      mod_item_names,
      item_names(), # names from user
      ~ tibble(
        Ability = IRT_thetas_for_plots(), # vector only
        Probability = probtrace(extract.item(fit, .x), IRT_thetas_for_plots())[, 2], # ascending probs
        Item = .y,
      )
    )
    d$Item <- factor(d$Item, levels = item_names())

    g <- d %>% ggplot(aes(x = Ability, y = Probability, color = Item)) +
      geom_line() +
      ylab("Probability of correct answer") +
      theme_app()
  }
  g
})

# ** Plot of IIC ####
report_IRT_binary_iic <- reactive({
  fit <- report_IRT_binary_model()

  if (is.null(fit)) {
    g <- ""
  } else {
    mod_item_names <- fit@Data$data %>% colnames()

    d <- map2_dfr(
      mod_item_names,
      item_names(), # names from user
      ~ tibble(
        Ability = IRT_thetas_for_plots(), # vector only
        Information = iteminfo(extract.item(fit, .x), IRT_thetas_for_plots()),
        Item = .y,
      )
    )
    d$Item <- factor(d$Item, levels = item_names())

    g <- d %>% ggplot(aes(x = Ability, y = Information, color = Item)) +
      geom_line() +
      theme_app()
  }
  g
})

# ** Plot of TIC ####
report_IRT_binary_tic <- reactive({
  fit <- report_IRT_binary_model()

  if (is.null(fit)) {
    g <- ""
  } else {
    plt <- plot(fit, type = "infoSE")

    vals <- plt$panel.args
    x <- vals[[1]]$x
    y <- vals[[1]]$y
    df <- data.frame(cbind(Ability = x, Information = y))

    df$SE <- 1 / sqrt(df$Information)

    g <- ggplot(data = df, aes(x = Ability)) +
      geom_line(aes(y = Information, col = "info")) +
      geom_line(aes(y = SE, col = "se")) +
      scale_color_manual("", values = c("blue", "pink"), labels = c("Information", "SE")) +
      scale_y_continuous("Information",
        sec.axis = sec_axis(~., name = "SE")
      ) +
      theme(axis.title.y = element_text(color = "pink")) +
      theme_app()
  }
  g
})

# ** Table of parameters ####
report_IRT_binary_coef <- reactive({
  fit <- report_IRT_binary_model()

  if (is.null(fit)) {
    tab <- ""
  } else {
    n <- length(item_names())

    # parametrization should be added as option into reports
    IRTpars <- input$IRT_binary_summary_parametrization == "irt"

    par_tab <- coef(fit, IRTpars = IRTpars, simplify = TRUE)$items
    if (dim(fit@vcov)[1] > 1) {
      se_list <- coef(fit, IRTpars = IRTpars, printSE = TRUE)
      se_tab <- do.call(rbind, lapply(1:nrow(par_tab), function(i) se_list[[i]]["SE", ]))
    } else {
      se_tab <- cbind(rep(NA, nrow(par_tab)), NA, NA, NA)
    }

    tab <- cbind(par_tab, se_tab)[, order(c(seq(ncol(par_tab)), seq(ncol(se_tab))))]


    item_fit_cols <- c("S_X2", "df.S_X2", "p.S_X2")

    tab_fit <- itemfit(fit, na.rm = TRUE)[, item_fit_cols]

    if (!is.null(tryCatch(round(tab_fit, 3), error = function(e) {
      cat("ERROR : ", conditionMessage(e), "\n")
    }))) {
      tab <- data.frame(tab, tab_fit)
      colnames(tab)[9:11] <- c("SX2-value", "df", "p-value")
    } else {
      tab <- data.frame(tab, cbind("-", "-", "-"))
      colnames(tab)[9:11] <- c("SX2-value", "df", "p-value")
    }

    if (IRTpars) {
      colnames(tab)[1:8] <- paste0(
        c("", "SE("),
        paste0("\\(\\mathit{", rep(c("a", "b", "c", "d"), each = 2), "}\\)"),
        c("", ")")
      )
    } else {
      colnames(tab)[1:8] <- paste0(
        c("", "SE("),
        paste0("\\(\\mathit{", rep(c("\\beta_{1}", "\\beta_{0}", "c", "d"), each = 2), "}\\)"),
        c("", ")")
      )
      tab <- tab[, c(3:4, 1:2, 5:8, 9:11)]
    }

    rownames(tab) <- item_names()
    tab
  }
  tab
})

# ** Ability estimates plot ####
report_IRT_binary_ability_plot <- reactive({
  fit <- report_IRT_binary_model()

  if (is.null(fit)) {
    g <- ""
  } else {
    fscore <- as.vector(fscores(fit))
    zscore <- z_score()

    df <- data.frame(fscore, zscore)

    g <- ggplot(df, aes(.data$zscore, .data$fscore)) +
      geom_point(size = 3) +
      labs(x = "Standardized total score", y = "Factor score") +
      theme_app() +
      theme(
        legend.box.just = "left",
        legend.justification = c(1, 0),
        legend.position = c(1, 0),
        legend.box = "vertical",
        legend.key.size = unit(1, "lines"),
        legend.text.align = 0,
        legend.title.align = 0
      )
  }
  g
})

# ** Ability estimates table ####
report_IRT_binary_ability_table <- reactive({
  fit <- report_IRT_binary_model()

  if (is.null(fit)) {
    tab <- ""
  } else {
    score <- as.vector(total_score())
    zscore <- as.vector(z_score())
    fscore <- fscores(fit)

    tab <- data.frame(score, zscore, fscore)
    tab <- data.frame(
      Min = sapply(tab, min, na.rm = TRUE),
      Max = sapply(tab, max, na.rm = TRUE),
      Mean = sapply(tab, mean, na.rm = TRUE),
      Median = sapply(tab, median, na.rm = TRUE),
      SD = sapply(tab, sd, na.rm = TRUE),
      Skewness = sapply(tab, ShinyItemAnalysis:::skewness),
      Kurtosis = sapply(tab, ShinyItemAnalysis:::kurtosis)
    )
    rownames(tab) <- c("Total Scores", "Z-Scores", "F-scores")
  }
  tab
})

# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# * DIF ####
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# * Group present ####
groupPresent <- reactive({
  (any(dataset$group != "missing") | is.null(dataset$group))
})

# * Observed score / DIF matching present ####
DIFmatchingPresent <- reactive({
  (any(dataset$DIFmatching != "missing") | is.null(dataset$DIFmatching))
})

# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# * PROGRESS BAR ####
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# * Progress bar ####
observeEvent(input$generate, {
  withProgress(message = "Creating content", value = 0, style = "notification", {
    list( # header
      author = input$reportAuthor,
      dataset = input$reportDataName,
      # datasets
      a = nominal(),
      k = key(),
      itemNames = item_names(),
      # total scores
      incProgress(0.05),
      results = t(totalscores_table_Input()),
      histogram_totalscores = totalscores_histogram_Input(),
      cutScore = input$slider_totalscores_histogram,
      # standard scores
      standardscores_table = standardscores_table_Input(),
      incProgress(0.05),
      # validity section
      corr_plot = {
        if (input$corr_report) {
          if (input$customizeCheck) {
            corr_plot_Input_report()
          } else {
            corr_plot_Input()
          }
        } else {
          ""
        }
      },
      corr_plot_numclust = ifelse(input$customizeCheck, input$corr_plot_clust_report, input$corr_plot_clust),
      corr_plot_clustmethod = ifelse(input$customizeCheck, input$corr_plot_clustmethod_report, input$corr_plot_clustmethod),
      corr_type = ifelse(input$customizeCheck, input$corr_plot_type_of_corr_report, input$type_of_corr),
      # scree_plot = {
      #   if (input$corr_report) {
      #     scree_plot_Input()
      #   } else {
      #     ""
      #   }
      # },
      isCriterionPresent = criterionPresent(),
      validity_check = input$predict_report,
      validity_plot = {
        if (input$predict_report) {
          if (criterionPresent()) {
            validity_plot_Input()
          } else {
            ""
          }
        }
      },
      validity_table = {
        if (input$predict_report) {
          if (criterionPresent()) {
            validity_table_Input()
          } else {
            ""
          }
        }
      },
      incProgress(0.05),
      # item analysis
      DDplot = report_itemanalysis_DDplot(),
      DDplotRange1 = ifelse(input$customizeCheck, input$report_itemanalysis_DDplot_range_slider[[1]], input$itemanalysis_DDplot_range_slider[[1]]),
      DDplotRange2 = ifelse(input$customizeCheck, input$report_itemanalysis_DDplot_range_slider[[2]], input$itemanalysis_DDplot_range_slider[[2]]),
      DDplotNumGroups = ifelse(input$customizeCheck, input$report_itemanalysis_DDplot_groups_slider, input$itemanalysis_DDplot_groups_slider),
      DDplotDiscType = ifelse(input$customizeCheck, input$report_itemanalysis_DDplot_discrimination, input$itemanalysis_DDplot_discrimination),
      itemexam = report_itemanalysis_table(),
      cronbachs_alpha_table = reliability_cronbachalpha_table_Input(),
      incProgress(0.05),
      # distractors
      distractor_plot = report_distractor_plot(),
      type_distractor_plot = input$report_distractor_type,
      distractor_plot_legend_length = report_distractor_plot_legend_length(),
      incProgress(0.25),
      # regression
      multiplot = report_regression_multinomial_plot(),
      incProgress(0.05),
      # irt
      irt_wrightmap = report_IRT_binary_wrightmap(),
      irt_equation = report_IRT_binary_equation(),
      irt_model = input$report_IRT_binary_model,
      irt_parametrization = input$IRT_binary_summary_parametrization,
      irt_icc = report_IRT_binary_icc(),
      irt_iic = report_IRT_binary_iic(),
      irt_tic = report_IRT_binary_tic(),
      irt_coef = report_IRT_binary_coef(),
      irt_ability_plot = report_IRT_binary_ability_plot(),
      irt_ability_table = report_IRT_binary_ability_table(),
      incProgress(0.25),
      # DIF
      ### presence of group vector
      isGroupPresent = groupPresent(),
      ### histograms by group
      histCheck = input$histCheck,
      DIF_total_table = {
        if (groupPresent()) {
          if (input$histCheck) {
            DIF_total_table()
          }
        }
      },
      DIF_total_hist = {
        if (groupPresent()) {
          if (input$histCheck) {
            DIF_total_histogram()
          }
        }
      },
      DIF_total_ttest = {
        if (groupPresent()) {
          if (input$histCheck) {
            DIF_total_ttest()
          }
        }
      },
      ### delta plot
      deltaplotCheck = input$deltaplotCheck,
      deltaplot = {
        if (groupPresent()) {
          if (input$deltaplotCheck) {
            report_DIF_DP_plot()
          }
        }
      },
      DP_text_normal = {
        if (groupPresent()) {
          if (input$deltaplotCheck) {
            report_DIF_DP()
          }
        }
      },
      ### Mantel-Haenszel
      MHCheck = input$MHCheck,
      DIF_MH_print = {
        if (groupPresent()) {
          if (input$MHCheck) {
            report_DIF_MH_model()
          }
        }
      },
      ### logistic regression
      logregCheck = input$logregCheck,
      DIF_logistic_plot = {
        if (groupPresent()) {
          if (input$logregCheck) {
            report_DIF_logistic_plot()
          }
        }
      },
      DIF_logistic_print = {
        if (groupPresent()) {
          if (input$logregCheck) {
            report_DIF_logistic_model()
          }
        }
      },
      ### DDF multinomial
      multiCheck = input$multiCheck,
      DIF_multinomial_print = {
        if (groupPresent()) {
          if (input$multiCheck) {
            report_DIF_multinomial_method()
          }
        }
      },
      DIF_multinomial_plot = {
        if (groupPresent()) {
          if (input$multiCheck) {
            report_DIF_multinomial_plot()
          }
        }
      },
      incProgress(0.25),
      ### sessionInfo
      sessionInfo = input$include_session
    )
  })

  output$download_report_button <- renderUI({
    if (is.null(input$generate)) {
      return(NULL)
    }
    downloadButton(
      outputId = "report",
      label = "Download report",
      class = "btn btn-primary"
    )
  })
})

# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# * DOWNLOAD REPORT ####
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# * Download report ####
output$report <- downloadHandler(
  filename = reactive({
    paste0("report.", input$report_format)
  }),
  content = function(file) {
    reportPath <- file.path(getwd(), paste0("report", input$report_format, ".Rmd"))
    parameters <- list( # header
      author = input$reportAuthor,
      dataset = input$reportDataName,
      # datasets
      a = nominal(),
      k = key(),
      itemNames = item_names(),
      # total scores
      totalscores_table = t(totalscores_table_Input()),
      histogram_totalscores = totalscores_histogram_Input(),
      cutScore = input$slider_totalscores_histogram,
      # standard scores
      standardscores_table = standardscores_table_Input(),
      # validity section
      corr_plot = {
        if (input$corr_report) {
          if (input$customizeCheck) {
            corr_plot_Input_report()
          } else {
            corr_plot_Input()
          }
        } else {
          ""
        }
      },
      corr_plot_numclust = ifelse(input$customizeCheck, input$corr_plot_clust_report, input$corr_plot_clust),
      corr_plot_clustmethod = ifelse(input$customizeCheck, input$corr_plot_clustmethod_report, input$corr_plot_clustmethod),
      corr_type = ifelse(input$customizeCheck, input$corr_plot_type_of_corr_report, input$type_of_corr),
      # scree_plot = {
      #   if (input$corr_report) {
      #     scree_plot_Input()
      #   } else {
      #     ""
      #   }
      # },
      isCriterionPresent = criterionPresent(),
      validity_check = input$predict_report,
      validity_plot = {
        if (input$predict_report) {
          if (criterionPresent()) {
            validity_plot_Input()
          } else {
            ""
          }
        }
      },
      validity_table = {
        if (input$predict_report) {
          if (criterionPresent()) {
            validity_table_Input()
          } else {
            ""
          }
        }
      },
      # item analysis
      DDplot = report_itemanalysis_DDplot(),
      DDplotRange1 = ifelse(input$customizeCheck, input$report_itemanalysis_DDplot_range_slider[[1]], input$itemanalysis_DDplot_range_slider[[1]]),
      DDplotRange2 = ifelse(input$customizeCheck, input$report_itemanalysis_DDplot_range_slider[[2]], input$itemanalysis_DDplot_range_slider[[2]]),
      DDplotNumGroups = ifelse(input$customizeCheck, input$report_itemanalysis_DDplot_groups_slider, input$itemanalysis_DDplot_groups_slider),
      DDplotDiscType = ifelse(input$customizeCheck, input$report_itemanalysis_DDplot_discrimination, input$itemanalysis_DDplot_discrimination),
      itemexam = report_itemanalysis_table(),
      cronbachs_alpha_table = reliability_cronbachalpha_table_Input(),
      # distractors
      distractor_plot = report_distractor_plot(),
      type_distractor_plot = input$report_distractor_type,
      distractor_plot_legend_length = report_distractor_plot_legend_length(),
      # regression
      multiplot = report_regression_multinomial_plot(),
      # irt
      irt_wrightmap = report_IRT_binary_wrightmap(),
      irt_equation = report_IRT_binary_equation(),
      irt_model = input$report_IRT_binary_model,
      irt_parametrization = input$IRT_binary_summary_parametrization,
      irt_icc = report_IRT_binary_icc(),
      irt_iic = report_IRT_binary_iic(),
      irt_tic = report_IRT_binary_tic(),
      irt_coef = report_IRT_binary_coef(),
      irt_ability_plot = report_IRT_binary_ability_plot(),
      irt_ability_table = report_IRT_binary_ability_table(),
      # DIF
      ### presence of group vector
      isGroupPresent = groupPresent(),
      ### histograms by groups
      histCheck = input$histCheck,
      DIF_total_table = {
        if (groupPresent()) {
          if (input$histCheck) {
            DIF_total_table()
          }
        }
      },
      DIF_total_hist = {
        if (groupPresent()) {
          if (input$histCheck) {
            DIF_total_histogram()
          }
        }
      },
      DIF_total_ttest = {
        if (groupPresent()) {
          if (input$histCheck) {
            DIF_total_ttest()
          }
        }
      },
      ### delta plot
      deltaplotCheck = input$deltaplotCheck,
      DIF_deltaplot = {
        if (groupPresent()) {
          if (input$deltaplotCheck) {
            report_DIF_DP_plot()
          }
        }
      },
      DIF_deltaplot_text = {
        if (groupPresent()) {
          if (input$deltaplotCheck) {
            report_DIF_DP()
          }
        }
      },
      ### Mantel-Haenszel
      MHCheck = input$MHCheck,
      DIF_MH_print = {
        if (groupPresent()) {
          if (input$MHCheck) {
            report_DIF_MH_model()
          }
        }
      },
      ### logistic regression
      logregCheck = input$logregCheck,
      DIF_logistic_plot = {
        if (groupPresent()) {
          if (input$logregCheck) {
            report_DIF_logistic_plot()
          }
        }
      },
      DIF_logistic_print = {
        if (groupPresent()) {
          if (input$logregCheck) {
            report_DIF_logistic_model()
          }
        }
      },
      ### multinomial regression
      multiCheck = input$multiCheck,
      DIF_multinomial_print = {
        if (groupPresent()) {
          if (input$multiCheck) {
            report_DIF_multinomial_method()
          }
        }
      },
      DIF_multinomial_plot = {
        if (groupPresent()) {
          if (input$multiCheck) {
            report_DIF_multinomial_plot()
          }
        }
      },
      ### sessionInfo
      sessionInfo = input$include_session
    )
    rmarkdown::render(reportPath,
      output_file = file,
      params = parameters, envir = new.env(parent = globalenv())
    )
  }
)

# source('tests/helper_functions/markdown_render.R', local = TRUE)
#
# exportTestValues(report = report_react())
