R/afs.R

Defines functions afs

Documented in afs

#' Analogy from stimuli.
#'
#' Creates an analogy item from pre-made stimuli, the latter being either figural or verbal.
#' To create figural analogies from stimuli generated by IMak, the
#' \code{\link{build_fa}} and \code{\link{plot_fa}} functions should be used.
#'
#' Create an analogy item by using pre-made stimuli. Such stimuli can be either figural or
#' verbal, and it should be sufficient to complete the A, B and C terms of an A:B::C:D analogy stem
#' plus at least two answer options. Use a source/target folder to save the item by providing an
#' argument to \code{path}. For a figural item, save the pre-made figures as PNG files inside that folder
#' (the ideal would be to supply perfect-square high-resolution images).
#' Give arguments to \code{sa}, \code{sb} and \code{sc}, thus indicating the names of stimuli A, B and C.
#' Give arguments to \code{s1} and \code{s2} to indicate the names of two answer options. Provide further arguments
#' to parameters \code{s3} to \code{s10} if you would like to add up to 10 options in total. All of these
#' names are the image file names plus their ".png" extensions when you want to create a figural item.
#' Include "All incorrect" and "I don't know" options by setting \code{ai.idn} to \code{TRUE}. Other variables
#' that can be altered are: the way of indicating the A:B::C:D relations, the question mark,
#' the option labels, the sizes and the language of verbal stimuli.
#'
#' @param path Directory where files are saved and/or collected. For example: \code{"C:/Desktop/Folder"}. For a figural item, figural stimuli should be placed inside the correspondent folder.
#' @param type Should the \code{afs} function create a figural (\code{"F"}) or a verbal (\code{"V"}) item?
#' @param sa String with stimulus name A of an A:B::C:D analogy, including ".png" extension when \code{type = "F"}.
#' @param sb String with stimulus name B of an A:B::C:D analogy, including ".png" extension when \code{type = "F"}.
#' @param sc String with stimulus name C of an A:B::C:D analogy, including ".png" extension when \code{type = "F"}.
#' @param s1 String with response option name 1, including ".png" extension when \code{type = "F"}.
#' @param s2 String with response option name 2, including ".png" extension when \code{type = "F"}.
#' @param s3 String with response option name 3, including ".png" extension when \code{type = "F"}.
#' @param s4 String with response option name 4, including ".png" extension when \code{type = "F"}.
#' @param s5 String with response option name 5, including ".png" extension when \code{type = "F"}.
#' @param s6 String with response option name 6, including ".png" extension when \code{type = "F"}.
#' @param s7 String with response option name 7, including ".png" extension when \code{type = "F"}.
#' @param s8 String with response option name 8, including ".png" extension when \code{type = "F"}.
#' @param s9 String with response option name 9, including ".png" extension when \code{type = "F"}.
#' @param s10 String with response option name 10, including ".png" extension when \code{type = "F"}.
#' @param relations Should analogical relations be indicated by arrows and a colon (\code{"A"}), just colons (\code{"C"}) or words (\code{"W"})?
#' @param question Should there be a question mark?
#' @param labels Should options be labeled by letters (\code{"L"}), numbers (\code{"N"}) or no labels (\code{F})?
#' @param ai.idn Should there be "All incorrect" and "I don't know" options?
#' @param size.arrow Thickness of the arrow.
#' @param size.arrowhead Size of the arrowhead.
#' @param size.colon Size of the colon.
#' @param size.relword Size of words that relate the stimuli of the A:B::C:D stem to each other.
#' @param size.q Size of the question mark.
#' @param size.word Size of verbal stimuli excluding labels and words of the stem (for these two, use \code{size.label} and \code{size.relword} respectively).
#' @param size.label Size of labels.
#' @param language Language of verbal stimuli including words of the stem.
#' @param out Output file name.
#' @return A PNG file containing the item.
#' @author Diego Blum \email{blumworx@gmail.com}
#' @importFrom "png" "readPNG"
#' @importFrom "grDevices" "dev.off" "png"
#' @importFrom "graphics" "strwidth" "layout" "arrows" "par" "plot" "text" "rasterImage"
#' @importFrom "utils" "head"
#' @export
afs <- function(
  path,
  type = "F",
  sa,
  sb,
  sc,
  s1 = "No content",
  s2 = "No content",
  s3 = "No content",
  s4 = "No content",
  s5 = "No content",
  s6 = "No content",
  s7 = "No content",
  s8 = "No content",
  s9 = "No content",
  s10 = "No content",
  relations = "A",
  question = T,
  labels = "L",
  ai.idn = F,
  size.arrow = 34,
  size.arrowhead = 3.0,
  size.colon = 55,
  size.relword = 32,
  size.q = 85,
  size.word = 32,
  size.label = 25,
  language = "E",
  out = "item")

