#' Reporting the participant data
#'
#' A helper function to help you format the participants data (age, sex, ...) in
#' the participants section.
#'
#' @param data A data frame.
#' @param age The name of the column containing the age of the participant.
#' @param sex The name of the column containing the sex of the participant. The
#'   classes should be one of `c("Male", "M", "Female", "F")`. Note that
#'   you can specify other characters here as well (e.g., `"Intersex"`), but
#'   the function will group all individuals in those groups as `"Other"`.
#' @param gender The name of the column containing the gender of the
#'   classes should be one of `c("Man", "M", "Male", Woman", "W", "F",
#'   "Female", Non-Binary", "N")`. Note that you can specify other characters
#'   here as well (e.g., `"Gender Fluid"`), but the function will group all
#'   individuals in those groups as `"Non-Binary"`.
#' @param education The name of the column containing education information.
#' @param country The name of the column containing country information.
#' @param race The name of the column containing race/ethnicity information.
#' @param threshold Percentage after which to combine, e.g., countries (default is 10%,
#' so countries that represent less than 10% will be combined in the "other" category).
#' @param participants The name of the participants' identifier column (for
#'   instance in the case of repeated measures).
#' @param by A character vector indicating the name(s) of the column(s) used
#'   for stratified description.
#' @param spell_n Logical, fully spell the sample size (`"Three participants"`
#'   instead of `"3 participants"`).
#' @inheritParams report.numeric
#' @param group Deprecated. Use `by` instead.
#'
#' @return A character vector with description of the "participants", based on
#'   the information provided in `data`.
#'
#' @examples
#' library(report)
#' data <- data.frame(
#'   "Age" = c(22, 23, 54, 21, 8, 42),
#'   "Sex" = c("Intersex", "F", "M", "M", "NA", NA),
#'   "Gender" = c("N", "W", "W", "M", "NA", NA)
#' )
#' report_participants(data, age = "Age", sex = "Sex")
#'
#' # Years of education (relative to high school graduation)
#' data$Education <- c(0, 8, -3, -5, 3, 5)
#' report_participants(data,
#'   age = "Age", sex = "Sex", gender = "Gender",
#'   education = "Education"
#' )
#'
#' # Education as factor
#' data$Education2 <- c(
#'   "Bachelor", "PhD", "Highschool",
#'   "Highschool", "Bachelor", "Bachelor"
#' )
#' report_participants(data, age = "Age", sex = "Sex", gender = "Gender", education = "Education2")
#'
#' # Country
#' data <- data.frame(
#'   "Age" = c(22, 23, 54, 21, 8, 42, 18, 32, 24, 27, 45),
#'   "Sex" = c("Intersex", "F", "F", "M", "M", "M", "F", "F", "F", "F", "F"),
#'   "Gender" = c("N", "W", "W", "M", "M", "M", "W", "W", "W", "W", "W"),
#'   "Country" = c(
#'     "USA", NA, "Canada", "Canada", "India", "Germany",
#'     "USA", "USA", "USA", "USA", "Canada"
#'   )
#' )
#' report_participants(data)
#'
#' # Country, control presentation treshold
#' report_participants(data, threshold = 5)
#'
#' # Race/ethnicity
#' data <- data.frame(
#'   "Age" = c(22, 23, 54, 21, 8, 42, 18, 32, 24, 27, 45),
#'   "Sex" = c("Intersex", "F", "F", "M", "M", "M", "F", "F", "F", "F", "F"),
#'   "Gender" = c("N", "W", "W", "M", "M", "M", "W", "W", "W", "W", "W"),
#'   "Race" = c(
#'     "Black", NA, "White", "Asian", "Black", "Arab", "Black",
#'     "White", "Asian", "Southeast Asian", "Mixed"
#'   )
#' )
#' report_participants(data)
#'
#' # Race/ethnicity, control presentation treshold
#' report_participants(data, threshold = 5)
#'
#' # Repeated measures data
#' data <- data.frame(
#'   "Age" = c(22, 22, 54, 54, 8, 8),
#'   "Sex" = c("I", "F", "M", "M", "F", "F"),
#'   "Gender" = c("N", "W", "W", "M", "M", "M"),
#'   "Participant" = c("S1", "S1", "s2", "s2", "s3", "s3")
#' )
#' report_participants(data, age = "Age", sex = "Sex", gender = "Gender", participants = "Participant")
#'
#' # Grouped data
#' data <- data.frame(
#'   "Age" = c(22, 22, 54, 54, 8, 8, 42, 42),
#'   "Sex" = c("I", "I", "M", "M", "F", "F", "F", "F"),
#'   "Gender" = c("N", "N", "W", "M", "M", "M", "Non-Binary", "Non-Binary"),
#'   "Participant" = c("S1", "S1", "s2", "s2", "s3", "s3", "s4", "s4"),
#'   "Condition" = c("A", "A", "A", "A", "B", "B", "B", "B")
#' )
#'
#' report_participants(data,
#'   age = "Age",
#'   sex = "Sex",
#'   gender = "Gender",
#'   participants = "Participant",
#'   by = "Condition"
#' )
#'
#' # Spell sample size
#' paste(
#'   report_participants(data, participants = "Participant", spell_n = TRUE),
#'   "were recruited in the study by means of torture and coercion."
#' )
#' @export
report_participants <- function(
  data,
  age = NULL,
  sex = NULL,
  gender = NULL,
  education = NULL,
  country = NULL,
  race = NULL,
  participants = NULL,
  by = NULL,
  spell_n = FALSE,
  digits = 1,
  threshold = 10,
  group = NULL,
  ...
) {
  ## TODO: deprecate later
  if (!is.null(group)) {
    insight::format_warning(
      "Argument `group` is deprecated and will be removed in a future release. Please use `by` instead."
    ) # nolint
    by <- group
  }

  # Convert empty strings to NA
  data_list <- lapply(data, function(x) {
    x[which(x == "")] <- NA # nolint
    x
  })
  data <- as.data.frame(data_list, stringsAsFactors = FALSE)

  # find age variable automatically
  if (is.null(age)) {
    age <- .find_age_in_data(data)
  }

  # find sex variable automatically
  if (is.null(sex)) {
    sex <- .find_sex_in_data(data)
  }

  # find gender variable automatically
  if (is.null(gender)) {
    gender <- .find_gender_in_data(data)
  }

  # find education variable automatically
  if (is.null(education)) {
    education <- .find_education_in_data(data)
  }

  # find country variable automatically
  if (is.null(country)) {
    country <- .find_country_in_data(data)
  }

  # find race variable automatically
  if (is.null(race)) {
    race <- .find_race_in_data(data)
  }

  if (is.null(by)) {
    final_text <- .report_participants(
      data,
      age = age,
      sex = sex,
      gender = gender,
      education = education,
      country = country,
      race = race,
      participants = participants,
      spell_n = spell_n,
      digits = digits,
      threshold = threshold,
      ...
    )
  } else {
    final_text <- NULL
    data[[by]] <- as.character(data[[by]])
    for (i in split(data, data[by])) {
      current_text <- .report_participants(
        i,
        age = age,
        sex = sex,
        gender = gender,
        education = education,
        country = country,
        race = race,
        participants = participants,
        spell_n = spell_n,
        digits = digits,
        threshold = threshold
      )

      pre_text <- paste0(
        "the '",
        paste0(
          names(i[by]),
          " - ",
          vapply(i[by], unique, "character"),
          collapse = " and "
        ),
        "' group: "
      )

      final_text <- c(final_text, paste0(pre_text, current_text))
    }
    final_text <- paste(
      "For",
      datawizard::text_concatenate(
        final_text,
        sep = ", for ",
        last = " and for "
      )
    )
  }
  final_text
}

