functions_beauty.R

# .................................................. ####
# Text basis  ####

cat0 <- function(...) {
  #' @description
  #' cat-function with sep = "".
  
  return(cat(sep = "", ...))
}

cat0s <- function(...) {
  #' @description
  #' cat-function with sep = "" for paragraphs with a period at the end.
  
  return(cat(sep = "", "\n\n", ..., ".\n\n"))
}

cat0sw <- function(...) {
  #' @description
  #' cat-function with sep = "" for paragraphs without a period at the end.
  
  return(cat(sep = "", "\n\n", ..., "\n\n"))
}

caption <- function(...) {
  #' @description
  #' Makes captions for tables and graphs.
  #' cat-function with sep = "" for paragraphs without a period at the end.
  #' The same as cat0sw.
  
  return(cat(sep = "", "\n\n", ..., "\n\n"))
}

# Caption - Change numbering of captioner  ####

captionstart <- function(name, value) {
  #' @description
  #' Creates captions to change the start number of the captioner.
  #' @param name name of the caption
  #' @param value starting value.
  
  for (i in 1L:(value - 1L)) {
    if (i != 0L) {
      do.call(name,
              list(
                name = paste("a", i),
                caption = paste("a", i),
                display = FALSE))
    }
  }
}

# .................................................. ####
# Explaining the treatments, etc.  ####

rr_factorname <- "rank-reversal factor"

needs_factorname <- "need factor"

reg_abbr_note <- function(end = ".", safespace = FALSE) {
  
  if (safespace == TRUE) {
    return(
      paste0("RR\u00a0=\u00a0rank reversal treatment; ",
             "NEED\u00a0=\u00a0need treatment", end)
    )
  } else {
    return(
      paste0("RR = rank reversal treatment; NEED = need treatment", end)
    )
  }
}

rr_needs_abbr_note <- function(end = ".", safespace = FALSE) {
  
  if (safespace) {
    return(paste0(
      "RR\u00a0=\u00a0rank reversal treatment; ",
      "NEED\u00a0=\u00a0need treatment", end
    )
    )
  } else {
    return(paste0(
      "RR = rank reversal treatment; NEED = need treatment", end))
  }
}

all_rr_needs_abbr_note <- function(end = ".",  safespace = FALSE) {
  
  if (safespace) {
    return(
      paste0(
        "RR\u00a0=\u00a0rank reversal treatment; ",
        "NoRR\u00a0=\u00a0no rank reversal treatment; ",
        "NEED\u00a0=\u00a0need treatment; ",
        "NoNEED\u00a0=\u00a0no need treatment", end))
  } else {
    return(
      paste0(
        "RR = rank reversal treatment; ",
        "NoRR = no rank reversal treatment; ",
        "NEED = need treatment; ",
        "NoNEED = no need treatment", end
      ))
  }
}

pp_abbr_note <- function(end = ".",  safespace = FALSE) {
  
  if (safespace == TRUE) {
    return(
      paste0(
        "CI\u00a0=\u00a0confidence interval ",
        "based on clustered standard error; ",
        "LL\u00a0=\u00a0lower limit; ",
        "UL\u00a0=\u00a0upper limit; ",
        "RR\u00a0=\u00a0rank reversal treatment; ",
        "NoRR\u00a0=\u00a0no rank reversal treatment; ",
        "NEED\u00a0=\u00a0need treatment; ",
        "NoNEED\u00a0=\u00a0no need treatment",
        end)
    )
  } else {
    return(
      paste0(
        "CI = confidence interval based on clustered standard errors; ",
        "LL = lower limit; ",
        "UL = upper limit; ",
        "RR = rank reversal treatment; ",
        "NoRR = no rank reversal treatment; ",
        "NEED = need treatment; ",
        "NoNEED = no need treatment",
        end)
    )
  }
}

# .................................................. ####
# CI and p values   ####

est_ci_percent_string_p_type <- function(data, estimatetype) {
  #' @description
  #' Estimates from a predicted probability table.
  #' The same as est_ci_percent but for tables that
  #' are already formatted with beautify_pp.
  
  # Check if there is a columns called "type"
  if (is.null(data$type)) {
    if (!is.null(data$Group)) {
      data$type <- data$Group
    } else {
      data$type <- data[, 1L]
    }
  }
  
  x <- percentx(data[data$type == estimatetype, "Estimate"])
  lower <- data[data$type == estimatetype, "Lower"]
  upper <- data[data$type == estimatetype, "Upper"]
  
  out <- list(
    Estimate = x,
    CI = CI_p(unique(data$KI), lower, upper),
    Together = paste0(x, ", ", CI_p(unique(data$KI), lower, upper))
  )
  return(out)
}

