## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup--------------------------------------------------------------------
library(formr)

## ----eval = FALSE-------------------------------------------------------------
# # Inside a calculate item's "value" field:
# formr_api_authenticate()
# 
# past <- formr_api_fetch_results(.formr$run_name, item_names = "score", join = TRUE)
# mean(past$score, na.rm = TRUE)

## ----eval = FALSE-------------------------------------------------------------
# # In a note item's label — fetch and display in one step:
# # ```{r, echo=FALSE, results='asis'}
# # formr_api_authenticate()
# # scores <- formr_api_fetch_results(.formr$run_name,
# #   item_names = "engagement", join = TRUE)
# # cat("The sample mean is ", mean(scores$engagement, na.rm = TRUE), ".")
# # ```

## ----eval = FALSE-------------------------------------------------------------
# # Inside a mc_multiple choice option's label — fetch and display in one step:
# # ```{r}
# # formr_api_authenticate()
# # posts <- formr_api_fetch_results(.formr$run_name, item_names = "title", join = TRUE)
# # posts$title[1]
# # ```

## ----eval = FALSE-------------------------------------------------------------
# formr_api_authenticate()

## ----eval = FALSE-------------------------------------------------------------
# run_name <- .formr$run_name
# user_session <- survey_run_sessions$session

## ----eval = FALSE-------------------------------------------------------------
# data <- formr_api_fetch_results(.formr$run_name,
#   item_names = c("name", "age", "score"), join = TRUE)

## -----------------------------------------------------------------------------
# formr repeats items within a session; current() returns the latest value.
# Here is a participant's history of one menu item across repeats:
choice_history <- c("option_a", "option_b", "option_a")
current(choice_history)                 # the current (most recent) selection

# In a showif you would compare it directly, e.g.:
current(choice_history) == "option_a"   # TRUE

# first() and last() are siblings that drop missing values by default:
first(c(NA, 2, 3))   # 2
last(c(1, 2, NA))    # 2

## ----eval = FALSE-------------------------------------------------------------
# formr_api_authenticate()
# 
# past <- formr_api_fetch_results(.formr$run_name, item_names = "name", join = TRUE)
# 
# if (nrow(past) > 0) nrow(past) + 1 else 1

## ----eval = FALSE-------------------------------------------------------------
# # ```{r, echo=FALSE, results='asis'}
# # cat("## Welcome, Participant #", participant_count, "\n\n", sep = "")
# # cat("Please proceed with the study.")
# # ```

## ----eval = FALSE-------------------------------------------------------------
# # ```{r, echo=FALSE, results='asis', fig.width=6, fig.height=3}
# # library(ggplot2)
# # formr_api_authenticate()
# #
# # # Fetch all participants' engagement scores
# # all_scores <- formr_api_fetch_results(.formr$run_name,
# #   item_names = "engagement", join = TRUE)
# #
# # # Current participant's own score — local, no API needed
# # my_engagement <- current(burnout$engagement)
# #
# # ggplot(all_scores, aes(x = engagement)) +
# #   geom_density(fill = "grey70") +
# #   geom_vline(xintercept = my_engagement, colour = "red", linewidth = 1) +
# #   labs(
# #     title = "Your engagement score vs. the organisation",
# #     subtitle = paste0("Sample: ", nrow(all_scores), " colleagues"),
# #     x = "Engagement", y = ""
# #   ) +
# #   theme_minimal()
# # ```

## ----eval = FALSE-------------------------------------------------------------
# formr_api_authenticate()
# 
# # Fetch the condition assignments from all completed sessions
# past <- formr_api_fetch_results(.formr$run_name,
#   item_names = "assigned_condition", join = TRUE)
# 
# count_a <- sum(past$assigned_condition == "A", na.rm = TRUE)
# count_b <- sum(past$assigned_condition == "B", na.rm = TRUE)
# 
# # Assign to the smaller group; break ties randomly
# if (count_a <= count_b) "A" else "B"

## ----eval = FALSE-------------------------------------------------------------
# # Admin trigger — run outside the study, on your local machine or a cron job
# formr_api_authenticate(host = "https://api.rforms.org", account = "admin")
# 
# # Find sessions currently at the waiting room (position 20)
# queued <- formr_api_sessions("my-run-name", active = TRUE)
# waiting <- queued$session[queued$position == 20]
# 
# if (length(waiting) >= 2) {
#   formr_api_session_action("my-run-name",
#     session_codes = waiting, action = "move_to_position", position = 40)
#   message("Released ", length(waiting), " participants to the dyadic task.")
# }

## -----------------------------------------------------------------------------
safe_parse_json <- function(x) {
  tryCatch(
    jsonlite::fromJSON(x),
    error = function(e) list()
  )
}

safe_parse_json('{"score": 5, "label": "high"}')   # parses to a list
safe_parse_json("not valid json")                    # returns list(), no error

## ----eval = FALSE-------------------------------------------------------------
# data <- formr_api_fetch_results(.formr$run_name, item_names = "score", join = TRUE)
# 
# if (nrow(data) == 0 || all(is.na(data$score))) {
#   result <- 0
# } else {
#   result <- max(data$score, na.rm = TRUE)
# }