#' @keywords internal
.check_df_names <- function(data, names) {
  data[names] <- lapply(names, function(x) {
    if (is.null(x) || !all(x %in% names(data))) {
      NA
    } else {
      data[[x]]
    }
  })
  data
}

#' @keywords internal
.replace_names <- function(data, x) {
  if (is.null(x) || !all(x %in% names(data))) {
    tools::toTitleCase(deparse(substitute(x)))
  } else {
    x
  }
}

#' @keywords internal
.report_participants <- function(
  data,
  age = "Age",
  sex = "Sex",
  gender = "Gender",
  education = "Education",
  country = "Country",
  race = "Race",
  participants = NULL,
  spell_n = FALSE,
  digits = 1,
  threshold = 10,
  ...
) {
  # Sanity checks
  demo_names <- c("Age", "Sex", "Gender", "Education", "Country", "Race")
  data <- .check_df_names(data, names = demo_names)

  age <- .replace_names(data, age)
  sex <- .replace_names(data, sex)
  gender <- .replace_names(data, gender)
  education <- .replace_names(data, education)
  country <- .replace_names(data, country)
  race <- .replace_names(data, race)

  # Set age as numeric
  data[[age]] <- as.numeric(data[[age]])

  # Grouped data
  if (!is.null(participants)) {
    data <- data.frame(
      Age = stats::aggregate(
        data[[age]],
        by = list(data[[participants]]),
        FUN = mean
      )[[2]],
      Sex = stats::aggregate(
        data[[sex]],
        by = list(data[[participants]]),
        FUN = utils::head,
        n = 1
      )[[2]],
      Gender = stats::aggregate(
        data[[gender]],
        by = list(data[[participants]]),
        FUN = utils::head,
        n = 1
      )[[2]],
      Education = stats::aggregate(
        data[[education]],
        by = list(data[[participants]]),
        FUN = utils::head,
        n = 1
      )[[2]],
      Country = stats::aggregate(
        data[[country]],
        by = list(data[[participants]]),
        FUN = utils::head,
        n = 1
      )[[2]],
      Race = stats::aggregate(
        data[[race]],
        by = list(data[[participants]]),
        FUN = utils::head,
        n = 1
      )[[2]],
      stringsAsFactors = FALSE
    )
    age <- "Age"
    sex <- "Sex"
    gender <- "Gender"
    education <- "Education"
    country <- "Country"
    race <- "Race"
  }

  if (spell_n) {
    size <- tools::toTitleCase(insight::format_number(nrow(data)))
  } else {
    size <- nrow(data)
  }

  # Create text
  if (all(is.na(data[[age]]))) {
    text_age <- ""
  } else {
    text_age <- summary(
      report_statistics(
        data[[age]],
        n = FALSE,
        centrality = "mean",
        missing_percentage = TRUE,
        digits = digits,
        ...
      )
    )
    text_age <- sub("Mean =", "Mean age =", text_age, fixed = TRUE)
  }

  text_sex <- if (all(is.na(data[[sex]]))) {
    ""
  } else {
    paste0(
      "Sex: ",
      insight::format_value(
        length(data[[sex]][
          tolower(
            data[[sex]]
          ) %in%
            c("female", "f")
        ]) /
          nrow(data) *
          100,
        digits = digits
      ),
      "% females, ",
      insight::format_value(
        length(data[[sex]][
          tolower(
            data[[sex]]
          ) %in%
            c("male", "m")
        ]) /
          nrow(data) *
          100,
        digits = digits
      ),
      "% males, ",
      insight::format_value(
        100 -
          length(data[[sex]][
            tolower(
              data[[sex]]
            ) %in%
              c("male", "m", "female", "f", NA, "na")
          ]) /
            nrow(data) *
            100,
        digits = digits
      ),
      "% other",
      if (
        insight::format_value(
          length(data[[sex]][tolower(data[[sex]]) %in% c(NA, "na")]) /
            nrow(data) *
            100
        ) !=
          "0.00"
      ) {
        # nolint
        paste0(
          ", ",
          insight::format_value(
            length(data[[sex]][
              tolower(
                data[[sex]]
              ) %in%
                c(NA, "na")
            ]) /
              nrow(data) *
              100
          ),
          "% missing"
        )
      }
    )
  }

  genders_woman <- c(
    "woman",
    "w",
    "female",
    "f",
    "women",
    "girl",
    "lady",
    "miss",
    "madam",
    "dame",
    "lass"
  )
  genders_man <- c(
    "man",
    "m",
    "male",
    "men",
    "boy",
    "guy",
    "dude",
    "lad",
    "sir"
  )
  both_genders <- c(genders_woman, genders_man, NA, "na")

  text_gender <- if (all(is.na(data[[gender]]))) {
    ""
  } else {
    paste0(
      "Gender: ",
      insight::format_value(
        length(data[[gender]][
          tolower(
            data[[gender]]
          ) %in%
            genders_woman
        ]) /
          nrow(data) *
          100,
        digits = digits
      ),
      "% women, ",
      insight::format_value(
        length(data[[gender]][
          tolower(
            data[[gender]]
          ) %in%
            genders_man
        ]) /
          nrow(data) *
          100,
        digits = digits
      ),
      "% men, ",
      insight::format_value(
        100 -
          length(data[[gender]][
            tolower(
              data[[gender]]
            ) %in%
              both_genders
          ]) /
            nrow(data) *
            100
      ),
      "% non-binary",
      if (
        insight::format_value(
          length(data[[gender]][
            tolower(
              data[[gender]]
            ) %in%
              c(NA, "na")
          ]) /
            nrow(data) *
            100
        ) !=
          "0.00"
      ) {
        paste0(
          ", ",
          insight::format_value(
            length(data[[gender]][
              tolower(
                data[[gender]]
              ) %in%
                c(NA, "na")
            ]) /
              nrow(data) *
              100
          ),
          "% missing"
        )
      }
    )
  }

  if (all(is.na(data[[education]]))) {
    text_education <- ""
  } else if (is.numeric(data[[education]])) {
    text_education <- summary(
      report_statistics(
        data[[education]],
        n = FALSE,
        centrality = "mean",
        missing_percentage = NULL,
        digits = digits,
        ...
      )
    )

    text_education <- sub(
      "Mean =",
      "Mean education =",
      text_education,
      fixed = TRUE
    )
  } else {
    data[which(data[[education]] %in% c(NA, "NA")), education] <- "missing"
    txt <- summary(report_statistics(
      as.factor(data[[education]]),
      levels_percentage = TRUE,
      digits = digits,
      ...
    ))

    text_education <- paste0("Education: ", txt)
  }

  text_country <- if (all(is.na(data[[country]]))) {
    ""
  } else {
    data[[country]] <- as.character(data[[country]])
    data[which(data[[country]] %in% c(NA, "NA")), country] <- "missing"
    freq_tbl <- table(data[[country]])
    frequency_table <- data.frame(
      Value = names(freq_tbl),
      Percent = as.numeric(freq_tbl) / nrow(data) * 100,
      stringsAsFactors = FALSE
    )
    frequency_table <- frequency_table[order(-frequency_table$Percent), ]
    upper <- frequency_table[which(frequency_table$Percent >= threshold), ]
    lower <- frequency_table[which(frequency_table$Percent < threshold), ]
    if (nrow(lower) > 0) {
      lower_sum <- data.frame(
        Value = "other",
        Percent = sum(lower$Percent),
        stringsAsFactors = FALSE
      )
      combined <- rbind(upper, lower_sum)
    } else {
      combined <- upper
    }
    combined$Percent <- insight::format_value(combined$Percent)
    value_string <- paste0(
      combined$Percent,
      "% ",
      combined$Value,
      collapse = ", "
    )
    text_country <- paste("Country:", value_string)
  }

  text_race <- if (all(is.na(data[[race]]))) {
    ""
  } else {
    data[[race]] <- as.character(data[[race]])
    data[which(data[[race]] %in% c(NA, "NA")), race] <- "missing"
    freq_tbl <- table(data[[race]])
    frequency_table <- data.frame(
      Value = names(freq_tbl),
      Percent = as.numeric(freq_tbl) / nrow(data) * 100,
      stringsAsFactors = FALSE
    )
    frequency_table <- frequency_table[order(-frequency_table$Percent), ]
    upper <- frequency_table[which(frequency_table$Percent >= threshold), ]
    lower <- frequency_table[which(frequency_table$Percent < threshold), ]
    if (nrow(lower) > 0) {
      lower_sum <- data.frame(
        Value = "other",
        Percent = sum(lower$Percent),
        stringsAsFactors = FALSE
      )
      combined <- rbind(upper, lower_sum)
    } else {
      combined <- upper
    }
    combined$Percent <- insight::format_value(combined$Percent)
    value_string <- paste0(
      combined$Percent,
      "% ",
      combined$Value,
      collapse = ", "
    )
    text_race <- paste("Race:", value_string)
  }

  # nolint start
  paste0(
    size,
    " participants (",
    ifelse(text_age == "", "", text_age),
    ifelse(
      text_sex == "",
      "",
      paste0(
        ifelse(
          text_age == "",
          "",
          "; "
        ),
        text_sex
      )
    ),
    ifelse(
      text_gender == "",
      "",
      paste0(
        ifelse(
          text_age == "" & text_sex == "",
          "",
          "; "
        ),
        text_gender
      )
    ),
    ifelse(
      text_education == "",
      "",
      paste0(
        ifelse(
          text_age == "" & text_sex == "" & text_gender == "",
          "",
          "; "
        ),
        text_education
      )
    ),
    ifelse(
      text_country == "",
      "",
      paste0(
        ifelse(
          text_education == "" &
            text_age == "" &
            text_sex == "" &
            text_gender == "",
          "",
          "; "
        ),
        text_country
      )
    ),
    ifelse(
      text_race == "",
      "",
      paste0(
        ifelse(
          text_country == "" &
            text_education == "" &
            text_age == "" &
            text_sex == "" &
            text_gender == "",
          "",
          "; "
        ),
        text_race
      )
    ),
    ")"
  )
  # nolint end
}