CI_p <- function(ci_lvl, lower, upper, digits = 1) {
  #' @description
  #' Confidence intervals for percent.
  
  CI <- paste0(
    ci_lvl * 100, "% CI [",
    percentx(lower, digits),
    ",\u00a0",
    percentx(upper, digits),
    "]")
  
  return(CI)
}

est_ci_percent_string_p <- function(data, estimateNr) {
  #' @description
  #' Estimates from a predicted probability table.
  
  x <- percentx(as.double(data[estimateNr, "Estimate"]))
  lower <- as.double(data[estimateNr, "Lower"])
  upper <- as.double(data[estimateNr, "Upper"])
  KI <- 0.95
  
  out   <- list(
    Estimate = x,
    CI = CI_p(KI, lower, upper),
    Together = paste0(x, ", ", CI_p(KI, lower, upper))
  )
  return(out)
}

pvaluestars <- function(pvalue) {
  #' @description
  #' Convert p-values into their corresponding significance stars.
  
  if (length(pvalue) == 1) {
    
    # If string only contains numbers (i.e., no < sign), convert to numeric
    if (!grepl(pattern = "<", x = pvalue)) {
      pvalue <- as.numeric(pvalue)
    }
    
    if (pvalue < 0.001 ||
        pvalue == "p < .001" ||
        pvalue == "<.001") {
      return("***")
    } else if (pvalue < 0.01 ||
               pvalue == "p < .01" ||
               pvalue == "<.01") {
      return("**")
    } else if (pvalue < 0.05 ||
               pvalue == "p < .05" ||
               pvalue == "<.05") {
      return("*")
    } else if (pvalue >= 0.05) {
      return("")
    } else {
      return(paste("Error: ", pvalue))
    }
  } else if (length(pvalue) > 1) {
    
    pvalues <- c()
    for (i in seq_along(pvalue)) {
      
      # If string only contains numbers (i.e., no < sign), convert to numeric
      if (!grepl(pattern = "<", x = pvalue[i])) {
        pvalue[i] <- as.numeric(pvalue[i])
      }
      
      if (is.na(pvalue[i])) {
        pvalues[i] <- NA
        stop(paste("Error for p-value: ", pvalue[i]))
      } else if (pvalue[i] < 0.001 ||
                 pvalue[i] == "p < .001" ||
                 pvalue[i] == "<.001") {
        pvalues[i] <- "***"
      } else if (pvalue[i] < 0.01 ||
                 pvalue[i] == "p < .01" ||
                 pvalue[i] == "<.01") {
        pvalues[i] <- "**"
      } else if (pvalue[i] < 0.05 ||
                 pvalue[i] == "p < .05" ||
                 pvalue[i] == "<.05") {
        pvalues[i] <- "*"
      } else if (pvalue[i] >= 0.05) {
        return("")
      }
    }
    
    return(pvalues)
    
  } else {
    stop("No p-values")
  }
}

CI_pp <- function(ci_lvl, lower, upper, digits = 1) {
  #' @description
  #' Confidence intervals for percentage points.
  
  # Make sure, ci_lvl is numeric and unique
  ci_lvl <- unique(as.numeric(ci_lvl))
  
  # Make output
  CI <- paste0(
    ci_lvl * 100, "% CI [",
    ppdx(lower, digits),
    ",\u00a0",
    ppdx(upper, digits),
    "]")
  
  return(CI)
}

ORregstats_NEW <- function(ORtable, coefficient, level, digits = 1) {
  #' @description
  #' Reports regression OR and its confidence interval inside the text.
  #' Confidence interval is not reported in parentheses.
  
  # Check first
  if (ncol(ORtable) == 3) {
    # Caution. Number of columns is not three.
    # If the number of columes is three, then this is because the
    # first column does not contain the parameter names.
    # (Get them from the rownames!)
    ORtable <- data.frame(coefficient = row.names(ORtable), ORtable)
    row.names(ORtable) <- NULL
  }
  
  if (digits == 1)  {
    out <- paste0(
      "*OR*\u00a0=\u00a0",
      digit1(ORtable[ORtable$coefficient == coefficient, 2]),
      ", ", level * 100, "%\u00a0",
      "CI\u00a0=\u00a0[",
      digit1(ORtable[ORtable$coefficient == coefficient, 3]), ",\u00a0",
      digit1(ORtable[ORtable$coefficient == coefficient, 4]), "]")
    
  } else if (digits == 2) {
    out <- paste0(
      "*OR*\u00a0=\u00a0",
      digit2(ORtable[ORtable$coefficient == coefficient, 2]),
      ", ", level * 100, "%\u00a0",
      "CI\u00a0=\u00a0[",
      digit2(ORtable[ORtable$coefficient == coefficient, 3]), ",\u00a0",
      digit2(ORtable[ORtable$coefficient == coefficient, 4]), "]")
    
  } else {
    stop("Please enter digits = 1 or digits = 2!")
  }
  
  return(out)
}