{
  path <- paste0(path, "/")
  setwd(path)
  if (type %in% c("V", "F") == "F")
    stop("\'type\' must be either \"V\" or \"F\".")
  content <- c(s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, "No content", "No content")
  content[content != "No content"] <- 1
  content[content == "No content"] <- 0
  content <- as.numeric(content)
  if (sum(content) == 0)
    stop("Incomplete item content. Check your data.")
  if (sum(content) != sum(content[1:sum(content)]))
    stop ("Blank space(s) detected among options. Please fix or complete.")
  if (s1 == "No content" | s2 == "No content")
    stop("The item must contain 2 answer options at minimum.")
  if (relations %in% c ("A", "C", "W") == F)
    stop ("\'relations\' must be either \"A\", \"C\" or \"W\".")
  if (question %in% c(T, F) == F)
    stop ("No logical argument for \'question\'. It should be either TRUE or FALSE.")
  if (labels %in% c("L", "N", F) == F)
    stop ("\'labels\' must be either \"L\", \"N\" or FALSE.")
  if (ai.idn %in% c(T, F) == F)
    stop ("No logical argument for \'ai.idn\'. It should be either TRUE or FALSE.")
  if (language %in% c("E", "S") == F)
    stop ("\'language\' must be either \"E\" for English or \"S\" for Spanish.")

  # Loading the information from files (type = "F") or as text (type = "V"):

  if (type == "F") {
  sac <- readPNG(paste0(path, sa))
  sbc <- readPNG(paste0(path, sb))
  scc <- readPNG(paste0(path, sc))
  s1c <- readPNG(paste0(path, s1))
  s2c <- readPNG(paste0(path, s2))
  for (i in 3:10) {
    if(get(paste0("s", i)) != "No content")
      assign(paste0("s", i, "c"), readPNG(paste0(path, get(paste0("s", i)))))
  }
  } else {
  sac <- sa
  sbc <- sb
  scc <- sc
  s1c <- s1
  s2c <- s2
  for (i in 3:10) {
    if(get(paste0("s", i)) != "No content")
      assign(paste0("s", i, "c"), get(paste0("s", i)))
  }
  }

  # Making the appropriate plot conditioned by a number of variables:

  if (type == "F") {
    if (labels != F) {
                   height.labels <- 1.5
                   height.options <- 6
                   height.item <- 1600
                   higher.item <- 3200
    } else {
                   height.labels <- .2
                   height.options <- 6
                   height.item <- 1330
                   higher.item <- 2660
    }} else {
    if (labels != F) {
                   height.labels <- .8
                   height.options <- 1.5
                   height.item <- 1000
                   higher.item <- 2000
    } else {
                   height.labels <- .2
                   height.options <- 1.5
                   height.item <- 740
                   higher.item <- 1460
    }}

  if (s3 == "No content" & ai.idn == F) {

    max.options <- 2
    png(paste0(out, ".png"), width = 9590.16, height = height.item)
    par(mar = rep(0, 4))
    layout(matrix(c(5, 1, 6, 3, 7, 2, 4, 0, 8, 0, 9,
                    0, 0, 0, 0, 0, 0, 0, 0, 10, 0, 11),
                  2, 11, byrow = T), heights = c(height.options, height.labels),
           widths = c(rep(c(2, 1.2), 3), .8, 1, 2, .2, 2))

  } else

  if (s4 == "No content" & ai.idn == F) {

    max.options <- 3
    png(paste0(out, ".png"), width = 10942.62, height = height.item)
    par(mar = rep(0, 4))
    layout(matrix(c(5, 1, 6, 3, 7, 2, 4, 0, 8, 0, 9, 0, 10,
                    0, 0, 0, 0, 0, 0, 0, 0, 11, 0, 12, 0, 13),
                  2, 13, byrow = T), heights = c(height.options, height.labels),
           widths = c(rep(c(2, 1.2), 3), .8, 1, 2, rep(c(.2, 2), 2)))

  } else

  if ((s5 == "No content" & ai.idn == F) | (s3 == "No content" & ai.idn == T)) {

    max.options <- 4
    png(paste0(out, ".png"), width = 12295.08, height = height.item)
    par(mar = rep(0, 4))
    layout(matrix(c(5, 1, 6, 3, 7, 2, 4, 0, 8, 0, 9, 0, 10, 0, 11,
                    0, 0, 0, 0, 0, 0, 0, 0, 12, 0, 13, 0, 14, 0, 15),
                  2, 15, byrow = T), heights = c(height.options, height.labels),
           widths = c(rep(c(2, 1.2), 3), .8, 1, 2, rep(c(.2, 2), 3)))

  } else

  if ((s6 == "No content" & ai.idn == F) | (s4 == "No content" & ai.idn == T)) {

    max.options <- 5
    png(paste0(out, ".png"), width = 13647.54, height = height.item)
    par(mar = rep(0, 4))
    layout(matrix(c(5, 1, 6, 3, 7, 2, 4, 0, 8, 0, 9, 0, 10, 0, 11, 0, 12,
                    0, 0, 0, 0, 0, 0, 0, 0, 13, 0, 14, 0, 15, 0, 16, 0, 17),
                  2, 17, byrow = T), heights = c(height.options, height.labels),
           widths = c(rep(c(2, 1.2), 3), .8, 1, 2, rep(c(.2, 2), 4)))

  } else

  if ((s7 == "No content" & ai.idn == F) | (s5 == "No content" & ai.idn == T)) {

    max.options <- 6
    png(paste0(out, ".png"), width = 15000, height = height.item)
    par(mar = rep(0, 4))
    layout(matrix(c(5, 1, 6, 3, 7, 2, 4, 0, 8, 0, 9, 0, 10, 0, 11, 0, 12, 0, 13,
                    0, 0, 0, 0, 0, 0, 0, 0, 14, 0, 15, 0, 16, 0, 17, 0, 18, 0, 19),
                  2, 19, byrow = T), heights = c(height.options, height.labels),
           widths = c(rep(c(2, 1.2), 3), .8, 1, 2, rep(c(.2, 2), 5)))

  } else

  if ((s9 == "No content" & ai.idn == F) | (s7 == "No content" & ai.idn == T)) {

    max.options <- 8
    png(paste0(out, ".png"), width = 12541, height = higher.item)
    par(mar = rep(0, 4))
    layout(matrix(c(5, 1, 6, 3, 7, 2, 4, 0, 8, 0, 9, 0, 10, 0, 11,
                    0, 0, 0, 0, 0, 0, 0, 0, 16, 0, 17, 0, 18, 0, 19,
                    0, 0, 0, 0, 0, 0, 0, 0, 12, 0, 13, 0, 14, 0, 15,
                    0, 0, 0, 0, 0, 0, 0, 0, 20, 0, 21, 0, 22, 0, 23),
                  4, 15, byrow = T), heights = c(height.options, height.labels,
                                                height.options, height.labels),
           widths = c(rep(c(2, 1.2), 3), .8, 1.4, 2, rep(c(.2, 2), 3)))

  } else

    if ((s9 == "No content" & ai.idn == T) | (s9 != "No content" & ai.idn == F)) {

    max.options <- 10
    png(paste0(out, ".png"), width = 13770, height = higher.item)
    par(mar = rep(0, 4))
    layout(matrix(c(5, 1, 6, 3, 7, 2, 4, 0, 8, 0, 9, 0, 10, 0, 11, 0, 12,
                    0, 0, 0, 0, 0, 0, 0, 0, 18, 0, 19, 0, 20, 0, 21, 0, 22,
                    0, 0, 0, 0, 0, 0, 0, 0, 13, 0, 14, 0, 15, 0, 16, 0, 17,
                    0, 0, 0, 0, 0, 0, 0, 0, 23, 0, 24, 0, 25, 0, 26, 0, 27),
                  4, 17, byrow = T), heights = c(height.options, height.labels,
                                                height.options, height.labels),
           widths = c(rep(c(2, 1.2), 3), .8, 1.2, 2, rep(c(.2, 2), 4)))

  } else {

    max.options <- 12
    png(paste0(out, ".png"), width = 15000, height = higher.item)
    par(mar = rep(0, 4))
    layout(matrix(c(5, 1, 6, 3, 7, 2, 4, 0, 8, 0, 9, 0, 10, 0, 11, 0, 12, 0, 13,
                    0, 0, 0, 0, 0, 0, 0, 0, 20, 0, 21, 0, 22, 0, 23, 0, 24, 0, 25,
                    0, 0, 0, 0, 0, 0, 0, 0, 14, 0, 15, 0, 16, 0, 17, 0, 18, 0, 19,
                    0, 0, 0, 0, 0, 0, 0, 0, 26, 0, 27, 0, 28, 0, 29, 0, 30, 0, 31),
                  4, 19, byrow = T), heights = c(height.options, height.labels,
                                                height.options, height.labels),
           widths = c(rep(c(2, 1.2), 3), .8, 1, 2, rep(c(.2, 2), 5)))

  }

  # Providing plot content:

  if (labels == "L") labelsc <- c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l")
  if (labels == "N") labelsc <- 1:12
  if (question == T) q <- "?" else q <- " "
  if (language == "E") {
    is.to <- "is to"
    as <- "as"
    no.correct <- "All\nincorrect"
    not.know <- "I don\u0027t\nknow"
  } else {
    is.to <- "es a"
    as <- "como"
    no.correct <- "Ninguna es\ncorrecta"
    not.know <- "No s\u00E9"
  }
  myplot <- function(xlim = c(-5, 5), ylim = c(-5, 5)) {
    plot(xlim = xlim, ylim = ylim, 0, type = "l",
         bty = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "")
  }
  if (relations == "A") {
    for (i in 1:2) {
      myplot(xlim = c(-1, 1), ylim = c(-1, 1))
      arrows(-.6, 0, .6, 0, length = size.arrowhead, lwd = size.arrow)
    }
    myplot()
    text(0, 0, ":", cex = size.colon, family = "mono")
  } else
    if (relations == "C") {
    for (i in 1:2){
      myplot()
      text(0, 0, ":", cex = size.colon, family = "mono")
    }
    myplot()
    w <- strwidth(c(":", ":"))
    ww <- cumsum(c(0, head(w, -1)) * 55)
    text(-1 + ww, 0, ":", cex = size.colon, family = "mono")
    } else {
      for (i in 1:2){
        myplot()
        text(0, 0, is.to, cex = size.relword, family = "serif", font = 2)
      }
      myplot()
      text(0, 0, as, cex = size.relword, family = "serif", font = 2)
  }
  myplot()
  text(0, 0, q, cex = size.q, family = "serif")
  if (type == "F") {
  myplot()
    rasterImage(sac, -5, -5, 5, 5)
  myplot()
    rasterImage(sbc, -5, -5, 5, 5)
  myplot()
    rasterImage(scc, -5, -5, 5, 5)
  myplot()
    rasterImage(s1c, -5, -5, 5, 5)
  myplot()
    rasterImage(s2c, -5, -5, 5, 5)
  } else {
    words <- c(sac, sbc, scc, s1c, s2c)
    for (i in 1:5) {
    myplot()
    text(0, 0, words[i], cex = size.word, family = "serif")
    }
  }
  if (sum(content) > 2 | ai.idn == T)
  for (i in 3:max.options) {
    if (content[i] == 1)
      if (type == "F") {
        myplot()
        rasterImage(get(paste0("s", i, "c")), -5, -5, 5, 5)
        } else {
        myplot()
        text(0, 0, get(paste0("s", i, "c")), cex = size.word, family = "serif")
      }
    if (content[i] == 0 & sum(content) + 1 == i & ai.idn == T) {
      myplot()
    text(0, 0, no.correct, cex = size.word, family = "serif", font=2)
    } else
    if (content[i] == 0 & sum(content) + 2 == i & ai.idn == T) {
      myplot()
    text(0, 0, not.know, cex = size.word, family = "serif", font=2)
    } else
    if (content[i] == 0) {
      myplot()
    text(0, 0, "", font = 2)
    }
  }
  for (i in 1:max.options) {
    if (labels != F) {
    if ((content[i] == 1) | ((sum(content) + 1 == i |
                               sum(content) + 2 == i) & ai.idn == T))
      {
      myplot()
    text(0, 0, labelsc[i], cex = size.label, font = 2)
    } else
    if (content[i] == 0) {
      myplot()
    text(0, 0, "", cex = size.label, font = 2)
    }  }  }
  dev.off()
}

Try the IMak package in your browser

Any scripts or data that you put into this service are public.

IMak documentation built on May 2, 2022, 5:08 p.m.