#' @keywords internal
.find_age_in_data <- function(data) {
  if ("Age" %in% colnames(data)) {
    "Age"
  } else if ("age" %in% colnames(data)) {
    "age"
  } else if (any(startsWith("Age", colnames(data)))) {
    grep("^Age", colnames(data), value = TRUE)[1]
  } else if (any(startsWith("age", colnames(data)))) {
    grep("^age", colnames(data), value = TRUE)[1]
  } else {
    ""
  }
}

#' @keywords internal
.find_sex_in_data <- function(data) {
  if ("Sex" %in% colnames(data)) {
    "Sex"
  } else if ("sex" %in% colnames(data)) {
    "sex"
  } else if (any(startsWith("Sex", colnames(data)))) {
    grep("^Sex", colnames(data), value = TRUE)[1]
  } else if (any(startsWith("sex", colnames(data)))) {
    grep("^sex", colnames(data), value = TRUE)[1]
  } else {
    ""
  }
}

#' @keywords internal
.find_gender_in_data <- function(data) {
  if ("Gender" %in% colnames(data)) {
    "Gender"
  } else if ("gender" %in% colnames(data)) {
    "gender"
  } else if (any(startsWith("Gender", colnames(data)))) {
    grep("^Gender", colnames(data), value = TRUE)[1]
  } else if (any(startsWith("gender", colnames(data)))) {
    grep("^gender", colnames(data), value = TRUE)[1]
  } else {
    ""
  }
}

