R/buildfa.R

Defines functions print.fa_items build_fa

Documented in build_fa

#' Build figural analogies.
#'
#' \code{build_fa} generates the information of figural analogies
#' that can be read by \code{\link{plot_fa}}.
#'
#' Thorough information about the \code{build_fa} function can be found in the cited
#' research paper of Blum and Holling (2018). Make sure to read the PDF version of it,
#' since it is clearer. Additional information can also be found on icar-project.com.
#'
#' @param isomorphs A number of isomorphic items to be developed.
#' @param main.rot A numeric vector with two main shape rotation values multiple of 45 and between -135 and 180. No rotation: 0.
#' @param mirror A number designating the presence of shape reflection or no reflection (i.e., 1 or 0).
#' @param trap.rot A numeric vector with two trapezium rotation values multiple of 45 and between -135 and 180. No rotation: 0.
#' @param subtract A numeric vector with two line segments of the main shape to subtract from 1 to 5, or letter \code{"R"} for a random subtraction. No subtraction: 0.
#' @param dot.mov A numeric vector with two dot edge movement amounts, with a maximum of 5 movements in total. No dot edge movement: 0.
#' @param a.main A numeric vector with possible rotation states of the main shape of Figure A from 1 to 8. Random by default.
#' @param a.flip A logical value designating whether Figure A is flipped with respect to its vertical axis or not (i.e., \code{T} or \code{F}). Random by default.
#' @param a.trap A numeric vector with possible rotation states of the trapezium of Figure A from 1 to 8. Random by default.
#' @param a.dot A numeric vector with possible dot positions in Figure A from 1 to 6. Random by default.
#' @param constrict A character string designating a part of Figure A to display all possible positions every 'n' isomorphs.
#' @param al.main.rot A numeric vector with alternative main shape rotation solutions. Random by default.
#' @param al.mirror A numeric vector with alternative reflection solutions. Random by default.
#' @param al.trap.rot A numeric vector with alternative trapezium rotation solutions. Random by default.
#' @param al.subtract A numeric vector with alternative subtraction solutions. Random by default.
#' @param al.dot.mov A numeric vector with alternative dot edge movement solutions. Random by default.
#' @param correct A vector with numbers ranging from 1 to 9 for correct response placements. Random by default.
#' @param add.rule A number specifying which rule from 1 to 5 adds itself to the options of one-rule-based items. Random by default.
#' @param automatic Should options be generated by the program? True by default.
#' @return An object of class \code{'fa_items'}, basically a list including elements to be plotted with function \code{\link{plot_fa}}.
#' @author Diego Blum \email{blumworx@gmail.com}
#' @references Blum, D., & Holling, H. (2018). Automatic generation of figural analogies with the IMak package. \emph{Frontiers in psychology, 9}(1286), 1-13. <DOI:10.3389/fpsyg.2018.01286>
#' @seealso \code{\link{plot_fa}}
#' @examples
#' ## For plotting options, see the plot_fa examples.
#'
#' ## Create two isomorphs with one rule and set the correct answer to 1:
#' one <- build_fa(isomorphs = 2, dot.mov = c(1, 2), correct = 1)
#'
#' ## Create four isomorphs with two rules:
#' two <- build_fa(isomorphs = 4, main.rot = c(180, 135), trap.rot = c(90, 45))
#'
#' ## Create 20 isomorphs with three rules. Set automatic = FALSE and affect the options:
#' three <- build_fa(isomorphs = 20, mirror = 1, trap.rot = c(90, 45), dot.mov = c(1, 2),
#' automatic = FALSE, al.mirror = c(0, 1), al.trap.rot = -45, al.dot.mov = 1)
#'
#' ## Create four two-rule-based isomorphs, all of them comprising the same Figure A:
#' four <- build_fa(isomorphs = 4, a.main = 1, a.flip = FALSE, a.trap = 2, a.dot = 6,
#' mirror = 1, subtract = "R")
#'
#' ## Create 16 isomorphs by constricting the main shape rotation rule:
#' five <- build_fa(isomorphs = 16, subtract = c(1, 4), constrict = "main")
#' @export
build_fa <- function(
  isomorphs = 1,
  main.rot = c(0, 0),
  mirror = 0,
  trap.rot = c(0, 0),
  subtract = c(0, 0),
  dot.mov = c(0, 0),
  a.main = "R",
  a.flip = "R",
  a.trap = "R",
  a.dot = "R",
  constrict = F,
  al.main.rot = 0,
  al.mirror = 0,
  al.trap.rot = 0,
  al.subtract = 0,
  al.dot.mov = 0,
  correct = 0,
  add.rule = 0,
  automatic = T)

  {

# Restrictions to the values chosen for Figure A:
if ((! sum(a.main %in% 1:8) == length(a.main) &
       ! a.main[1] == "R") |
    (! sum(a.flip %in% c("R", F, T)) == length(a.flip) &
       ! a.flip[1] == "R") |
    length(a.flip) > 1 |
    (! sum(a.trap %in% c("R", 1:8)) == length(a.trap) &
       ! a.trap[1] == "R") |
    (! sum(a.dot %in% c("R", 1:6)) == length(a.dot) &
       ! a.dot[1] == "R") |
    ! constrict %in% c(F, "main", "trap", "dot") |
    length(constrict) > 1)
  stop("Only the following can be applied to Figure A:
       Main shape or trapezium values from 1 to 8.
       One flipping value for presence (T) or absence (F).
       Dot corner values from 1 to 6.
       One constriction label: \"main\", \"trap\" or \"dot\".")
if (! isomorphs > 0) stop("Invalid number of isomorphs.")
if (sum(duplicated(a.main)) > 0 |
    sum(duplicated(a.trap)) > 0 |
    sum(duplicated(a.dot)) > 0)
  stop("Attempt to replicate a Figure A position.")
if (! sum(correct %in% 1:9) == length(correct) &
    ! correct[1] == 0)
  stop("Failure in assignment of correct answers.")

.Random.seed <- 0
rm(.Random.seed)

# How to extract random rows:
randomRows <- function(df, n=1) {
  return(df[sample(nrow(df), n),])
}

# Values for a randomized Figure A according to choices:
rangle <- c(-135, -90, -45, 0, 45, 90, 135, 180)
rdot <- 1:6

# Defining angles for the main shape of Figure A:
if (a.main[1] != "R") {
  for (i in 1:length(a.main)) {
    a.main[i] <- switch(a.main[i],
                    "1" = 0, "2" = 45, "3" = 90, "4" = 135,
                    "5" = 180, "6" = -135, "7" = -90, "8" = -45)
  }} else a.main <- rangle

# Defining 1 or 0 for flipping of Figure A:
if (a.flip != "R") {
   a.flip <- if(a.flip == F) 0 else 1
  } else a.flip <- 0:1

# Defining angles for the trapezium of Figure A:
if (a.trap[1] != "R") {
  for (i in 1:length(a.trap)) {
    a.trap[i] <- switch(a.trap[i],
                        "1" = 0, "2" = 45, "3" = 90, "4" = 135,
                        "5" = 180, "6" = -135, "7" = -90, "8" = -45)
  }} else a.trap <- rangle

# Defining corner positions for the dot of Figure A:
if (a.dot[1] == "R") a.dot <- rdot

combinations <- list(
  firstrule <- a.main,
  secondrule <- a.flip,
  thirdrule <- a.trap,
  fifthrule <- a.dot)
names(combinations) <- c("main", "flip", "trap", "dot")

# Number of combinations:
product <- 1
number_comb <- combinations
number_comb <- number_comb[!is.na(number_comb)]
for (i in 1:length(number_comb)){
  product <- product*length(number_comb[[i]])
  }

#List of combined feature levels for Figure A:
random.list <- expand.grid(combinations)
random.list <- as.matrix(random.list)
random.list <- randomRows(random.list, n=length(random.list[,1]))
if (product == 1) random.list <- rbind(random.list, random.list)

# Constricting to a shape part, so that different positions appear every 'n' times:
if (constrict %in% c("main","trap","dot") & product > 1) {
  constriction <- switch (constrict,
                          "main" = a.main,
                          "trap" = a.trap,
                          "dot" = a.dot)
  constr.column <- switch (constrict,
                           "main" = 1,
                           "trap" = 3,
                           "dot" = 4)
  if (constrict == "main" & length(a.flip) > 1) {
    random.list <- random.list[order(match(random.list[,2], 0:1)),]
    more <- 2
    } else
      more <- 1
  random.list <- random.list[order(match(random.list[,constr.column], constriction)),]
  range <- product/(length(constriction)*more)
  rrll <- matrix(rep(NA, times = 4), nrow=1)
  for (j in range)
    for (k in 1:range)
      for (i in 0:(length(constriction)*more - 1)){
        rrll <- rbind(rrll, random.list[i*j + k,])
      }
  random.list <- rrll[-1,]
}

# Replicate list according to the number of isomorphs:
table_multiplier <- ceiling(isomorphs/product)
if (table_multiplier > 1) {
  if (length(a.main) != 1 | length(a.trap) != 1 |
      length(a.flip) != 1 | length(a.dot) != 1) {
    warning(paste("At least one item matrix after item",
                  product, "may match the matrix of a previous item."))
  } else {
    warning(paste("All item matrices may match."))
}}
random.alt <- random.list
if (table_multiplier > 1) for (i in 2:table_multiplier)
  random.list <- rbind(random.list, random.alt)

# Replicate list of correct answers according to the number of isomorphs:
if (correct[1] == 0) {
  correct <- sample(1:9, size = isomorphs, replace = T)
} else {
  correct_multiplier <- ceiling(isomorphs/length(correct))
  correct.alt <- correct
  if (correct_multiplier > 1) for (i in 2:correct_multiplier)
    correct <- c(correct, correct.alt)
}

# Creating features for every isomorph
# It goes almost until the end of the function!:
for (l in 1:isomorphs){

# MATRIX

# List of features for figure A:
a <- list(
  rotation = random.list[,"main"][[l]],
  mirror = random.list[,"flip"][[l]],
  hampos = random.list[,"trap"][[l]],
  bootlines = c(1, 1, 1, 1, 1),
  dotpos = random.list[,"dot"][[l]])

# For now, we equal figures A, B and C:
b <- a
c <- a

# Function for changing B and C properties according to rules:
apply_rule <- function(x, rule, degree, pos){
  if (rule == "rotate.m") x[[1]] <- x[[1]] + degree
  if (rule == "mirror.a")
    (x[[2]] <- !x[[2]]) &
    (if (x[[1]] == 0 | x[[1]] == 180) x[[1]] <- x[[1]] + 180 else
      if (x[[1]] == 45 | x[[1]] == -135) x[[1]] <- x[[1]] + 90 else
        if (x[[1]] == 90 | x[[1]] == -90) x[[1]] else
          if (x[[1]] == 135 | x[[1]] == -45) x[[1]] <- x[[1]] - 90)
  if (rule == "mirror.b") (x[[2]] <- !x[[2]]) &
    (if (x[[1]] == 0 | x[[1]] == 180) x[[1]] else
      if (x[[1]] == 45 | x[[1]] == -135) x[[1]] <- x[[1]] - 90 else
        if (x[[1]] == 90 | x[[1]] == -90) x[[1]] <- x[[1]] + 180 else
          if (x[[1]] == 135 | x[[1]] == -45) x[[1]] <- x[[1]] + 90)
  if (rule == "rotate.h") x[[3]] <- x[[3]] + degree
  if (rule == "movedot") if (x[[5]] < 4) x[[5]] <- x[[5]] + pos else x[[5]] <- x[[5]] - pos
  return(x)
}

# Function that calls apply_rule and is further assigned to a list:
shape_matrix <- function(x) {
  if (length(x[[1]]) > 2 | length(x[[2]]) > 1 | length(x[[3]]) > 2 |
      length(x[[4]]) > 2 | length(x[[5]]) > 2)
    stop("Amount of rule numbers out of bounds.")
  if(length (x$circle_rotation) == 1)
    stop("Second main shape rotation undefined.")
  if(length (x$hammer_rotation) == 1)
    stop("Second trapezium rotation undefined.")
  if(length (x$subtraction) == 1)
    stop("Second subtraction undefined.")
  if(length (x$dot_movement) == 1)
    stop("Second dot movement undefined.")
  if((x$circle_rotation[1] != 0 | x$circle_rotation[2] != 0) & x$mirroring == 1)
    stop("Main shape rotation and reflection cannot coexist.")
  if(x[[1]][1] == 0 & x[[1]][2] == 0 & x[[2]] == 0 & x[[3]][1] == 0 & x[[3]][2] == 0 &
     x[[4]][1] == 0 & x[[4]][2] == 0 & x[[5]][1] == 0 & x[[5]][2] == 0)
    stop("Cannot find the rule(s).")
  if(x$subtraction[1] == x$subtraction[2] + 1 | x$subtraction[1] == x$subtraction[2] - 1)
    stop("Attempt to subtract two adjacent line segments, which is not recommended.")
  if(x$subtraction[1] == x$subtraction[2] & x$subtraction[1] > 0)
    stop("Attempt to subtract the same line segment twice.")
  if (x[[1]][1] %in% c(-135, -90, -45, 0, 45, 90, 135, 180) == F | x[[1]][2] %in% c(-135, -90, -45, 0, 45, 90, 135, 180) == F |
      x[[3]][1] %in% c(-135, -90, -45, 0, 45, 90, 135, 180) == F | x[[3]][2] %in% c(-135, -90, -45, 0, 45, 90, 135, 180) == F)
    stop("Only 0 and multiples of 45 between -135 and 180 are allowed to be used for rotation rules.")
  if (x[[2]] != 1 & x[[2]] != 0) stop("Only 0 and 1 are allowed to be used for the reflection rule.")
  if (x[[4]][1] %in% 0:5 == F | x[[4]][2] %in% 0:5 == F) stop("At least one number of the subtraction rule out of bounds.")
  if (x$dot_movement[1] %in% 0:3 == F | x$dot_movement[2] %in% 0:3 == F | sum(x$dot_movement) > 5)
    stop("At least one number of the dot edge movement rule out of bounds.")
  b <- apply_rule(b, "rotate.m", degree=x$circle_rotation[1])
  c <- apply_rule(c, "rotate.m", degree=x$circle_rotation[2])
  if (x$mirroring==1) {
    b <- apply_rule(b, "mirror.a")
    c <- apply_rule(c, "mirror.b")
    }
  b <- apply_rule(b, "rotate.h", degree = x$hammer_rotation[1])
  c <- apply_rule(c, "rotate.h", degree = x$hammer_rotation[2])
  for (i in 1:5) {
    if (x$subtraction[1]==i) b$bootlines[i] <- 0
  }
  for (i in 1:5) {
    if (x$subtraction[2]==i) c$bootlines[i] <- 0
  }
  if (x$dot_movement[1] + x$dot_movement[2] == 4 &
        (a[[5]] == 3 | a[[5]] == 4)) {
   a[[5]] <- sample(c(1, 2, 5, 6), 1)
   warning(paste("Dot movement of figure A has been resampled to one of four possible values in item ", l, ".", sep=""))
   b[[5]] <- a[[5]]
   c[[5]] <- a[[5]]
   b <- apply_rule(b, "movedot", pos = x$dot_movement[1])
   c <- apply_rule(c, "movedot", pos = x$dot_movement[2])
   } else
     if (x$dot_movement[1] + x$dot_movement[2]==5 &
           (a[[5]] != 1 & a[[5]] != 6)) {
      a[[5]] <- sample(c(1, 6), 1)
      warning(paste("Dot movement of figure A has been resampled to one of two possible values in item ", l, ".", sep=""))
      b[[5]] <- a[[5]]
      c[[5]] <- a[[5]]
      b <- apply_rule(b, "movedot", pos=x$dot_movement[1])
      c <- apply_rule(c, "movedot", pos=x$dot_movement[2])
      } else {
             b <- apply_rule(b, "movedot", pos=x$dot_movement[1])
             c <- apply_rule(c, "movedot", pos=x$dot_movement[2])
             }
  return(list(a=a, b=b, c=c))
}

# Random subtraction or fixed lines:
r_subt <- matrix(ncol = 2, byrow = T,
                 c(1, 3, 3, 5, 5, 3, 3, 1,
                   1, 4, 2, 5, 5, 2, 4, 1))
copy_subtract <- c(al.subtract, 0, 0, 0, 0, 0)
copy_subtract <- copy_subtract[1:6]
if (length(al.subtract) != 1 & automatic == F) {
  al_sub <- matrix(copy_subtract, byrow = T, ncol = 2)
  for (j in 1:length(al_sub[,1])) {
    for (i in 1:length(r_subt[,1])) {
      if (sum(r_subt[i,] %in% al_sub[j,]) == 2)
        r_subt[i,] <- NA
}}}
r_subt <- matrix(r_subt[!is.na(r_subt)], ncol = 2)
subchoice <- if (subtract[1] == "R") randomRows(r_subt) else
  subtract

# List and class for this list:
matrix <- list(
  circle_rotation = main.rot,
  mirroring = mirror,
  hammer_rotation = trap.rot,
  subtraction = subchoice,
  dot_movement = dot.mov)
out <- shape_matrix(matrix)

# Create A, B and C again:
a <- out$a
b <- out$b
c <- out$c

# Create values for correct answer D:
correct_rot <- if (a[[2]] != b[[2]]) a[[1]] + 180 else
                   b[[1]] - a[[1]] + c[[1]]
correct_boot <- 0
for (i in 1:5) {
  if (b$boot[i] == 0 | c$boot[i] == 0)
  correct_boot[i] <- 0 else correct_boot[i] <- 1
}
d <- list(
  rotation = correct_rot,
  mirror = a[[2]],
  hampos = b[[3]]-a[[3]] + c[[3]],
  bootlines = correct_boot,
  dotpos = b[[5]]-a[[5]] + c[[5]])

# Correction of the rotation angle:
one_rot <- c(1, 3)
for (i in 1:2){
  if (b[[one_rot[i]]] > 180) b[[one_rot[i]]] <- b[[one_rot[i]]] - 360
  if (b[[one_rot[i]]] < (-135))   b[[one_rot[i]]] <- b[[one_rot[i]]] + 360
  if (c[[one_rot[i]]] > 180) c[[one_rot[i]]] <- c[[one_rot[i]]] - 360
  if (c[[one_rot[i]]] < (-135))   c[[one_rot[i]]] <- c[[one_rot[i]]] + 360
  if (d[[one_rot[i]]] > 180) d[[one_rot[i]]] <- d[[one_rot[i]]] - 360
  if (d[[one_rot[i]]] < (-135))   d[[one_rot[i]]] <- d[[one_rot[i]]] + 360}

# OPTIONS

# Function to create options according to the
# Solutions Combination Design (Blum & Holling, 2018):
shape_options <- function(x){

  # Presence of each rule (0 if not present, 1 if pesent):
  rulePresence <- 0
  for (i in 1:5) {
    ifelse (b[[i]] == a[[i]] & c[[i]] == a[[i]],
            rulePresence[i] <- 0, rulePresence[i] <- 1)
  }
  if (rulePresence[2] == 1) rulePresence[1] <- 0

  # Numbers of rules being used:
  numPresence <- 0
  for (i in 1:5) {
    if (rulePresence[i] == 1)
      numPresence[i] <- i else numPresence[i] <- NA
  }
  numPresence <- numPresence[!is.na(numPresence)]

  # Numbers of rules not being used:
  numAbsence <- 1:5
  for (i in 1:5) {
    if (i %in% numPresence) numAbsence[i] <- NA
  }
  numAbsence <- numAbsence[!is.na(numAbsence)]

  # Random right answer:
  if (x$correct == 0) {
    x$correct <- sample(1:9, 1)
    random_answer <- T
  } else random_answer <- F

  # Forbidden:
  if (x$correct > 9) stop("Correct answer number out of bounds.")
  if (sum(rulePresence) > 1 & x$add > 0)
    warning("No extra rule needed when working with more than one rule. Added rule discarded.")
  if (((rulePresence[1] == 1 & x$add == 2) | (rulePresence[2] == 1 & x$add == 1)) & sum(rulePresence) == 1)
    stop("Main shape rotation and reflection cannot coexist throughout the options.")
  for (i in 1:5) if (rulePresence[i] == 1 & x$add == i & sum(rulePresence) == 1)
    stop("Attempt to add same rule as the one being already used.")
  if (x$add %in% -1:5 == F & sum(rulePresence) == 1) stop("Added rule number out of bounds.")

  # Creating matrices and a function to sample matrix rows:
  bootmatrix1 <- matrix(c(0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1,
                          0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1,
                          0), ncol=5, byrow=TRUE)
  bootmatrix2 <- matrix(c(0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 0, 1,
                          0, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0,
                          1), ncol=5, byrow=TRUE)
  bootmatrix3 <- rbind(bootmatrix1, bootmatrix2)

  # WORKING WITH ONLY ONE RULE FOR BOTH MATRIX AND OPTIONS:
  if (x$add == -1 & sum(rulePresence) == 1){

    # Creating vectors of angle positions from D:
    rangle45from_d1 <- c(d[[1]] + 45, d[[1]] + 90,
                         d[[1]] + 135, d[[1]] + 180,
                         d[[1]] + 225, d[[1]] + 270,
                         d[[1]] + 315)
    rangle45from_d3 <- c(d[[3]] + 45, d[[3]] + 90,
                         d[[3]] + 135, d[[3]] + 180,
                         d[[3]] + 225, d[[3]] + 270,
                         d[[3]] + 315)
    rangle90from_d <- c(d[[1]], d[[1]] + 90,
                        d[[1]] + 180, d[[1]] + 270)

    # Creating a list of angle and mirror positions:
    rmirrorlist <- list(
      rbind(rangle90from_d[1], !d[[2]]),
      rbind(rangle90from_d[2], d[[2]]),
      rbind(rangle90from_d[2], !d[[2]]),
      rbind(rangle90from_d[3], d[[2]]),
      rbind(rangle90from_d[3], !d[[2]]),
      rbind(rangle90from_d[4], d[[2]]),
      rbind(rangle90from_d[4], !d[[2]]))

    # Randomizing the latter information:
    samples_ra45d1 <- sample(rangle45from_d1, 7, replace=FALSE)
    samples_ra90d1 <- sample(rangle90from_d, 4, replace=FALSE)
    samples_ra45d3 <- sample(rangle45from_d3, 7, replace=FALSE)
    samples_mirror <- sample(rmirrorlist, 7, replace=FALSE)

    # Getting D's bootline information:
    samples_bootrows <- bootmatrix3[sample(nrow(bootmatrix3), 9),]
    for (i in 1:9) {
      if (sum(ifelse(samples_bootrows[i,] == d[[4]], 1, 0)) == 5)
        samples_bootrows[i,] <- NA
    }
    samples_bootrows <- samples_bootrows[!is.na(samples_bootrows)]
    samples_bootrows <- matrix(samples_bootrows, ncol=5)

    # Creating a list of lists, each containing information from D:
    setlength <- 8
    set <- 1:setlength
    set <- as.list(set)
    for (i in 1:setlength) set[i] <- as.list(set[i])
    for (i in 1:setlength) set[[i]] <- d

    # Main shape rotation:
    if (rulePresence[1] == 1){
      warning("No more than eight computable answer options. 'None is correct' cannot be the right answer.")
      if (x$correct == 9) {
        x$correct <- sample(1:8, 1)
        if (random_answer == F)
          warning(paste("Correct answer number changed to ", x$correct, " in item ", l, ".", sep=""))
      }
     for (j in 1:7) {
       if (x$correct == j) for (i in 1:(8-j))
         set[[x$correct + i]][[1]] <- samples_ra45d1[i]
     }
     for (j in 2:8) {
       if (x$correct == j) for (i in 1:(j-1))
         set[[i]][[1]] <- samples_ra45d1[i + (8-j)]
     }
     for (i in 1:8) {
       names(set)[i] <- paste("op", i, sep="")
     }

    } else

    # Hammer rotation:
    if (rulePresence[3] == 1){
        warning("No more than eight computable answer options. 'None is correct' cannot be the right answer.")
     if (x$correct == 9) {
       x$correct <- sample(1:8, 1)
       if (random_answer == F)
         warning(paste("Correct answer number changed to ", x$correct, " in item ", l, ".", sep=""))
     }
      for (j in 1:7) {
        if (x$correct == j)
          for (i in 1:(8-j)) {
            set[[x$correct + i]][[3]] <- samples_ra45d3[i]
      }}
      for (j in 2:8) {
        if (x$correct == j)
          for (i in 1:(j-1)) {
          set[[i]][[3]] <- samples_ra45d3[i + (8-j)]
      }}
      for (i in 1:8) {
        names(set)[i] <- paste("op", i, sep="")
      }

     } else

      # Reflection:
     if (rulePresence[2] == 1){
      warning("No more than eight computable answer options. 'None is correct' cannot be the right answer.")
      if (x$correct == 9) {
        x$correct <- sample(1:8, 1)
        if (random_answer == F)
          warning(paste("Correct answer number changed to ", x$correct, " in item ", l, ".", sep=""))
      }
      for (j in 1:7) {
       if (x$correct == j)
        for (i in 1:(8-j)) {
            set[[x$correct + i]][[1]] <- samples_mirror[[i]][1]
            set[[x$correct + i]][[2]] <- samples_mirror[[i]][2]
      }}
      for (j in 2:8) {
        if (x$correct == j)
          for (i in 1:(j-1)) {
            set[[i]][[1]] <- samples_mirror[[i + (8-j)]][1]
            set[[i]][[2]] <- samples_mirror[[i + (8-j)]][2]
      }}
      for (i in 1:8) {
        names(set)[i] <- paste("op", i, sep="")
      }

     } else

     # Subtraction:
     if (rulePresence[4] == 1) {
       for (j in 1:7) {
         if (x$correct == j)
           for (i in 1:(8-j)) {
             set[[x$correct + i]][[4]] <- samples_bootrows[i,]
       }}
       for (j in 2:8) {
         if (x$correct == j)
           for (i in 1:(j-1)) {
            set[[i]][[4]] <- samples_bootrows[i + (8-j),]
       }}
       for (i in 1:8) {
         names(set)[i] <- paste("op", i, sep="")
       }

     } else

     # Dot movement:
     if (rulePresence[5] == 1)
       stop("No more than six computable answer options for dot edge movement. Cannot build item list.")

  } else {

  # WORKING WITH MORE THAN ONE RULE THROUGHOUT THE OPTIONS:

  # Adding a random rule only when working with one rule:
  if (sum(rulePresence) == 1) {
    numAvailable <- numAbsence
    if (rulePresence[1] + rulePresence[2] == 1)
      numAvailable <- numAvailable[-1]
    if (x$add == 0){
      if (length(numAvailable) == 1) x$add <- numAvailable else
        x$add <- sample(numAvailable, 1)
  }} else x$add <- 0

  # Creating matrices for each rule, where the correct
  # answer is the first row, and then randomizing the rows:

  # Rule 2:
  if (rulePresence[2] == 1 | x$add == 2) {
    if (x$automatic == F){
     if (length(x$swap2) == 1 | length(x$swap2) == 3 | length(x$swap2) == 5)
       stop("Pairs of numbers for the alternative reflection solution required.")
     if (length(x$swap2) > 6) stop("Maximum of six numbers allowed for the alternative reflection solution.")
     for (i in 1:(length(x$swap2)/2)) for (j in (i*2):(i*2)) if (x$swap2[j] > 1)
       stop("Only 0 and 1 are allowed to be used for the second element of the alternative reflection solution.")
     for (i in 1:(length(x$swap2)/2)) for (j in (i*2-1):(i*2-1))
       if (x$swap2[j] %in% c(-135, -90, -45, 0, 45, 90, 135, 180) == F)
       stop("Only 0 and multiples of 45 between -135 and 180 are allowed to be used for the first element of the alternative reflection solution.")
     for (i in 1:(length(x$swap2)/2)) for (j in (i*2-1):(i*2-1))
       if (x$swap2[j] == 0 & x$swap2[j + 1] == 0) stop("At least one alternative reflection solution is identical to the correct reflection solution.")
     mirvec <- c(d[[1]] + x$swap2[1], x$swap2[2], d[[1]] + x$swap2[3],
                 x$swap2[4], d[[1]] + x$swap2[5], x$swap2[6])
     mirvec <- mirvec[!is.na(mirvec)]
     for (i in 1:(length(mirvec)/2)) {
       for (j in (2*i):(2*i)) {
         mirvec[j] <- if (x$swap2[j] == 1) !d[[2]] else d[[2]]
     }}
    } else {
     if (d[[1]] %in% c(-270, -180, -90, 0, 90, 180, 270) == T)
       mirvec <- c(d[[1]], !d[[2]], d[[1]] + 180, 0, d[[1]] + 180, 1) else
         mirvec <- c(d[[1]]-90, !d[[2]], d[[1]] + 180, d[[2]], d[[1]] + 90, !d[[2]])
     forsampling <- matrix(1:6, ncol=2, byrow=T)
     if (x$add == 2 | sum(rulePresence) > 2){
       forsampling <- randomRows(forsampling)
       mirvec <- mirvec[forsampling]}
     if (sum(rulePresence) == 2){
       forsampling <- randomRows(forsampling, 2)
       mirvec <- c(mirvec[forsampling[1,]], mirvec[forsampling[2,]])}
    }
    mirs <- matrix(mirvec, ncol=2, byrow=T)
    mirs <- rbind(c(d[[1]], d[[2]]), mirs)
    # Random rows:
    vectormirs <- sample(nrow(mirs), nrow(mirs))
    mirlines <- mirs
    for (i in 1:length(vectormirs)) mirlines[i,] <- mirs[vectormirs[i],]
    mirs <- matrix(mirlines[,2],ncol=1)
    main <- matrix(mirlines[,1],ncol=1)
   } else

   # Rule 1:
    if (rulePresence[1] == 1 | x$add == 1) {
      if (x$automatic == F) {
         for (j in 1:length(x$swap1)) {
           if (x$swap1[j] == 0) stop("Cannot find the alternative solutions of the main shape rotation rule.")
         }
       if (length(x$swap1) > 3) stop("Maximum of three numbers allowed for the alternative main-shape rotation solution.")
       for (j in 1:length(x$swap1)) {
         if (x$swap1[j] %in% c(-135, -90, -45, 45, 90, 135, 180) == F)
           stop("Only multiples of 45 between -135 and 180 are allowed to be used for the alternative main-shape rotation solution.")
       }
       mainvec <- c(d[[1]] + x$swap1[1], d[[1]] + x$swap1[2], d[[1]] + x$swap1[3])
       mainvec <- mainvec[!is.na(mainvec)]
      } else {
       forsampling <- matrix(ncol=3, byrow=T, c(-135, -90, -45, -90, -45, 45, -45, 45, 90, 45, 90, 135))
       forsampling <- randomRows(forsampling)
       mainvec <- c(d[[1]] + forsampling[1], d[[1]] + forsampling[2], d[[1]] + forsampling[3])
       if (x$add == 1 | sum(rulePresence) > 2) mainvec <- sample(c(d[[1]]-45, d[[1]] + 45), 1)
       if (sum(rulePresence) == 2) {
         forsampling <- matrix(ncol=2, byrow=T, c(-90, -45, -45, 45, 45, 90))
         forsampling <- randomRows(forsampling)
         mainvec <- c(d[[1]] + forsampling[1], d[[1]] + forsampling[2])
       }}
      main <- matrix(mainvec, ncol=1)
      main <- rbind(d[[1]], main)
      # Random rows:
      main <- randomRows(main, length(main))
      main <- matrix(main, ncol=1)
      mirs <- matrix(d[[2]])
    } else {
    main <- matrix(d[[1]])
    mirs <- matrix(d[[2]])}

  # Rule 3:
  if (rulePresence[3] == 1 | x$add == 3) {
    if (x$automatic == F) {
      for (j in 1:length(x$swap3)) {
        if (x$swap3[j] == 0)
          stop("Cannot find the alternative solutions of the trapezium rotation rule.")
      }
      if (length(x$swap3) > 3) stop("Maximum of three numbers allowed for the alternative trapezium rotation solution.")
      for (j in 1:length(x$swap3)) {
        if (x$swap3[j] %in% c(-135, -90, -45, 0, 45, 90, 135, 180) == F)
          stop("Only 0 and multiples of 45 between -135 and 180 are allowed to be used for the alternative trapezium rotation solution.")
      }
      hamvec <- c(d[[3]] + x$swap3[1], d[[3]] + x$swap3[2], d[[3]] + x$swap3[3])
      hamvec <- hamvec[!is.na(hamvec)]
     } else {
      forsampling <- matrix(ncol=3, byrow=T, c(-135, -90, -45, -90, -45, 45, -45, 45, 90, 45, 90, 135))
      forsampling <- randomRows(forsampling)
      hamvec <- c(d[[3]] + forsampling[1], d[[3]] + forsampling[2], d[[3]] + forsampling[3])
      if (x$add == 3 | sum(rulePresence) > 2) hamvec <- sample(c(d[[3]]-45, d[[3]] + 45), 1)
      if (sum(rulePresence) == 2) {
       forsampling <- matrix(ncol=2, byrow=T, c(-90, -45, -45, 45, 45, 90))
       forsampling <- randomRows(forsampling)
       hamvec <- c(d[[3]] + forsampling[1], d[[3]] + forsampling[2])
     }}
    ham <- matrix(hamvec, ncol=1)
    ham <- rbind(d[[3]], ham)
    # Random rows:
    ham <- randomRows(ham, length(ham))
    ham <- as.matrix(ham, ncol=1)
   } else ham <- matrix(d[[3]])

  # Rule 4:
  if (rulePresence[4] == 1 | x$add == 4) {
    if (x$automatic == F) {
      if (length(x$swap4) == 1 | length(x$swap4) == 3 | length(x$swap4) == 5)
        stop("Pairs of numbers for the alternative subtraction solution required.")
      if (length(x$swap4) > 6) stop("Maximum of six numbers allowed for the alternative subtraction solution.")
     for (j in 1:length(x$swap4)) {
       if (x$swap4[j] %in% 0:5 == F)
         stop ("At least one number of the alternative subtraction solution out of bounds.")
     }
     numbersub=0
     for (i in 1:5) if (d[[4]][i] == 0) numbersub[i] <- i else NA
     for (i in 1:5) if (d[[4]][i] != 0) numbersub[i] <- NA else i
     numbersub <- numbersub[!is.na(numbersub)]
     numbersubop1 <- matrix(x$swap4, ncol=2, byrow=TRUE)
     numbersubop2 <- cbind(numbersubop1[,2], numbersubop1[,1])
     for (i in 1:length(numbersubop1[,1]))
       if (sum(numbersub == numbersubop1[i,]) == 2 | sum(numbersub == numbersubop2[i,]) == 2)
         stop("At least one alternative subtraction solution is identical to the correct subtraction solution.")
     subs=1:3
     subs <- as.list(subs)
     for (i in 1:3) subs[[i]] <- rep(1, times=5)
     for (i in 1:3) for (j in (2*i-1):(2*i-1))
       subs[[i]] <- subs[[i]][!is.na(x$swap4[j])]
     subs <- subs[lapply(subs, length) > 0]
     for (k in 1:length(subs)) for (j in (2*k-1):((2*k-1) + 1))
       for (i in 1:5) if (x$swap4[j] == i) subs[[k]][i] <- 0
     subs <- do.call(rbind, subs)
    } else {
      submatrix <- bootmatrix2
      for (i in 1:length(submatrix[,1])) {
        if (d[[4]][1] == submatrix[i,1] & d[[4]][2] == submatrix[i,2] &
            d[[4]][3] == submatrix[i,3] & d[[4]][4] == submatrix[i,4] &
            d[[4]][5] == submatrix[i,5])
          submatrix[i,] <- NA
      }
      submatrix <- matrix(submatrix[!is.na(submatrix)], ncol=5)
      subs <- randomRows(submatrix, 3)
      if (x$add == 4) subs <- matrix(randomRows(bootmatrix1), nrow=1)
      if (sum(rulePresence) > 2)
        subs <- matrix(randomRows(submatrix), nrow=1)
      if (sum(rulePresence) == 2) subs <- randomRows(subs, 2)
    }
    subs <- rbind(d[[4]], subs)
    # Random rows:
    vectorsubs <- sample(nrow(subs), nrow(subs))
    sublines <- subs
    for (i in 1:length(vectorsubs)) sublines[i,] <- subs[vectorsubs[i],]
    subs <- sublines
   } else subs <- matrix(d[[4]], ncol=5)

  # Rule 5:
  if (rulePresence[5] == 1 | x$add == 5) {
    dotleft <- 1:6
    for (i in 1:6) {
      if (d[[5]] == dotleft[i]) dotleft[i] <- NA
    }
    dotleft <- dotleft[!is.na(dotleft)]
    if (x$automatic == F){
      for (j in 1:length(dotleft)) {
        if (dotleft[j] %in% x$swap5 == T) dotleft[j] <- NA
      }
      dotleft <- dotleft[!is.na(dotleft)]
     for (j in 1:length(x$swap5)) if (d[[5]] == x$swap5[j])
       {x$swap5[j] <- dotleft[1]
        warning(paste("An alternative dot position solution had to be resampled in item ", l, ".", sep=""))}
     for (j in 1:length(x$swap5)) if (x$swap5[j] %in% 1:6 == F)
     stop ("At least one number of the alternative dot edge movement solution out of bounds.")
     if (length(x$swap5) > 3) stop("Maximum of three numbers allowed for the alternative dot edge movement solution.")
     dotvec <- 0
     for (i in 1:3) dotvec[i] <- x$swap5[i]
     dotvec <- dotvec[!is.na(dotvec)]
    } else {
      dotvec <- sample(dotleft, 3)
      if (x$add == 5 | sum(rulePresence) > 2) dotvec <- sample(dotleft, 1)
      if (sum(rulePresence) == 2) dotvec <- sample(dotleft, 2)
    }
    dot <- matrix(dotvec, ncol=1)
    dot <- rbind(d[[5]], dot)
    # Random rows:
    dot <- randomRows(dot, length(dot))
    dot <- as.matrix(dot, ncol=1)
  } else dot <- matrix(d[[5]])
  thecount <- 0
  for (i in 1:length(dot[,1])) {
    if (d[[5]] == dot[i,]) thecount[i] <- 1 else
    thecount[i] <- 0
  }
  if (sum(thecount) > 1) stop("The correct dot placement coincides with at least one alternative placement.")

  # Creating a vector of solutions per rule:
  solutions <- rep(0, times=5)
  solutions <- as.list(solutions)
  solutions[[1]] <- main
  solutions[[2]] <- mirs
  solutions[[3]] <- ham
  solutions[[4]] <- subs
  solutions[[5]] <- dot

  # Correcting angle numbers again, just in case:
  if ((rulePresence[1] + rulePresence[2] == 1) | x$add == 1 | x$add == 2)
    for (i in 1:length(solutions[[1]])) {
     solutions[[1]][i,] <- if (solutions[[1]][i,] > 180) solutions[[1]][i,] - 360 else solutions[[1]][i,]
     solutions[[1]][i,] <- if (solutions[[1]][i,] < (-135)) solutions[[1]][i,] + 360 else solutions[[1]][i,]
    }
  if (rulePresence[3] == 1 | x$add == 3)
    for (i in 1:length(solutions[[3]])) {
     solutions[[3]][i,] <- if (solutions[[3]][i,] > 180) solutions[[3]][i,] - 360 else solutions[[3]][i,]
     solutions[[3]][i,] <- if (solutions[[3]][i,] < (-135)) solutions[[3]][i,] + 360 else solutions[[3]][i,]
    }

  # Creating a list of lists, each containing information from D:
  increment <- if (sum(rulePresence) == 4) 7 else 0
  setlength <- 9 + increment
  set <- 1:setlength
  set <- as.list(set)
  for (i in 1:setlength) set[i] <- as.list(set[i])
  for (i in 1:setlength) set[[i]] <- d

  # Combinations for one rule in a 4x2 design by default (it is compulsory to
  # add one more solution of another rule):
  if (sum(rulePresence) == 1) {
    set[[9]] <- NA
    set <- set[!is.na(set)]
    for (i in 1:5) {
      if ((rulePresence[i] == 1 & length(solutions[[i]][,1]) != 4) |
         (x$add == i & length(solutions[[i]][,1]) != 2))
      stop("Three alternative solutions for the applied rule and one for the added rule are required.")
    }
    for (j in 1:5) {
      if (rulePresence[j] == 1)
        for (i in 1:4) {
          set[[i]][[j]] <- solutions[[j]][i,]
          set[[i + 4]][[j]] <- solutions[[j]][i,]
    }}
    if (rulePresence[2] == 1)
        for (i in 1:4) {
          set[[i]][[1]] <- solutions[[1]][i,]
          set[[i + 4]][[1]] <- solutions[[1]][i,]
        }
    for (j in 1:5) {
      if (x$add == j)
        for (i in 1:4) {
          set[[i]][[j]] <- solutions[[j]][1,]
          set[[i + 4]][[j]] <- solutions[[j]][2,]
    }}
      if (x$add == 2)
        for (i in 1:4) {
          set[[i]][[1]] <- solutions[[1]][1,]
          set[[i + 4]][[1]] <- solutions[[1]][2,]
        }
   }

  # Combinations for two rules in a 3x3 design by default:
  if (sum(rulePresence) == 2) {
    if (sum(length(solutions[[numPresence[1]]][,1]) == 3,
            length(solutions[[numPresence[2]]][,1]) == 3) != 2)
      stop("Two alternative solutions for each of the applied rules are required.")
    for (i in 1:3) {
      set[[i]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
      set[[i + 3]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
      set[[i + 6]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
    }
    if (numPresence[1] == 2)
      for (i in 1:3) {
        set[[i]][[1]] <- solutions[[1]][i,]
        set[[i + 3]][[1]] <- solutions[[1]][i,]
        set[[i + 6]][[1]] <- solutions[[1]][i,]
      }
    for (i in 1:3) {
        set[[i]][[numPresence[2]]] <- solutions[[numPresence[2]]][1,]
        set[[i + 3]][[numPresence[2]]] <- solutions[[numPresence[2]]][2,]
        set[[i + 6]][[numPresence[2]]] <- solutions[[numPresence[2]]][3,]
    }
    # For the case of a 3x3 design, when one answer is correct,
    # we eliminate an option:
    if (x$correct < 9) {
      dif1=0
      dif2=0
      dif3=0
      dif4=0
      difall=0
      for (i in 1:length(set)) {
        dif1[i] <- if (set[[i]][[1]] != d[[1]] | set[[i]][[2]] != d[[2]]) 1 else 0
        dif2[i] <- set[[i]][[3]] != d[[3]]
        dif3[i] <- if (sum(unlist(set[[i]][[4]]) == unlist(d[[4]])) == 5) 0 else 1
        dif4[i] <- set[[i]][[5]] != d[[5]]
      }
      for (i in 1:length(set)) {
        difall[i] <- if (dif1[i] + dif2[i] + dif3[i] + dif4[i] > 0) 1 else 0
      }
      for (i in 1:length(set)) {
        difall[i] <- if (difall[i] == 0) NA else i
      }
      difall <- difall[!is.na(difall)]
      set[[difall[1]]] <- NA
      set <- set[!is.na(set)]
    }
  }

  # Combinations for three rules in a 2x2x2 design by default:
  if (sum(rulePresence) == 3) {
    if (sum(length(solutions[[numPresence[1]]][,1]) == 2,
            length(solutions[[numPresence[2]]][,1]) == 2,
            length(solutions[[numPresence[3]]][,1]) == 2) != 3)
      stop("Only one alternative solution for each of the applied rules is required.")
    for (i in 1:2) {
      set[[i]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
      set[[i + 2]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
      set[[i + 4]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
      set[[i + 6]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
    }
    if (numPresence[1] == 2)
      for (i in 1:2) {
        set[[i]][[1]] <- solutions[[1]][i,]
        set[[i + 2]][[1]] <- solutions[[1]][i,]
        set[[i + 4]][[1]] <- solutions[[1]][i,]
        set[[i + 6]][[1]] <- solutions[[1]][i,]
      }
    for (i in 1:2) {
      set[[i]][[numPresence[2]]] <- solutions[[numPresence[2]]][1,]
      set[[i + 2]][[numPresence[2]]] <- solutions[[numPresence[2]]][2,]
      set[[i + 4]][[numPresence[2]]] <- solutions[[numPresence[2]]][1,]
      set[[i + 6]][[numPresence[2]]] <- solutions[[numPresence[2]]][2,]
    }
    for (i in 1:4) {
      set[[i]][[numPresence[3]]] <- solutions[[numPresence[3]]][1,]
      set[[i + 4]][[numPresence[3]]] <- solutions[[numPresence[3]]][2,]
    }
  }

  # Combinations for four rules with a 2x2x2x2 design by default:
  if (sum(rulePresence) == 4) {
    if ((sum(length(solutions[[numPresence[1]]][,1]) == 2,
             length(solutions[[numPresence[2]]][,1]) == 2,
             length(solutions[[numPresence[3]]][,1]) == 2,
             length(solutions[[numPresence[4]]][,1]) == 2) != 4))
      stop("Only one alternative solution for each of the applied rules is required.")
    for (i in 1:2) {
      set[[i]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
      set[[i + 2]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
      set[[i + 4]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
      set[[i + 6]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
      set[[i + 8]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
      set[[i + 10]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
      set[[i + 12]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
      set[[i + 14]][[numPresence[1]]] <- solutions[[numPresence[1]]][i,]
    }
    if (numPresence[1] == 2)
      for (i in 1:2) {
        set[[i]][[1]] <- solutions[[1]][i,]
        set[[i + 2]][[1]] <- solutions[[1]][i,]
        set[[i + 4]][[1]] <- solutions[[1]][i,]
        set[[i + 6]][[1]] <- solutions[[1]][i,]
        set[[i + 8]][[1]] <- solutions[[1]][i,]
        set[[i + 10]][[1]] <- solutions[[1]][i,]
        set[[i + 12]][[1]] <- solutions[[1]][i,]
        set[[i + 14]][[1]] <- solutions[[1]][i,]
      }
    for (i in 1:2) {
      set[[i]][[numPresence[2]]] <- solutions[[numPresence[2]]][1,]
      set[[i + 2]][[numPresence[2]]] <- solutions[[numPresence[2]]][2,]
      set[[i + 4]][[numPresence[2]]] <- solutions[[numPresence[2]]][1,]
      set[[i + 6]][[numPresence[2]]] <- solutions[[numPresence[2]]][2,]
      set[[i + 8]][[numPresence[2]]] <- solutions[[numPresence[2]]][1,]
      set[[i + 10]][[numPresence[2]]] <- solutions[[numPresence[2]]][2,]
      set[[i + 12]][[numPresence[2]]] <- solutions[[numPresence[2]]][1,]
      set[[i + 14]][[numPresence[2]]] <- solutions[[numPresence[2]]][2,]
    }
    for (i in 1:4) {
      set[[i]][[numPresence[3]]] <- solutions[[numPresence[3]]][1,]
      set[[i + 4]][[numPresence[3]]] <- solutions[[numPresence[3]]][2,]
      set[[i + 8]][[numPresence[3]]] <- solutions[[numPresence[3]]][1,]
      set[[i + 12]][[numPresence[3]]] <- solutions[[numPresence[3]]][2,]
    }
    for (i in 1:8) {
      set[[i]][[numPresence[4]]] <- solutions[[numPresence[4]]][1,]
      set[[i + 8]][[numPresence[4]]] <- solutions[[numPresence[4]]][2,]
    }
    # Eliminating options that have three or one rule equal to D:
    dif1=0
    dif2=0
    dif3=0
    dif4=0
    for (i in 1:length(set)) {
      dif1[i] <- if (set[[i]][[1]] != d[[1]] | set[[i]][[2]] != d[[2]]) 1 else 0
      dif2[i] <- set[[i]][[3]] != d[[3]]
      dif3[i] <- if (sum(unlist(set[[i]][[4]]) == unlist(d[[4]])) == 5) 0 else 1
      dif4[i] <- set[[i]][[5]] != d[[5]]
      if ((dif1[i] + dif2[i] + dif3[i] + dif4[i] == 3) | (dif1[i] + dif2[i] + dif3[i] + dif4[i] == 1))
        set[[i]] <- NA
    }
    set <- set[!is.na(set)]
  }

  # Random distribution of options:
  numbersset <- c(1:length(set))
  rset <- sample(numbersset, length(set))
  set2 <- set
  for (i in 1:length(set)) set[[i]] <- set2[[rset[i]]]

  # Subtracting the option equal to D:
  for (i in 1:length(set)) {
    if (sum(ifelse(unlist(set[[i]]) == unlist(d), 1, 0)) == 9)
      set[[i]] <- NA
  }
  set <- set[!is.na(set)]

  # When there are seven options and no correct answer, we create
  # the 8th option based on the random alteration of a rule:
  if (length(set) == 7 & x$correct == 9) {
    rangle1 <- matrix(rangle[!rangle %in% solutions[[1]]], ncol=1)
    rangle2 <- matrix(rangle[!rangle %in% solutions[[3]]], ncol=1)
    if (rulePresence[2] == 1) {
      tablemir <- cbind(solutions[[1]], solutions[[2]])
      rmirrorvec <- c(0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0)
      ranglemirror <- cbind(matrix(cbind(rangle, rangle), ncol=1), rmirrorvec)
      for (i in 1:16) {
        for (j in 1:length(tablemir[,1])) {
         if (sum(ranglemirror[i,] == tablemir[j,]) == 2) ranglemirror[i,] <- 999
      }}
      for (i in 1:16) if (sum(ranglemirror[i,] == 999) == 2) ranglemirror[i,] <- NA
      for (i in 1:16) {
        if (is.na(ranglemirror[i,1]))
          rmirror2 <- matrix(ranglemirror[(!is.na(ranglemirror))], ncol=2)
      }
     } else rmirror2 <- matrix(0, ncol=2)
    for (i in 1:10) {
      for (j in 1:length(solutions[[4]][,1])) {
        if (sum(bootmatrix3[i,] == solutions[[4]][j,]) == 5) bootmatrix3[i,] <- 999
    }}
    for (i in 1:10) if (sum(bootmatrix3[i,] == 999) == 5) bootmatrix3[i,] <- NA
    for (i in 1:10) {
      if (is.na(bootmatrix3[i,1]))
        rboot <- matrix(bootmatrix3[(!is.na(bootmatrix3))], ncol=5) else rboot <- bootmatrix3
    }
    rdot2 <- matrix(rdot[!rdot %in% solutions[[5]]], ncol=1)
    rsolutions <- rep(0, times=5)
    rsolutions <- as.list(rsolutions)
    rsolutions[[1]] <- if (rulePresence[1] == 1) rangle1 else
      if (rulePresence[2] == 1) matrix(rmirror2[, 1]) else matrix(d[[1]])
    rsolutions[[2]] <- matrix(rmirror2[, 2])
    rsolutions[[3]] <- rangle2
    rsolutions[[4]] <- rboot
    rsolutions[[5]] <- rdot2
    numbers <- c(3, 5)
    rnumber <- sample(numbers, 1)
    set[[8]] <- d
    set[[8]][[rnumber]] <- randomRows(rsolutions[[rnumber]])
    numbersset <- c(1:length(set))
    rset <- sample(numbersset, length(set))
    set3 <- set
    for (i in 1:length(set))
      set[[i]] <- set3[[rset[i]]]
  }

  # Placing the correct option when there are seven options
  # and a defined location of the correct answer:
  if (length(set) == 7 & x$correct < 9) {
    set4 <- set
    for (k in 1:8) if (x$correct == k) set[[k]] <- d
    for (j in 1:7)
      if (x$correct == j) for (i in 1:(8-j))
        set[[x$correct + i]] <- set4[[i]]
    for (j in 2:8)
      if (x$correct == j) for (i in 1:(j-1))
        set[[i]] <- set4[[i + (8-j)]]
  }

  # Naming the 8 options:
  for (i in 1:8) names(set)[i] <-
    paste("op", i, sep="")
  }

  # Final phase:
  shapes <- c("a", "b", "c", "info")
  for (i in 9:12) {
    set[[i]] <- 0
    set[[i]] <- as.list(set[[i]])
    names(set)[i] <- shapes[i-8]
  }
  set[[12]][[1]] <- x$correct
  set[[12]][[2]] <- numPresence
  return(set)
}

# Creating a list with a menu for the options:
options <- list(
  swap1=al.main.rot,
  swap2=al.mirror,
  swap3=al.trap.rot,
  swap4=al.subtract,
  swap5=al.dot.mov,
  correct=correct[l],
  add=add.rule,
  automatic=automatic)
out <- shape_options(options)

# Save all isomorphs into labels "item1", "item2", etc.:
out$a <- a
out$b <- b
out$c <- c
assign(paste("item", l, sep=""), out)
}

# Creating a mega-list containing all items:
items <- 0
items <- as.list(items)
for (i in 1:isomorphs) {
  items[i] <- 0
  items[i] <- as.list(items[i])
  items[[i]] <- get(paste("item", i, sep=""))
}

class(items) <- "fa_items"
return(items)
}

#' @export
print.fa_items <- function(x, ...) {
  inc <- length(x)
  rulenames <- c("  Main shape rotation\n", "  Reflection\n", "  Trapezium rotation\n",
                 "  Subtraction\n", "  Dot edge movement\n")
  presence <- rep("", times = 5)
  for (i in 1:5) if (!i %in% x[[1]]$info[[2]]) rulenames[i] <- ""
  cat(paste("Number of created isomorphs: ", inc, ".\n", sep = ""))
  cat(paste("General rules applied:\n",
            paste(rulenames, collapse = ""),
            sep = ""))
}

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.