## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.width = 2.6, fig.height = 2.6)
oldpar <- par(no.readonly = TRUE)

show <- function(m, title, zlim = range(m, na.rm = TRUE)) {
  op <- par(mar = c(0, 0, 1.4, 0))
  # image() takes [x, y] with y increasing upwards, so a matrix indexed
  # [row, col] has to be transposed and flipped to display the right way up.
  image(t(m[nrow(m):1, ]), col = gray.colors(256), axes = FALSE, asp = 1, # nolint: seq_linter.
        main = title, zlim = zlim, useRaster = TRUE)
  par(op)
}

## ----setup--------------------------------------------------------------------
library(rcicr)

## ----stimuli, results = "hide"------------------------------------------------
n <- 64
x <- matrix(seq(-1, 1, length.out = n), n, n, byrow = TRUE)
y <- -matrix(seq(-1, 1, length.out = n), n, n)
face <- exp(-(x^2 / 0.45 + y^2 / 0.75))
face <- face - 0.55 * exp(-(((x + 0.3)^2 + (y - 0.25)^2) / 0.012))
face <- face - 0.55 * exp(-(((x - 0.3)^2 + (y - 0.25)^2) / 0.012))
face <- face - 0.35 * exp(-(x^2 / 0.10 + (y + 0.42)^2 / 0.006))
face <- (face - min(face)) / (max(face) - min(face))
base_face <- tempfile(fileext = ".png")
png::writePNG(face, base_face)

stimulus_path <- tempfile("stimuli")
generateStimuli2IFC(list(face = base_face), n_trials = 120, img_size = n,
                    stimulus_path = stimulus_path, seed = 1, nscales = 3,
                    ncores = 1, save_as_png = FALSE)
rdata_file <- list.files(stimulus_path, pattern = "\\.Rdata$", full.names = TRUE)[1]

## ----observer-----------------------------------------------------------------
e <- new.env()
load(rdata_file, envir = e)
set.seed(99)
template <- generateNoiseImage(rnorm(max(e$p$patchIdx)), e$p)
evidence <- vapply(seq_len(120), function(i) {
  base::sum(generateNoiseImage(e$stimuli_params$face[i, ], e$p) * template)
}, numeric(1))
evidence <- evidence / sd(evidence)
set.seed(7)
choice <- ifelse(evidence + rnorm(120) > 0, 1, -1) # 1: original chosen, -1: inverted

## ----noise-only, results = "hide"---------------------------------------------
grey <- tempfile(fileext = ".png")
png::writePNG(matrix(0.5, n, n), grey)
noise_path <- tempfile("noise")
generateStimuli2IFC(list(grey = grey), n_trials = 4, img_size = n,
                    stimulus_path = noise_path, seed = 1, nscales = 3, ncores = 1,
                    maximize_baseimage_contrast = FALSE)

## ----noise-only-show, fig.show = "hold"---------------------------------------
ori <- png::readPNG(file.path(noise_path, "rcic_grey_1_00001_ori.png"))
inv <- png::readPNG(file.path(noise_path, "rcic_grey_1_00001_inv.png"))
show(ori, "trial 1, original", zlim = c(0, 1))
show(inv, "trial 1, inverted", zlim = c(0, 1))

## ----noise-frame, results = "hide"--------------------------------------------
noise <- generateStimuli2IFC(list(grey = grey), n_trials = 4, img_size = n, seed = 1,
                             nscales = 3, ncores = 1, return_as_dataframe = TRUE,
                             maximize_baseimage_contrast = FALSE,
                             save_as_png = FALSE, save_rdata = FALSE)

## ----noise-frame-show---------------------------------------------------------
# The same scaling the stimuli use, without the base: most noise falls in [-0.3, 0.3].
noise_1 <- pmin(pmax((matrix(noise[[1]], n, n) + 0.3) / 0.6, 0), 1)
show(noise_1, "trial 1 noise, full contrast", zlim = c(0, 1))

## ----ratings------------------------------------------------------------------
set.seed(11)
rating <- as.integer(cut(evidence + rnorm(120, 0, 0.7), c(-Inf, -0.7, 0, 0.7, Inf)))
table(rating)

ci_rating <- generateCI(1:120, c(-2, -1, 1, 2)[rating], "face", rdata_file,
                        save_as_png = FALSE)
cor(as.vector(ci_rating$ci), as.vector(template))

## ----dropped------------------------------------------------------------------
kept <- setdiff(1:120, seq(3, 120, by = 6))
ci_kept <- generateCI(kept, choice[kept], "face", rdata_file, save_as_png = FALSE)
attr(ci_kept, "trial_design")$stimuli[1:10]

