# Scale ID: 			APQ-17 (Wave 3 only)
# Scale Name: 		Ageing Perceptions 17-item
# TILDA Variables: 	MHapq_tl_accr; MHapq_tl_cyc; MHapq_emo; MHapq_ctpve; MHapq_ctnve; MHapq_cqpve; MHapq_cqnve
# Dataset:      		TILDA Waves 3
# Author:
# Institution:  		The Irish Longitudinal Study on Ageing (TILDA)
# 
# Description:
# Creates the Apeing Perceptions Questionnaire (17 item) scale and all associated sub-scales
# 
# Version:      1.0
# Date:         2026-09-01
# Language:     R

# Assumption: the working data frame is called `data`.

apq_vars <- grep("^SCQAgePrc", names(data), value = TRUE)
special_missing <- c(-99, -812, -823, -834, -845)

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

# The Stata rowmean() calculations are subsequently set to missing if
# any contributing item is missing, so complete-case row means are used here.
data$MHapq_tl_accr <- rowMeans(
  data[c("SCQAgePrc2","SCQAgePrc3","SCQAgePrc5")], na.rm = FALSE)

data$MHapq_tl_cyc <- rowMeans(
  data[c("SCQAgePrc27","SCQAgePrc30","SCQAgePrc32")], na.rm = FALSE)

data$MHapq_emo <- rowMeans(
  data[c("SCQAgePrc9","SCQAgePrc25","SCQAgePrc29")], na.rm = FALSE)

data$MHapq_ctnve <- rowMeans(
  data[c("SCQAgePrc21","SCQAgePrc22","SCQAgePrc23")], na.rm = FALSE)
data$MHapq_ctnve <- 6 - data$MHapq_ctnve

data$MHapq_cqpve <- rowMeans(
  data[c("SCQAgePrc6","SCQAgePrc7","SCQAgePrc8")], na.rm = FALSE)

data$MHapq_cqnve <- rowMeans(
  data[c("SCQAgePrc17","SCQAgePrc20")], na.rm = FALSE)

attr(data$MHapq_tl_accr, "label") <- "APQ - Timeline Chronic/Acute"
attr(data$MHapq_tl_cyc, "label") <- "APQ - Timeline Cyclic"
attr(data$MHapq_emo, "label") <- "APQ - Emotional Representations"
attr(data$MHapq_ctnve, "label") <- "APQ - Control Negative"
attr(data$MHapq_cqpve, "label") <- "APQ - Consequences Positive"
attr(data$MHapq_cqnve, "label") <- "APQ - Consequences Negative"

# Missing-item count, matching the Stata loop.
score_items <- c(2,3,5,6,7,8,9,17,20,21,22,23,25,27,29,30,32)
data$MHapqmiss <- NA_real_
eligible <- !is.na(data$in_scq) & data$in_scq == 1
data$MHapqmiss[eligible] <- 0

for (i in score_items) {
  v <- paste0("SCQAgePrc", i)
  missv <- paste0("SCQAgePrcmiss", i)
  data[[missv]] <- NA
  data[[missv]][eligible] <- abs(data[[v]][eligible]) > 10
  data$MHapqmiss[eligible & is.na(data[[v]])] <-
    data$MHapqmiss[eligible & is.na(data[[v]])] + 1
}

for (v in c("MHapq_tl_accr","MHapq_emo","MHapq_ctnve",
            "MHapq_cqpve","MHapq_cqnve","MHapq_tl_cyc")) {
  data[[v]][!is.na(data[[v]]) & (data[[v]] < 0 | data[[v]] > 20)] <- NA_real_
}

# The Stata source ends with "drop SCQAgePrcmiss"; the generated variables
# have numbered suffixes, so this translation drops the intended wildcard set.
data[grep("^SCQAgePrcmiss", names(data), value = TRUE)] <- NULL