mypvalue <- function(value) {
  #' @description
  #' Makes pretty p-values for the text.
  #' @example
  #' mypvalue(0.2)  # "p = .200"
  #' mypvalue(0.0001)  # "p < .001"
  
  if (value < 0.001) {
    return("*p*\u00a0<\u00a0.001")
  } else {
    x <- no0(formatC(value, digits = 3, format = "f"))
    return(paste0("*p*\u00a0=\u00a0", x))
  }
}

# .................................................. ####
# Model names  ####

makemodelnames2 <- function(number) {
  #' @description
  #' Automatically creates normal model names followed by a "B".
  #' @return
  #' Returns a vector with model names in the form of c("Model 1 B",
  #' "Model 2 B", "Model 3 B").
  
  names <- c()
  for (i in c(1:number)) {
    names <- c(names, paste0("Model ", i, " B"))
  }
  
  return(names)
}

rankingmodelnames <- function() {
  #' @description
  #' Automatically creates model names for ranking of principles models.
  #' @return
  #' Returns a vector with model names in the form of (c("ORR B",
  #' "Equality B", "Needs B"))
  
  return(c("Ranking of ORR B", "Ranking of Equality B", "Ranking of Needs B"))
}

# .................................................. ####
# Change column and row names of correlation matrix  ####

newnamescorplot1 <- function(corrmatrix) {
  #' @description
  #' Puts number before column and row names of a correlation plot.
  
  rownames(corrmatrix) <-
    sapply(seq(1, length(rownames(corrmatrix))),
           function(i) paste0("(", i, ") ", rownames(corrmatrix)[i]))
  
  colnames(corrmatrix) <-
    sapply(seq(1, length(colnames(corrmatrix))),
           function(i) paste0("(", i, ") ", colnames(corrmatrix)[i]))
  
  return(corrmatrix)
}

# .................................................. ####
# Table and graph notes  ####

note <- function(...) {
  cat("\n\nNote. ",
      ...,
      "\n\n",
      sep = "")
}

notes <- function(...) {
  cat("\n\nNote. ",
      ...,
      ".\n\n",
      sep = "")
}

ci_cluster_note <- function(CI = .95)  {
  #' @description
  #' Creates CI notes for pp-tables and pp-plots
  #' (with clustered standard errors).
  
  note <-
    paste0(CI * 100,
           "% confidence intervals took clustered standard errors into account.")
  return(note)
}

ci_nocluster_note <- function(CI = .95)  {
  #' @description
  #' Creates CI notes for pp-tables or graphs (without clustered standard errors
  #' because of aggregated data)
  
  note <- paste0(CI * 100,
                 "% confidence intervals.")
  return(note)
}

ci_origin_pp_note <- function(...) {
  #' @description
  #' Creates an information on where the numbers behind an pp graph can be found.
  
  return(paste0(
    "The figure is based on the predicted probabilities in ESM Appendix D, ",
    ..., "."))
}

glm_cluster_note <- function(...) {
  #' @description
  #' Creates an information on the underlying regression model for a pp-table or -graph.
  
  return(paste(
    "Predicted probabilities are based on the logistic regression models in ",
    ..., "."))
}

se_cluster_note <- function() {
  return("Robust standard errors clustered at the participant level are reported in parentheses.")
}

se_cluster_note2 <- function() {
  return("Robust standard errors clustered at the participant level are reported in parentheses.\n")
}

ci_pp_note <- function(...) {
  note <- paste0(" Confidence intervals are taken from the predicted probabilities in ",
                 ...,
                 ".")
  return(note)
}

centered_var_note <- function(newlinebefore = FALSE,
                              newlineafter = FALSE) {
  
  text <- "^a^ Centered variable"
  
  if (newlinebefore == TRUE) {
    text <- paste0("\n\n", text)
  }
  if (newlineafter == TRUE) {
    text <- paste0(text, "\n\n")
  }
  return(text)
}