## ----dropped-infoval, results = "hide", message = TRUE------------------------
default <- computeInfoVal2IFC(ci_kept, rdata_file, iter = 10000)
matched <- computeInfoVal2IFC(ci_kept, rdata_file, iter = 10000,
                              reference_stimuli = attr(ci_kept, "trial_design")$stimuli)

## ----dropped-infoval-show-----------------------------------------------------
c(default = default, matched = matched)

## ----masked, results = "hide"-------------------------------------------------
mask <- matrix(0, n, n)
mask[18:30, 10:54] <- 1
ci_eyes <- generateCI(1:120, choice, "face", rdata_file, mask = mask, save_as_png = FALSE)
infoval_eyes <- computeInfoVal2IFC(ci_eyes, rdata_file, iter = 10000)

## ----masked-show--------------------------------------------------------------
show(ci_eyes$ci, "CI, eye region only")
infoval_eyes

## ----batch, results = "hide"--------------------------------------------------
set.seed(3)
data <- data.frame(
  participant = rep(c("p1", "p2", "p3"), each = 120),
  stimulus    = rep(1:120, 3),
  response    = c(ifelse(evidence + rnorm(120, 0, 0.5) > 0, 1, -1),
                  ifelse(evidence + rnorm(120, 0, 2) > 0, 1, -1),
                  sample(c(1, -1), 120, replace = TRUE))
)
cis <- batchGenerateCI2IFC(data, "participant", "stimulus", "response", "face",
                           rdata_file, save_as_png = FALSE)
infovals <- batchComputeInfoVal2IFC(cis, rdata_file, iter = 10000)

## ----batch-show---------------------------------------------------------------
round(infovals, 2)

## ----averaged, results = "hide", message = TRUE-------------------------------
ci_group <- generateCI(data$stimulus, data$response, "face", rdata_file,
                       participants = data$participant, save_as_png = FALSE, n_cores = 1)
infoval_group <- computeInfoVal2IFC(ci_group, rdata_file, iter = 10000)

## ----averaged-show------------------------------------------------------------
infoval_group

## ----old-version, eval = FALSE------------------------------------------------
# dir.create("rcicr-1.4.1")
# remotes::install_github("rdotsch/rcicr@v1.4.1", lib = "rcicr-1.4.1")
# library(rcicr, lib.loc = "rcicr-1.4.1")

## ----reproduce, results = "hide", warning = FALSE-----------------------------
ci_all <- generateCI(1:120, choice, "face", rdata_file, save_as_png = FALSE)

gram_file <- tempfile(fileext = ".Rdata")
file.copy(rdata_file, gram_file)
generateReferenceDistribution2IFC(gram_file, iter = 1000, ncores = 1)
infoval_gram <- computeInfoVal2IFC(ci_all, gram_file, iter = 1000)

images_file <- tempfile(fileext = ".Rdata")
file.copy(rdata_file, images_file)
generateReferenceDistribution2IFC(images_file, iter = 1000, ncores = 1,
                                  reference_method = "images")
infoval_images <- computeInfoVal2IFC(ci_all, images_file, iter = 1000)

## ----reproduce-show-----------------------------------------------------------
c(gram = infoval_gram, images = infoval_images, difference = infoval_images - infoval_gram)

## ----lost, results = "hide"---------------------------------------------------
archive <- tempfile("archive")
generateStimuli2IFC(list(face = base_face), n_trials = 10, img_size = n,
                    stimulus_path = archive, seed = 5, nscales = 3, ncores = 1)
unlink(list.files(archive, pattern = "\\.Rdata$", full.names = TRUE))

## ----lost-files---------------------------------------------------------------
head(list.files(archive), 2)

## ----lost-check---------------------------------------------------------------
regenerate <- function(nscales) {
  grey <- tempfile(fileext = ".png")
  png::writePNG(matrix(0.5, n, n), grey)
  path <- tempfile("regenerated")
  generateStimuli2IFC(list(face = grey), n_trials = 10, img_size = n, stimulus_path = path,
                      seed = 5, nscales = nscales, ncores = 1, save_as_png = FALSE,
                      maximize_baseimage_contrast = FALSE)
  list.files(path, pattern = "\\.Rdata$", full.names = TRUE)
}

## ----lost-scores, results = "hide"--------------------------------------------
candidates <- c(3, 5)
files <- lapply(candidates, regenerate)

## ----lost-scores-show---------------------------------------------------------
lowest_share <- function(rdata) {
  min(checkStimulusPNGs2IFC(rdata, archive, label = "rcic", seed = 5)$share)
}
setNames(vapply(files, lowest_share, numeric(1)), paste("nscales =", candidates))

## ----include = FALSE----------------------------------------------------------
par(oldpar)