R/report_errors.r

In AIscreenR: AI Screening Tools in R for Systematic Reviewing

#' @title Generate a report for screening disagreements between human and AI decisions
#'
#' @name report
#'
#' @description
#' `r lifecycle::badge("stable")`<br>
#' <br>
#' This function generates a report for screening disagreements between human and GPT decisions.
#' It extracts information from the provided data. The function then compiles this information into a 
#' report using Quarto. The report can be saved in formats as HTML, PDF, Word, or more. The generated 
#' report includes sections for each study, displaying the study ID, title, abstract, and the decision 
#' generated by the GPT API model. The report also includes a section for a comment on the GPT decision, 
#' which the user will provide. The function also provides options to customize the document title, 
#' subtitle, and output directory.
#'
#' @param data Data frame containing the screening data of disagreements between human decisions and GPT decisions.
#' @param studyid Column name for the study ID.
#' @param title Column name for the title.
#' @param abstract Column name for the abstract.
#' @param gpt_answer Column name for the AI's answer.
#' @param file Name of the output file. You can also provide a full path.
#' @param format Format of the output file. Valid formats are 'html', 'pdf', 'docx'.
#' @param open Logical indicating whether to open the report after generation. Default is TRUE.
#' @param document_title Title of the document.
#' @param document_subtitle Subtitle of the document. Default is an empty string.
#' @param directory Directory where the output file will be saved. Default is the current working directory.
#' @param human_code Column name for the human screening decision (numeric 0/1).
#' @param final_decision_gpt_num Column name for the final numeric GPT decision (0/1).
#' @importFrom htmltools htmlEscape
#' 
#' @return An object of class `'report'`. The object is a list containing the following components:
#' \item{file_out}{string indicating the path to the generated report file.}
#' \item{...}{some additional attributed values/components, including an attributed list with the arguments used in the function.}
#'
#' @examples
#' \dontrun{
#' # Generate a report from the disagreements data
#' report(
#'   data = disagreements,
#'   studyid = studyid,
#'   title = title,
#'   abstract = abstract,
#'   gpt_answer = longest_answer,
#'   human_code = human_code,
#'   final_decision_gpt_num = final_decision_gpt_num,
#'   file = "Screening_Disagreements_Report",
#'   format = "html",
#'   document_title = "Study Report - Disagreement Explanations",
#'   open = TRUE
#' )
#' }
#'
#' @export