#' @keywords internal
.find_education_in_data <- function(data) {
  if ("Education" %in% colnames(data)) {
    "Education"
  } else if ("education" %in% colnames(data)) {
    "education"
  } else if (any(startsWith("Education", colnames(data)))) {
    grep("^Education", colnames(data), value = TRUE)[1]
  } else if (any(startsWith("education", colnames(data)))) {
    grep("^education", colnames(data), value = TRUE)[1]
  } else if ("isced" %in% colnames(data)) {
    "isced"
  } else if (any(startsWith("isced", colnames(data)))) {
    grep("^isced", colnames(data), value = TRUE)[1]
  } else {
    ""
  }
}

#' @keywords internal
.find_country_in_data <- function(data) {
  if ("Country" %in% colnames(data)) {
    "Country"
  } else if ("country" %in% colnames(data)) {
    "country"
  } else if (any(startsWith("Country", colnames(data)))) {
    grep("^Country", colnames(data), value = TRUE)[1]
  } else if (any(startsWith("country", colnames(data)))) {
    grep("^country", colnames(data), value = TRUE)[1]
  } else {
    ""
  }
}

#' @keywords internal
.find_race_in_data <- function(data) {
  if ("Race" %in% colnames(data)) {
    "Race"
  } else if ("race" %in% colnames(data)) {
    "race"
  } else if (any(startsWith("Race", colnames(data)))) {
    grep("^Race", colnames(data), value = TRUE)[1]
  } else if (any(startsWith("race", colnames(data)))) {
    grep("^race", colnames(data), value = TRUE)[1]
  } else {
    ""
  }
}
