Nothing
#' Functions to manipulate variables' or project's folder structure
#'
#' Variables in Crunch datasets are organized into folders, like in a file
#' system. Datasets are similarly organized into hierarchical Projects.
#' These functions allow you to create new folders and move objects into
#' folders. Their names, `mv` and `mkdir`, suggest their Unix file utility
#' inspiration.
#'
#' The functions have some differences from the strict behavior of their Unix
#' ancestors. For one, they work recursively, without additional arguments:
#' `mkdir` will make every directory necessary to construct the requested path,
#' even if all parent directories didn't already exist; and `mv` doesn't
#' require that the directory to move to already exist---it will effectively
#' call `mkdir` along the way.
#'
#' @param x A `CrunchDataset` or `Folder` (`VariableFolder` or `ProjectFolder`)
#' @param path A character "path" to the folder: either a
#' vector of nested folder names or a single string with nested folders
#' separated by a delimiter ("/" default, configurable via
#' `options(crunch.delimiter)`). The path is interpreted as
#' relative to the location of the folder `x` (when `x` is a dataset, that
#' means the root, top-level folder). `path` may also be a `Folder` object.
#' @param what A Variable, selection of variables from `dataset`, or any
#' other object that can be moved to a folder (e.g. a dataset when organizing
#' projects).
#' @return `x`, with the folder at `path` guaranteed to be created, and for
#' `mv`, containing `what` moved into it.
#' @seealso [cd()] to select a folder by path; [rmdir()] to delete a folder;
#' [folder()] to identify and set an object's parent folder;
#' \code{\link[base:files2]{base::dir.create()}}
#' if you literally want to create a directory in your local file system, which
#' `mkdir()` does not do
#' @examples
#' \dontrun{
#' ds <- loadDataset("Example survey")
#' ds <- mv(ds, c("gender", "age", "educ"), "Demographics")
#' ds <- mkdir(ds, "Key Performance Indicators/Brand X")
#' # These can also be chained together
#' require(magrittr)
#' ds <- ds %>%
#' mv(c("aware_x", "nps_x"), "Key Performance Indicators/Brand X") %>%
#' mv(c("aware_y", "nps_y"), "Key Performance Indicators/Brand Y")
#' # Can combine with cd() and move things with relative paths
#' ds %>%
#' cd("Key Performance Indicators/Brand X") %>%
#' mv("nps_x", "../Net Promoters")
#' # Can combine with folder() to move objects to the same place as something else
#' ds %>% mv("nps_y", folder(ds$nps_x))
#' # Now let's put ds in a Project
#' projects() %>%
#' mv(ds, "Brand Tracking Studies")
#' }
#' @export
mv <- function(x, what, path) {
## TODO: add an "after" argument, pass to addToFolder
## dplyr/tidyselect-ish functions, hacked in here (inspired by how pkgdown does it)
fns <- list(
starts_with = function(str, ...) grep(paste0("^", str), names(x), ...),
ends_with = function(str, ...) grep(paste0(str, "$"), names(x), ...),
matches = function(str, ...) grep(str, names(x), ...),
contains = function(str, ...) grep(str, names(x), ..., fixed = TRUE)
)
e2 <- substitute(substitute(zzz, fns), list(zzz = match.call()[["what"]]))
what <- eval.parent(eval(e2))
if (is.language(what)) {
## It's one of our fns. Eval it again
what <- eval(what)
}
if (!is.shojiObject(what)) {
## Character, numeric, logical. Extract from the dataset/folder
## TODO: add a "*" special case for for ShojiFolder [ method
what <- x[what]
}
f <- cd(x, path, create = TRUE)
.moveToFolder(f, what)
return(invisible(x))
}
#' @rdname mv
#' @export
mkdir <- function(x, path) {
## TODO: add an "after" argument, move created folder there
cd(x, path, create = TRUE)
# Refresh without busting cache, in case there was no change
# If there had been a change, cd() would have busted cache already
x <- do.call(class(x), crGET(self(x)))
return(invisible(x))
}
#' Change the name of the current folder
#'
#' If you just need to change the name of the folder you are currently in, you
#' can use `setName()`. It doesn't move variables or change anything
#' other than the name of the current folder.
#'
#' @param object A `Folder`
#' @param nm A character that is the new name the folder should have
#' @return `object`, with its name duly changed
#' @seealso [cd()] and [mv()]
#' @examples
#' \dontrun{
#' ds <- ds %>%
#' cd("Demographics") %>%
#' setName("Key Demos.")
#' }
#' @export
setName <- function(object, nm) {
# The arguments `object` for the folder object to be renamed and `nm` for
# the new name are to maintain consistency with `setNames()`
name(object) <- nm
return(invisible(object))
}
#' Change to different folder
#'
#' Like `cd` in a file system, this function takes you to a different folder,
#' given a relative path specification.
#'
#' @inheritParams mv
#' @param create logical: if the folder indicated by `path` does not exist,
#' should it be created? Default is `FALSE`. Argument mainly exists for the
#' convenience of `mv()`, which moves entities to a folder and ensures that
#' the folder exists. You can call `cd` directly with `create=TRUE`, though that
#' seems unnatural.
#' @return A `Folder` (`VariableFolder` or `ProjectFolder`)
#' @seealso [mv()] to move entities to a folder; [rmdir()] to delete a folder;
#' \code{\link[base:getwd]{base::setwd()}} if you literally want to change your working
#' directory in your local file system, which `cd()` does not do
#' @examples
#' \dontrun{
#' ds <- loadDataset("Example survey")
#' demo <- cd(ds, "Demographics")
#' names(demo)
#' # Or with %>%
#' require(magrittr)
#' ds <- ds %>%
#' cd("Demographics") %>%
#' names()
#' # Can combine with mv() and move things with relative paths
#' ds %>%
#' cd("Key Performance Indicators/Brand X") %>%
#' mv("nps_x", "../Net Promoters")
#' }
#' @export
cd <- function(x, path, create = FALSE) {
if (is.character(x)) {
## Probably user error
halt(
dQuote("cd()"),
" requires a Crunch Dataset or Folder as its first argument"
)
}
if (is.folder(path)) {
## Great! No lookup required
return(path)
}
if (is.dataset(x)) {
## Get the variable folders root catalog
x <- publicFolder(x)
}
if (!is.folder(x)) {
## Probably user error
halt(
dQuote("cd()"),
" requires a Crunch Dataset or Folder as its first argument"
)
}
out <- x[[path, create = create]]
if (!is.folder(out)) {
halt(deparse(path), " is not a folder")
}
return(out)
}
#' Delete a folder
#'
#' Like `rmdir` in a file system, this function removes a folder. Unlike the
#' file-system version, it does not require the folders to be empty.
#'
#' @inheritParams mv
#' @return `NULL`
#' @seealso [mv()] to move entities to a folder; [cd()] to select a folder;
#' \code{\link[base:files]{file.remove()}} if you literally want to delete a directory
#' from your local file system, which `rmdir()` does not do
#' @examples
#' \dontrun{
#' ds <- loadDataset("Example survey")
#' rmdir(ds, "Demographics")
#' # Or with %>%
#' require(magrittr)
#' ds <- ds %>%
#' rmdir("Demographics")
#' }
#' @export
rmdir <- function(x, path) {
to_delete <- cd(x, path)
if (is.project(x) && length(to_delete) > 0) {
halt(
"Cannot remove '", name(to_delete), "' because it is not empty. ",
"Move its contents somewhere else and then retry."
)
}
delete(to_delete)
invisible(refresh(x))
}
#' Find and move entities to a new folder
#'
#' @param x For `folder`, a Variable to find. For folder assignment, a Variable,
#' selection of variables in a
#' Dataset, or any other object that can be moved to a folder.
#' @return `folder` returns the parent folder of `x`, or `NULL` if the `x` is the root
#' level. `folder<-` returns the
#' `x` input, having been moved to the requested location.
#' @export
#' @examples
#' \dontrun{
#' ds <- loadDataset("Example survey")
#' folder(ds$income) <- "Demographics/Economic"
#' folder(ds$income)
#' ## [1] "Demographics" "Economic"
#' }
#' @seealso [mv()] [cd()]
folder <- function(x) {
if (is.folder(x)) {
## Parent folder is of the same type
cls <- class(x)
} else if (is.variable(x)) {
cls <- "VariableFolder"
} else {
halt("No folder for object of class ", class(x))
}
u <- parentFolderURL(x)
if (is.null(u)) {
## This has no parent. Root level, right?
return(NULL)
}
return(new(cls, crGET(u)))
}
#' @param value For assignment, a character "path" to the folder: either a
#' vector of nested folder names or a single string with nested folders
#' separated by a delimiter ("/" default)
#' @rdname folder
`folder<-` <- function(x, value) {
if (is.character(value)) {
## Turn path into folder relative to folder(x)
value <- cd(folder(x), value)
## TODO: update man page generally (including examples)
## Note in man page that this is relative; to absolute, use "/"
}
.moveToFolder(value, self(x))
return(refresh(x)) ## Actually, just need to get entity again, cache already busted
}
.moveToFolder <- function(folder, what) {
## Get the URLs of things to move
if (is.project(folder)) {
if (is.dataset(what)) {
# If moving a dataset into a project, get its self, but first
# check that we're not trying to move dataset to root project,
# which is not allowed
if (is.null(parentFolderURL(folder))) {
halt("Can't move a dataset to the top-level project")
}
what <- self(what)
}
} else {
## Variable folder
if (is.dataset(what)) {
## If moving a "dataset" into a variable folder, it's a variable
## catalog subset. So get the catalog.
what <- allVariables(what)
} else if (is.variable(what)) {
what <- self(what)
}
}
if (inherits(what, "ShojiCatalog")) {
what <- urls(what)
}
## No need to include vars that already exist in this folder
what <- setdiff(what, urls(folder))
if (length(what)) {
payload <- wrapCatalog(
index = sapply(what, emptyObject, simplify = FALSE)
)
if (length(what) > 1) {
# If we're only adding one thing, no need to specify the graph
# because by default it will be added to the end on the server.
# Only need to specify the graph if we care about the order of
# what we're sending (i.e. we're sending several (ordered)
# variables).
# Choosing not to send the graph should make the operation more
# robust to stale local state or other concurrency concerns
# (or overzealous/mistaken server validation)
# TODO later, also send if the mv() specifies a position ("after")
payload$graph <- I(c(folder@graph, what))
}
crPATCH(self(folder), body = toJSON(payload))
## Additional cache invalidation
## Drop all variable entities because their catalogs.folder refs are stale
dropOnly(what)
## Drop all folders
## Hard to be smarter about figuring out which folders are dirty without
## doing a bunch of GETs.
## TODO: should API provide a catalogs.parent for folders so we don't ../
dropCache(absoluteURL("../", self(folder)))
## Also drop the old hierarchical order (forgive the ugly rel path)
dropCache(absoluteURL("../../variables/hier/", self(folder)))
folder <- refresh(folder)
}
return(invisible(folder))
}
# recursively go through folders returning folder names or variables. This should
# be used sparingly since it will take a while to touch each node in the tree.
folder_recurse <- function(folder) {
# can't just use lapply(folder, ...) because we don't have a bespoke lapply
# for folders
out <- lapply(seq_along(folder), function(i) {
dir <- folder[[i]]
if (is.folder(dir)) {
out <- list(folder_recurse(dir))
names(out) <- name(dir)
return(out)
}
# otherwise, this is a variable, return the alias
return(alias(dir))
})
}
# take a folder/var tree (from folder_recurse) and copy it to dataset
plant_tree <- function(tree, dataset, folder_position) {
lapply(seq_along(tree), function(i) {
item <- tree[[i]]
if(!is.null(names(item))) {
# we have a folder!
make_folder_continue(item, dataset, folder_position)
} else {
# deal with the variables we have
vars <- Filter(Negate(is.list), item)
# make sure the vars are in dataset
vars <- vars[vars %in% aliases(allVariables(dataset))]
if (length(vars) > 0) {
mv(dataset, unlist(vars), folder_position)
# TODO: this should be possible without refreshing here.
folder_position <- refresh(folder_position)
setOrder(folder_position, unlist(vars))
}
folders <- Filter(is.list, item)
if (length(folders) > 0) {
lapply(folders, make_folder_continue, dataset, folder_position)
}
}
})
}
# make a folder, then continue down the tree specified in items (if it exists)
make_folder_continue <- function(item, dataset, folder_position) {
position <- cd(mkdir(cd(dataset, folder_position), names(item)), names(item))
plant_tree(item, dataset, folder_position = position)
}
#' Copy the folder structure from one dataset to another.
#'
#' @param source the dataset you want to copy the order from
#' @param target the dataset you want to copy the order to
#' @return returns the target dataset with source's folder structure
#' @examples
#' \dontrun{
#' ds <- copyFolders(ds1, ds)
#' }
#' @export
copyFolders <- function(source, target) {
if (!is.dataset(source) | !is.dataset(target)) {
halt("Both source and target must be Crunch datasets.")
}
source_tree <- folder_recurse(publicFolder(source))
plant_tree(list(source_tree), target, publicFolder(target))
return(invisible(refresh(target)))
}
# Recursively get all variables below a folder
# TODO: Use trampoline? https://community.rstudio.com/t/tidiest-way-to-do-recursion-safely-in-r/1408
# My initial tests say it's slower, but is safer if we ever expect a large number of folders
variablesBelowFolder <- function(folder) {
vars <- variables(folder)
dirs <- folder[types(folder) %in% "folder"]
out <- vars
# Don't preserve graph for now because not sure how graph is used & whether it could
# handle hierarchical graphs
out@graph <- list()
below <- lapply(seq_along(dirs), function(i) variablesBelowFolder(dirs[[i]])@index)
below <- unlist(below, recursive = FALSE)
out@index <- c(out@index, below)
VariableCatalog(out)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.