Nothing
#' Plot figural analogies.
#'
#' \code{plot_fa} plots figural analogies by reading the
#' information previously stored in an object of class \code{'fa_items'}
#' generated with \code{\link{build_fa}}.
#'
#' Thorough information about the \code{plot_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 items An object of class \code{'fa_items'} generated with function \code{build_fa}. No default.
#' @param which A numeric vector designating which isomorph(s) to plot. Plot all by default.
#' @param mode A character string designating plot mode \code{"A"}, \code{"B"} or \code{"C"}. Plot mode \code{"A"} by default.
#' @param language A character string designating English (\code{"E"}), German (\code{"D"}) or Spanish (\code{"S"}) language. Default is \code{"E"}.
#' @param language.dir A character string designating language for output files. \code{"A"} by default selects all languages.
#' @param form.int A character string designating the form from \code{"A"} to \code{"D"} of the internal main shape, or \code{"R"} for random. Default is \code{"A"}.
#' @param form.ext A character string designating the form from \code{"A"} to \code{"D"} of the trapezium, or \code{"R"} for random. Default is \code{"A"}.
#' @param size.shape A number designating the size of every shape. Default is 1.
#' @param size.dot A number designating the size of every shape dot. Default is 2.
#' @param size.line A number designating the thickness of every shape. Default is 1.
#' @param size.q A number designating the size of the question mark. Default is 3.5.
#' @param size.word A number designating the size of the verbal options. Default is 1.2.
#' @param info Should the applied rules and correct answers be informed? True by default.
#' @param sep Field separator character of the "Info.csv" file. The default \code{","} is recommended for English MS Office.
#' @param directory A character string designating a folder in your PC where to store the isomorphs.
#' @param switch.from Number 'p' designating an option from 1 to 8 to switch with 'q'.
#' @param switch.to Number 'q' designating an option from 1 to 8 to switch with 'p'.
#' @return A data frame containing rules applied and right answers when \code{info = T} by default, or an object of class \code{'fa_items'} when \code{which} has length 1, its value is greater than 0 and both \code{switch.from} and \code{switch.to} are greater than 0.
#' @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{build_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)
#' ## Plot them:
#' plot_fa(one)
#' ## Change the correct answer of item 2 from position 1 to position 2:
#' one <- plot_fa(one, which = 2, switch.from = 1, switch.to = 2)
#' ## Choose a directory and save the items:
#' # dir1 <- "enter your new directory here"
#' # plot_fa(one, directory = dir1)
#'
#' ## Create four isomorphs with two rules:
#' two <- build_fa(isomorphs = 4, mirror = 1, trap.rot = c(90, 45))
#' ## Plot them in German language:
#' plot_fa(two, language = "D")
#' ## Plot only items 2 and 3 in Spanish and choose form "B" for the internal main shape:
#' plot_fa(two, language = "S", form.int = "B", which = c(2, 3))
#' ## Choose a different directory and save these two items by keeping the latter configuration:
#' # dir2 <- "enter your new directory here"
#' # plot_fa(two, which = c(2, 3), language.dir = "S", form.int = "B", directory = dir2)
#'
#' ## 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)
#' ## Plot them:
#' plot_fa(three)
#' ## Plot each individual shape of item 13 in German language only:
#' plot_fa(three, which = 13, mode = "C", language = "D")
#' ## Save the item parts in a different folder. Re-import them to create and save another plot:
#' # dir3 <- "enter your new directory here"
#' # plot_fa(three, which = 13, mode = "C", language.dir = "D", directory = dir3)
#' # afs(sa = "item13a.png", sb = "item13b.png", sc = "item13c.png",
#' # s1 = "item13op1.png", s2 = "item13op2.png", s3 = "item13op3.png",
#' # s4 = "item13op4.png", s5 = "item13op5.png", s6 = "item13op6.png",
#' # s7 = "item13op7.png", s8 = "item13op8.png", ai.idn = T, path = dir3)
#' @importFrom "grDevices" "dev.off" "png"
#' @importFrom "graphics" "layout" "lines" "par" "plot" "points" "text"
#' @importFrom "utils" "write.table"
#' @export
plot_fa <- function(
items,
which = 0,
mode = "A",
language = "E",
language.dir = "A",
form.int = "A",
form.ext = "A",
size.shape = 1,
size.dot = 2,
size.line = 1,
size.q = 3.5,
size.word = 1.2,
info = T,
sep = ",",
directory = F,
switch.from = 0,
switch.to = 0)
{
#Forbidden:
if (!mode %in% c("A", "B", "C") | !language %in% c("E", "D", "S") |
!language.dir %in% c("A", "E", "D", "S") | !form.int %in% c("A", "B", "C", "D", "R") |
!form.ext %in% c("A", "B", "C", "D", "R") | !info %in% c(0, 1) |
is.numeric(size.shape) == F | is.numeric(size.dot) == F | is.numeric(size.line) == F |
is.numeric(size.q) == F | is.numeric(size.word) == F)
stop("Incorrect data input.")
if (!inherits(items, "fa_items"))
stop("Cannot find the item(s).")
if (switch.from > 0 & switch.to > 0 & (length(which) != 1 | sum(which) == 0))
stop("Item to switch options from is not correctly designated.")
if ((switch.from > 0 | switch.to > 0) & (!switch.from %in% 1:8 | !switch.to %in% 1:8))
stop("Incorrect data input for argument 'switch.from' or 'switch.to'.")
# BASIC CODE FOR FEATURES
# Rotation function:
rot <- function(x, angle=0) {
cbind(cos(angle*0.0174532925)*x[,1] - sin(angle*0.0174532925)*x[,2],
sin(angle*0.0174532925)*x[,1] + cos(angle*0.0174532925)*x[,2])
}
# Reflection function:
mir <- function(x) {
cbind(-1*x[,1], x[,2])
}
# Broken circle coordinates:
t <- seq(0, 2*pi, length=200)
bcirc <- cbind(3.5*sin(t[25:200]), 3.5*cos(t[25:200]))
# Number of isomorphs:
isomorphs <- length(items)
# a, b, c vector:
abc <- c("a", "b", "c")
# Items to plot are all or some?
all_or_some <- 0
if (sum(which %in% 0:isomorphs) == length(which) &
(sum(which > 0) == 0 | sum(which > 0) == length(which))) {
all_or_some <- if (sum(which == 0) == length(which))
"all" else if (sum(which > 0) == length(which))
"some"
} else stop("Incorrect data input for 'which'.")
# Creating a data frame with item characteristics:
information <- data.frame(NA, NA, NA, NA, NA, NA)
names(information) <- c("Isomorphs", "Correct", " ",
"General rules", " ", "Total")
information[,6] <- if (all_or_some == "all")
isomorphs else length(which)
information[,4] <- as.character()
rulenames <- 0
for (i in 1:length(items[[1]][[12]][[2]])) {
rulenames[i] <- switch(items[[1]][[12]][[2]][i],
"1" = "Main shape rotation",
"2" = "Reflection",
"3" = "Trapezium rotation",
"4" = "Subtraction",
"5" = "Dot edge movement")
}
for (i in 1:length(rulenames)) {
information[i,4] <- rulenames[i]
}
correct_ones <- 0
correct_ones <- as.data.frame(correct_ones, ncol=2)
for (i in 1:isomorphs) {
correct_ones[i,1] <- i
correct_ones[i,2] <- paste(items[[i]][[12]][1])
}
if (all_or_some == "some") {
correct_ones <- correct_ones[which,]
}
for (i in 1:length(correct_ones[,1])) {
information[i,1:2] <- ""
information[i,1] <- correct_ones[i,1]
information[i,2] <- correct_ones[i,2]
}
for (i in 1:length(information[,1])) {
information[i,3] <- ""
information[i,5] <- ""
}
if (length(rulenames) < length(information[,1]))
for (i in (length(rulenames) + 1):length(information[,1])) {
information[i,4] <- ""
}
if (length(rulenames) > length(correct_ones[,1]))
for (i in (length(correct_ones[,1]) + 1):length(rulenames)) {
information[i,1] <- ""
information[i,2] <- ""
}
if (length(rulenames) != 1 | length(correct_ones[,1]) != 1)
for (i in 2:length(information[,1])) {
information[i,6] <- ""
}
# PLOTTING FUNCTION
# Function to plot figures (it will be assigned to a list):
plot.figure <- function(x) {
# Identify reflection:
bcirc_mir_or_not <- if (x$mirror == 0) bcirc else mir(bcirc)
boot_mir_or_not <- if (x$mirror == 0) boot else mir(boot)
# Once reflection is identified, apply rotation:
rot_bcirc <- rot(bcirc_mir_or_not, angle=x$rotation)
rot_boot <- rot(boot_mir_or_not, angle=x$rotation)
rot_hammer <- rot(hammer, angle=x$hampos)
# How much to add when plotting in a different way?
increment <- c(0, 0, 0)
# Plot parameters:
if(directory != F & mode == "C") increment[1] <- 0.5
if(directory == F & mode == "C") increment[1] <- 0.5
limits <- 6-size.shape-increment[1]
par(mai = c(0, 0, 0, 0), pty="s")
plot(xlim=c(-(limits), limits), ylim=c(-(limits), limits),
0, type="l", bty="n", xaxt="n", yaxt="n", xlab="", ylab="")
# Drawing the plot:
if(directory != F) {
increment[2] <- 10
increment[3] <- 23
}
if(directory != F & mode == "C") {
increment[2] <- 13
increment[3] <- 17
}
if(directory == F & mode == "C") {
increment[2] <- 5.5
increment[3] <- 4.5
}
lines(rot_bcirc, lwd=size.line + increment[2])
for (i in 1:5) {
if (x$bootlines[i] == 1) lines(rot_boot[i:(i + 1),], lwd=size.line + increment[2])
}
point <- cbind(rot_boot[x$dotpos,][1], rot_boot[x$dotpos,][2])
points(point, pch=16, cex=size.dot + increment[3])
lines(rot_hammer, lwd=size.line + increment[2])}
# Setting the number of items to plot:
items_to_plot <- 0
if (all_or_some == "all")
items_to_plot <- 1:isomorphs else
items_to_plot <- which
# Setting the directory (if any) to save the items and change language:
if(directory != F) {
setwd(directory)
language <- if(language.dir == "A") 1:3 else
if(language.dir == "E") 1 else
if(language.dir == "D") 2 else
if(language.dir == "S") 3
} else
language <- if(language == "E") 1 else
if(language == "D") 2 else
if(language == "S") 3
langname <- 0
for(i in 1:length(language)) {
langname[i] <- if(language[i] == 1) "E" else
if(language[i] == 2) "D" else
if(language[i] == 3) "S"
}
langname <- as.vector(langname)
# Properties of every item to be plotted:
for (m in items_to_plot){
# Change places of options when choosing a single item:
if (length(which) == 1 & which[1] > 0 & switch.from %in% 1:8 &
switch.to %in% 1:8 & directory == F) {
if (switch.from == items[[which[1]]][[12]][[1]] |
switch.to == items[[which[1]]][[12]][[1]]) {
if (information[1,2] == switch.from) {
items[[which[1]]][[12]][[1]] <- switch.to
information[1,2] <- switch.to
} else {
items[[which[1]]][[12]][[1]] <- switch.from
information[1,2] <- switch.from
}
warning(paste("Correct answer of item ", which, " changed to position ", information[1,2], ".", sep=""))
}
items_to_change <- 0
items_to_change <- as.list(items_to_change)
items_to_change[[1]] <- items[[which[1]]][[switch.from]]
items_to_change[[2]] <- items[[which[1]]][[switch.to]]
items[[which[1]]][[switch.to]] <- items_to_change[[1]]
items[[which[1]]][[switch.from]] <- items_to_change[[2]]
}
for (h in 1:length(language)){
if(directory != F & mode != "C")
png(paste("item", m, langname[h], ".png", sep=""),
width = switch(mode,A=4800,B=6000),
height = switch(mode, A=3600, B=1500))
switch (mode,
A = {layout(matrix(c(0, 0, 0, 0, 1, 1, 2, 2, 0, 0, 0, 0,
0, 0, 0, 0, 3, 3, 4, 4, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 0,
0, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 0),
5, 12, byrow=TRUE), heights=c(1.5, 1.5, 1, 1.5, 1.5))},
B = {layout(matrix(c(1, 2, 0, 5, 6, 7, 8, 9,
3, 4, 0, 10, 11, 12, 13, 14),
2, 8, byrow=TRUE), widths=c(1.5, 1.5, 1, 1.5, 1.5, 1.5, 1.5, 1.5))},
C = layout(matrix(1)))
par(mar = rep(1, 4)) # Shrink margins.
# Correct plotting when plotting each figure separately:
if (directory != F) {
if (mode == "C") {
plot.fa.size.q <- size.q + 30
plot.fa.size.word <- size.word + 12
} else {
plot.fa.size.q <- size.q + 41
plot.fa.size.word <- size.word + 16
}
} else
if (mode == "C") {
plot.fa.size.q <- size.q + 7
plot.fa.size.word <- size.word + 2.5
} else {
plot.fa.size.q <- size.q
plot.fa.size.word <- size.word
}
# Width of every single frame when mode is C:
width.single <- 800
# Internal boot coordinates subject to change:
coord.x <- 3.5*sin(t[25])
coord.y <- 3.5*cos(t[25])
randomboot <- list(
A = matrix(byrow=T, ncol=2, c(0, 3.5, 0, .875, -2, -1.125, coord.x - 1.425,
-1.125, coord.x, .3, coord.x, coord.y)),
B = matrix(byrow=T, ncol=2, c(0, 3.5, 0, .5, -2.2, .5, .5, -2.2, coord.x,
-2.2 + (coord.x - .5), coord.x, coord.y)),
C = matrix(byrow=T, ncol=2, c(0, 3.5, -2, 1.5, -2, -1.125, coord.x - 1.425,
-1.125, coord.x - 1.425, coord.y - 1.425, coord.x, coord.y)),
D = matrix(byrow=T, ncol=2, c(0, 3.5, -2, 1.5, -2, -1.125, .5, 1.375,
coord.x, 1.375 - (coord.x - .5), coord.x, coord.y)))
boot <- if (form.int == "R") randomboot[[sample(1:4, 1)]] else
switch(form.int,
"A" = randomboot[[1]],
"B" = randomboot[[2]],
"C" = randomboot[[3]],
"D" = randomboot[[4]])
# External trapezium (aka: hammer) coordinates subject to change:
randomhammer <- list(
A= cbind(c(1, -1, 0, 1, 1), c(3.5, 3.5, 4.5, 4.5, 3.5)),
B= cbind(c(1, -1, -1, 0, 1), c(3.5, 3.5, 4.5, 4.5, 3.5)),
C= cbind(c(0, -1, -1, 1, 0), c(3.5, 3.5, 4.5, 4.5, 3.5)),
D= cbind(c(1, 0, -1, 1, 1), c(3.5, 3.5, 4.5, 4.5, 3.5)))
hammer <- if (form.ext == "R")
randomhammer[[sample(1:4, 1)]] else
switch(form.ext,
"A" = randomhammer[[1]],
"B" = randomhammer[[2]],
"C" = randomhammer[[3]],
"D" = randomhammer[[4]])
# Plot A, B & C:
for (i in 1:3) {
if(directory != F & mode == "C")
png(paste("item", m, abc[i], ".png", sep=""),
width = width.single, height = width.single)
plot.figure(items[[m]][[i + 8]])
if(directory != F & mode == "C") dev.off()
}
# Plot question mark:
if(directory != F & mode == "C")
png(paste("item", m, "d(q).png", sep=""),
width = width.single, height=width.single)
par(mai = c(0, 0, 0, 0), pty="s")
plot(xlim=c(-5, 5), ylim=c(-5, 5), 0, type="l",
bty="n", xaxt="n", yaxt="n", xlab="", ylab="")
text(0, 0, "?", cex=plot.fa.size.q)
if(directory != F & mode == "C") dev.off()
# Plot options:
for (i in 1:8){
if(directory != F & mode == "C")
png(paste("item", m, "op", i, ".png", sep=""), width = width.single, height=width.single)
plot.figure(items[[m]][[i]])
if(directory != F & mode == "C") dev.off()
}
# Plot 9th and 10th options:
op9 <- if(langname[h] == "D") "Keine\nAntwort\nist richtig" else
if(langname[h] == "E") "No\nanswer\nis correct" else
if(langname[h] == "S") "Ninguna\nrespuesta\nes correcta"
if(directory != F & mode == "C")
png(paste("item", m, "op9", langname[h], ".png", sep=""), width = width.single,height=width.single)
par(mai = c(0,0,0,0), pty = "s")
plot(xlim = c(-5, 5), ylim = c(-5, 5),
0, type = "l", bty = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "")
text(0, 0, op9, cex=plot.fa.size.word)
if(directory != F & mode == "C") dev.off()
op10 <- if(langname[h] == "D") "Ich wei\u00DF\nnicht" else
if(langname[h] == "E") "I don\u0027t\nknow" else
if(langname[h] == "S") "No s\u00E9"
if(directory != F & mode == "C")
png(paste("item", m, "op10", langname[h], ".png", sep=""), width = width.single, height=width.single)
par(mai = c(0, 0, 0, 0), pty = "s")
plot(xlim = c(-5, 5), ylim = c(-5, 5),
0, type = "l", bty = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "")
text(0, 0, op10, cex = plot.fa.size.word)
if(directory != F & mode == "C") dev.off()
if(directory != F & mode != "C") dev.off()
}}
# Information about the items to be plotted:
if (directory != F & info == T)
write.table(information, "Info.csv", quote = F, sep = sep, row.names = F)
if (length(which) == 1 & which[1] > 0 &
switch.from %in% 1:8 & switch.to %in% 1:8 & directory == F)
return(items) else
if (info == T) return(information)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.