binary_var_note <- function(newlinebefore = FALSE,
                            newlineafter = FALSE) {
  
  text <- "^b^ Binary variable"
  
  if (newlinebefore == TRUE) {
    text <- paste0("\n\n", text)
  }
  if (newlineafter == TRUE) {
    text <- paste0(text, "\n\n")
  }
  return(text)
}

stars <- function() {
  #' @description
  #' Makes star documentation for table notes.
  #' \u00a0  = non-breaking space
  
  x <- paste0("\\***", "\u00a0", "*p*", "\u00a0", "<", "\u00a0", "0.001; ")
  y <- paste0("\\**", "\u00a0*p*\u00a0", "<", "\u00a0", "0.01; ")
  z <- paste0("\\*", "\u00a0*p*\u00a0", "<", "\u00a0", "0.05; ")
  a <- paste0(".", "\u00a0*p*\u00a0", "<", "\u00a0", "0.1")
  x <- paste0(x, y, z, a)
  return(x)
}

# .................................................. ####
# Beautify the numbers of the tables   ####

beautify_pp_inequ <- function(table) {
  #' @description
  #' Beautify the inequality row names of a predicted probability table.
  
  table$Group <- as.character(table$Group)
  table$Group[table$Group == "3"] <- "3 Token Inequality"
  table$Group[table$Group == "4"] <- "4 Token Inequality"
  table$Group[table$Group == "6"] <- "6 Token Inequality"
  table$Group[table$Group == "7"] <- "7 Token Inequality"
  table$Group[table$Group == "9"] <- "9 Token Inequality"
  
  return(table)
}

beautify_pp <- function(table, digits = 4) {
  #' @description
  #' Rounds the numbers in a pp table.
  
  library(dplyr)
  
  table[, "SE"]       <- formatC(as.double(table[, "SE"]),
                                 digits = digits, format = "f")
  table[, "Estimate"] <- formatC(as.double(table[, "Estimate"]),
                                 digits = digits, format = "f")
  
  if ("p" %in% names(table)) {
    table[, "p"] <- formatC(as.double(table[, "p"]),
                            digits = digits,
                            format = "f")
  }
  
  if ("*p*" %in% names(table)) {
    table[, "*p*"] <- formatC(as.double(table[, "*p*"]),
                              digits = digits,
                              format = "f")
  }
  
  if ("z" %in% names(table)) {
    table[, "z"] <- formatC(as.double(table[, "z"]),
                            digits = digits,
                            format = "f")
  }
  
  # Lower sometimes saved with uppercase or lowercase letters
  if ("Lower" %in% names(table)) {
    table[, "Lower"] <- formatC(round(as.double(table[, "Lower"]),
                                      digits = digits),
                                digits = digits,
                                format = "f")
  }
  if ("lower" %in% names(table)) {
    table[, "lower"] <- formatC(as.double(table[, "lower"]),
                                digits = digits,
                                format = "f")
  }
  
  # Upper sometimes saved with uppercase or lowercase letters
  if ("Upper" %in% names(table)) {
    table[, "Upper"] <- formatC(as.double(table[, "Upper"]),
                                digits = digits,
                                format = "f")
  }
  if ("upper" %in% names(table)) {
    table[, "upper"] <- formatC(as.double(table[, "upper"]),
                                digits = digits,
                                format = "f")
  }
  
  if ("Facet" %in% names(table)) {
    table[
      table$Facet == "initial.inequality", "Facet"] <- "Initial inequality"
    table[table$Facet == "needsTR.f", "Facet"] <- "Need factor"
    table[table$Facet == "rrTR.f", "Facet"] <- "Reranking factor"
  }
  
  return(table)
}

beautify_reg_table_1model <- function(table, digits = 5) {
  #' @description
  #' Sets digits in a regression table.
  #' @example
  #' pander::pander(beautify_reg_table_1model(model_corrected[, ]),
  #' justify = "left")
  
  # Estimates and errors
  table[, "Estimate"] <- formatC(as.double(table[, "Estimate"]),
                                 digits = digits,
                                 format = "f")
  
  table[, "Estimate"] <- minuss(table[, "Estimate"])
  
  table[, "Std. Error"] <- formatC(as.double(table[, "Std. Error"]),
                                   digits = digits,
                                   format = "f")
  
  # P and z
  if ("z value" %in% colnames(table)) {
    table[, "z value"] <- formatC(as.double(table[, "z value"]),
                                  digits = digits,
                                  format = "f")
    
    table[, "z value"] <- minuss(table[, "z value"])
  }
  if ("Pr(>|z|)" %in% colnames(table)) {
    table[, "Pr(>|z|)"] <- formatC(as.double(table[, "Pr(>|z|)"]),
                                   digits = digits,
                                   format = "f")
  }
  
  return(table)
}