report <- function(
    data,
    studyid,
    title,
    abstract,
    gpt_answer,
    human_code,
    final_decision_gpt_num,
    file,
    format = "html",
    open = TRUE,
    document_title,
    document_subtitle = "",
    directory = getwd()
){

  # Error handling for missing arguments
  if (missing(data)) stop("Argument 'data' is missing. Please provide data")
  if (missing(studyid)) stop("Argument 'studyid' is missing. Please check the column names in data.")
  if (missing(title)) stop("Argument 'title' is missing. Please check the column names in data.")
  if (missing(abstract)) stop("Argument 'abstract' is missing. Please check the column names in data.")
  if (missing(file)) stop("Argument 'file' is missing. Please provide a file name.")
  if (missing(format)) stop("Argument 'format' is missing. Please provide a valid format.")
  if (missing(document_title)) stop("Argument 'document_title' is missing. Please provide a title for the document.")
  if (missing(human_code)) stop("Argument 'human_code' is missing. Please check the column names in data.")
  if (missing(final_decision_gpt_num)) stop("Argument 'final_decision_gpt_num' is missing. Please check the column names in data.")
  
  # Error handling for invalid file format
  valid_formats <- c("html", "pdf", "docx")
  if (!(format %in% valid_formats)) stop("Invalid format. Choose from 'html', 'pdf', 'docx'.")
  
  # allow full path in `file`
  file_has_path <- basename(file) != file
  if (file_has_path) {
    file_directory <- dirname(file)
    if (!dir.exists(file_directory)) {
      stop("The directory parsed from argument 'file' does not exist.")
    }

    normalized_directory <- normalizePath(directory, winslash = "/", mustWork = FALSE)
    normalized_file_directory <- normalizePath(file_directory, winslash = "/", mustWork = FALSE)
    if (!missing(directory) && tolower(normalized_directory) != tolower(normalized_file_directory)) {
      warning("Argument 'file' includes a directory. Using that directory and ignoring 'directory'.")
    }

    directory <- file_directory
    file <- basename(file)
  }

  # Error handling for output directory
  if (!dir.exists(directory)) stop("The specified directory does not exist.")
  
  # Add .qmd to file name if not present
  if (!grepl("\\.qmd$", file)) {
    file <- paste0(file, ".qmd")
  }

  # Only set document_subtitle if it wasn't explicitly provided or is empty
  if (document_subtitle == "") {
    human_code_vec <- data |> dplyr::pull({{ human_code }})
    final_decision_vec <- data |> dplyr::pull({{ final_decision_gpt_num }})

    if (all(human_code_vec == 1) && all(final_decision_vec == 0)) {
      document_subtitle <- "Included by humans, excluded by GPT"
    } else if (all(human_code_vec == 0) && all(final_decision_vec == 1)) {
      document_subtitle <- "Excluded by humans, included by GPT"
    } else if (all(human_code_vec != final_decision_vec)) {
      document_subtitle <- "Disagreement between humans and GPT"
    } else {
      document_subtitle <- "Full report"
    }
  }
  
  # Warning message for document_subtitle
  if (document_subtitle == "") warning("No subtitle provided. Using an empty string.")
  
  # Extracting data columns
  studyid_vec <- data |> 
    dplyr::pull({{ studyid }}) |> 
    htmltools::htmlEscape()

  title_vec   <- data |> 
    dplyr::pull({{ title }})   |> 
    htmltools::htmlEscape()
    
  abstract_vec<- data |> 
    dplyr::pull({{ abstract }})|> 
    htmltools::htmlEscape()

  # Preparing text for the report
  studyid_txt  <- paste0("**STUDY-ID: ", studyid_vec, ":**", "\n\n")
  title_text   <- paste0("-- *Title:* '", gsub("'", " ", gsub("\"", " ", title_vec)), "'", "\n\n")
  abs_txt      <- paste0("-- *Abstract*: '", gsub("'", " ", gsub("\"", " ", abstract_vec)), "'", "\n\n")
  gpt_num_answer <- paste0("-- *Answer (GPT - numeric)*: ", data |> dplyr::pull({{ final_decision_gpt_num }}), "\n\n")
  human_answer   <- paste0("-- *Answer (Human)*: ", data |> dplyr::pull({{ human_code }}), "\n\n")

  
  if (missing(gpt_answer)){
    answer_txt <- NULL
    warning("Argument 'gpt_answer' is missing. The report will include only numeric GPT answers from 'final_decision_gpt_num'.")
  } else {
    gpt_answer <- data |> dplyr::pull({{ gpt_answer }})
    answer_txt <- paste0("-- *Answer (GPT)*: ", gpt_answer, "\n\n")
  }
  
  comment_text <- paste0("*Please add a comment on whether and why you agree with the GPT decision or not:*\n\n \n\n")
  
  print_test <- paste0(studyid_txt, title_text, abs_txt, answer_txt, gpt_num_answer, human_answer, comment_text, collapse = "")

  # Create the header
  header <- paste("---\ntitle: \"", document_title, "\"\nsubtitle: \"", document_subtitle, "\"\nformat:\n  ", format, " \n---")
  
  # Create the R setup chunk
  rsetup <- "```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```"
  
  # Create the methods chunk
  print_test_literal <- encodeString(print_test, quote = "\"")
  methods <- paste0(
    "```{r, echo=FALSE, results='asis', include=TRUE}\n",
    "print_test <- ", print_test_literal, "\n",
    "base::cat(print_test)\n",
    "```"
  )

  # Full path to the Quarto source file
  qmd_path <- file.path(directory, file)
  
  # Writing to the Quarto file
  con <- file(qmd_path, "w")
  writeLines(header, con)
  writeLines(rsetup, con)
  writeLines(methods, con)
  close(con)
  
  # Define path to the rendered file
  file_out <- file.path(directory, sub("\\.qmd$", paste0(".", format), basename(file)))

  # Check if the file is already open
  if (file.exists(file_out) && open) {
      con <- try(suppressWarnings(file(file_out, open = "r+")), silent = TRUE)
      if (inherits(con, "try-error")) {
          stop("The report file is already open. Please close it before proceeding.", call. = FALSE)
      } else {
          close(con)
      }
  }

  # Rendering the Quarto file
  message(paste0("Saving to ", qmd_path))
  file_out <- suppressWarnings(quarto::quarto_render(qmd_path, output_format = format, quiet = TRUE))
  
  # Define path to the rendered file
  file_out <- file.path(directory, sub("\\.qmd$", paste0(".", format), basename(file)))
  
  # Opening the report if open = TRUE
  if (open) {
    message(paste0("Opening report ...\n"))
    if (.Platform$OS.type == "windows") {
      shell.exec(file_out)
    } else {
      optb <- getOption("browser")
      if (is.function(optb)) {
        invisible(optb(file_out))
      } else {
        system(paste0(optb, " '", file_out, "'"))
      }
    }
  }
  
  invisible(file_out)
}