diff --git a/DESCRIPTION b/DESCRIPTION index 92f72c6..96901c7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: jaspTools Type: Package Title: Helps preview and debug JASP analyses -Version: 1.5.0 +Version: 1.6.0 Author: Tim de Jong Maintainer: Tim de Jong Description: This package assists JASP developers when writing R code. It removes the necessity of building JASP every time a change is made. Rather, analyses can be called directly in R and be debugged interactively. diff --git a/NAMESPACE b/NAMESPACE index 9e11207..0140b57 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ export(expect_equal_tables) export(installJaspModules) export(makeTestTable) export(manageTestPlots) +export(monitor) export(runAnalysis) export(runTestsTravis) export(setPkgOption) diff --git a/R/dataset.R b/R/dataset.R index 57dbc70..6e4d95a 100644 --- a/R/dataset.R +++ b/R/dataset.R @@ -1,8 +1,6 @@ -loadCorrectDataset <- function(x) { - if (is.matrix(x) || is.data.frame(x)) { - return(x) - } else if (is.character(x)) { - if (! endsWith(x, ".csv")) { +loadDataset <- function(x) { + if (is.character(x)) { + if (!endsWith(x, ".csv")) { x <- paste0(x, ".csv") } @@ -11,8 +9,8 @@ loadCorrectDataset <- function(x) { return(utils::read.csv(x, header = TRUE, check.names = FALSE)) } - # check if it's a name of a JASP dataset - locations <- getPkgOption("data.dirs") + # check if it's a name of a jasp-desktop, jaspTools or module dataset + locations <- getDatasetLocations() allDatasets <- c() for (location in locations) { @@ -33,6 +31,11 @@ loadCorrectDataset <- function(x) { cat("It appears", x, "could not be found. Please supply either a full filepath or the name of one of the following datasets:\n", paste0(sort(allDatasets), collapse = '\n'), "\n") stop(paste(x, "not found")) + } else { + return(x) } - stop(paste("Cannot handle data of type", mode(x))) +} + +getDatasetLocations <- function() { + return(c(getPkgOption("data.dirs"), getModuleDatasetLocations())) } diff --git a/R/modules.R b/R/modules.R new file mode 100644 index 0000000..12d8de4 --- /dev/null +++ b/R/modules.R @@ -0,0 +1,165 @@ +#' Tell jaspTools what module you are currently working on. +#' +#' This information is used to find the correct analysis resources and monitor the module for any changes. +#' +#' @param modulePaths Path to the root of the module (if no path is specified, then the current working directory will be used). +#' @examples +#' +#' monitor(c("~/Documents/Github/Regression", "~/Document/Github/Frequencies")) +#' +#' @export monitor +monitor <- function(modulePaths = ".") { + validModulePaths <- verifyModulePaths(modulePaths) + if (length(validModulePaths) == 0) + stop("No valid module(s) supplied in `modulePaths` and working directory is not a module. Note that all JASP modules should be R packages and have these files: DESCRIPTION, NAMESPACE and inst/Description.qml.") + + numInvalidPaths <- length(modulePaths) - length(validModulePaths) + if (numInvalidPaths > 0) + warning("Dropped ", numInvalidPaths, " invalid module(s) supplied in `modulePaths`") + + .setInternal("modulePaths", validModulePaths) + message("Now monitoring: ", paste(validModulePaths, collapse = ", ")) +} + +asNamespacedFunctionCall <- function(funName) { + modulePath <- getModulePathFromRFunction(funName) + if (is.null(modulePath)) + stop("Could not locate the module location for `", funName, "`") + + return(paste(getModuleName(modulePath), funName, sep = "::")) +} + +getModulePaths <- function() { + modulePaths <- .getInternal("modulePaths") + if (modulePaths == "") { + if (setWorkDirAsModule()) + modulePaths <- .getInternal("modulePaths") + else + stop("jaspTools needs to know what module to obtain resources from. Please set the current working directory to your JASP module, or specify it through `monitor(\"path/to/module\")`") + } + + return(modulePaths) +} + +setWorkDirAsModule <- function() { + if (!is.null(verifyModulePaths(getwd()))) { + message("Current working directory is a JASP module, using that (to override this behaviour use `monitor()`)") + monitor(getwd()) + return(TRUE) + } + return(FALSE) +} + +verifyModulePaths <- function(modulePaths) { + validModulePaths <- NULL + if (length(modulePaths) > 0 && any(modulePaths != "")) { + for (modulePath in modulePaths) { + validModuleRoot <- getValidModuleRoot(modulePath) + if (!is.null(validModuleRoot)) + validModulePaths <- c(validModulePaths, validModuleRoot) + } + } + + return(validModulePaths) +} + +getModulePathFromRFunction <- function(funName) { + modulePath <- NULL + + modulePaths <- getModulePaths() + for (i in seq_along(modulePaths)) { + if (rFunctionExistsInModule(funName, modulePaths[[i]])) { + modulePath <- modulePaths[i] + break + } + } + + if (is.null(modulePath)) + stop("Could not locate R function `", funName, "` in any of your specified modules. Did you type the R function correctly (it's case sensitive)?") + + return(modulePath) +} + +rFunctionExistsInModule <- function(funName, modulePath) { + + if (isBinaryPackage(modulePath)) { + + # this is how `::` looks up functions + moduleName <- getModuleName(modulePath) + ns <- asNamespace(moduleName) + return(!is.null(.getNamespaceInfo(ns, "exports")[[funName]])) + + } else { + + env <- new.env() + rFiles <- list.files(file.path(modulePath, "R"), pattern = "\\.[RrSsQq]$", recursive = TRUE, full.names = TRUE) + if (length(rFiles) == 0) + return(FALSE) + + for (rFile in rFiles) + source(rFile, local = env) + + if (funName %in% names(env)) + return(TRUE) + + return(FALSE) + } +} + +getModulePathsForTesting <- function() { + modulesWithTests <- NULL + modulePaths <- getModulePaths() + for (modulePath in modulePaths) { + testDir <- file.path(modulePath, "tests", "testthat") + if (dir.exists(testDir) && length(list.files(testDir)) > 0) + modulesWithTests <- c(modulesWithTests, modulePath) + } + + if (length(modulesWithTests) == 0) + message("No tests were found. Note that the tests should be in `moduleDir/tests/testthat` and named `test-analysisName.R`.") + + return(modulesWithTests) +} + +getModuleName <- function(moduleRoot) { + descrFile <- file.path(moduleRoot, "DESCRIPTION") + pkgName <- as.vector(read.dcf(descrFile, fields = "Package")) + if (is.na(pkgName)) + stop("Could not obtain package name from `Package` field in ", descrFile) + + return(pkgName) +} + +getValidModuleRoot <- function(path) { + while (!hasJaspModuleRequisites(path)) { + parentDir <- dirname(path) + if (identical(parentDir, dirname(parentDir))) # we're at the root of the filesystem + return(NULL) + path <- parentDir + } + return(tidyPath(path)) +} + +sourceModuleRequisites <- function(sep = .Platform$file.sep) { + return(c("NAMESPACE", "DESCRIPTION", paste("inst", "Description.qml", sep = sep))) +} + +binaryModuleRequisites <- function() { + return(c("NAMESPACE", "DESCRIPTION", "Description.qml", "qml", "Meta")) +} + +hasJaspModuleRequisites <- function(path) { + all(file.exists(file.path(path, sourceModuleRequisites()))) || + all(file.exists(file.path(path, binaryModuleRequisites()))) +} + +getModuleDatasetLocations <- function() { + dataPaths <- NULL + modulePaths <- getModulePaths() + for (i in seq_along(modulePaths)) { + dataFiles <- list.files(modulePaths[i], "\\.csv$", recursive = TRUE, full.names = TRUE) + if (length(dataFiles) > 0) + dataPaths <- c(dataPaths, unique(dirname(dataFiles))) + } + return(dataPaths) +} diff --git a/R/pkg-settings.R b/R/pkg-settings.R index d877c5d..b9cdc79 100644 --- a/R/pkg-settings.R +++ b/R/pkg-settings.R @@ -21,9 +21,8 @@ #' When you run an analysis or test it, jaspTools calls the *installed* version of the module. #' This option specifies if the installed version should be reinstalled automatically when you make any changes to your module. #' -#' @details \code{module.dirs}: -#' The directories that hold the source for the JASP module(s) you are working on. -#' These module directories are used to find the R functions etc. in \code{runAnalysis} and the various testing functions. +#' @details \code{install.deps}: +#' This option specifies if jaspTools should install missing deps of the module. #' #' @return A print of the configurable options. #' @export viewPkgOptions @@ -53,7 +52,7 @@ viewPkgOptions <- function() { #' @param value Value the option should be set to. #' @examples #' -#' setPkgOption("module.dirs", c("~/Documents/Github/Regression", "~/Document/Github/Frequencies")) +#' setPkgOption("reinstall.modules", FALSE) #' #' @export setPkgOption setPkgOption <- function(name, value) { @@ -63,6 +62,16 @@ setPkgOption <- function(name, value) { if (length(name) > 1) stop("Please only set one option at a time") + if (name == "module.dirs") { + lifecycle::deprecate_warn( + when = "1.6.0", + what = "setPkgOption('module.dirs')", + with = "monitor()" + ) + monitor(value) + return(invisible(NULL)) + } + if (!name %in% names(.pkgenv[["pkgOptions"]])) stop(name, " is not a valid option to set") @@ -75,7 +84,7 @@ setPkgOption <- function(name, value) { if (!dir.exists(value[i])) # if the value is not a null value it should be a valid path stop("Directory ", value[i], " does not exist") - value[i] <- gsub("[\\/]$", "", normalizePath(value[i])) # normalize path and strip trailing slashes + value[i] <- tidyPath(value[i]) } } diff --git a/R/pkg-setup.R b/R/pkg-setup.R index 26e75fb..a6913d1 100644 --- a/R/pkg-setup.R +++ b/R/pkg-setup.R @@ -137,8 +137,8 @@ getSetupCompleteFileName <- function() { .removeCompletedSetupFiles <- function() { unlink(getSetupCompleteFileName()) - unlink(getJavascriptLocation(), recursive = TRUE) - unlink(getDatasetsLocations(jaspOnly = TRUE), recursive = TRUE) + unlink(getJaspDesktopJSLocation(), recursive = TRUE) + unlink(getJaspDesktopDatasetLocation(), recursive = TRUE) message("Removed files from previous jaspTools setup") } @@ -165,13 +165,13 @@ fetchJaspDesktopDependencies <- function(jaspdesktopLoc = NULL, branch = "develo if (!isJaspDesktopDir(jaspdesktopLoc)) return(invisible(FALSE)) - fetchJavaScript(jaspdesktopLoc) - fetchDatasets(jaspdesktopLoc) + fetchJaspDesktopJS(jaspdesktopLoc) + fetchJaspDesktopDatasets(jaspdesktopLoc) return(invisible(TRUE)) } -getJavascriptLocation <- function(rootOnly = FALSE) { +getJaspDesktopJSLocation <- function(rootOnly = FALSE) { jaspToolsDir <- getJaspToolsDir() htmlDir <- file.path(jaspToolsDir, "html") if (!rootOnly) @@ -180,17 +180,16 @@ getJavascriptLocation <- function(rootOnly = FALSE) { return(htmlDir) } -getDatasetsLocations <- function(jaspOnly = FALSE) { - jaspToolsDir <- getJaspToolsDir() - dataDirs <- file.path(jaspToolsDir, "jaspData") - if (!jaspOnly) - dataDirs <- c(dataDirs, file.path(jaspToolsDir, "extdata")) +getJaspToolsDatasetLocation <- function() { + return(file.path(getJaspToolsDir(), "extdata")) +} - return(dataDirs) +getJaspDesktopDatasetLocation <- function() { + return(file.path(getJaspToolsDir(), "jaspData")) } -fetchJavaScript <- function(path) { - destDir <- getJavascriptLocation(rootOnly = TRUE) +fetchJaspDesktopJS <- function(path) { + destDir <- getJaspDesktopJSLocation(rootOnly = TRUE) if (!dir.exists(destDir)) dir.create(destDir) @@ -199,12 +198,12 @@ fetchJavaScript <- function(path) { stop("Could not move html files from jasp-desktop, is the path correct? ", path) file.copy(from = htmlDir, to = destDir, overwrite = TRUE, recursive = TRUE) - file.rename(file.path(destDir, "html"), getJavascriptLocation()) + file.rename(file.path(destDir, "html"), getJaspDesktopJSLocation()) message("Moved html files to jaspTools") } -fetchDatasets <- function(path) { - destDir <- getDatasetsLocations(jaspOnly = TRUE) +fetchJaspDesktopDatasets <- function(path) { + destDir <- getJaspDesktopDatasetLocation() if (!dir.exists(destDir)) dir.create(destDir) @@ -336,7 +335,7 @@ isRepoJaspModule <- function(repo, branch) { repoTree <- githubGET(asGithubReposUrl("jasp-stats", repo, c("git", "trees", branch), params = list(recursive = "false"))) if (length(names(repoTree)) > 0 && "tree" %in% names(repoTree)) { pathNames <- unlist(lapply(repoTree[["tree"]], `[[`, "path")) - return(all(moduleRequisites(sep = "/") %in% pathNames)) + return(all(sourceModuleRequisites(sep = "/") %in% pathNames)) } return(FALSE) diff --git a/R/rbridge.R b/R/rbridge.R index 68f0506..bcd44ab 100644 --- a/R/rbridge.R +++ b/R/rbridge.R @@ -15,9 +15,7 @@ env[[".setColumnDataAsNominalText"]] <- function(...) return(TRUE) env[[".allColumnNamesDataset"]] <- function(...) { - dataset <- .getInternal("dataset") - dataset <- loadCorrectDataset(dataset) - return(colnames(dataset)) + return(colnames(.getInternal("dataset"))) } } @@ -30,7 +28,6 @@ columns.as.factor = c(), all.columns = FALSE) { dataset <- .getInternal("dataset") - dataset <- loadCorrectDataset(dataset) if (all.columns) { columns <- colnames(dataset) diff --git a/R/run.R b/R/run.R index 68a7c3e..863501e 100644 --- a/R/run.R +++ b/R/run.R @@ -114,7 +114,7 @@ runAnalysis <- function(name, dataset, options, view = TRUE, quiet = FALSE, make fetchRunArgs <- function(name, options) { possibleArgs <- list( name = name, - functionCall = findCorrectFunction(name), + functionCall = asNamespacedFunctionCall(name), title = "", requiresInit = TRUE, options = jsonlite::toJSON(options), @@ -133,7 +133,7 @@ initAnalysisRuntime <- function(dataset, makeTests, ...) { reinstallChangedModules() # dataset to be found in the analysis when it needs to be read - .setInternal("dataset", dataset) + .setInternal("dataset", loadDataset(dataset)) # prevent the results from being translated (unless the user explicitly wants to) Sys.setenv(LANG = getPkgOption("language")) @@ -173,6 +173,11 @@ reinstallChangedModules <- function() { pkgload::unload(moduleName, quiet = TRUE) message("Installing ", moduleName, " from source") + + if (isTRUE(getPkgOption("install.deps"))) + suppressWarnings(remotes::install_deps(modulePath, upgrade = "never", INSTALL_opts = "--no-multiarch")) + + # we use install.packages here because of https://github.com/jasp-stats/jaspTools/pull/14#issuecomment-748112692 suppressWarnings(install.packages(modulePath, type = "source", repos = NULL, quiet = TRUE, INSTALL_opts = "--no-multiarch")) if (moduleName %in% installed.packages()) { diff --git a/R/test.R b/R/test.R index ec514f4..9642ee4 100644 --- a/R/test.R +++ b/R/test.R @@ -12,7 +12,7 @@ runTestsTravis <- function(modulePath) { if (!.isSetupComplete()) stop("The setup should be completed before the tests are ran") - setPkgOption("module.dirs", modulePath) + monitor(modulePath) # this check is identical to covr::in_covr() codeCoverage <- identical(Sys.getenv("R_COVR"), "true") diff --git a/R/testthat-helper-plots.R b/R/testthat-helper-plots.R index d616fab..ee17438 100644 --- a/R/testthat-helper-plots.R +++ b/R/testthat-helper-plots.R @@ -20,6 +20,12 @@ #' #' @export expect_equal_plots expect_equal_plots <- function(test, name, dir = lifecycle::deprecated()) { + if (!missing(dir)) + lifecycle::deprecate_warn( + when = "1.5.0", + what = "expect_equal_plots(dir)", + ) + if (length(test) == 0) { expect(FALSE, getEmptyTestMsg("expect_equal_plots()")) return() diff --git a/R/utils.R b/R/utils.R index 068bf49..3fafe0b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,59 +1,6 @@ #' @importFrom utils install.packages menu download.file unzip capture.output installed.packages packageVersion #' @importFrom testthat expect skip -findCorrectFunction <- function(funName) { - modulePath <- getModulePathFromRFunction(funName) - if (is.null(modulePath)) - stop("Could not locate the module location for `", funName, "`") - - return(paste(getModuleName(modulePath), funName, sep = "::")) -} - -getModulePaths <- function() { - validModules <- NULL - - modulePaths <- getPkgOption("module.dirs") - if (length(modulePaths) > 0 && any(modulePaths != "")) { - - for (modulePath in modulePaths) { - validModuleRoot <- getValidModuleRoot(modulePath) - if (!is.null(validModuleRoot)) - validModules <- c(validModules, validModuleRoot) - } - - } else { - - wdAsValidModule <- getValidModuleRoot(getwd()) - if (!is.null(wdAsValidModule)) { - message("Current working directory is a JASP module, using that because `module.dirs` is empty.") - setPkgOption("module.dirs", wdAsValidModule) - validModules <- wdAsValidModule - } else { - stop("jaspTools needs to know what module to obtain resources from. Please set the current working directory to your JASP module, or specify it through `setPkgOption(\"module.dirs\", \"path/to/module\")`") - } - - } - - if (length(validModules) == 0) - stop("None of the modules specified through `setPkgOption(\"module.dirs\", ...)` are valid JASP modules. All JASP modules should be valid R packages and have these files: DESCRIPTION, NAMESPACE and inst/Description.qml.") - - return(validModules) -} - -getModulePathFromRFunction <- function(funName) { - modulePath <- NULL - - modulePaths <- getModulePaths() - for (i in seq_along(modulePaths)) - if (rFunctionExistsInModule(funName, modulePaths[[i]])) - modulePath <- modulePaths[i] - - if (is.null(modulePath)) - stop("Could not locate R function `", funName, "` in any module. Did you specify the R function correctly (it's case sensitive)? Also make sure the `module.dirs` is complete (see `viewPkgOptions()`).") - - return(modulePath) -} - isBinaryPackage <- function(modulePath) { # check if a JASP module is a binary package. The main difference is that in an installed binary package module/inst/* is moved to module/* @@ -62,79 +9,6 @@ isBinaryPackage <- function(modulePath) { length(list.files(file.path(modulePath, "R"))) == 3L } -rFunctionExistsInModule <- function(funName, modulePath) { - - if (isBinaryPackage(modulePath)) { - - # this is how `::` looks up functions - moduleName <- getModuleName(modulePath) - ns <- asNamespace(moduleName) - return(!is.null(.getNamespaceInfo(ns, "exports")[[funName]])) - - } else { - - env <- new.env() - rFiles <- list.files(file.path(modulePath, "R"), pattern = "\\.[RrSsQq]$", recursive = TRUE, full.names = TRUE) - if (length(rFiles) == 0) - return(FALSE) - - for (rFile in rFiles) - source(rFile, local = env) - - if (funName %in% names(env)) - return(TRUE) - - return(FALSE) - } -} - -getModulePathsForTesting <- function() { - modulesWithTests <- NULL - modulePaths <- getModulePaths() - for (modulePath in modulePaths) { - testDir <- file.path(modulePath, "tests", "testthat") - if (dir.exists(testDir) && length(list.files(testDir)) > 0) - modulesWithTests <- c(modulesWithTests, modulePath) - } - - if (length(modulesWithTests) == 0) - message("No tests were found. Note that the tests should be in `moduleDir/tests/testthat` and named `test-analysisName.R`.") - - return(modulesWithTests) -} - -getModuleName <- function(moduleRoot) { - descrFile <- file.path(moduleRoot, "DESCRIPTION") - pkgName <- as.vector(read.dcf(descrFile, fields = "Package")) - if (is.na(pkgName)) - stop("Could not obtain package name from `Package` field in ", descrFile) - - return(pkgName) -} - -getValidModuleRoot <- function(path) { - while (!hasJaspModuleRequisites(path)) { - parentDir <- dirname(path) - if (identical(parentDir, dirname(parentDir))) # we're at the root of the filesystem - return(NULL) - path <- parentDir - } - return(path) -} - -moduleRequisites <- function(sep = .Platform$file.sep) { - return(c("NAMESPACE", "DESCRIPTION", paste("inst", "Description.qml", sep = sep))) -} - -binaryModuleRequisites <- function() { - return(c("NAMESPACE", "DESCRIPTION", "Description.qml", "qml", "Meta")) -} - -hasJaspModuleRequisites <- function(path) { - all(file.exists(file.path(path, moduleRequisites()))) || - all(file.exists(file.path(path, binaryModuleRequisites()))) -} - insideTestEnvironment <- function() { testthat <- vapply(sys.frames(), function(frame) @@ -287,3 +161,7 @@ getGithubHeader <- function() { httr::add_headers(Authorization = sprintf("token %s", pat), Accept = "application/vnd.github.golden-comet-preview+json") } + +tidyPath <- function(path) { + gsub("[\\/]$", "", normalizePath(path)) # normalize path and strip trailing slashes +} diff --git a/R/zzz.R b/R/zzz.R index 1cce5c0..0d4fe55 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -2,10 +2,11 @@ internal = list(jaspToolsPath = "", dataset = "", state = list(), + modulePaths = "", modulesMd5Sums = list() ), - pkgOptions = list(module.dirs = "", - reinstall.modules = TRUE, + pkgOptions = list(reinstall.modules = TRUE, + install.deps = TRUE, view.in.rstudio = TRUE, html.dir = "", data.dirs = "", @@ -32,8 +33,8 @@ .initInternalPaths <- function() { suppressMessages({ - setPkgOption("html.dir", getJavascriptLocation()) - setPkgOption("data.dirs", getDatasetsLocations()) + setPkgOption("html.dir", getJaspDesktopJSLocation()) + setPkgOption("data.dirs", c(getJaspDesktopDatasetLocation(), getJaspToolsDatasetLocation())) }) } diff --git a/README.md b/README.md index 9193056..d5604d6 100644 --- a/README.md +++ b/README.md @@ -12,23 +12,21 @@ After loading jaspTools with `library(jaspTools)`, you need to call `setupJaspTo required once after every reinstall of jaspTools. ## Functionality -At the moment jaspTools has three classes of functions. -Each of these functions has documentation you may view by the usual syntax, e.g., `?runAnalysis`. - -The general classes are: +jaspTools has three classes of functions related to: +1. Modifying jaspTools' settings +2. Running JASP analyses +3. Testing JASP analyses +These are further explained below. All functions have documentation you may view by the usual syntax, e.g., `?runAnalysis`. +Note that before using functions from 2. or 3. you will need to tell jaspTools what module you're working on by calling `monitor("path/to/module")` (unless your working directory already points to a module). +jaspTools will use this information to locate R functions, tests, etc. The module(s) that you specify are automatically reinstalled every time you change your R, NAMESPACE or DESCRIPTION files. ### 1. Modifying jaspTools' settings - `viewPkgOptions`: views options in the package -- `setPkgOption`: change an options in the package (e.g., what module you are working on) +- `setPkgOption`: change an options in the package After `setupJaspTools()` retrieves all the necessary dependencies (packages, html, data files), the paths to a number of these dependencies are stored inside of the pkgOptions. You will generally not need to change them. -However, what you must usually do is tell jaspTools what modules you are working on (unless your working directory already points to a module): - -`setPkgOption("module.dirs", c("/path/to/module1", "/path/to/module2"))` - -jaspTools will use these to locate R functions, tests, etc. The module(s) that you specify are automatically reinstalled every time you change your R, NAMESPACE or DESCRIPTION files. ### 2. Running JASP analyses - `runAnalysis`: run a JASP analysis @@ -39,7 +37,7 @@ jaspTools will use these to locate R functions, tests, etc. The module(s) that y There are three general procedures to obtaining the options to run an analysis with in jaspTools. ##### Procedure 1 -The first procedure uses the .qml files to create option lists. +The first procedure uses the UI .qml files to create option lists. These lists will almost always require further editing. ###### Example @@ -52,9 +50,10 @@ options[["variables"]] <- "contBinom" runAnalysis("BinomialTest", dataset="debug.csv", options=options) ``` -##### Procedure 2 -And so the second procedure might be preferred. You can set the options to your liking in JASP and then save the .jasp file (it may contain several analyses). +##### Procedure 2 (recommended) +And so the second procedure might be preferred. You can set the analysis options to your liking in JASP and then save the .jasp file (it may contain several analyses). You can then let jaspTools read the .jasp file to extract the options from. +Note that you do not need to close JASP while jaspTools reads the .jasp file. So you can read the .jasp file in R, change some more UI options in JASP followed by a save, and run the read command in R again. ###### Example ``` @@ -114,9 +113,9 @@ It is not necessary to use a JASP dataset (such as the debug.csv file we showed data.frame to the dataset argument of the `runAnalysis` function. ### 3. Testing JASP analyses -- `testAll`: test all analyses +- `testAll`: test all analyses (in one or more modules) - `testAnalysis`: test a specific analysis -- `manageTestPlots`: validate a new plot or inspect differing test plots +- `manageTestPlots`: inspect failing test plots - `makeTestTable`: transform the output of a JASP table to short, testable list To ensure that no aspects of JASP are accidentally broken, we use unit testing. diff --git a/man/monitor.Rd b/man/monitor.Rd new file mode 100644 index 0000000..c69b7bb --- /dev/null +++ b/man/monitor.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/modules.R +\name{monitor} +\alias{monitor} +\title{Tell jaspTools what module you are currently working on.} +\usage{ +monitor(modulePaths = ".") +} +\arguments{ +\item{modulePaths}{Path to the root of the module (if no path is specified, then the current working directory will be used).} +} +\description{ +This information is used to find the correct analysis resources and monitor the module for any changes. +} +\examples{ + +monitor(c("~/Documents/Github/Regression", "~/Document/Github/Frequencies")) + +} diff --git a/man/setPkgOption.Rd b/man/setPkgOption.Rd index a4d582c..01da123 100644 --- a/man/setPkgOption.Rd +++ b/man/setPkgOption.Rd @@ -18,6 +18,6 @@ incorporated when any jaspTools function is called. } \examples{ -setPkgOption("module.dirs", c("~/Documents/Github/Regression", "~/Document/Github/Frequencies")) +setPkgOption("reinstall.modules", FALSE) } diff --git a/man/viewPkgOptions.Rd b/man/viewPkgOptions.Rd index ea6240e..ebed922 100644 --- a/man/viewPkgOptions.Rd +++ b/man/viewPkgOptions.Rd @@ -32,7 +32,6 @@ This option specifies where the html output of \code{runAnalysis} will be shown: When you run an analysis or test it, jaspTools calls the \emph{installed} version of the module. This option specifies if the installed version should be reinstalled automatically when you make any changes to your module. -\code{module.dirs}: -The directories that hold the source for the JASP module(s) you are working on. -These module directories are used to find the R functions etc. in \code{runAnalysis} and the various testing functions. +\code{install.deps}: +This option specifies if jaspTools should install missing deps of the module. }