# Beautify the coefficient-names of the tables   ####

beautifynames <- function(names) {
  #' @description
  #' Makes the coefficient names in a regression table nicer.
  #' (The code could be better sorted.)
  
  x <- names
  x <- gsub("\\(Intercept\\)", "Intercept", x)
  
  # Strip re-level information of factor variables
  x <- gsub("stats::relevel\\(pol_conservative.f, 1)", "Pol_cons_", x)
  x <- gsub("stats::relevel\\(pol_affiliation.f, 1)", "Pol_aff_", x)
  x <- gsub("stats::relevel\\(pol_leftright.f, 1)", "Pol_LR_", x)
  x <- gsub("stats::relevel\\(edu_rec.f, 1)", "Edu^f^", x)
  
  # Strip further information
  x <- gsub("sociodemographics.1.player.", "", x)
  # If other table:
  x <- gsub("sociodemographics.", "", x)
  
  # Delete everything after a bf
  x <- gsub("bf(.*?)$", "bf", x)
  
  # Diverse
  x <- gsub("needsTR", "NEED", x)
  x <- gsub(paste0("^edu_rec$"),
            "Level of Education", x)  # Only replace whole word (Ed. level)
  x <- gsub(paste0("edu_rec.f$"),
            "Education^f^", x)  # Only replace whole word (Ed. level)
  
  # Special characters
  x <- gsub(":", " x ", x)  # Must be before the others, but after relevel
  x <- gsub("player\\.", "", x)
  x <- gsub("Player\\.", "", x)
  x <- gsub("\\.f", " ", x)  # Must be before the dot!
  x <- gsub("\\_", " ", x)
  x <- gsub("\\.", " ", x)
  
  x <- gsub(".rec01$", "", x)
  x <- gsub("_rec$", "", x)
  x <- gsub("rec$", "", x)
  x <- gsub("\\brec\\b", "", x)
  
  x <- gsub("  ", " ", x)
  
  # Title case
  x <- stringr::str_to_title(x)
  
  # Treatments
  x <- gsub("Needs", "NEED", x)
  x <- gsub("Need Need", "NEED", x)
  x <- gsub("NEED NEED", "NEED", x)
  x <- gsub("RrTRf.f", "RR", x)
  x <- gsub("Rrtr", "RR", x)
  x <- gsub("Rr", "RR", x)
  x <- gsub("RR RR", "RR", x)
  
  # Sociodemographics
  x <- gsub("White White", "White", x)
  x <- gsub("House01", "House 01", x)
  x <- gsub("Edu\\s", "Education: ", x)
  x <- gsub("Usorigin", "Us Origin", x)
  
  # Rankings of the principles
  x <- gsub("Ranking", "Ranking:", x)
  x <- gsub("Hierrank", "ORR", x)
  x <- gsub("Hierequality", "Equality", x)
  x <- gsub("Hierneeds", "Needs", x)
  
  # SCO
  x <- gsub("Totalscore", "SCO", x)
  
  # Politics
  x <- gsub("Pol Leftright01", "Right-wing", x)
  x <- gsub("Pol Conservative01", "Conservative", x)
  x <- gsub("Conservative3", "Orientation:", x)
  x <- gsub("Affiliation3", "Affiliation:", x)
  x <- gsub("Leftright3", "Leftright:", x)
  
  # Change capitalization
  x <- gsub("Sco", "SCO", x)
  x <- gsub("Ses", "SES", x)
  x <- gsub("Norr", "NoRR", x)
  x <- gsub("Us", "US", x)
  x <- gsub("Hh", "HH", x)
  x <- gsub("\\^F\\^", "^f^", x)
  
  # Diverse
  x <- gsub("0", "", x)                 # Remove all leftover 01
  x <- gsub("1", "", x)                 # Remove all leftover 01
  x <- gsub(" X ", " x ", x)            # Make the interaction sign smaller
  
  x <- gsub(" C$", "^a^", x)            # Center symbol to superscript a
  x <- gsub(" Bf$", "^b^", x)           # Binary factor variable
  
  x <- gsub(paste0("\\bAnd\\b"), "and", x)      # Only replace whole word
  
  # Strip heading and last space
  x <- gsub("^ ", "", x)
  x <- gsub(" $", "", x)
  
  # Remove double SCO
  x <- gsub("SCO  SCO", "SCO", x)
  x <- gsub("SCO Opinion", "SCO-Opinion", x)
  x <- gsub("SCO Ability", "SCO-Ability", x)
  
  # Sociodemographics
  x <- gsub("Borninus", "Born in US", x)
  x <- gsub("^US ", "U.S. ", x)
  x <- gsub("Non white", "Non-white", x)
  x <- gsub("Leftright", "Left&ndash;right", x)
  x <- gsub("^Edu$", "Education", x)
  x <- gsub("^Education\\:$", "Education", x)
  x <- gsub("^Pol", "Pol.", x)
  x <- gsub("Left-right", "Left&ndash;Right", x)
  
  # Rankings again
  x <- gsub("First$", "1^st^", x)
  
  x <- gsub("No-reranking", "No-Reranking", x)
  
  return(x)
}

