# /******************************************************************
# Scale ID:           RelationshipQuality
# Scale Name:         Relationship Quality Scale
# TILDA Variables:    QRFrendScore; QROtherFamScore; QRChldScore; QRSpouScore
# Dataset:            TILDA Wave 1-6
# Author:
# Institution:        The Irish Longitudinal Study on Ageing (TILDA)
#
# Description:
# Generates scoring for the spouse, family, child and friends relationship scales.
#
# Version:      1.0
# Date:         2026-09-01
# Language:     R
# ******************************************************************/
#
# Assumption: the working data frame is called `data`.


# ---------------------------------------------------------------
# Recode special missing values
# ---------------------------------------------------------------

special_missing <- c(-99, -812, -823, -834, -845)

# Spouse: includes -1 missing by design
spouse_items <- c(
  "SCQQRSpou", "SCQQRSpou2", "SCQQRSpou3", "SCQQRSpou4",
  "SCQQRSpou5", "SCQQRSpou6", "SCQQRSpou7"
)

for (v in spouse_items) {
  data[[v]][data[[v]] %in% c(-1, special_missing)] <- NA_real_
}

# Children
child_items <- c(
  "SCQQRChld", "SCQQRChld2", "SCQQRChld3", "SCQQRChld4",
  "SCQQRChld5", "SCQQRChld6", "SCQQRChld7"
)

for (v in child_items) {
  data[[v]][data[[v]] %in% special_missing] <- NA_real_
}

# Other family
otherfam_items <- c(
  "SCQQROtherFam", "SCQQROtherFam2", "SCQQROtherFam3", "SCQQROtherFam4",
  "SCQQROtherFam5", "SCQQROtherFam6", "SCQQROtherFam7"
)

for (v in otherfam_items) {
  data[[v]][data[[v]] %in% special_missing] <- NA_real_
}

# Friends
friend_items <- c(
  "SCQQRFrend", "SCQQRFrend2", "SCQQRFrend3", "SCQQRFrend4",
  "SCQQRFrend5", "SCQQRFrend6", "SCQQRFrend7"
)

for (v in friend_items) {
  data[[v]][data[[v]] %in% special_missing] <- NA_real_
}


# ---------------------------------------------------------------
# Score each relationship scale
# ---------------------------------------------------------------

score_relationship <- function(data, rel, prefix) {

  raw_vars <- c(prefix, paste0(prefix, 2:7))
  score_vars <- paste0("QR", rel, 1:7, "_s")

  # Items 1-3: 1-4 becomes 0-3
  for (i in 1:3) {
    x <- data[[raw_vars[i]]]
    data[[score_vars[i]]] <- ifelse(
      !is.na(x) & x >= 1 & x <= 4,
      x - 1,
      NA_real_
    )
  }

  # Items 4-7: reverse scored
  # 1->3, 2->2, 3->1, 4->0
  for (i in 4:7) {
    x <- data[[raw_vars[i]]]
    data[[score_vars[i]]] <- ifelse(
      !is.na(x) & x >= 1 & x <= 4,
      4 - x,
      NA_real_
    )
  }

  # Sum items
  score_name <- paste0("QR", rel, "Score")
  data[[score_name]] <- rowSums(data[score_vars], na.rm = TRUE)

  # Require all seven items to have valid responses
  missing_name <- paste0("QR", rel, "_missing")
  data[[missing_name]] <- rowSums(is.na(data[score_vars]))
  data[[score_name]][data[[missing_name]] > 0] <- NA_real_

  data
}

data <- score_relationship(data, "Spou", "SCQQRSpou")
data <- score_relationship(data, "Chld", "SCQQRChld")
data <- score_relationship(data, "OtherFam", "SCQQROtherFam")
data <- score_relationship(data, "Frend", "SCQQRFrend")


# ---------------------------------------------------------------
# Variable labels
# ---------------------------------------------------------------

attr(data$QRSpouScore, "label") <-
  "Relationship quality with spouse: total strain score (0-21)"

attr(data$QRChldScore, "label") <-
  "Relationship quality with children: total strain score (0-21)"

attr(data$QROtherFamScore, "label") <-
  "Relationship quality with other family: total strain score (0-21)"

attr(data$QRFrendScore, "label") <-
  "Relationship quality with friends: total strain score (0-21)"


# ---------------------------------------------------------------
# Drop temporary scoring variables
# ---------------------------------------------------------------

temporary_vars <- c(
  paste0("QRSpou", 1:7, "_s"), "QRSpou_missing",
  paste0("QRChld", 1:7, "_s"), "QRChld_missing",
  paste0("QROtherFam", 1:7, "_s"), "QROtherFam_missing",
  paste0("QRFrend", 1:7, "_s"), "QRFrend_missing"
)

data[temporary_vars] <- NULL
