R/create_ALP_prompts.R

In Kidapt/keda: A Package to Support Exploratory Data Analysis

#' Create ALP Metadata
#'
#' Create prompt keys so that each prompt has a unique identifier and use these in metadata sheet
#' @param data is your data table
#' @param scene is the scene (skin) identifier for this SFDA
#' @keywords prompt key
#' @export
#' @examples
#' final_items <- create_ALP_metadata(items, scene="bear_scene", "URI_STEM", "GAME_ID")
#'
#'

create_ALP_metadata <- function(data, scene, URI_STEM, GAME_ID) {
	items_w_prompts <- create_init_prompt_key(data, scene=scene)
	prompt_key_seq <- create_prompt_key_seq(items_w_prompts)
	final_items <- create_prompt_key_final(items_w_prompts, prompt_key_seq)
	final_items <- build_uri(final_items, URI_STEM, GAME_ID)
	return(final_items)
}

## Section: Gather essential fields ----
##############################################################################-
create_init_prompt_key <- function(data, prompt_part="prompt_part", scene, level="level", correct_option="correct_option", addl.arg1=NULL)  {
	data %>%
	filter(prompt_part == "promptScript") %>%
	mutate(prompt_key = paste(scene, as.character(level), correct_option, addl.arg1, sep = "_"))
}

## __Section: Add a 2-digit seqence to distinguish repeated prompt_keys ----
##############################################################################-
create_prompt_key_seq <- function(data, prompt_key_seq="prompt_key_seq") {
	data %>%
	arrange(alp_prompt_id) %>%
	group_by(prompt_key) %>%
	filter(n() > 1) %>%
	mutate(
		prompt_key_seq = 1L,
		prompt_key_seq = cumsum(prompt_key_seq),
		prompt_key_seq = as.character(prompt_key_seq),
		prompt_key_seq =
			case_when(
				nchar(prompt_key_seq) == 2L ~ prompt_key_seq,
				nchar(prompt_key_seq) == 1L ~ paste0("0", prompt_key_seq),
				TRUE ~ NA_character_
			)
	) %>%
	select(alp_prompt_id, prompt_key, prompt_key_seq)
}

# merge the sequence data table with the full data table and then remove the prompt_key_seq column
create_prompt_key_final <- function(data1, data2) {
	data <- left_join(data1, data2, by = c("alp_prompt_id", "prompt_key"))
	data <- data %>%
		mutate(prompt_key = case_when(
			is.na(prompt_key_seq) ~ prompt_key,
			!is.na(prompt_key_seq) ~ paste(prompt_key, prompt_key_seq, sep = "_")
		)) %>%
		select(-prompt_key_seq)
}

## __Section: build uri and select essential fields ----
##############################################################################-
build_uri <- function(data, URI_STEM, GAME_ID) {
  data <-
    data %>%
    mutate(
      uri = paste(URI_STEM, cognitive_task, prompt_key, sep = "/"),
      game_id = GAME_ID
    ) %>%
    select(id = alp_prompt_id, game_id, prompt_key, uri)
}