diff --git a/DESCRIPTION b/DESCRIPTION index 69ea063..0f4c95f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,37 +1,45 @@ Package: gmoTree Title: Get and Modify 'oTree' Data -Version: 1.2.0 -Date: 2024-09-30 +Version: 1.3.0 +Date: 2024-12-06 Authors@R: - person(given = "Patricia F.", family = "Zauchner", - role = c("aut", "trl", "cre", "cph"), - email = "patricia.zauchner@gmx.at", - comment = c("https://orcid.org/0000-0002-5938-1683", "University of Bremen")) + person("Patricia F.", "Zauchner", , "patricia.zauchner@gmx.at", role = c("aut", "trl", "cre", "cph"), + comment = c(ORCID = "https://orcid.org/0000-0002-5938-1683", "University of Bremen")) Description: Efficiently manage and process data from 'oTree' experiments. - Import 'oTree' data and clean them by using - functions that handle messy data, dropouts, and other problematic cases. - Create IDs, calculate the time, transfer - variables between app data frames, and delete sensitive information. - Review your experimental data prior to running - the experiment and automatically generate a detailed summary - of the variables used in your 'oTree' code. - Information on 'oTree' is found in Chen, D. L., Schonger, M., & - Wickens, C. (2016) . + Import 'oTree' data and clean them by using functions that handle + messy data, dropouts, and other problematic cases. Create IDs, + calculate the time, transfer variables between app data frames, and + delete sensitive information. Review your experimental data prior to + running the experiment and automatically generate a detailed summary + of the variables used in your 'oTree' code. Information on 'oTree' is + found in Chen, D. L., Schonger, M., & Wickens, C. (2016) + . License: GPL (>= 3) URL: https://zauchnerp.github.io/gmoTree/, - https://github.com/ZauchnerP/gmoTree/, - https://github.com/ZauchnerP/gmoTree + https://github.com/ZauchnerP/gmoTree/, + https://github.com/ZauchnerP/gmoTree BugReports: https://github.com/ZauchnerP/gmoTree/issues -Depends: R (>= 4.4.0) -Imports: data.table (>= 1.15.4), dplyr (>= 1.1.4), knitr (>= 1.47), - openxlsx (>= 4.2.5.2), pander (>= 0.6.5), plyr (>= 1.8.9), - rlang (>= 1.1.4), rlist (>= 0.4.6.2), rmarkdown (>= 2.27), - stringr (>= 1.5.1) -Suggests: testthat (>= 3.2.1), withr (>= 3.0.0) -VignetteBuilder: knitr +Depends: + R (>= 4.4.0) +Imports: + data.table (>= 1.15.4), + dplyr (>= 1.1.4), + knitr (>= 1.47), + openxlsx (>= 4.2.5.2), + pander (>= 0.6.5), + plyr (>= 1.8.9), + rlang (>= 1.1.4), + rlist (>= 0.4.6.2), + rmarkdown (>= 2.27), + stringr (>= 1.5.1) +Suggests: + testthat (>= 3.2.1), + withr (>= 3.0.0) +VignetteBuilder: + knitr BuildVignettes: true Config/testthat/edition: 3 Encoding: UTF-8 LazyData: true -RoxygenNote: 7.3.2 NeedsCompilation: no +RoxygenNote: 7.3.2 diff --git a/NEWS.md b/NEWS.md index 58810d1..ad2efd8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,35 @@ -**Changes in CITATION file and NEWS file are not documented.** +**Changes in CITATION file, NEWS file are not documented.** -# gmoTree 1.2.0 +# gmoTree 1.3.0 + +* Changes in ```codebook()``` + * Bug fixes + * Resolved an issue with ```Constants``` vector presentations in the output files + * Fixed incorrect handling of equal signs (```=```) in documentation + and choices. + * New arguments + * ```splitvarname``` to deal with long variable names. Caveat: In some cases, columns may still overlap. Control your output carefully. + * ```sep_list``` to decide on list presentation or newline presentation in the output file + * ```initial``` to include the initial values in the codebook + * Enhancements + * New preamble text + * ```output_format``` + * Expanded the input possibilities for greater flexibility + * Changed default of ```output_format``` to ```pdf_document_simple``` + * Improved handling of quotations + * Better presentations of quotations inside strings + * Quotation marks are now presented as straight and not smart form + * Removed non-escaped quotation marks from the output + * Improved list handling + * Values are now saved in list format and not as vectors + * Types of variables now correspond better to the types of the original variables + * Improved list presentation in output files for better readability + * Enhanced error and warning messages + * The function can now better deal better with empty arguments in the oTree code +* Linted older functions (more readable) +* Website changes + +# gmoTree 1.2.1 * New function * ```codebook()```: Create a codebook for the oTree code diff --git a/R/apptime.R b/R/apptime.R index d900bf4..032f991 100644 --- a/R/apptime.R +++ b/R/apptime.R @@ -90,7 +90,7 @@ apptime <- function(oTree, } else { # If apps are defined, check if they are there if (length(apps[apps %in% names(oTree)]) != length(apps)) { - if (length(apps[apps %in% names(oTree)]) > 0) { + if (length(apps[apps %in% names(oTree)]) > 0L) { warning( "The following app(s) is/are not in ", "the list of oTree data frames: ", @@ -110,7 +110,7 @@ apptime <- function(oTree, } # Seconds or minutes #### - if (seconds == TRUE) { + if (seconds) { divsec <- 1L } else { divsec <- 60L # Divide seconds by 60 to get minutes @@ -121,7 +121,7 @@ apptime <- function(oTree, stop("There is no \"Time\" data frame.") } - if (nrow(oTree$Time) == 0) { + if (nrow(oTree$Time) == 0L) { stop("Your \"Time\" data frame is empty.") } @@ -492,7 +492,7 @@ apptime <- function(oTree, duration <- duration / divsec - if (duration == 0) { + if (duration == 0L) { duration <- NA } @@ -620,7 +620,7 @@ apptime <- function(oTree, if (nrow(singledurations) == 0L) { if (!is.null(duplicate_participants) && - length(duplicate_participants) > 1) { + length(duplicate_participants) > 1L) { # Duplicate data @@ -726,7 +726,7 @@ apptime <- function(oTree, output[["messages"]] <- unique(message_vector) output[["first_app_one_page"]] <- firststageproblemparticipants - if (length(warningparticipants > 0L)) { + if (length(warningparticipants) > 0L) { output[["warnings"]] <- unique(warningparticipants) } @@ -858,7 +858,7 @@ apptime <- function(oTree, # Time for app for all participants #### output <- all_time() - if (length(output) == 1 && + if (length(output) == 1L && grepl("Durations not calculated", output)) { next } @@ -866,11 +866,10 @@ apptime <- function(oTree, } - if (!is.null(pcode)) { - if (length(onepersonnoapp) > 0) { + if (!is.null(pcode) && length(onepersonnoapp) > 0L) { warning("Duration could not be calculated for the person in app(s): ", paste(onepersonnoapp, collapse = ", "), ".") - } + } diff --git a/R/assignv_to_aaw.R b/R/assignv_to_aaw.R index e3a351e..f5b9475 100644 --- a/R/assignv_to_aaw.R +++ b/R/assignv_to_aaw.R @@ -115,9 +115,9 @@ assignv_to_aaw <- function(oTree, # Make indices indices <- c( - 1:which(names(oTree$all_apps_wide) == resafter), + 1L:which(names(oTree$all_apps_wide) == resafter), ncol(oTree$all_apps_wide), # Put the new variable here - (which(names(oTree$all_apps_wide) == resafter) + 1): + (which(names(oTree$all_apps_wide) == resafter) + 1L): (ncol(oTree$all_apps_wide) - 1L) ) diff --git a/R/codebook.R b/R/codebook.R index 8b239f3..0818e47 100644 --- a/R/codebook.R +++ b/R/codebook.R @@ -13,7 +13,7 @@ #' #' Caution 2: If there are commas in the value strings, they might be #' used to split the text. Please manually insert a backslash symbol -#' in front of the commas to avoid that. +#' in front of the commas to avoid that (i.e., escape them). #' E.g. \code{"Yes, I will"} -> \code{"Yes\, I will"}. #' #' Caution 3: This code cannot interpret variables that were imported from other @@ -27,6 +27,11 @@ #' If you experience issues with newer versions or more complex code structures, #' please open an issue on GitHub. #' +#' Caution 5: Custom exports are not part of the codebook. +#' +#' Further info: \code{None} values are presented as "None" (i.e. as a string) +#' in the list and in the codebook. +#' #' @param path Character. Path of the oTree experiment. #' @param fsource Character. \code{"init"} if information should be taken #' from the \code{init.py} files (newer oTree code with 5.x @@ -42,25 +47,36 @@ #' the function's output will be saved. #' Only absolute paths are allowed for this parameter. #' Relative paths can be specified in the \code{output_file} parameter. -#' @param output_file Character. The name of the output file generated by the function. +#' @param output_file Character. +#' The name of the output file generated by the function. #' The file name can be provided with or without an extension. #' Relative paths are also allowed in the file name. -#' @param output_format Character. Format of the file output. -#' This is the format that is passed to the \code{output_format} +#' @param output_format Character. Specifies the format of the file output. +#' This value is passed to the \code{output_format} #' argument of \link[rmarkdown:render]{rmarkdown::render}. -#' You must use either \code{"pdf_document"}, \code{"html_document"}, \code{"word_document"}, \code{"odt_document"}, \code{"rtf_document"}, \code{"md_document"}, or \code{"latex_document"}. -#' @param output_open Logical. \code{TRUE} if file output should be opened after creation. -#' @param app_doc Logical. \code{TRUE} if app documentation should be included in -#' output file. +#' Allowed options are: \code{"html_document"}, \code{"word_document"}, \code{ +#' "odt_document"}, \code{"rtf_document"}, \code{"md_document"}, \code{ +#' "latex_document"}, \code{"pdf_document"}, \code{"pdf_document_simple"}, +#' or their short forms \code{"html"}, \code{"word"}, \code{"odt"}, \code{ +#' "rtf"}, \code{"md"}, \code{"latex"}, \code{"pdf"}, \code{"pdf_simple"}. +#' Important: The \code{"pdf_document"} format uses \code{xelatex} for +#' PDF generation. +#' If your document does not require advanced LaTeX features, +#' it is recommended to use \code{"pdf_document_simple"}. +#' @param output_open Logical. \code{TRUE} if file output should +#' be opened after creation. +#' @param app_doc Logical. \code{TRUE} if app documentation should be +#' included in the output file. #' @param app Character. Name of the included app(s). #' Default is to use all apps. -#' This argument can not be used simultaneously as the argument \code{app_rm}. +#' Cannot be used simultaneously with \code{app_rm}. #' @param app_rm Character. Name of the excluded app(s). #' Default is to exclude no apps. -#' This argument can not be used simultaneously as the argument app. +#' Cannot be used simultaneously with \code{app}. #' @param doc_info Logical. \code{TRUE} if a message with information on all -#' variables without documentation should also be returned. -#' @param sort Character. Vector that specifies the order of +#' variables without documentation should also be returned. \code{FALSE} if +#' this message should be suppressed. +#' @param sort Character vector. Vector that specifies the order of #' the apps in the codebook. #' @param settings_replace Character or \code{NULL}. #' Specifies how to handle references to settings variables. @@ -69,10 +85,11 @@ #' Use \code{"user"} to replace references with the variables #' provided in the \code{user_settings} argument. #' Use \code{NULL} to leave references to settings variables unchanged. -#' Caution: This function does not use variables defined in \code{SESSION_CONFIGS}. +#' Caution: This function does not use variables defined +#' in \code{SESSION_CONFIGS}. #' If you vary settings variables in \code{SESSION_CONFIGS}, -#' set \code{settings_replace} to \code{"user"} and manually replace them using the -#' \code{user_settings} argument. +#' set \code{settings_replace} to \code{"user"} and manually replace +#' them using the \code{user_}\code{settings} argument. #' @param user_settings List. List of variables in the \code{settings.py} file #' that are used to replace setting variable references. #' This is only used if \code{settings_replace = "user"} and should be used when @@ -80,20 +97,30 @@ #' @param preamb Logical. #' \code{TRUE} if a preamble should be printed that explains #' how oTree saves variables. +#' @param encoding Character. Encoding of the created Markdown file. +#' As in \link[knitr:knit]{knitr::knit}, this argument is +#' always assumed to be \code{UTF-8} +#' and ignored. +#' @param title Character. Title of output file. +#' @param subtitle Character. Subtitle of output file. #' @param include_cons Logical. #' \code{TRUE} if there should be a section for the constants in the codebook. #' @param params List. #' List of variable name and value pairs to be passed to the RmD file. #' Only relevant if argument output \code{"file"} or \code{"both"} if chosen. -#' @param date Date that is passed to the Rmd file. +#' @param date Character or \code{NULL}. Date that is passed to the Rmd file. #' Either \code{"today"}, \code{NULL}, or a user defined date. #' Only relevant if argument output \code{"file"} or \code{"both"} if chosen. -#' @param encoding Character. Encoding of the created Markdown file. -#' As in \link[knitr:knit]{knitr::knit}, this argument is -#' always assumed to be \code{UTF-8} -#' and ignored. -#' @param title Character. Title of output file. -#' @param subtitle Character. Subtitle of output file. +#' @param splitvarname Logical. \code{TRUE} if long variable names should be +#' split across multiple lines in the output file tables. +#' If \code{FALSE}, table columns should adjust to fit the longest +#' variable names. +#' @param sep_list Character. Determines how sub-lists are displayed +#' in the file output. Use \code{"newline"} to separate sub-lists with +#' newline characters (`\\n`), or \code{"vector"} to display them as +#' strings in `c(...)` format. +#' @param initial Logical. \code{TRUE} if initial values should be included +#' in the output file. \code{FALSE} if they should not be included. #' @import knitr #' @import pander #' @import rmarkdown @@ -130,7 +157,7 @@ #' app = "bargaining", #' doc_info = FALSE) #' -#' # Show the structure of the codebook +#' # Show the structure of the codebook #' str(combined_codebook, 1) #' str(combined_codebook$bargaining$Player, 1) #' @@ -142,7 +169,7 @@ #' app_rm = "bargaining", #' doc_info = FALSE) #' -#' # Show the structure of the codebook +#' # Show the structure of the codebook #' str(combined_codebook, 1) #' str(combined_codebook$bargaining$Player, 1) #' @@ -151,11 +178,19 @@ #' path = system.file("extdata/ocode_z", package = "gmoTree"), #' fsource = "model", #' output = "list", -#' doc_info = TRUE) +#' doc_info = FALSE) #' #' # Show the structure of the codebook #' str(combined_codebook, 1) #' +#' # Show information on missing documentation or complex code +#' combined_codebook <- codebook( +#' path = system.file("extdata/ocode_new", package = "gmoTree"), +#' fsource = "init", +#' output = "list", +#' app_rm = "bargaining", +#' doc_info = TRUE) +#' #' \dontrun{ #' #' # Create a codebook PDF with authors' names and todays' date @@ -196,9 +231,9 @@ codebook <- function(path = ".", fsource = "init", output = "both", - output_dir = getwd(), + output_dir = NULL, output_file = "codebook", - output_format = "pdf_document", + output_format = "pdf_document_simple", output_open = TRUE, app_doc = TRUE, app = NULL, @@ -213,12 +248,13 @@ codebook <- function(path = ".", title = "Codebook", subtitle = "created with gmoTree", params = NULL, - date = "today") { + date = "today", + splitvarname = FALSE, + sep_list = "newline", + initial = TRUE) { - output_dir_input <- substitute(output_dir) - - # Stop part 1 - # Path and fsource #### + # Stop and load + # Source original code #### # Define path if (!is.null(path)) { # Change Windows paths to paths that can be read by Ubuntu @@ -246,85 +282,158 @@ codebook <- function(path = ".", stop("fsource must be either \"init\", \"model\", or \"models\"!") } - # Others #### - # Check output format - if (!is.character(output) || - length(output) != 1L || - !(output %in% c("list", "both", "file"))) { - stop("Output should be \"list\", \"both\", or \"file\"!") - } + if (fsource == "model" || fsource == "models") { + + files <- list.files(path, + pattern = "models\\.py", + full.names = TRUE, + recursive = TRUE) - # Check pandoc - if (output != "list") { - pandoc.installed <- system('pandoc -v', ignore.stdout = TRUE, ignore.stderr = TRUE) == 0 + } else if (fsource == "init") { + files <- list.files(path, + pattern = "__init__\\.py", + full.names = TRUE, + recursive = TRUE) + + # Exclude files from the _builtin folders + files <- files[grepl("(? 1L || - !(output_format %in% allowed_formats)) { - stop("Output format should be one of the following: ", - paste0(allowed_formats, collapse = ", "), "!") - } - - # Create variables, and environment #### - - - # Create a new environment - env <- new.env() - - # Settings.py file - env$settingspy <- TRUE - env$settingslist <- c() + # Create a new environment and initialize + env <- new.env(parent = emptyenv()) + env$settingspy <- TRUE # Is there a settings.py file? + env$settingslist <- character() # Settings vars that cannot be replaced + env$usettingslist <- character() # User sett. vars that cannot be replaced + env$equalvariables <- character() # Vars with unescaped equal signs? # Create vector of variables without documentation env$nodocs <- character() @@ -382,36 +479,13 @@ codebook <- function(path = ".", # Background functions #### - # Paths and directories #### - - # Define and create output dir - if (!is.null(output_dir)) { - - # If dir is a relative path - if (grepl("^\\.", x = output_dir)) { - stop("Please don't use relative paths in output_dir!") - } - - # If dir is not there - if (!dir.exists(output_dir)) { - - stop("The directory ", - output_dir, - " does not exist yet. ", - "Please create it manually before running this function.") - } - - # Change Windows paths to paths that can be read by Ubuntu - output_dir <- gsub("\\\\", "/", output_dir) - } - # Stop if #### # Settings_replace if (length(user_settings) > 0L && settings_replace != "user") { - stop("settings_replace must be set to \"user\"", - "if user_settings are not empty!") + stop("settings_replace must be set to \"user\" ", + "if \"user_settings\" are not empty!") } # Check if only app or app_rm is specified @@ -421,53 +495,74 @@ codebook <- function(path = ".", # Helping functions #### process_lists <- function(variablevalue, - type = "s", - folder_name = folder_name, - env = env) { + folder_name, + current_class, + variable, + env) { + skip <- FALSE + returnlist <- list() + + # One level list (vector, sublist) #### + if (!grepl("^\\[\\s*\\[\\s*\\[", variablevalue) && + !grepl("^\\[\\s*\\[", variablevalue) && + startsWith(variablevalue, "[" + )) { + + skip <- TRUE + + # make [..] to list(...) #### + variablevalue <- gsub(pattern = "\\[", + replacement = "\\list(", + x = variablevalue) + + variablevalue <- gsub(pattern = "\\]", + replacement = "\\)", + x = variablevalue) + + # Transform string of vector to normal vector #### + variablevalue <- evaluatestring(variablevalue) - # Empty list - if (variablevalue == "[]") { - return(variablevalue) + returnlist <- variablevalue } - # Three level list - if (stringr::str_detect(string = unlist(variablevalue), - pattern = "^\\[{3,}")) { + # Three level list, sublists #### + if (!skip && + stringr::str_detect(string = unlist(variablevalue), + pattern = "^\\[\\s*\\[\\s*\\[")) { - # Not sure if ever needed - stop("This function does not support lists with more than two levels.") + stop("This function does not support lists with more than two levels.", + " Found in: $", folder_name, "$", current_class, + "$", variable, ".") } - # Two level lists vs. one level = vector - if (startsWith(variablevalue, - "[[")) { + # Two level lists #### + if (!skip && + grepl("^\\[\\s*\\[", variablevalue)) { # Replace first and last square brackets variablevalue <- sub(x = variablevalue, - pattern = "^\\[", + pattern = "^ *\\[", replacement = "") - variablevalue <- sub(x = variablevalue, - pattern = "\\][^]]*$", + pattern = "\\][^]] *$", replacement = "") # Extract each [ ... ] block if (stringr::str_detect(variablevalue, "\\[")) { - variablevalue <- unlist(stringr::str_match_all(variablevalue, - pattern = "\\[.*?\\]")) + variablevalue <- unlist( + stringr::str_match_all(variablevalue, + pattern = "\\s*\\[.*?\\]\\s*")) } - # Replace first and last square brackets + # Replace first and last square brackets from these blocks variablevalue <- sub(x = variablevalue, - pattern = "^\\[", + pattern = "^\\s*\\[ *", replacement = "") variablevalue <- sub(x = variablevalue, - pattern = "\\][^]]*$", + pattern = "\\s*\\][^]]*$", replacement = "") - returnlist <- list() - for (variablevalue_i in seq_along(variablevalue)) { elem <- variablevalue[variablevalue_i] @@ -475,35 +570,24 @@ codebook <- function(path = ".", # Split the element into key and value parts <- stringr::str_split(elem, ",")[1L] - # Clean and assign key and value - parts <- clean_string(parts, - quotes = TRUE, - folder_name = folder_name) + # Parts must be in list format afterwards because of mixed types + parts <- as.list(parts[[1L]]) + parts <- lapply(X = parts, + clean_string, + equal = FALSE, # Important!! + quotes = TRUE, + current_class = current_class, + folder_name = + paste(folder_name, + errorinfo = "called by parts"), + variable = variable) + + parts <- lapply(parts, + evaluatestring) returnlist[[variablevalue_i]] <- parts } - } else if (startsWith(variablevalue, "[")) { - - # make [..] to c(...) #### - variablevalue <- gsub(pattern = "\\[", - replacement = "\\c(", - x = variablevalue) - - variablevalue <- gsub(pattern = "\\]", - replacement = "\\)", - x = variablevalue) - - # Transform string of vector to normal vector #### - - try({ - tmp <- eval(parse(text = variablevalue)) - if (!is.function(tmp)) { - variablevalue <- tmp - } - }, silent = TRUE) - - returnlist <- variablevalue } if (length(returnlist) == 1L) { @@ -522,7 +606,7 @@ codebook <- function(path = ".", env = env) { # This is called by process_settings and process_files - # Get variable names #### + # Get variable names # Only those that are on the same indent are measured! pattern <- paste0("^\\s{", normalspace, @@ -544,21 +628,21 @@ codebook <- function(path = ".", # Check if "with" occurs if (grepl(x = matches, pattern = "\\nwith")) { env$complexcons <- - c(env$complexcons, paste0("> App", folder_name, "(", - current_class, ") (with)\n")) + c(env$complexcons, paste0("> $", folder_name, "$", + current_class, " (with)\n")) } # Check if "read_csv" occurs if (grepl(x = matches, pattern = "read_csv")) { env$complexcons <- - c(env$complexcons, paste0("> App ", folder_name, "(", - current_class, ") (read_csv)\n")) + c(env$complexcons, paste0("> $", folder_name, "$", + current_class, " (read_csv)\n")) } # Get everything until the second variable is mentioned and modify for (cons_sett_i in seq_along(all_cons_sett_vars)) { - if (all_cons_sett_vars[cons_sett_i] != "with" && # Unnecessary, there is no = sign + if (all_cons_sett_vars[cons_sett_i] != "with" && # TODO? Unnecessary, there is no = sign all_cons_sett_vars[cons_sett_i] != "from") { # Make pattern @@ -588,26 +672,24 @@ codebook <- function(path = ".", text = matches, perl = TRUE))) - varval <- clean_string(varval, - equal = TRUE, - n = TRUE, - quotes = FALSE, - space = TRUE, - brackets = FALSE, - sbrackets = FALSE, - folder_name = folder_name) + varval <- clean_string(string = varval, + folder_name = folder_name, + equal = TRUE, + n = TRUE, + quotes = TRUE, + space = TRUE, + brackets = FALSE, + sbrackets = FALSE, + current_class = current_class, + variable = variable) # Deal with lists #### if (startsWith(varval, "[")) { - - varval <- process_lists(varval) - - # Stop if list contains another list - if (any(vapply(varval, is.list, - FUN.VALUE = logical(1L)))) { - # Not sure if ever needed - stop("This function does not support overly complex lists.") - } + varval <- process_lists(varval, + folder_name, + current_class, + all_cons_sett_vars[cons_sett_i], + env) } # Replace variable references within Constants/settings #### @@ -634,15 +716,34 @@ codebook <- function(path = ".", perl = TRUE) } else { + # Make all to characters + replacementlist <- lapply( + filevars[[current_class]][[ + all_cons_sett_vars[j]]], + as.character) + + # Make lists + for (i in seq_along(replacementlist)) { + replacementlist[i] <- + paste0("list(", + paste(replacementlist[[i]], + collapse = ", "), + ")" + ) + } + + listvec <- "c(" # This should never happen + if (is.list(replacementlist)) { + listvec <- "list(" + } varval <- gsub(x = varval, pattern = paste0("(? $", folder_name, "$", + current_class, "$", variable, + " (unmatched brackets)\n")) } # Square brackets @@ -716,10 +806,11 @@ codebook <- function(path = ".", } else if (opensq == 1L && closesq == 0L) { string <- gsub(x = string, pattern = "\\[", replacement = "") } else if (opensq != closesq) { + # e.g. if there are more than one opening bracket env$complexcons <- - c(env$complexcons, paste0("> App", folder_name, "(", - current_class, - ") (unmatched square brackets)\n")) + c(env$complexcons, paste0("> $", folder_name, "$", + current_class, "$", variable, + " (unmatched square brackets)\n")) } # Don't remove square brackets if they are first and last yet! @@ -728,6 +819,8 @@ codebook <- function(path = ".", # Clean string clean_string <- function(string, + folder_name, # For error info + current_class, equal = TRUE, n = TRUE, space = TRUE, @@ -735,80 +828,184 @@ codebook <- function(path = ".", brackets = TRUE, sbrackets = TRUE, lastcomma = TRUE, - current_class = current_class, - folder_name = folder_name) { + variable) { - # Save real quotes first - string <- gsub(pattern = "\\\\\"", - replacement = "<>", - x = string) - - # Remove = signs + # Remove unescaped equal signs #### + # (those usually only happen at the start) if (equal) { - string <- gsub(pattern = "=", - replacement = "", - x = string) + # Remove equal + string <- stringr::str_replace_all(string, "(?>", + x = string, + perl = TRUE) + + string <- gsub(pattern = "\\\\\\'", # One more because of ' + replacement = "<>", + x = string, + perl = TRUE) + + # Remove line breaks #### if (n) { - string <- gsub(pattern = "\\n", + # Line breaks breaking strings + string <- gsub(pattern = paste0("\\\"", + "\\s*", + "\\n", # removes \n + "\\s*", + "\\\""), replacement = "", x = string) - } - # Remove quotes: " or \". - # Don't remove ' or \' because those are essential parts of text - # Will be done in the end - if (quotes) { - # Important! Must be done before any \ removals - string <- gsub(pattern = "\\\"|\"", + string <- gsub(pattern = paste0("\\\"", + "\\s*", + "\\\\\\n", # removes \\\n + "\\s*", + "\\\""), replacement = "", x = string) + + # Normal line breaks + string <- gsub(pattern = "\\n", + replacement = " ", + x = string) + } - # Trim white space + # Trim white space again #### if (space) { string <- trimws(string) } - # Remove last comma in a string + # Remove last comma in a string #### if (lastcomma) { string <- gsub(pattern = ",$", replacement = "", x = string) } - # Ensure that brackets are processed last - if (brackets && !is.na(string)) { - string <- replace_unmatched_parentheses(string, folder_name) - } + # Brackets (ensure that brackets are processed last!) #### + if (brackets) { # && !is.na(string) + string <- replace_unmatched_parentheses(string = string, + current_class = current_class, + folder_name = folder_name, + variable = variable, + env = env) - # Remove two single quotes only if they are at the beginning and end of the string - # Must be done at the end because they could also be used as apostrophes - if (quotes) { - - # Documentation - string <- gsub(pattern = "^'''(.*)'''$", - replacement = "\\1", # Keep the content in the middle - x = string, - perl = TRUE) - - # Normal quotes - string <- gsub(pattern = "^'(.*)'$", - replacement = "\\1", # Keep the content in the middle - x = string, - perl = TRUE) } - - # Get real quotes back - string <- gsub(pattern = "<>", + # Get real quotes back #### + string <- gsub(pattern = "<>", replacement = "\"", x = string) + string <- gsub(pattern = "<>", + replacement = "\'", + x = string) + + # Return #### + return(string) + } + + removefirstlastquote <- function(string) { + + if (is.character(string)) { + # Escaped + string <- sub("^\\\\\"(.*)\\\\\"$", "\\1", string) + + string <- sub("^\\\\\'(.*)\\\\\'$", "\\1", string) + + # Non-escaped + string <- sub("^\\\"(.*)\\\"$", "\\1", string) + string <- sub("^\\\'(.*)\\\'$", "\\1", string) + + string <- trimws(string) + + return(string) + + } else { + return(string) + + } + } + + evaluatestring <- function(string) { + # Converts a string representation of a vector/list + # into an actual vector/list and + # evaluates any arithmetic expressions within the string + + try({ + # Remove spaces after ( and before ) + string <- gsub("\\s*c\\(\\s*", "c\\(", string) + string <- gsub("\\s*\\)", "\\)", string) + # Len should be read as length + string <- gsub("^\\blen\\b\\(", "length\\(", string) + + # Create a custom environment where None is defined as "None" + custom_env <- new.env() + custom_env$None <- "None" + + # Evaluate the string in the custom environment + tmp <- eval(parse(text = string), envir = custom_env) + + if (!is.function(tmp)) { + string <- tmp + } + + }, silent = TRUE) + + if (!is.null(string)) { + return(string) + } + } + + removedocstrings <- function(string) { + + string <- gsub(pattern = "(?s)^'''(.*)'''$", + replacement = "\\1", # Keep the content in the middle + x = string, + perl = TRUE) + + string <- gsub(pattern = '(?s)^"""\\n*(.*)\\n*"""$', + replacement = "\\1", # Keep the content in the middle + x = string, + perl = TRUE) + + # Nonescaped double quotes + + string <- gsub(pattern = '(?s)^"""(.*)"""$', + replacement = "\\1", # Keep the content in the middle + x = string, + perl = TRUE) + + # Escaped double quotes + + string <- gsub(pattern = '(?s)^\\\"\\\"\\\"(.*)\\\"\\\"\\\"$', + replacement = "\\1", # Keep the content in the middle + x = string, + perl = TRUE) + return(string) + } + delprint <- function(string) { + if (is.character(string)) { + string <- + gsub( + x = string, + pattern = "print\\(.*\\)", + replacement = "") + string <- trimws(string) + } + return(string) } # Function to split each element at the last comma @@ -824,6 +1021,7 @@ codebook <- function(path = ".", return(c(stringr::str_trim(f_split_parts[1L]), stringr::str_trim(f_split_parts[2L]))) } else { + return(part) } } @@ -951,11 +1149,21 @@ codebook <- function(path = ".", if (!is.null(myreplacement)) { # First remove possible preceding + # (in Pyhon, a + adds strings together) - string <- sub(pattern = paste0("\\+\\s*", fullvarpattern), + + # Part before + string <- sub(pattern = paste0("['\"]?", + "\\s*", + "\\+", + "\\s*", fullvarpattern), replacement = fullvarpattern, x = string) - string <- sub(pattern = paste0(fullvarpattern, "\\s*", "\\+"), + # Part after + string <- sub(pattern = paste0(fullvarpattern, + "\\s*", + "\\+", + "\\s*", + "['\"]?"), replacement = fullvarpattern, x = string) @@ -968,29 +1176,51 @@ codebook <- function(path = ".", c(env$warnings, paste0("Variable ", fullvarpattern, " in folder ", folder_name, - " is not in Constants and cannot be replaced!", - " Check your code before continuing making the", - " codebook and running the experiment!")) + " is not in Constants and cannot be replaced:")) } } } } + return(string) } # Replace settings values references by actual values settings_replace_f <- function(mystring, - folder_name = NULL, # Folder name - combined_codebook = combined_codebook, - user_settings = user_settings, - settings_replace = settings_replace, + folder_name, # app + combined_codebook, + user_settings, + settings_replace, + env, e_variable = NULL, - e_key = NULL) { + e_key = NULL + ) { + + mystring <- mystring[[1L]] + + if (is.null(mystring) || + (length(mystring) == 1L && is.na(mystring))) { - pattern <- "settings\\.[_a-zA-Z0-9]+" + env$warnings <- + c(env$warnings, + "There is an unusual variable in your data! Variable: ", + e_variable, ".") - # First check for sub-lists - # Not necessary here because they are already sub-lists! + return(mystring) + + } else if (length(mystring) == 1L && mystring == "") { + + return(mystring) + } + + if (!is.character(mystring)) { + return(mystring) + } + + pattern <- "(? Folder \"", folder_name, - "\", variable: \"", e_variable, - "\", reference: \"settings.", settings_var, - "\".\n")) + paste0("> $", folder_name, + "$", e_variable, + ", reference \"settings.", settings_var, + "\"\n")) } else { myreplacement <- combined_codebook[["settings"]][[settings_var]] } + } else if (!is.null(settings_replace) && - settings_replace == "user"){ + settings_replace == "user") { if (!is.null(user_settings) && settings_var %in% names(user_settings)) { + myreplacement <- user_settings[[settings_var]] } else { - - stop("Variable \"", settings_var, "\" in app \"", folder_name, - "\" (and maybe others) is not in user_settings!") + env$usettingslist <- c(env$usettingslist, + paste0("> $", folder_name, + "$", e_variable, + ", reference \"settings.", + settings_var, + "\"\n")) } } # Replace variable within the whole string if (!is.null(myreplacement)) { - if (length(myreplacement) == 1L) { # Replace single value @@ -1057,61 +1291,45 @@ codebook <- function(path = ".", x = mystring) } else { - # If all numeric - - if (suppressWarnings(anyNA(as.integer(myreplacement)))) { - mystring <- - gsub(x = mystring, - pattern = fullvarpattern, - replacement = paste0("c(\"", - paste(myreplacement, - collapse = "\",\""), - "\")"), - perl = TRUE) + if (grepl(mystring, + pattern = paste0("^", fullvarpattern, "$"))) { + mystring <- myreplacement } else { - - # Replace with a vector - mystring <- - gsub(x = mystring, - pattern = fullvarpattern, - replacement = paste0("c(", - paste(myreplacement, - collapse = ","), - ")"), - perl = TRUE) + # Here exceptionally with c() because + # of future calculations with it + mystring <- sub(pattern = fullvarpattern, + replacement = paste0("c(", paste(myreplacement, + collapse = ", "), + ")"), + x = mystring) } + } } else { - # Do nothing because this is dealt with before + # Do nothing! env$(u)settingslist was filled above } } } + } else { + # If there are no references to settings, return string + + return(mystring) } # If numeric, then evaluate if (length(mystring) == 1L) { - try({ - - tmp <- eval(parse(text = mystring)) - if (!is.null(tmp) && !is.function(tmp)) { - mystring <- tmp - - } - }, silent = TRUE) + # Here, we can also see sublists e.g. "c(1,2,3)" + mystring <- evaluatestring(mystring) # WARum geht das nicht? } else { - # If single elements contain calculations + # Evaluate single elements for (mystring_i in seq_along(mystring)) { - try({ - tmp <- eval(parse(text = mystring[mystring_i])) - if (!is.null(tmp) && !is.function(tmp)) { - mystring[mystring_i] <- tmp - } - }, silent = TRUE) + val <- mystring[mystring_i] + mystring[mystring_i] <- evaluatestring(val) } } @@ -1151,7 +1369,7 @@ codebook <- function(path = ".", # Sometimes, init.py only has 1 line in old oTree if (length(file_content) <= 2L) { stop("At least one of your init-files is empty. ", - "Try using argument \"fsource = model\".") + "Try using the argument \"fsource = \'model\'\".") } file_content <- remove_line_comments(file_content) @@ -1179,8 +1397,13 @@ codebook <- function(path = ".", pattern = "^doc", replacement = "") - matches <- clean_string(matches, - folder_name = folder_name) + matches <- clean_string(string = matches, + quotes = TRUE, + current_class = current_class, + folder_name = folder_name, + variable = NULL) + + matches <- removefirstlastquote(matches) filevars[["doc"]] <- matches } @@ -1206,43 +1429,92 @@ codebook <- function(path = ".", env = env) # Clean constants - for (cons_i in seq_along(filevars[["Constants"]])) { + for (cons_var_i in seq_along(filevars[["Constants"]])) { # If there is a second level - if ((length(filevars[["Constants"]][[cons_i]])) > 1L) { + if (length(filevars[["Constants"]][[cons_var_i]]) > 1L) { - for (cons_j in seq_along(filevars[["Constants"]][[cons_i]])) { + for (cons_l2 in seq_along(filevars[["Constants"]][[cons_var_i]])) { - # Delete print() - filevars[["Constants"]][[cons_i]][[cons_j]] <- - gsub( - x = filevars[["Constants"]][[cons_i]][[cons_j]], - pattern = "print\\(.*\\)", - replacement = "") + # Delete print command + filevars[["Constants"]][[cons_var_i]][[cons_l2]] <- + delprint(filevars[["Constants"]][[cons_var_i]][[cons_l2]]) # Replace all references to the settings with the actual variables - filevars[["Constants"]][[cons_i]][[cons_j]] <- - settings_replace_f( - mystring = filevars[["Constants"]][[cons_i]][[cons_j]], + + if (length(filevars[["Constants"]][[cons_var_i]][[cons_l2]]) == + 1L) { + filevars[["Constants"]][[cons_var_i]][[cons_l2]] <- + settings_replace_f( + mystring = filevars[["Constants"]][[cons_var_i]][[cons_l2]], + folder_name = folder_name, + combined_codebook = combined_codebook, + user_settings = user_settings, + settings_replace = settings_replace, + e_variable = paste0( + names(filevars[["Constants"]])[[cons_var_i]], + ", element: ", + cons_l2 + ), env = env + ) + + # Remove first and last quote + filevars[["Constants"]][[cons_var_i]][[cons_l2]] <- + removefirstlastquote( + filevars[["Constants"]][[cons_var_i]][[cons_l2]] + ) + + } else { + + filevars[["Constants"]][[cons_var_i]][[cons_l2]] <- sapply( + filevars[["Constants"]][[cons_var_i]][[cons_l2]], + settings_replace_f, folder_name = folder_name, combined_codebook = combined_codebook, user_settings = user_settings, settings_replace = settings_replace, - e_variable = names(filevars[["Constants"]][cons_i])[[cons_j]]) - + e_variable = paste0( + names(filevars[["Constants"]])[[cons_var_i]], + ", element: ", + cons_l2), + env = env, + simplify = FALSE + ) + + # Remove first and last quote + filevars[["Constants"]][[cons_var_i]][[cons_l2]] <- + sapply(filevars[["Constants"]][[cons_var_i]][[cons_l2]], + removefirstlastquote, + simplify = FALSE + ) + } } } else { + + # Delete print command + filevars[["Constants"]][[cons_var_i]] <- + delprint(filevars[["Constants"]][[cons_var_i]]) + # Replace all references to the settings with the actual variables - filevars[["Constants"]][[cons_i]] <- - settings_replace_f( - mystring = filevars[["Constants"]][[cons_i]], + if (is.character(filevars[["Constants"]][[cons_var_i]])) { + repl <- settings_replace_f( + mystring = filevars[["Constants"]][[cons_var_i]], folder_name = folder_name, combined_codebook = combined_codebook, user_settings = user_settings, settings_replace = settings_replace, - e_variable = names(filevars[["Constants"]][cons_i])) + e_variable = names(filevars[["Constants"]])[[cons_var_i]], + env = env) + + filevars[["Constants"]][[cons_var_i]] <- repl + # Remove first and last quote + filevars[["Constants"]][[cons_var_i]] <- removefirstlastquote( + filevars[["Constants"]][[cons_var_i]] + ) + + } } } } @@ -1255,6 +1527,7 @@ codebook <- function(path = ".", if (line_nr == player_lines[1L]) { matches <- file_content[(line_nr + 1L):player_lines[2L]] current_class <- "Player" + } else { matches <- file_content[(line_nr + 1L):group_lines[2L]] current_class <- "Group" @@ -1282,7 +1555,7 @@ codebook <- function(path = ".", # Strip spaces etc. variables <- trimws(variables) - # Variable info #### + # Variable values #### for (variables_i in seq_along(variables)) { variable <- variables[variables_i] @@ -1326,12 +1599,15 @@ codebook <- function(path = ".", perl = TRUE ) + # Remove print from matches + varmatches <- delprint(varmatches) + # Get variable information #### # Get field field <- stringr::str_extract(varmatches, "(?<=models\\.)[^(]+") - # Remove field from matches + last ) + # Remove field from matches varmatches <- sub( pattern = paste0(" *= *models\\.", field), replacement = "", @@ -1339,17 +1615,19 @@ codebook <- function(path = ".", perl = TRUE ) # First bracket stays but this is okay and stripped later. + # Remove last part of matches if (grepl(x = varmatches, pattern = "\\)[\n ]*$", perl = TRUE)) { + + # Remove last closing bracket varmatches <- sub( - pattern = "\\)$", + pattern = "\\,*[\n ]*\\)[\n ]*$", replacement = "", x = varmatches, perl = TRUE ) - } else { # "Else" is just for development / should not happen - stop("Internal gmoTree error!") + } # If there are no arguments @@ -1363,29 +1641,29 @@ codebook <- function(path = ".", varmatches, sep = " ") } - # If documentation does not start with doc, add it - # Not sure if ever needed - if (stringr::str_detect(varmatches, "^ *\"\"\"|^ *'''")) { - varmatches <- paste("doc = ", varmatches) - } - # Variable information #### # First split its content at every = sign #### - parts <- stringr::str_split(stringr::str_trim(varmatches), - " *= *")[[1L]] - # Now the value of one variable is together with - # the variable name of the next variable - # Apply split_at_last_comma to each element - # except the first and last + # Check for unescaped equal signs in choice options + # = within square brackets + list_with_equals_pattern <- "\\[[^\\]]*[^\\\\]=[^\\]]*\\]" - if (length(parts) > 2) { - split_parts <- unlist(lapply(parts[2L:(length(parts) - 1L)], - split_at_last_comma)) - } else { - split_parts <- c() + if (grepl(pattern = list_with_equals_pattern, + x = varmatches, + perl = TRUE)) { + + paste(variable) + env$equalvariables <- c(env$equalvariables, + paste0("\n> $", folder_name, "$", + current_class, "$", + variable)) + + next } + split_pattern <- "(? 2L) { + + # Now the value of one variable is together with + # the variable name of the next variable + # Apply split_at_last_comma to each element + # except the first and last + + split_parts <- unlist(lapply(parts[2L:(length(parts) - 1L)], + split_at_last_comma)) + parts <- c(parts[1L], split_parts, parts[length(parts)]) @@ -1403,6 +1690,18 @@ codebook <- function(path = ".", "Please contact the maintainer with details.") } + if (length(parts) %% 2L != 0L) { + env$equalvariables <- c(env$equalvariables, + paste0("\n> $", folder_name, "$", + current_class, "$", + variable)) + + next + + } else { + + } + # Make key value frame #### # Create an empty list to store your kv_frame kv_frame <- data.frame(key = c(), @@ -1422,11 +1721,14 @@ codebook <- function(path = ".", "\\n", "") + # Clean key kv_frame$key <- sapply(kv_frame$key, clean_string, quotes = TRUE, - folder_name = folder_name) + current_class = current_class, + folder_name = folder_name, + variable = variable) # Choices need to be specified ##### if ("choices" %in% kv_frame$key) { @@ -1437,11 +1739,10 @@ codebook <- function(path = ".", text <- trimws(text) # In case the kv_frame works with square brackets - numbrack <- length(unlist(gregexpr(pattern = "\\[", + numbrackets <- length(unlist(gregexpr(pattern = "\\[", text = text))) - if (numbrack > 1L) { # If key - value pairs - + if (numbrackets > 1L) { # If key - value pairs # Replace first and last square brackets text <- sub(x = text, pattern = "^\\[", @@ -1461,47 +1762,59 @@ codebook <- function(path = ".", unlist(stringr::str_match_all(text, pattern = "\\[.*?\\]")) - # Combine into a single data frame + # If choices, combine into a single data frame # (not dict because values can appear several times) choices <- data.frame( - key <- c(), - value <- c()) + choices_key <- c(), + choices_value <- c()) for (elem in text) { + # Split the element into key and value parts <- stringr::str_split(string = elem, pattern = ",", n = 2L)[[1L]] # Clean and assign key and value - key <- clean_string(parts[1L], - quotes = TRUE, - folder_name = folder_name) - - value <- clean_string(parts[2L], - quotes = TRUE, - folder_name = folder_name) + # Key + choices_key <- clean_string(string = parts[1L], + quotes = TRUE, + current_class = current_class, + folder_name = folder_name, + variable = variable) + choices_key <- removefirstlastquote(choices_key) + + # Value + choices_value <- clean_string(string = parts[2L], + quotes = TRUE, + equal = TRUE, + current_class = current_class, + folder_name = folder_name, + variable = variable) - value <- cons_replace(value, filevars, - folder_name, env = env) + choices_value <- cons_replace(choices_value, filevars, + folder_name, env = env) - value <- settings_replace_f( - mystring = value, + choices_value <- settings_replace_f( + mystring = choices_value, folder_name = folder_name, combined_codebook = combined_codebook, user_settings = user_settings, settings_replace = settings_replace, - e_variable = variable) + e_variable = variable, + env = env) + + choices_value <- removefirstlastquote(choices_value) # Return key-value pair choices <- rbind(choices, data.frame( - key = key, - value = value)) + key = choices_key, + value = choices_value)) } + } else if (numbrackets == 1L) { - } else if (numbrack == 1L) { # If not key-value pairs. E.g. choices=[1, 2, 3] # Replace first and last square brackets @@ -1520,7 +1833,7 @@ codebook <- function(path = ".", choices <- stringr::str_split(text, "(? 0L) { + stop("\nThe following variable(s) cannot be read properly by gmoTree. ", + "\nPlease escape any equal signs in the values of the oTree code!", + paste0(env$equalvariables, collapse = "")) + } # Adjust settings #### if ("settings" %in% names(combined_codebook)) { @@ -1703,6 +2015,7 @@ codebook <- function(path = ".", # Sort apps in codebook #### if (!is.null(sort)) { + sort <- c("settings", sort) if ( @@ -1738,111 +2051,202 @@ codebook <- function(path = ".", } } - # If file #### - if (output == "file" || output == "both") { - - # If other files already have this name #### - nr_suffix <- 0L - - # Output extension as in output_format - output_form_ext <- sub(pattern = "_.*$", - replacement = "", - x = output_format) - - output_form_ext[output_form_ext == "word"] <- "docx" - output_form_ext[output_form_ext == "latex"] <- "tex" - - # Check if file extension is already in file name (strip if yes) - output_file <- sub(pattern = paste0("\\.", - output_form_ext, - "$"), - replacement = "", - x = output_file) - - # Check for non-fitting file extensions - if (!(tolower(tools::file_ext(output_file)) == "" || - tolower(tools::file_ext(output_file)) == tolower(output_form_ext) - )) { - stop("You are not allowed to use file extensions in the ", - "output_file that do not correspond to the output format! ", - "Your output_file extension is ", - tools::file_ext(output_file), - ". The extension according to your output_format should be ", - output_form_ext, ".") - } + # Make output file #### + if (output == "file" || output == "both") { + + # If other files already have this name #### + nr_suffix <- 0L + + # Output extension as in output_format + output_form_ext <- sub(pattern = "_.*$", + replacement = "", + x = output_format) + + output_form_ext[output_form_ext == "word"] <- "docx" + output_form_ext[output_form_ext == "latex"] <- "tex" + + # Check if file extension is already in file name (strip if yes) + output_file <- sub(pattern = paste0("\\.", + output_form_ext, + "$"), + replacement = "", + x = output_file) + + # Check for non-fitting file extensions + if (!(tolower(tools::file_ext(output_file)) == "" || + tolower(tools::file_ext(output_file)) == tolower(output_form_ext) + )) { + stop("You are not allowed to use dots in your output_file names or ", + "file extensions in the ", + "output_file that do not correspond to the output format! ", + "Your output_file extension is ", + tools::file_ext(output_file), + ". The extension according to your output_format should be ", + output_form_ext, ".") + } - # Define dictionary that has to be checked - checkdir <- dirname(output_file) + # Define dictionary that has to be checked + checkdir <- dirname(output_file) - # Check if there are files with the same name in the folder - nr_doc_same <- sum( - grepl(pattern = paste0("^", basename(output_file), - "[_\\d]*\\.", output_form_ext), - x = list.files(checkdir), - perl = TRUE)) + # Check if there are files with the same name in the folder + nr_doc_same <- sum( + grepl(pattern = paste0("^", basename(output_file), + "[_\\d]*\\.", output_form_ext), + x = list.files(checkdir), + perl = TRUE)) + + # If yes, add number to file + if (nr_doc_same > 0L) { + nr_suffix <- nr_doc_same + 1L + output_file <- paste0(output_file, "_", nr_suffix) + } + + # Make parameters #### + params2 <- list( + app_doc = app_doc, + preamb = preamb, + include_cons = include_cons, + title = title, + date = date, + subtitle = subtitle, + encoding = encoding, + combined_codebook = combined_codebook, + splitvarname = splitvarname, + sep_list = sep_list, + initial = initial) + + if (!is.null(params)) { + + if (is.list(params)) { + params <- utils::modifyList(params2, params) - # If yes, add number to file - if (nr_doc_same > 0L) { - nr_suffix <- nr_doc_same + 1L - output_file <- paste0(output_file, "_", nr_suffix) } + } else { + params <- params2 + } - # Make parameters #### - params2 <- list( - app_doc = app_doc, - preamb = preamb, - include_cons = include_cons, - title = title, - date = date, - subtitle = subtitle, - encoding = encoding) + if (!is.null(params[["date"]]) && params[["date"]] == "today") { + params[["date"]] <- format(Sys.time(), "%d %B %Y") + } - if (!is.null(params)) { + # Make output #### - if (is.list(params)) { + # Specify output_format + output_format2 <- output_format + output_options <- NULL - params <- utils::modifyList(params2, params) + pdflist <- list(pdf = FALSE) + latexengine <- list(latex_engine = NA) - } else { - stop("params must be a list!") - } - } else { - params <- params2 - } + if (output_format2 == "pdf_document") { - if (!is.null(params[["date"]]) && params[["date"]] == "today") { - params[["date"]] <- format(Sys.time(), "%d %B %Y") - } + # Xelatex better for multilingual documents + output_format2 <- rmarkdown::pdf_document( + latex_engine = "xelatex", + md_extensions = "-smart") - # Make output #### - tryCatch({ + pdflist <- list(pdf = TRUE) + latexengine <- list(latex_engine = "xelatex") - # Specify output_format - if (output_format == "pdf_document") { - output_format <- rmarkdown::pdf_document(latex_engine = "xelatex") - } + # Count longest variable value + maxlen <- 0L - # Don't use output_dir here, - # because that's already included in file name! - created_file <- rmarkdown::render( - input = system.file("rmd", "codebook.Rmd", package = "gmoTree"), - output_format = output_format, - output_file = output_file, - params = params, - clean = TRUE # Encoding is ignored here! Always UTF-8 - ) + for (folder in names(combined_codebook)) { + + if (folder != "settings" && folder != "user_settings") { + + for (class in names(combined_codebook[[folder]])) { + + if (class != "doc" && + !is.null(combined_codebook[[folder]][[class]])) { + + for (variable in + names(combined_codebook[[folder]][[class]])) { - # Open - created_file <- normalizePath(created_file) + if ((class == "Player" || class == "Group") && + "choices" %in% names(combined_codebook[[folder]][[class]][[variable]])) { - if (output_open) { - utils::browseURL(created_file) + lenofval <- + length( + combined_codebook[[folder]][[class]][[variable]][["choices"]]) + + maxlen <- pmax(lenofval, maxlen) + + } else if (class == "Constants") { + + lenofval <- + length( + combined_codebook[[folder]][[class]][[variable]]) + + maxlen <- pmax(lenofval, maxlen) + } + } + } + } + } + } + + # Check for many variable values + if (maxlen > 20L) { + # 20 is tested on my computer. There might be better solutions! + warning("One of your variables has many values ", + "(no of values/sublists = ", + maxlen, + ") and may cause serious problems in the PDF output! ", + "(Some PDF viewers such as NITRO might struggle with it.) ", + "If you experience any problems, use \"output_format = ", + "pdf_document_simple\", first knit to Latex, or open ", + "and save again with a PDF reader that can handle ", + "long table cells. ") } - message("File saved in ", created_file) - }, error = function(e) { - message("Error in rmarkdown::render: ", e$message) - }) + } else if (output_format2 == "pdf_document_simple") { + output_format2 <- rmarkdown::pdf_document( + md_extensions = "-smart") + + pdflist <- list(pdf = TRUE) + latexengine <- list(latex_engine = "pdflatex") + + } else if (output_format2 == "html_document") { + output_format2 <- rmarkdown::html_document(md_extensions = "-smart") + pdflist <- list(pdf = FALSE) + + } else if (output_format2 == "latex_document") { + output_format2 <- rmarkdown::latex_document( + md_extensions = "-smart") + + pdflist <- list(pdf = TRUE) + latexengine <- list(latex_engine = "") + + } else { + pdflist <- list(pdf = FALSE) + latexengine <- list(latex_engine = NA) + } + + params <- utils::modifyList(pdflist, params) + params <- utils::modifyList(latexengine, params) + + # Render file + # Don't use output_dir here, + # because that's already included in file name! + + created_file <- rmarkdown::render( + input = system.file("rmd", "codebook.Rmd", package = "gmoTree"), + output_format = output_format2, + output_file = output_file, + params = params, + quiet = FALSE, + output_options = output_options, + clean = TRUE # Encoding is ignored here! Always UTF-8 + ) + + # Open + created_file <- normalizePath(created_file) + + if (output_open) { + utils::browseURL(created_file) + } + message("File saved in ", created_file) } # Message: Variables with no documentation info #### @@ -1875,14 +2279,14 @@ codebook <- function(path = ".", } } else { - # Check if the element is a character string containing "float" + # Add the current path to the list if "float" is found if (length(codebook) == 1L && is.character(codebook) && grepl("float(?!Field)", codebook, ignore.case = TRUE, perl = TRUE)) { - # Add the current path to the list if "float" is found + collected_paths <- c(collected_paths, path) } } @@ -1899,41 +2303,64 @@ codebook <- function(path = ".", env$complexcons <- c(env$complexcons, complex2) - # Show warning if there is complex code in Constants, Player, Group or settings + # Show warning if there is complex code in Constants, + # Player, Group or settings if (length(env$complexcons) > 0L) { env$warnings <- c(env$warnings, - paste0("Some variables or code parts contain code that is too complex for this function. ", + paste0("Some variables or code parts contain code that ", + "is too complex for this function. ", "Hence, this function might have overseen ", "important variables and references to them. ", - "Check the output carefully! Found in:\n", + "Found in:\n", paste(env$complexcons, collapse = ""))) } # Return warnings #### - if (length(env$settingslist) > 0) { - if (env$settingspy == TRUE) { + # Warning message regarding global settings variables + if (length(env$settingslist) > 0L && + !is.null(settings_replace) && + settings_replace == "global") { + + if (env$settingspy) { env$warnings <- c(env$warnings, - paste0("The following settings variable/s is/are not in settings and ", + paste0("The following settings variable/s is/are ", + "not in settings and ", "cannot be replaced:\n", - env$settingslist)) + paste0(env$settingslist, collapse = ""))) } else { env$warnings <- c(env$warnings, paste0("There is no settings.py in your path! ", "The following settings variable/s is/are not in settings and ", - "cannot be replaced:\n ", - env$settingslist)) + "cannot be replaced:\n", + paste0(env$settingslist, collapse = ""))) } } - if (length(env$warnings) > 0) { + # Warning message regarding user settings variables + if (length(env$usettingslist) > 0L && + !is.null(settings_replace) && + settings_replace == "user") { + + env$warnings <- + c(env$warnings, + paste0("The following settings variable/s is/are ", + "not in user_settings and ", + "cannot be replaced:\n", + paste0(env$usettingslist, collapse = ""))) + + } + + if (length(env$warnings) > 0L) { env$warnings <- paste(env$warnings, collapse = "\n\n") warning(env$warnings) } + # Return list #### + if (output == "list" || output == "both") { return(combined_codebook) } diff --git a/R/delete_cases.R b/R/delete_cases.R index 9e82582..b16d942 100644 --- a/R/delete_cases.R +++ b/R/delete_cases.R @@ -138,11 +138,13 @@ delete_cases <- function(oTree, omit = FALSE, info = FALSE) { + + env <- new.env(parent = emptyenv()) + env$messed_message <- character(0L) + env$chat_messed <- FALSE + env$time_messed <- FALSE all_deleted <- character(0L) deletion_frame <- data.frame() - time_messed <- FALSE - chat_messed <- FALSE - messed_message <- character(0L) # Create list of apps #### appnames <- names(oTree) @@ -164,8 +166,8 @@ delete_cases <- function(oTree, tryCatch({ messy_time(oTree, combine = FALSE) }, error = function(e) { - time_messed <<- TRUE - messed_message <<- paste0("Please run messy_time() with the argument ", + env$time_messed <- TRUE + env$messed_message <- paste0("Please run messy_time() with the argument ", "combine=TRUE before running this function.") }) @@ -173,19 +175,19 @@ delete_cases <- function(oTree, tryCatch({ messy_chat(oTree, combine = FALSE) }, error = function(e) { - chat_messed <<- TRUE + env$chat_messed <- TRUE - if (time_messed) { + if (env$time_messed) { # Combine messy chat message with messy time message - messed_message <<- - paste0(messed_message, + env$messed_message <- + paste0(env$messed_message, " AND: Please run messy_chat() with the argument ", "combine=TRUE before running this function.") } else { # Make messy chat message - messed_message <<- + env$messed_message <- paste0("Please run messy_chat() with the argument ", "combine=TRUE before running this function.") } @@ -193,9 +195,9 @@ delete_cases <- function(oTree, # Stop if messy time and/or chat variables should not be merged - if (time_messed || chat_messed) { + if (env$time_messed || env$chat_messed) { stop("You combined data from old and new oTree versions. ", - messed_message) + env$messed_message) } # Warnings #### @@ -217,7 +219,7 @@ delete_cases <- function(oTree, } if (!(is.null(saved_vars)) && - any(!(saved_vars %in% colnames(oTree$all_apps_wide)))) { + !all(saved_vars %in% colnames(oTree$all_apps_wide))) { stop("saved_vars not in \"all_apps_wide\" data frame!") } diff --git a/R/delete_sessions.R b/R/delete_sessions.R index bd050fb..95aafa3 100644 --- a/R/delete_sessions.R +++ b/R/delete_sessions.R @@ -113,10 +113,14 @@ delete_sessions <- function(oTree, messages <- character(0L) deleted_participants <- character(0L) deletion_frame <- data.frame() - time_messed <- FALSE - chat_messed <- FALSE - messed_message <- character(0L) + + env <- new.env(parent = emptyenv()) + env$messed_message <- character(0L) + env$time_messed <- FALSE + env$chat_messed <- FALSE + + # Create list of apps #### appnames <- names(oTree) appnames <- appnames[appnames != "info"] @@ -137,8 +141,8 @@ delete_sessions <- function(oTree, tryCatch({ messy_time(oTree, combine = FALSE) }, error = function(e) { - time_messed <<- TRUE - messed_message <<- paste0("Please run messy_time() with the argument ", + env$time_messed <- TRUE + env$messed_message <- paste0("Please run messy_time() with the argument ", "combine=TRUE before running this function.") }) @@ -146,23 +150,23 @@ delete_sessions <- function(oTree, tryCatch({ messy_chat(oTree, combine = FALSE) }, error = function(e) { - chat_messed <<- TRUE + env$chat_messed <- TRUE - if (time_messed) { - messed_message <<- - paste0(messed_message, + if (env$time_messed) { + env$messed_message <- + paste0(env$messed_message, " AND: Please run messy_chat() with the argument ", "combine=TRUE before running this function.") } else { - messed_message <<- + env$messed_message <- paste0("Please run messy_chat() with the argument ", "combine=TRUE before running this function.") } }) - if (time_messed || chat_messed) { + if (env$time_messed || env$chat_messed) { stop("You combined data from old and new oTree versions. ", - messed_message) + env$messed_message) } # Set background function: chat function #### diff --git a/R/extime.R b/R/extime.R index 6438b88..43384a1 100644 --- a/R/extime.R +++ b/R/extime.R @@ -293,15 +293,14 @@ extime <- function( # Seconds #### if (seconds) { - divsec <- 1 + divsec <- 1L } else { - divsec <- 60 # Divide seconds by 60 to get minutes + divsec <- 60L # Divide seconds by 60 to get minutes } # Transform plabel to pcode identifier #### if (!is.null(plabel)) { - if (length(unique(oTree$all_apps_wide$participant.label)) == - length(oTree$all_apps_wide$participant.label)) { + if (anyDuplicated(oTree$all_apps_wide$participant.label) == 0L) { pcode <- oTree$all_apps_wide$participant.code[ oTree$all_apps_wide$participant.label == plabel] diff --git a/R/make_ids.R b/R/make_ids.R index e43128b..4b565b2 100644 --- a/R/make_ids.R +++ b/R/make_ids.R @@ -88,10 +88,11 @@ make_ids <- function(oTree, emptyrows = NULL, icw = FALSE) { - my_warnings <- character(0L) - time_messed <- FALSE - chat_messed <- FALSE - messed_message <- character(0L) + env <- new.env(parent = emptyenv()) + env$time_messed <- FALSE + env$chat_messed <- FALSE + env$messed_message <- character(0L) + env$my_warnings <- character(0L) # Before start: Error messages #### if (from_app %in% c("info", "Chats", "Time")) { @@ -121,13 +122,12 @@ make_ids <- function(oTree, stop("Please only use from_app (all except all_apps_wide) ", "or from_var!") - } else if (from_app == "all_apps_wide") { - if (is.null(oTree[[from_app]][[from_var]])) { + } else if (from_app == "all_apps_wide" && is.null(oTree[[from_app]][[from_var]])) { stop("from_var \"", - from_var, - "\" not found. ", - "Please select another one.") - } + from_var, + "\" not found. ", + "Please select another one.") + } # gmake should be automatically TRUE if from_var is set @@ -147,8 +147,8 @@ make_ids <- function(oTree, tryCatch({ messy_time(oTree, combine = FALSE) }, error = function(e) { - time_messed <<- TRUE - messed_message <<- paste0("Please run messy_time() with the argument ", + env$time_messed <- TRUE + env$messed_message <- paste0("Please run messy_time() with the argument ", "combine=TRUE before running this function.") }) @@ -156,28 +156,28 @@ make_ids <- function(oTree, tryCatch({ messy_chat(oTree, combine = FALSE) }, error = function(e) { - chat_messed <<- TRUE + env$chat_messed <- TRUE - if (time_messed) { + if (env$time_messed) { # Combine messy chat message with messy time message - messed_message <<- - paste0(messed_message, + env$messed_message <<- + paste0(env$messed_message, " AND: Run messy_chat() with the argument ", "combine=TRUE before running this function!") } else { # Make messy chat message - messed_message <<- + env$messed_message <<- paste0("Run messy_chat() with the argument ", "combine=TRUE before running this function!") } }) # Stop if messy time and/or chat variables should not be merged - if (time_messed || chat_messed) { + if (env$time_messed || env$chat_messed) { stop("You combined data from old and new oTree versions. ", - messed_message) + env$messed_message) } # Check for NAs in the relevant variables @@ -203,26 +203,26 @@ make_ids <- function(oTree, if (length(oTree[[from_app]]$participant.code) != length(unique(oTree[[from_app]]$participant.code))) { - stop(paste0( + stop( from_app, ": The length of participant codes is not equal the length of ", "unique participant codes. Please check your data for ", "duplicates or empty rows! ", "(Advice: You may use delete_duplicate() to ", - "remove duplicate rows of all oTree data frames.")) + "remove duplicate rows of all oTree data frames.") } } else { if (length(unique(oTree[[from_app]]$participant.code)) != length(oTree[[from_app]]$participant.code) / max(oTree[[from_app]]$subsession.round_number)) { - stop(paste0( + stop( from_app, ": The length of participant codes is not equal the length of ", "unique participant codes. Please check your data for ", "duplicates or empty rows! ", "(Advice: You may use delete_duplicate() to ", - "remove duplicate rows of all oTree data frames.")) + "remove duplicate rows of all oTree data frames.") } } @@ -244,25 +244,25 @@ make_ids <- function(oTree, )) { if (length(unique(oTree$Chats$participant_code[ - oTree$Chats$session_code == code])) == 1) { + oTree$Chats$session_code == code])) == 1L) { - if (icw == FALSE) { + if (!icw) { stop(messymessage) } } else if (length(unique( oTree$Chats$participant__code[ - oTree$Chats$session__code == code])) == 1) { + oTree$Chats$session__code == code])) == 1L) { - if (icw == FALSE) { + if (!icw) { stop(messymessage) # Can this even happen? } } else if (length(unique( oTree$Chats$participant__code[ - oTree$Chats$participant__session__code == code])) == 1) { + oTree$Chats$participant__session__code == code])) == 1L) { - if (icw == FALSE) { + if (!icw) { stop(messymessage) # Can this even happen? } } @@ -270,19 +270,19 @@ make_ids <- function(oTree, # Check if group numbers are the same in all variables # if app and round is not specified - if (gmake == TRUE && + if (gmake && from_app == "all_apps_wide" && is.null(from_var)) { checkdata <- oTree[[from_app]][, endsWith(names(oTree[[from_app]]), "group.id_in_subsession")] - if (ncol(checkdata) == 0) { + if (ncol(checkdata) == 0L) { stop("No variable that ends with \"group.id_in_subsession\"") } if (inherits(checkdata, "data.frame") && - !(all(checkdata == checkdata[, 1]))) { + !(all(checkdata == checkdata[, 1L]))) { # Not all the same stop( "group_id can not be calculated. ", @@ -319,10 +319,10 @@ make_ids <- function(oTree, data.table::rleidv(oTree[[from_app]]$GroupSessionID) oTree[[from_app]]$group_id <- - oTree[[from_app]]$group_id + (gstart - 1) + oTree[[from_app]]$group_id + (gstart - 1L) - if (length(unique(oTree[[from_app]][[from_var]])) == 1) { - my_warnings <<- c(my_warnings, paste0( + if (length(unique(oTree[[from_app]][[from_var]])) == 1L) { + env$my_warnings <<- c(env$my_warnings, paste0( "The group variable values are constant. ", "Group IDs now correspond to session IDs.")) } @@ -340,15 +340,15 @@ make_ids <- function(oTree, all_group_ids <- oTree[[from_app]][, grep("group.id_in_subsession", colnames(oTree[[from_app]]))] - if (inherits(all_group_ids, "data.frame") == TRUE && - ncol(all_group_ids) > 0) { + if (inherits(all_group_ids, "data.frame") && + ncol(all_group_ids) > 0L) { # Make a helping variable GroupSessionID - oTree <- group_session_id_df(oTree) + oTree <- group_session_id_df(oTree, env = env) } else { # Make a helping variable GroupSessionID - oTree <- group_session_id_vector(oTree) + oTree <- group_session_id_vector(oTree, env = env) } # 2) Arrange group numbers, too (I took the first occurrence) @@ -359,12 +359,12 @@ make_ids <- function(oTree, # 3) Assign session wide group number oTree[[from_app]]$group_id <- - data.table::rleidv(oTree[[from_app]]$GroupSessionID) + (gstart - 1) + data.table::rleidv(oTree[[from_app]]$GroupSessionID) + (gstart - 1L) return(oTree) } - group_session_id_df <- function(oTree) { + group_session_id_df <- function(oTree, env) { # Here several variables are called group.id_in_subsession. # Take the first one. @@ -373,14 +373,14 @@ make_ids <- function(oTree, paste( oTree[[from_app]]$session_id, oTree[[from_app]][, grep("group.id_in_subsession", - colnames(oTree[[from_app]]))][, 1]) + colnames(oTree[[from_app]]))][, 1L]) if (length( unique(oTree[[from_app]][, grep("group.id_in_subsession", - colnames(oTree[[from_app]]))][, 1])) == 1) { + colnames(oTree[[from_app]]))][, 1L])) == 1L) { - my_warnings <<- c(my_warnings, paste0( + env$my_warnings <<- c(env$my_warnings, paste0( "The group variable values (of the first group variable) ", "are constant. ", "Group IDs now correspond to session IDs.")) @@ -388,7 +388,7 @@ make_ids <- function(oTree, return(oTree) } - group_session_id_vector <- function(oTree) { + group_session_id_vector <- function(oTree, env) { # Here only one variable is called group.id_in_subsession # Add session ID so there are no group IDs twice @@ -402,7 +402,7 @@ make_ids <- function(oTree, unique(oTree[[from_app]][, grep("group.id_in_subsession", colnames(oTree[[from_app]]))])) == 1L) { - my_warnings <<- c(my_warnings, paste0( + env$my_warnings <<- c(env$my_warnings, paste0( "The group variable values are constant. ", "Group IDs now correspond to session IDs.")) } @@ -550,8 +550,8 @@ make_ids <- function(oTree, # This part is usually called if session.code is NA # This does not happen with cleaned data if (anyNA(oTree[[from_app]]$session.code)) { - my_warnings <- - c(my_warnings, + env$my_warnings <- + c(env$my_warnings, (paste0("At least one of your session.codes in your from_app is ", "NA. All session codes that are Na are ", "handled as being the same ", @@ -571,7 +571,7 @@ make_ids <- function(oTree, # Make session_id oTree[[from_app]]$session_id <- - data.table::rleid(oTree[[from_app]]$session.code) + (sstart - 1) + data.table::rleid(oTree[[from_app]]$session.code) + (sstart - 1L) # Delete variable again oTree[[from_app]]$participant.time_started_min <- NULL @@ -620,7 +620,7 @@ make_ids <- function(oTree, # Make participant_id oTree[[from_app]]$participant_id <- data.table::rleidv(oTree[[from_app]]$participant.code) + - (pstart - 1) + (pstart - 1L) } else { stop("There is no participant.code in ", @@ -631,7 +631,7 @@ make_ids <- function(oTree, # Step 4: Make info lists #### listincluded <- c("session_id", "session.code", "participant.code") - oTree[["info"]][["additional_variables"]] <- c("session_id") + oTree[["info"]][["additional_variables"]] <- "session_id" if (group_size_info) { @@ -672,7 +672,7 @@ make_ids <- function(oTree, oTree[[from_app]]$participant.code)]) if (length(participants_more) > 0L) { - my_warnings <- c(my_warnings, + env$my_warnings <- c(env$my_warnings, paste0("Data frame \"", names(oTree)[[i]], "\" has more participants than ", @@ -692,7 +692,7 @@ make_ids <- function(oTree, oTree[[from_app]]$participant.code)]) if (length(participants_more) > 0L) { - my_warnings <- c(my_warnings, + env$my_warnings <- c(env$my_warnings, paste0("Data frame \"", names(oTree)[[i]], "\" has more participants than ", @@ -713,7 +713,7 @@ make_ids <- function(oTree, participants_more <- unique(participants_more) if (length(participants_more) > 0L) { - my_warnings <- c(my_warnings, + env$my_warnings <- c(env$my_warnings, paste0("Data frame \"", names(oTree)[[i]], "\" has more participants than ", from_app, ": ", @@ -724,8 +724,8 @@ make_ids <- function(oTree, oTree <- ids_in_old_time_apps(oTree, df_group_in_date, i) } else { - my_warnings <- - c(my_warnings, + env$my_warnings <- + c(env$my_warnings, paste0("Participant code variable couldn't be found in \"", name_of_app, "\"! No IDs are calculated for this data frame.")) @@ -734,10 +734,10 @@ make_ids <- function(oTree, # Reorder columns #### j <- 0L if (pmake) { - j <- j + 1 + j <- j + 1L } if (group_size_info) { - j <- j + 1 + j <- j + 1L } oTree[[i]] <- oTree[[i]][, c(c((ncol(oTree[[i]]) - j):ncol(oTree[[i]])), @@ -755,8 +755,8 @@ make_ids <- function(oTree, oTree[[from_app]]$initial_order <- NULL # Print warnings #### - if (length(my_warnings > 0)) { - warning(paste(my_warnings, collapse = "\n")) + if (length(env$my_warnings) > 0L) { + warning(paste(env$my_warnings, collapse = "\n")) } return(oTree) diff --git a/R/messy_time.R b/R/messy_time.R index 1d5759f..2c680e9 100644 --- a/R/messy_time.R +++ b/R/messy_time.R @@ -12,8 +12,8 @@ #' @param oTree A list of data frames that were created #' by \code{\link{import_otree}}. #' @param combine Logical. \code{TRUE} if all variables referring to epoch time -#' should be merged and/or all variables referring to participant code should be merged -#' in case data of several versions of oTree are used. +#' should be merged and/or all variables referring to participant code +#' should be merged in case data of several versions of oTree are used. #' @param epoch_time Logical. \code{TRUE} if all variables referring to the time #' stamp should be checked and merged. Only works if \code{combine = TRUE}. #' @param participant Logical. \code{TRUE} if all variables referring to the diff --git a/R/oTree.R b/R/oTree.R index 9515c79..c01c80a 100644 --- a/R/oTree.R +++ b/R/oTree.R @@ -1,4 +1,4 @@ -#' Sample experiment data +#' Sample experimental data #' #' @docType data #' @format A list of data frames created by import_otree(). diff --git a/R/pagesec.R b/R/pagesec.R index edcc57a..0a588ab 100644 --- a/R/pagesec.R +++ b/R/pagesec.R @@ -118,7 +118,7 @@ pagesec <- function( # Translate to minutes if (minutes) { - oTree$Time$minutes_on_page <- oTree$Time$seconds_on_page2 / 60 + oTree$Time$minutes_on_page <- oTree$Time$seconds_on_page2 / 60L if (rounded) { oTree$Time$minutes_on_page <- round(oTree$Time$minutes_on_page, diff --git a/R/show_dropouts.R b/R/show_dropouts.R index 98ebac8..039b572 100644 --- a/R/show_dropouts.R +++ b/R/show_dropouts.R @@ -79,8 +79,8 @@ show_dropouts <- function(oTree, final_pages = NULL, saved_vars = NULL) { - keep_these_participants <- c() # Is just here for the inconsistency test - delete_these_participants <- c() # Not deleted here. Inconsistency check! + keep_these_participants <- character() # Just here for the inconsistency test + delete_these_participants <- character() # Not deleted here. #Inconsistency dropout_data <- data.frame() output <- list() my_warnings <- list() @@ -163,7 +163,7 @@ show_dropouts <- function(oTree, delete_these_participants <- unique(delete_these_participants) # Test if no one in "keep" is in "delete" #### - newlist <- c() + newlist <- character() for (element in keep_these_participants) { if (element %in% delete_these_participants) { newlist <- append(element, newlist) diff --git a/build/vignette.rds b/build/vignette.rds deleted file mode 100644 index 1c03b68..0000000 Binary files a/build/vignette.rds and /dev/null differ diff --git a/cran-comments.md b/cran-comments.md index e79e35a..435da6f 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,3 +1,7 @@ +# Version 1.3.0 + +No comments. + # Version 1.2.0 ``` diff --git a/docs/404.html b/docs/404.html index 03bdbe6..0b8e823 100644 --- a/docs/404.html +++ b/docs/404.html @@ -14,8 +14,8 @@ - - + + @@ -28,7 +28,7 @@ gmoTree - 1.2.0 + 1.3.0