# .................................................. ####
# Nice numbers  ####
# Minus signs
minuss <- function(x) {
  #' @description
  #' Minus signs instead of hyphens
  
  x <- gsub("-", "\U2212", x)
  return(x)
}

# Digits
digit0 <- function(x) {
  #' @description
  #' Rounds a number to zero digits.
  
  x <- formatC(x, digits = 0, format = "f")
  
  return(x)
}

digit1 <- function(x) {
  #' @description
  #' Rounds a number to 1 digit.
  
  x <- formatC(x, digits = 1, format = "f")
  
  return(x)
}

digit2 <- function(x) {
  #' @description
  #' Rounds a number to 2 digits.
  
  x <- formatC(x, digits = 2, format = "f")
  
  return(x)
}

digit3 <- function(x) {
  #' @description
  #' Rounds a number to 3 digits.
  
  x <- formatC(x, digits = 3, format = "f")
  
  return(x)
}

# Percent
percentx <- function(numbers, digits = 1) {
  #' @description
  #' Converts numbers that range from 0-1 to percentages.
  
  newlist <- c()
  
  for (element in numbers) {
    
    element <- as.double(element)  # Make sure, the element is numeric
    y <- formatC(element * 100, digits = digits, format = "f")
    z <- paste0(y, "%")
    newlist <- append(newlist, z)
  }
  
  return(newlist)
}

ppd1 <- function(x) {
  #' @description
  #' Takes a number from 0-1 and converts it to a percentage points (pp)
  #' number with 1 digit.
  
  x <- as.double(x)
  y <- formatC(x * 100, digits = 1, format = "f")
  z <- paste0(y, " pp")
  return(z)
}

ppdx <- function(x, digits) {
  #' @description
  #' Takes a number from 0-1 and converts it to a percentage points (pp).
  
  x <- as.double(x)
  y <- formatC(mean(x, na.rm = TRUE) * 100, digits = digits, format = "f")
  z <- paste0(y, " pp")
  
  return(z)
}

myperc <- function(variable, condition) {
  #' @description
  #' Calculates the percent by condition.
  #' Excludes NA values.
  #' If multiple conditions are specified, they are combined.
  
  x <- formatC(length(variable[!is.na(variable) &
                                 variable %in% condition]) /
                 length(variable[!is.na(variable)]) * 100,
               digits = 1,
               format = "f")
  x <- paste0(x, "%")
  
  return(x)
}

perc1 <- function(variable) {
  #' @description
  #' Calculates the percentage that has value 1.
  
  x <- length(variable[
    !is.na(variable) & variable == 1]) /
    length(variable[!is.na(variable)])
  x <- x * 100
  x <- formatC(x, digits = 1, format = "f")
  x <- paste0(x, "%")
  return(x)
}

# Others
n0 <- function(variable) {
  #' @description
  #' Calculates how many instances have a value of zero.
  
  x <- length(variable[!is.na(variable) & variable == 0])
  return(x)
}

n1 <- function(variable) {
  #' @description
  #' Calculates how many instances have a value of one.
  
  x <- length(variable[!is.na(variable) & variable == 1])
  return(x)
}

dollar <- function(value) {
  #' @description
  #' Adds a dollar sign to a number in the text and rounds the number.
  
  return(paste0("$",
                formatC(value, format = "f", big.mark = ",", digits = 0)))
}

no0 <- function(x) {
  #' @description
  #' Removes leading zeroes.
  
  sub("^0+", "", x)
}