Nothing
R/buildfa.R
In IMak: Item Maker
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.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
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.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.