THIS IS A TEST INSTANCE ONLY! REPOSITORIES CAN BE DELETED AT ANY TIME!

Browse Source

Created package; previously part of an in-house package

pull/35/head
hb 6 years ago
commit
35f52a1c53
  1. 34
      .Rbuildignore
  2. 5
      .Rinstignore
  3. 26
      .coveralls.R
  4. 7
      .gitignore
  5. 193
      .make/.travis.yml.rsp
  6. 386
      .make/Makefile
  7. 127
      .make/README.md.rsp
  8. 147
      .make/appveyor.yml.rsp
  9. 77
      .travis.yml
  10. 16
      DESCRIPTION
  11. 1
      Makefile
  12. 14
      NEWS
  13. 49
      OVERVIEW.md
  14. 327
      R/listenv.R
  15. 66
      README.md
  16. 60
      appveyor.yml
  17. 21
      man/as.list.listenv.Rd
  18. 22
      man/cash-.listenv.Rd
  19. 21
      man/cash-set-.listenv.Rd
  20. 22
      man/get_variable.Rd
  21. 16
      man/length.listenv.Rd
  22. 18
      man/listenv.Rd
  23. 22
      man/map.Rd
  24. 17
      man/names.listenv.Rd
  25. 136
      tests/listenv.R

34
.Rbuildignore

@ -0,0 +1,34 @@
#----------------------------
# Git and SVN related
#----------------------------
^.svn
^.git
^.make
OVERVIEW[.]md
README[.]md
#----------------------------
# Travis-CI et al.
#----------------------------
^[.]travis[.]yml$
^travis-tool[.]sh$
^pkg-build[.]sh$
^appveyor[.]yml$
^covr-utils.R$
^[.]coveralls[.]R$
#----------------------------
# R related
#----------------------------
^cran-comments[.].*$
^vignettes/.*[.](pdf|PDF)$
^vignettes/.*[.](r|R)$
^vignettes/[.]install_extras$
^Makefile$
^incl
^NAMESPACE,.*[.]txt$
^nohup.*$
^[.]devel
^[.]test
^[.]check
^.*[.]tar[.]gz$

5
.Rinstignore

@ -0,0 +1,5 @@
# Certain LaTeX files (e.g. bib, bst, sty) must be part of the build
# such that they are available for R CMD check. These are excluded
# from the install using .Rinstignore in the top-level directory
# such as this one.
doc/.*[.](bib|bst|sty)$

26
.coveralls.R

@ -0,0 +1,26 @@
#################################################################
# Test coverage
#
# * covr-utils: https://github.com/HenrikBengtsson/covr-utils
# * covr: https://github.com/jimhester/covr
# * Coveralls: https://coveralls.io/
#
# Henrik Bengtsson
#################################################################
if (!file_test("-f", "covr-utils.R")) {
source("http://callr.org/install#R.utils[u]")
R.utils::downloadFile("https://raw.githubusercontent.com/HenrikBengtsson/covr-utils/master/covr-utils.R")
}
source("covr-utils.R")
# Exclusion rules
excl <- exclusions(
filter(r_files(), covr_lines), # Apply 'covr:' rules in source code
filter(r_files(), stop_lines) # Skip lines with stop().
)
str(excl)
# Run through tests, record source code coverage, and
# publish to Coveralls
covr_package(exclusions=excl, quiet=FALSE)

7
.gitignore

@ -0,0 +1,7 @@
.Rhistory
*~
**/*~
.check
.test
.o
.dll

193
.make/.travis.yml.rsp

@ -0,0 +1,193 @@
<%------------------------------------------------------------------------
Usage:
yml <- R.rsp::rfile(".travis.yml.rsp")
------------------------------------------------------------------------%>
<%
pd <- local({
pd <- NULL
function() {
if (is.null(pd)) {
pd <<- as.list(as.data.frame(read.dcf("DESCRIPTION"), stringsAsFactors=FALSE))
}
pd
}
})
pkg <- function() pd()$Package
deps <- function(what=c("Depends", "Imports", "Suggests", "SuggestsNote")) {
deps <- unlist(pd()[what], use.names=FALSE)
if (length(deps) == 0) return("")
deps <- unlist(strsplit(deps, split="[,:]"), use.names=FALSE)
deps <- gsub("[ \n\t]", "", deps)
deps <- gsub("[(].*[)]", "", deps)
deps <- setdiff(deps, c("R", "base", "datasets", "graphics", "grDevices", "methods", "parallel", "splines", "stats", "tcltk", "tools", "utils", "Recommended"))
sort(deps)
}
deps_on_R <- function() {
deps <- unlist(pd(), use.names=FALSE)
if (length(deps) == 0) return("")
deps <- unlist(strsplit(deps, split="[,:]"), use.names=FALSE)
deps <- gsub("^([ \n\t]+|[ \n\t]+$)", "", deps)
deps <- grep("^R[ ]*[(].*[)]$", deps, value=TRUE)
if (length(deps) == 0) {
op <- ">="
ver <- "0.0"
} else {
pattern <- ".*[(][ ]*([^0-9 ]*)[ ]*(.*)[)]$"
op <- gsub(pattern, "\\1", deps)
if (nchar(op) == 0L) op <- "=="
ver <- gsub(pattern, "\\2", deps)
}
comp <- eval(parse(text=sprintf("function(ver) { package_version(ver) %s package_version('%s') }", op, ver)))
list(op=op, ver=ver, comp=comp)
}
support_R <- function(ver) {
deps_on_R()$comp(ver)
}
cran <- local({
pkgs <- NULL
function() {
if (is.null(pkgs)) {
repos <- "http://cran.r-project.org"
data <- available.packages(contriburl=contrib.url(repos, "source"))
pkgs <<- rownames(data)
}
pkgs
}
})
bioc <- local({
pkgs <- NULL
function() {
if (is.null(pkgs)) {
repos <- "http://www.bioconductor.org/packages/devel/bioc/"
data <- available.packages(contriburl=contrib.url(repos, "source"))
pkgsA <- rownames(data)
repos <- "http://www.bioconductor.org/packages/devel/data/annotation/"
data <- available.packages(contriburl=contrib.url(repos, "source"))
pkgsB <- rownames(data)
repos <- "http://www.bioconductor.org/packages/devel/data/experiment/"
data <- available.packages(contriburl=contrib.url(repos, "source"))
pkgsC <- rownames(data)
pkgs <<- c(pkgsA, pkgsB, pkgsC)
}
pkgs
}
})
deps_on_cran <- function(...) {
deps <- deps(...)
deps[deps %in% cran()]
}
deps_on_bioc <- function(...) {
deps <- deps(...)
deps[deps %in% bioc()]
}
deps_elsewhere <- function(...) {
deps <- deps(...)
deps[!deps %in% c(cran(), bioc())]
}
install_cran <- function(...) {
pkgs <- deps_on_cran(...)
if (length(pkgs) > 0L) {
sprintf(" - $RENV install_r %s", paste(pkgs, collapse=" "))
} else ""
}
install_bioc <- function(...) {
pkgs <- deps_on_bioc(...)
if (length(pkgs) > 0L) {
sprintf(" - $RENV install_bioc %s", paste(pkgs, collapse=" "))
} else ""
}
%>
#----------------------------------------------------------------
# Travis-CI configuration for R packages
#
# REFERENCES:
# * Travis CI: https://travis-ci.org/
# * r-builder: https://github.com/metacran/r-builder
# * covr: https://github.com/jimhester/covr
# * Coveralls: https://coveralls.io/
#
# Validate your .travis.yml file at http://lint.travis-ci.org/
#----------------------------------------------------------------
language: c
env:
global:
- RENV="./pkg-build.sh" # r-builder
- R_BUILD_ARGS="--no-manual"
- R_CHECK_ARGS="--no-manual --as-cran"
- _R_CHECK_CRAN_INCOMING_=TRUE
- _R_CHECK_FORCE_SUGGESTS_=false
# Need LaTeX? (very time consuming!)
- BOOTSTRAP_LATEX=""
# Skip building vignettes, which iff LaTeX-based are very
# time consuming because LaTeX needs to be installed
# - R_BUILD_ARGS="--no-build-vignettes ${R_BUILD_ARGS}"
# - R_CHECK_ARGS="--no-build-vignettes ${R_CHECK_ARGS}"
# R versions r-builder should test on (ignored by r-travis)
matrix:
<%
rversion <- c(
"3.1.3" = "3.1.3",
"3.2.0" = "3.2.0",
"3.3.0" = "devel _R_CHECK_FULL_=TRUE"
)
for (v in names(rversion))
if (support_R(v)) cat(sprintf(" - RVERSION=%s\n", rversion[v]))
%>
before_install:
- echo RENV=$RENV
- curl -OL https://raw.githubusercontent.com/HenrikBengtsson/r-builder/master/pkg-build.sh;
- chmod 755 $RENV
- $RENV bootstrap
- if [ "BOOTSTRAP_LATEX" == "true" ]; then
(cd /tmp && curl -OL http://mirrors.ctan.org/macros/latex/contrib/xcolor.zip && cd /usr/share/texmf/tex/latex && sudo unzip /tmp/xcolor.zip && cd xcolor && sudo latex xcolor.ins && sudo texhash);
else
export R_RSP_COMPILELATEX_FALLBACK="copy-force";
fi
install:
<%= install_bioc(c("SuggestsNote")) %>
<%= install_cran(c("SuggestsNote")) %>
<%= install_bioc(c("Depends", "Imports")) %>
<%= install_cran(c("Depends", "Imports")) %>
<%= install_bioc(c("Suggests")) %>
<%= install_cran(c("Suggests")) %>
script:
- $RENV run_build
- $RENV run_check
after_success:
- $RENV dump_logs_by_extension out
- if [ -f ".coveralls.R" ]; then
$RENV install_devtools;
$RENV install_github HenrikBengtsson/covr;
curl -OL https://raw.githubusercontent.com/HenrikBengtsson/covr-utils/master/covr-utils.R;
$RENV run_script .coveralls.R;
fi
after_failure:
- $RENV dump_logs
notifications:
email:
on_success: change
on_failure: change
branches:
except:
- /-expt$/

386
.make/Makefile

@ -0,0 +1,386 @@
# Makefile for R packages
# CORE MACROS
ifeq ($(OS), Windows_NT)
CD=cd
CURDIR=$(subst \,/,"$(shell cmd.exe /C cd)")
else
CD=cd -P "$(CURDIR)"; cd # This handles the case when CURDIR is a softlink
endif
CP=cp
MAKE=make
MV=mv
RM=rm -f
MKDIR=mkdir -p
RMDIR=$(RM) -r
# PACKAGE MACROS
PKG_VERSION := $(shell grep -i ^version DESCRIPTION | cut -d : -d \ -f 2)
PKG_NAME := $(shell grep -i ^package DESCRIPTION | cut -d : -d \ -f 2)
PKG_DIR := $(shell basename "$(CURDIR)")
PKG_DIR := $(CURDIR)
PKG_TARBALL := $(PKG_NAME)_$(PKG_VERSION).tar.gz
PKG_ZIP := $(PKG_NAME)_$(PKG_VERSION).zip
PKG_TGZ := $(PKG_NAME)_$(PKG_VERSION).tgz
# FILE MACROS
FILES_R := $(wildcard R/*.R)
FILES_DATA := $(wildcard data/*)
FILES_MAN := $(wildcard man/*.Rd)
FILES_INCL := $(wildcard incl/*)
FILES_INST := $(wildcard inst/* inst/*/* inst/*/*/* inst/*/*/*/*)
FILES_VIGNETTES := $(wildcard vignettes/* vignettes/.install_extras)
FILES_SRC := $(wildcard src/* src/*/* src/*/*/* src/*/*/*/* src/*/*/*/*/* src/*/*/*/*/*/* src/*/*/*/*/*/*/* src/*/*/*/*/*/*/*/*)
FILES_TESTS := $(wildcard tests/*.R)
FILES_NEWS := $(wildcard NEWS inst/NEWS)
FILES_ROOT := DESCRIPTION NAMESPACE $(wildcard .Rbuildignore .Rinstignore)
PKG_FILES := $(FILES_ROOT) $(FILES_NEWS) $(FILES_R) $(FILES_DATA) $(FILES_MAN) $(FILES_INST) $(FILES_VIGNETTES) $(FILES_SRC) $(FILES_TESTS)
FILES_MAKEFILE := $(wildcard ../../Makefile)
# Has vignettes in 'vignettes/' or 'inst/doc/'?
DIR_VIGNS := $(wildcard vignettes inst/doc)
# R MACROS
R = R
R_SCRIPT = Rscript
R_HOME := $(shell $(R_SCRIPT) -e "cat(R.home())")
## R_USE_CRAN := $(shell $(R_SCRIPT) -e "cat(Sys.getenv('R_USE_CRAN', 'FALSE'))")
R_NO_INIT := --no-init-file
R_VERSION_STATUS := $(shell $(R_SCRIPT) -e "status <- tolower(R.version[['status']]); if (regexpr('unstable', status) != -1L) status <- 'devel'; cat(status)")
R_VERSION_X_Y := $(shell $(R_SCRIPT) -e "cat(gsub('[.][0-9]+$$', '', getRversion()))")
R_VERSION := $(shell $(R_SCRIPT) -e "cat(as.character(getRversion()))")
R_VERSION_FULL := $(R_VERSION)$(R_VERSION_STATUS)
R_LIBS_USER_X := $(shell $(R_SCRIPT) -e "cat(.libPaths()[1])")
R_OUTDIR := ../_R-$(R_VERSION_FULL)
## R_BUILD_OPTS :=
## R_BUILD_OPTS := $(R_BUILD_OPTS) --no-build-vignettes
R_CHECK_OUTDIR := $(R_OUTDIR)/$(PKG_NAME).Rcheck
_R_CHECK_CRAN_INCOMING_ = $(shell $(R_SCRIPT) -e "cat(Sys.getenv('_R_CHECK_CRAN_INCOMING_', 'FALSE'))")
_R_CHECK_XREFS_REPOSITORIES_ = $(shell if test "$(_R_CHECK_CRAN_INCOMING_)" = "TRUE"; then echo ""; else echo "invalidURL"; fi)
_R_CHECK_FULL_ = $(shell $(R_SCRIPT) -e "cat(Sys.getenv('_R_CHECK_FULL_', ''))")
R_CHECK_OPTS = --as-cran --timings $(shell if test "$(_R_CHECK_USE_VALGRIND_)" = "TRUE"; then echo "--use-valgrind"; fi)
R_RD4PDF = $(shell $(R_SCRIPT) -e "if (getRversion() < 3) cat('times,hyper')")
R_CRAN_OUTDIR := $(R_OUTDIR)/$(PKG_NAME)_$(PKG_VERSION).CRAN
HAS_ASPELL := $(shell $(R_SCRIPT) -e "cat(Sys.getenv('HAS_ASPELL', !inherits(try(aspell('DESCRIPTION', control=c('--master=en_US', '--add-extra-dicts=en_GB'), dictionaries='en_stats', program='aspell'), silent=TRUE), 'try-error')))")
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Main
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
all: build install check
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Displays macros
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
debug:
@echo CURDIR=\'$(CURDIR)\'
@echo R_HOME=\'$(R_HOME)\'
@echo
@echo PKG_DIR=\'$(PKG_DIR)\'
@echo PKG_NAME=\'$(PKG_NAME)\'
@echo PKG_VERSION=\'$(PKG_VERSION)\'
@echo PKG_TARBALL=\'$(PKG_TARBALL)\'
@echo
@echo HAS_ASPELL=\'$(HAS_ASPELL)\'
@echo
@echo R=\'$(R)\'
## @echo R_USE_CRAN=\'$(R_USE_CRAN)\'
@echo R_NO_INIT=\'$(R_NO_INIT)\'
@echo R_SCRIPT=\'$(R_SCRIPT)\'
@echo R_VERSION_X_Y=\'$(R_VERSION_X_Y)\'
@echo R_VERSION=\'$(R_VERSION)\'
@echo R_VERSION_STATUS=\'$(R_VERSION_STATUS)\'
@echo R_VERSION_FULL=\'$(R_VERSION_FULL)\'
@echo R_LIBS_USER_X=\'$(R_LIBS_USER_X)\'
@echo R_OUTDIR=\'$(R_OUTDIR)\'
@echo
@echo "Default packages:" $(shell $(R) --slave -e "cat(paste(getOption('defaultPackages'), collapse=', '))")
@echo
@echo R_BUILD_OPTS=\'$(R_BUILD_OPTS)\'
@echo
@echo R_CHECK_OUTDIR=\'$(R_CHECK_OUTDIR)\'
@echo _R_CHECK_CRAN_INCOMING_=\'$(_R_CHECK_CRAN_INCOMING_)\'
@echo _R_CHECK_XREFS_REPOSITORIES_=\'$(_R_CHECK_XREFS_REPOSITORIES_)\'
@echo _R_CHECK_FULL_=\'$(_R_CHECK_FULL_)\'
@echo R_CHECK_OPTS=\'$(R_CHECK_OPTS)\'
@echo R_RD4PDF=\'$(R_RD4PDF)\'
@echo
@echo R_CRAN_OUTDIR=\'$(R_CRAN_OUTDIR)\'
@echo
debug_full: debug
@echo
@echo FILES_ROOT=\'$(FILES_ROOT)\'
@echo FILES_R=\'$(FILES_R)\'
@echo FILES_DATA=\'$(FILES_DATA)\'
@echo FILES_MAN=\'$(FILES_MAN)\'
@echo FILES_INST=\'$(FILES_INST)\'
@echo FILES_VIGNETTES=\'$(FILES_VIGNETTES)\'
@echo FILES_SRC=\'$(FILES_SRC)\'
@echo FILES_TESTS=\'$(FILES_TESTS)\'
@echo FILES_INCL=\'$(FILES_INCL)\'
@echo
@echo DIR_VIGNS=\'$(DIR_VIGNS)\'
@echo dirname\(DIR_VIGNS\)=\'$(shell dirname $(DIR_VIGNS))\'
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Update / install
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Update existing packages
update:
$(R_SCRIPT) -e "try(update.packages(ask=FALSE)); source('http://bioconductor.org/biocLite.R'); biocLite(ask=FALSE);"
# Install missing dependencies
deps: DESCRIPTION
$(MAKE) update
$(R_SCRIPT) -e "x <- unlist(strsplit(read.dcf('DESCRIPTION',fields=c('Depends', 'Imports', 'Suggests')),',')); x <- gsub('([[:space:]]*|[(].*[)])', '', x); libs <- .libPaths()[file.access(.libPaths(), mode=2) == 0]; x <- unique(setdiff(x, c('R', rownames(installed.packages(lib.loc=libs))))); if (length(x) > 0) { try(install.packages(x)); x <- unique(setdiff(x, c('R', rownames(installed.packages(lib.loc=libs))))); source('http://bioconductor.org/biocLite.R'); biocLite(x); }"
setup: update deps
$(R_SCRIPT) -e "source('http://aroma-project.org/hbLite.R'); hbLite('R.oo')"
ns:
$(R_SCRIPT) -e "library('$(PKG_NAME)'); source('X:/devtools/NAMESPACE.R'); writeNamespaceSection('$(PKG_NAME)'); writeNamespaceImports('$(PKG_NAME)');"
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Build source tarball
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
$(R_OUTDIR)/$(PKG_TARBALL): $(PKG_FILES)
$(MKDIR) $(R_OUTDIR)
$(RM) $@
$(CD) $(R_OUTDIR);\
$(R) $(R_NO_INIT) CMD build $(R_BUILD_OPTS) $(PKG_DIR)
build: $(R_OUTDIR)/$(PKG_TARBALL)
build_force:
$(RM) $(R_OUTDIR)/$(PKG_TARBALL)
$(MAKE) install
# Make sure the tarball is readable
build_fix: $(R_OUTDIR)/$(PKG_TARBALL)
ifeq ($(OS), Windows_NT)
ifeq ($(USERNAME), hb)
$(MKDIR) X:/tmp/$(R_VERSION_FULL)
$(CP) -f $< X:/tmp/$(R_VERSION_FULL)/
$(RM) $<
$(MV) X:/tmp/$(R_VERSION_FULL)/$(<F) $<
endif
endif
build_fast: $(PKG_FILES)
$(MKDIR) $(R_OUTDIR)
$(RM) $@
$(CD) $(R_OUTDIR);\
$(R) $(R_NO_INIT) CMD build --keep-empty-dirs --no-build-vignettes --no-manual --no-resave-data --compact-vignettes="no" $(R_BUILD_OPTS) $(PKG_DIR)
build: $(R_OUTDIR)/$(PKG_TARBALL)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Install on current system
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
$(R_LIBS_USER_X)/$(PKG_NAME)/DESCRIPTION: $(R_OUTDIR)/$(PKG_TARBALL) build_fix
$(CD) $(R_OUTDIR);\
$(R) --no-init-file CMD INSTALL $(PKG_TARBALL)
install: $(R_LIBS_USER_X)/$(PKG_NAME)/DESCRIPTION
install_force:
$(RM) $(R_LIBS_USER_X)/$(PKG_NAME)/DESCRIPTION
$(MAKE) install
install_fast:
$(CD) $(R_OUTDIR);\
$(R) --no-init-file CMD INSTALL --no-docs --no-multiarch --no-byte-compile --no-test-load $(PKG_TARBALL)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Check source tarball
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
$(R_CHECK_OUTDIR)/.check.complete: $(R_OUTDIR)/$(PKG_TARBALL) build_fix
$(CD) $(R_OUTDIR);\
$(RM) -r $(PKG_NAME).Rcheck;\
export _R_CHECK_CRAN_INCOMING_=$(_R_CHECK_CRAN_INCOMING_);\
export _R_CHECK_CRAN_INCOMING_USE_ASPELL_=$(HAS_ASPELL);\
export _R_CHECK_XREFS_REPOSITORIES_=$(_R_CHECK_XREFS_REPOSITORIES_);\
export _R_CHECK_DOT_INTERNAL_=1;\
export _R_CHECK_USE_CODETOOLS_=1;\
export _R_CHECK_FORCE_SUGGESTS_=0;\
export R_RD4PDF=$(R_RD4PDF);\
export _R_CHECK_FULL_=$(_R_CHECK_FULL_);\
$(R) --no-init-file CMD check $(R_CHECK_OPTS) $(PKG_TARBALL);\
echo done > $(PKG_NAME).Rcheck/.check.complete
check: $(R_CHECK_OUTDIR)/.check.complete
check_force:
$(RM) -r $(R_CHECK_OUTDIR)
$(MAKE) check
clang:
clang -c -pedantic -Wall -I$(R_HOME)/include/ src/*.c
$(RM) *.o
valgrind_scan:
grep -E "^==.*==[ ]+(at|by) 0x" $(R_CHECK_OUTDIR)/tests/*.Rout | cat
grep "^==.* ERROR SUMMARY:" $(R_CHECK_OUTDIR)/tests/*.Rout | grep -v -F "ERROR SUMMARY: 0 errors" | cat
valgrind:
export _R_CHECK_USE_VALGRIND_=TRUE;\
$(MAKE) check_force
$(MAKE) valgrind_scan
# Check the line width of incl/*.(R|Rex) files [max 100 chars in R devel]
check_Rex:
$(R_SCRIPT) -e "if (!file.exists('incl')) quit(status=0); setwd('incl/'); fs <- dir(pattern='[.](R|Rex)$$'); ns <- sapply(fs, function(f) max(nchar(readLines(f)))); ns <- ns[ns > 100]; print(ns); if (length(ns) > 0L) quit(status=1)"
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Install and build binaries
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
$(R_OUTDIR)/$(PKG_ZIP): $(R_OUTDIR)/$(PKG_TARBALL) build_fix
$(CD) $(R_OUTDIR);\
$(R) --no-init-file CMD INSTALL --build --merge-multiarch $(PKG_TARBALL)
binary: $(R_OUTDIR)/$(PKG_ZIP)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Build Rd help files from Rdoc comments
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
rox:
$(R_SCRIPT) -e "roxygen2::roxygenize()"
Rd: check_Rex
$(R_SCRIPT) -e "setwd('..'); Sys.setlocale(locale='C'); R.oo::compileRdoc('$(PKG_NAME)', path='$(PKG_DIR)')"
%.Rd:
$(R_SCRIPT) -e "setwd('..'); Sys.setlocale(locale='C'); R.oo::compileRdoc('$(PKG_NAME)', path='$(PKG_DIR)', '$*.R')"
missing_Rd:
$(R_SCRIPT) -e "x <- readLines('$(R_CHECK_OUTDIR)/00check.log'); from <- grep('Undocumented code objects:', x)+1; if (length(from) > 0L) { to <- grep('All user-level objects', x)-1; x <- x[from:to]; x <- gsub('^[ ]*', '', x); x <- gsub('[\']', '', x); cat(x, sep='\n', file='999.missingdocs.txt'); }"
spell_Rd:
$(R_SCRIPT) -e "f <- list.files('man', pattern='[.]Rd$$', full.names=TRUE); utils::aspell(f, filter='Rd')"
spell_NEWS:
$(R_SCRIPT) -e "utils::aspell('$(FILES_NEWS)')"
spell:
$(R_SCRIPT) -e "utils::aspell('DESCRIPTION', filter='dcf')"
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Build package vignettes
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
$(R_OUTDIR)/vigns: install
$(MKDIR) $(R_OUTDIR)/vigns/$(shell dirname $(DIR_VIGNS))
$(CP) DESCRIPTION $(R_OUTDIR)/vigns/
$(CP) -r $(DIR_VIGNS) $(R_OUTDIR)/vigns/$(shell dirname $(DIR_VIGNS))
$(CD) $(R_OUTDIR)/vigns;\
$(R_SCRIPT) -e "v <- tools::buildVignettes(dir='.'); file.path(getwd(), v[['outputs']])"
vignettes: $(R_OUTDIR)/vigns
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Run package tests
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
$(R_OUTDIR)/tests/%.R: $(FILES_TESTS)
$(RMDIR) $(R_OUTDIR)/tests
$(MKDIR) $(R_OUTDIR)/tests
$(CP) $? $(R_OUTDIR)/tests
test_files: $(R_OUTDIR)/tests/*.R
test: $(R_OUTDIR)/tests/%.R
$(CD) $(R_OUTDIR)/tests;\
$(R_SCRIPT) -e "for (f in list.files(pattern='[.]R$$')) { print(f); source(f, echo=TRUE) }"
test_full: $(R_OUTDIR)/tests/%.R
$(CD) $(R_OUTDIR)/tests;\
export _R_CHECK_FULL_=TRUE;\
$(R_SCRIPT) -e "for (f in list.files(pattern='[.]R$$')) { print(f); source(f, echo=TRUE) }"
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Run extensive CRAN submission checks
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
$(R_CRAN_OUTDIR)/$(PKG_TARBALL): $(R_OUTDIR)/$(PKG_TARBALL) build_fix
$(MKDIR) $(R_CRAN_OUTDIR)
$(CP) $(R_OUTDIR)/$(PKG_TARBALL) $(R_CRAN_OUTDIR)
$(R_CRAN_OUTDIR)/$(PKG_NAME),EmailToCRAN.txt: $(R_CRAN_OUTDIR)/$(PKG_TARBALL)
$(CD) $(R_CRAN_OUTDIR);\
$(R_SCRIPT) -e "RCmdCheckTools::testPkgsToSubmit(delta=2/3)"
cran_setup: $(R_CRAN_OUTDIR)/$(PKG_TARBALL)
$(R_SCRIPT) -e "if (!nzchar(system.file(package='RCmdCheckTools'))) { source('http://aroma-project.org/hbLite.R'); hbLite('RCmdCheckTools', devel=TRUE); }"
cran: cran_setup $(R_CRAN_OUTDIR)/$(PKG_NAME),EmailToCRAN.txt
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Send to win-builder server
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
WIN_BUILDER = win-builder.r-project.org
win-builder-devel: $(R_OUTDIR)/$(PKG_TARBALL)
curl -v -T $? ftp://anonymous@$(WIN_BUILDER)/R-devel/
win-builder-release: $(R_OUTDIR)/$(PKG_TARBALL)
curl -v -T $? ftp://anonymous@$(WIN_BUILDER)/R-release/
win-builder: win-builder-devel win-builder-release
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Local repositories
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ifeq ($(OS), Windows_NT)
REPOS_PATH = T:/My\ Repositories/braju.com/R
else
REPOS_PATH = /tmp/hb/repositories/braju.com/R
endif
REPOS_SRC := $(REPOS_PATH)/src/contrib
$(REPOS_SRC):
$(MKDIR) "$@"
$(REPOS_SRC)/$(PKG_TARBALL): $(R_OUTDIR)/$(PKG_TARBALL) $(REPOS_SRC)
$(CP) $(R_OUTDIR)/$(PKG_TARBALL) $(REPOS_SRC)
repos: $(REPOS_SRC)/$(PKG_TARBALL)
Makefile: $(FILES_MAKEFILE)
$(R_SCRIPT) -e "d <- 'Makefile'; s <- '../../Makefile'; if (file_test('-nt', s, d) && (regexpr('Makefile for R packages', readLines(s, n=1L)) != -1L)) file.copy(s, d, overwrite=TRUE)"
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Refresh
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
refresh_%:
$(R_SCRIPT) -e "R.utils::downloadFile('https://raw.githubusercontent.com/HenrikBengtsson/r-package-files/master/templates/$*')"
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# GitHub, Travis CI, ...
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
README.md: .make/README.md.rsp
$(R_SCRIPT) -e "R.rsp::rfile('$<', postprocess=FALSE)"
.travis.yml: .make/.travis.yml.rsp
$(R_SCRIPT) -e "R.rsp::rfile('$<', postprocess=FALSE)"
appveyor.yml: .make/appveyor.yml.rsp
$(R_SCRIPT) -e "R.rsp::rfile('$<', postprocess=FALSE)"
config: .travis.yml appveyor.yml README.md

127
.make/README.md.rsp

@ -0,0 +1,127 @@
<%------------------------------------------------------------------------
Usage:
md <- R.rsp::rfile("README.md.rsp", postprocess=FALSE)
------------------------------------------------------------------------%>
<%
pkg <- local({
name <- NULL
function() {
if (is.null(name)) {
pd <- as.list(as.data.frame(read.dcf("DESCRIPTION"), stringsAsFactors=FALSE))
name <<- pd$Package
}
name
}
})
pkg_title <- local({
title <- NULL
function() {
if (is.null(title)) {
pd <- as.list(as.data.frame(read.dcf("DESCRIPTION"), stringsAsFactors=FALSE))
title <<- pd$Title
}
title
}
})
cran <- local({
available <- NULL
function() {
if (is.null(available)) {
repos <- "http://cran.r-project.org"
data <- available.packages(contriburl=contrib.url(repos, "source"))
available <<- pkg() %in% rownames(data)
}
available
}
})
bioc <- local({
available <- NULL
function() {
if (is.null(available)) {
repos <- "http://www.bioconductor.org/packages/devel/bioc/"
data <- available.packages(contriburl=contrib.url(repos, "source"))
available <<- pkg() %in% rownames(data)
}
available
}
})
github_repos = local({
repos <- NULL;
function() {
if (is.null(repos)) repos <<- gsub(".*:", "", gsub("[.]git", "", system2("git", args=c("config", "--get remote.origin.url"), stdout=TRUE)))
repos
}
})
repos <- function() {
if (cran()) "CRAN" else if (bioc()) "Bioonductor" else "GitHub"
}
repos_status <- function() {
if (cran()) {
sprintf("[status](http://cran.r-project.org/web/checks/check_results_%s.html)", pkg())
} else if (bioc()) {
biocURL <- function(type) {
sprintf('<a href="http://master.bioconductor.org/checkResults/%s/bioc-LATEST/%s"><img border="0" src="http://bioconductor.org/shields/build/%s/bioc/%s.svg" alt="Build status"></a> (%s)', type, pkg(), type, pkg(), type)
}
paste(biocURL(c("release", "devel")), collapse="</br>")
} else {
""
}
}
travis <- function() {
if (!file.exists(".travis.yml")) return("")
sprintf('<a href="https://travis-ci.org/%s"><img src="https://travis-ci.org/%s.svg" alt="Build status"></a>', github_repos(), github_repos())
}
appveyor <- function() {
if (!file.exists("appveyor.yml")) return("")
repos <- github_repos()
repos <- strsplit(repos, split="/")[[1]]
repos[2] <- gsub("[.]", "-", tolower(repos[2]))
repos <- paste(repos, collapse="/")
sprintf('<a href="https://ci.appveyor.com/project/%s"><img src="https://ci.appveyor.com/api/projects/status/github/%s" alt="Build status"></a>', repos, github_repos())
}
coveralls <- function() {
if (!file.exists(".coveralls.R")) return("")
sprintf('<a href="https://coveralls.io/r/%s"><img src="https://coveralls.io/repos/%s/badge.png?branch=develop" alt="Coverage Status"/></a>', github_repos(), github_repos())
}
%>
# <%=pkg()%>: <%=pkg_title()%>
<% if (file.exists("OVERVIEW.md")) { R.rsp::rcat(file="OVERVIEW.md") } %>
## Installation
<% if (cran()) { %>
R package <%=pkg()%> is available on [CRAN](http://cran.r-project.org/package=<%=pkg()%>) and can be installed in R as:
```r
install.packages('<%=pkg()%>')
```
<% } else if (bioc()) { %>
R package <%=pkg()%> is available on [Bioconductor](http://www.bioconductor.org/packages/devel/bioc/html/<%=pkg()%>.html) and can be installed in R as:
```r
source('http://bioconductor.org/biocLite.R')
biocLite('<%=pkg()%>')
```
<% } else { %>
R package <%=pkg()%> is only available via [GitHub](https://github.com/<%=github_repos()%>) and can be installed in R as:
```r
source('http://callr.org/install#<%=github_repos()%>')
```
<% } %>
## Software quality
| Resource: | <%=repos()%> | Travis CI | Appveyor |
| ------------- | ------------------- | ---------------- | ---------------- |
| _Platforms:_ | _Multiple_ | _Linux_ | _Windows_ |
| R CMD check | <%=repos_status()%> | <%=travis()%> | <%=appveyor() %> |
| Test coverage | | <%=coveralls()%> | |

147
.make/appveyor.yml.rsp

@ -0,0 +1,147 @@
<%------------------------------------------------------------------------
Usage:
yml <- R.rsp::rfile(".travis.yml.rsp")
------------------------------------------------------------------------%>
<%
pd <- local({
pd <- NULL
function() {
if (is.null(pd)) {
pd <<- as.list(as.data.frame(read.dcf("DESCRIPTION"), stringsAsFactors=FALSE))
}
pd
}
})
pkg <- function() pd()$Package
deps <- function(what=c("Depends", "Imports", "Suggests", "SuggestsNote")) {
deps <- unlist(pd()[what], use.names=FALSE)
if (length(deps) == 0) return("")
deps <- unlist(strsplit(deps, split="[,:]"), use.names=FALSE)
deps <- gsub("[(].*[)]", "", deps)
deps <- gsub("[ \n\t]", "", deps)
deps <- setdiff(deps, c("R", "base", "datasets", "graphics", "grDevices", "methods", "parallel", "splines", "stats", "tcltk", "tools", "utils", "Recommended"))
sort(deps)
}
cran <- local({
pkgs <- NULL
function() {
if (is.null(pkgs)) {
repos <- "http://cran.r-project.org"
data <- available.packages(contriburl=contrib.url(repos, "source"))
pkgs <<- rownames(data)
}
pkgs
}
})
bioc <- local({
pkgs <- NULL
function() {
if (is.null(pkgs)) {
repos <- "http://www.bioconductor.org/packages/devel/bioc/"
data <- available.packages(contriburl=contrib.url(repos, "source"))
pkgsA <- rownames(data)
repos <- "http://www.bioconductor.org/packages/devel/data/annotation/"
data <- available.packages(contriburl=contrib.url(repos, "source"))
pkgsB <- rownames(data)
repos <- "http://www.bioconductor.org/packages/devel/data/experiment/"
data <- available.packages(contriburl=contrib.url(repos, "source"))
pkgsC <- rownames(data)
pkgs <<- c(pkgsA, pkgsB, pkgsC)
}
pkgs
}
})
deps_on_cran <- function(...) {
deps <- deps(...)
deps[deps %in% cran()]
}
deps_on_bioc <- function(...) {
deps <- deps(...)
deps[deps %in% bioc()]
}
deps_elsewhere <- function(...) {
deps <- deps(...)
deps[!deps %in% c(cran(), bioc())]
}
install_cran <- function(...) {
pkgs <- deps_on_cran(...)
if (length(pkgs) > 0L) {
sprintf(" - travis-tool.sh install_r %s", paste(pkgs, collapse=" "))
} else ""
}
install_bioc <- function(...) {
pkgs <- deps_on_bioc(...)
if (length(pkgs) > 0L) {
sprintf(" - travis-tool.sh install_bioc %s", paste(pkgs, collapse=" "))
} else ""
}
%>
#----------------------------------------------------------------
# AppVeyor configuration for R packages
#
# REFERENCES:
# * AppVeyor CI: https://ci.appveyor.com/
# * r-travis: https://github.com/craigcitro/r-travis
# * covr: https://github.com/jimhester/covr
# * Coveralls: https://coveralls.io/
#
# Validate your .appveyor.yml file at
# https://ci.appveyor.com/tools/validate-yaml
#----------------------------------------------------------------
environment:
_R_CHECK_FORCE_SUGGESTS_: false
# DO NOT CHANGE the "init" and "install" sections below
# Download script file from GitHub
init:
ps: |
$ErrorActionPreference = "Stop"
Invoke-WebRequest http://raw.github.com/HenrikBengtsson/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1"
Import-Module '..\appveyor-tool.ps1'
install:
ps: Bootstrap
# Adapt as necessary starting from here
build_script:
<%= install_bioc(c("SuggestsNote")) %>
<%= install_cran(c("SuggestsNote")) %>
<%= install_bioc(c("Depends", "Imports")) %>
<%= install_cran(c("Depends", "Imports")) %>
<%= install_bioc(c("Suggests")) %>
<%= install_cran(c("Suggests")) %>
test_script:
- travis-tool.sh run_tests
on_failure:
- travis-tool.sh dump_logs
artifacts:
- path: '*.Rcheck\**\*.log'
name: Logs
- path: '*.Rcheck\**\*.out'
name: Logs
- path: '*.Rcheck\**\*.fail'
name: Logs
- path: '*.Rcheck\**\*.Rout'
name: Logs
- path: '\*_*.tar.gz'
name: Bits
- path: '\*_*.zip'
name: Bits

77
.travis.yml

@ -0,0 +1,77 @@
#----------------------------------------------------------------
# Travis-CI configuration for R packages
#
# REFERENCES:
# * Travis CI: https://travis-ci.org/
# * r-builder: https://github.com/metacran/r-builder
# * covr: https://github.com/jimhester/covr
# * Coveralls: https://coveralls.io/
#
# Validate your .travis.yml file at http://lint.travis-ci.org/
#----------------------------------------------------------------
language: c
env:
global:
- RENV="./pkg-build.sh" # r-builder
- R_BUILD_ARGS="--no-manual"
- R_CHECK_ARGS="--no-manual --as-cran"
- _R_CHECK_CRAN_INCOMING_=TRUE
- _R_CHECK_FORCE_SUGGESTS_=false
# Need LaTeX? (very time consuming!)
- BOOTSTRAP_LATEX=""
# Skip building vignettes, which iff LaTeX-based are very
# time consuming because LaTeX needs to be installed
# - R_BUILD_ARGS="--no-build-vignettes ${R_BUILD_ARGS}"
# - R_CHECK_ARGS="--no-build-vignettes ${R_CHECK_ARGS}"
# R versions r-builder should test on (ignored by r-travis)
matrix:
- RVERSION=3.1.3
- RVERSION=3.2.0
- RVERSION=devel _R_CHECK_FULL_=TRUE
before_install:
- echo RENV=$RENV
- curl -OL https://raw.githubusercontent.com/HenrikBengtsson/r-builder/master/pkg-build.sh;
- chmod 755 $RENV
- $RENV bootstrap
- if [ "BOOTSTRAP_LATEX" == "true" ]; then
(cd /tmp && curl -OL http://mirrors.ctan.org/macros/latex/contrib/xcolor.zip && cd /usr/share/texmf/tex/latex && sudo unzip /tmp/xcolor.zip && cd xcolor && sudo latex xcolor.ins && sudo texhash);
else
export R_RSP_COMPILELATEX_FALLBACK="copy-force";
fi
install:
- $RENV install_r R.utils
script:
- $RENV run_build
- $RENV run_check
after_success:
- $RENV dump_logs_by_extension out
- if [ -f ".coveralls.R" ]; then
$RENV install_devtools;
$RENV install_github HenrikBengtsson/covr;
curl -OL https://raw.githubusercontent.com/HenrikBengtsson/covr-utils/master/covr-utils.R;
$RENV run_script .coveralls.R;
fi
after_failure:
- $RENV dump_logs
notifications:
email:
on_success: change
on_failure: change
branches:
except:
- /-expt$/

16
DESCRIPTION

@ -0,0 +1,16 @@
Package: listenv
Version: 0.2.0
Depends:
R (>= 3.1.2)
Imports:
R.utils (>= 2.0.2),
Title: Environments Behaving As Lists
Authors@R: c(person("Henrik", "Bengtsson", role=c("aut", "cre", "cph"),
email = "henrikb@braju.com"))
Author: Henrik Bengtsson [aut, cre, cph]
Maintainer: Henrik Bengtsson <henrikb@braju.com>
Description: List Environments are environments that can be subsetted as lists, e.g. 'x <- listenv(); x[[2]] <- "b"; names(x)[2] <- "B"; print(x$B)'.
License: LGPL (>= 2.1)
LazyLoad: TRUE
URL: https://github.com/HenrikBengtsson/listenv
BugReports: https://github.com/HenrikBengtsson/listenv/issues

1
Makefile

@ -0,0 +1 @@
include .make/Makefile

14
NEWS

@ -0,0 +1,14 @@
Package: listenv
================
Version: 0.2.0 [2015-05-19]
o Moved list environments from an in-house package to its own package.
Version: 0.1.4 [2015-05-02]
o Added print() for listenv:s.
o CLEANUP: Using tempvar() of R.utils.
Version: 0.1.0 [2015-02-07]
o Created.

49
OVERVIEW.md

@ -0,0 +1,49 @@
Copyright Henrik Bengtsson, 2015
## List environments
_List environments_ are environments that behaves as lists by
overriding the subsetting functions for environments such that they
also emulates some of the index subsetting that lists have. For example,
```r
x <- listenv()
for (i in 1:3) {
x[[i]] <- i^2
}
names(x) <- c("a", "b", "c")
```
The values of a list environment can be retrieved individually via
`x$b` and `x[["b"]]` just as with regular environments, but also via
`x[[2]]` as with regular lists.
To retrieve all values of an environment as a list, use `as.list(x)`.
### Examples
Here is a longer set of examples illustrating what the list environments provides:
```r
> x <- listenv()
> x[[1]] <- { 1 }
> x[[3]] <- { "Hello world!" }
> length(x)
3
> seq_along(x)
[1] 1 2 3
> names(x) <- c("a", "b", "c")
> x$b <- TRUE
> x[[1]]
1
> as.list(x)
$a
[1] 1
$b
[1] TRUE
$c
[1] "Hello world!"
```
It is possible to also specify the length upfront, e.g.
```r
> x <- listenv(length=4)
> seq_along(x)
[1] 1 2 3 4
```

327
R/listenv.R

@ -0,0 +1,327 @@
#' Create a list environment
#'
#' @param length The number of NULL elements from start.
#'
#' @return An environment of class `listenv`.
#'
#' @export
listenv <- function(length=0L) {
stopifnot(length >= 0L)
metaenv <- new.env(parent=parent.frame())
metaenv$.listenv.map <- rep(NA_character_, times=length)
env <- new.env(parent=metaenv)
class(env) <- c("listenv", class(env))
env
}
#' @export
print.listenv <- function(x, ...) {
s <- sprintf("`%s` with %d elements: %s\n", class(x)[1L], length(x), hpaste(names(x)))
cat(s)
}
#' Variable name map for elements of list environment
#'
#' @param x A list environment.
#'
#' @return The a named character vector
#'
#' @aliases map.listenv map<- map<-.listenv
#' @export
#' @keywords internal
map <- function(...) UseMethod("map")
#' @export
map.listenv <- function(x, ...) {
get(".listenv.map", envir=x, inherits=TRUE)
}
#' @export
`map<-` <- function(x, value) UseMethod("map<-")
#' @export
`map<-.listenv` <- function(x, value) {
stopifnot(is.character(value))
assign(".listenv.map", value, envir=x, inherits=TRUE)
invisible(x)
}
#' Number of elements in list environment
#'
#' @param x A list environment.
#'
#' @export
#' @keywords internal
length.listenv <- function(x) {
length(map(x))
}
#' Names of elements in list environment
#'
#' @param x A list environment.
#'
#' @aliases names<-.listenv
#' @export
#' @keywords internal
names.listenv <- function(x) {
names(map(x))
}
#' @export
`names<-.listenv` <- function(x, value) {
map <- map(x)
if (is.null(value)) {
} else if (length(value) != length(map)) {
stop(sprintf("Number of names does not match the number of elments: %s != %s", length(value), length(map)))
}
## if (any(duplicated(value))) {
## stop("Environments cannot have duplicate names on elements")
## }
names(map) <- value
map(x) <- map
invisible(x)
}
#' List representation of a list environment
#'
#' @param x A list environment.
#' @param ... Not used.
#'
#' @return A list.
#'
#' @export
#' @keywords internal
as.list.listenv <- function(x, ...) {
vars <- map(x)
res <- vector("list", length=length(vars))
names(res) <- names(x)
ok <- !is.na(vars)
res[ok] <- mget(vars[ok], envir=x, inherits=FALSE)
res
}
#' Get elements of list environment
#'
#' @param x A list environment.
#' @param name The name or index of the element to retrieve.
#'
#' @return The value of an element or NULL if the element does not exist
#'
#' @aliases [[.listenv
#' @export
#' @keywords internal
`$.listenv` <- function(x, name) {
#' @keywords internal
## str(list(method="$<-", name=name))
map <- map(x)
var <- map[name]
## Non-existing variable?
if (is.na(var)) return(NULL)
get(var, envir=x, inherits=FALSE)
}
#' @export
`[[.listenv` <- function(x, i, ...) {
map <- map(x)
## str(list(method="[[", i=i))
if (is.character(i)) {
name <- i
i <- match(name, table=names(map))
if (is.na(i)) return(NULL)
} else if (!is.numeric(i)) {
return(NextMethod("[["))
}
if (length(i) != 1L) {
stop("Subsetting of more than one element at the time is not allowed for listenv's: ", length(i))
}
n <- length(map)
if (i < 1L || i > n) {
stop(sprintf("Subscript out of bounds [%d,%d]: %d", min(0,n), n, i), call.=FALSE)
}
var <- map[i]
## Return default (NULL)?
if (is.na(var) || !exists(var, envir=x, inherits=FALSE)) return(NULL)
get(var, envir=x, inherits=FALSE)
}
assignByName <- function(...) UseMethod("assignByName")
#' @importFrom R.utils hpaste
assignByName.listenv <- function(x, name, value) {
## Argument 'name':
if (length(name) == 0L) {
stop("Cannot assign value. Zero-length name.", call.=FALSE)
} else if (length(name) > 1L) {
stop("Cannot assign value. More than one name specified: ", hpaste(name), call.=FALSE)
} else if (nchar(name) == 0L) {
stop("Cannot assign value. Empty name specific: ", name, call.=FALSE)
}
map <- map(x)
## Map to an existing or a new element?
if (is.element(name, names(map))) {
var <- map[name]
## A new variable?
if (is.na(var)) {
var <- name
map[name] <- name
map(x) <- map
}
} else {
var <- name
## Append to map
map <- c(map, var)
names(map)[length(map)] <- var
map(x) <- map
}
## Assign value
assign(var, value, envir=x, inherits=FALSE)
invisible(x)
} # assignByName()
assignByIndex <- function(...) UseMethod("assignByIndex")
#' @importFrom R.utils tempvar
#' @importFrom R.utils hpaste
assignByIndex.listenv <- function(x, i, value) {
## Argument 'i':
if (length(i) == 0L) {
stop("Cannot assign value. Zero-length index.", call.=FALSE)
} else if (length(i) > 1L) {
stop("Cannot assign value. More than one index specified: ", hpaste(i), call.=FALSE)
} else if (!is.finite(i)) {
stop("Cannot assign value. Non-finite index: ", i, call.=FALSE)
} else if (i < 1L) {
stop("Cannot assign value. Non-positive index: ", i, call.=FALSE)
}
map <- map(x)
n <- length(map)
## Variable name
var <- map[i]
## Non-existing variable?
if (is.na(var)) {
## Expand map?
if (i > n) {
extra <- rep(NA_character_, times=i-n)
map <- c(map, extra)
}
## Create internal variable name
var <- tempvar(value=value, envir=x, inherits=FALSE)
map[i] <- var
## Update map
map(x) <- map
} else {
assign(var, value, envir=x, inherits=FALSE)
}
invisible(x)
} # assignByIndex()
#' Set an element of list environment
#'
#' @param x A list environment.
#' @param name Name or index of element
#' @param value The value to assign to the element
#'
#' @aliases [[<-.listenv
#' @export
#' @keywords internal
`$<-.listenv` <- function(x, name, value) {
assignByName(x, name=name, value=value)
}
#' @export
`[[<-.listenv` <- function(x, i, value) {
## str(list(method="[[<-", i=i, value=value))
if (is.character(i)) {
x <- assignByName(x, name=i, value=value)
} else if (is.numeric(i)) {
x <- assignByIndex(x, i=i, value=value)
} else if (is.symbol(i)) {
name <- eval(i, envir=parent.frame())
x <- assignByName(x, name=name, value=value)
} else {
stop(sprintf("Subsetted [[<- assignment to listenv's is only supported for names and indices, not %s", mode(i)), call.=FALSE)
}
return(invisible(x))
}
#' Get name of variable for a specific element of list environment
#'
#' @param x A list environment.
#' @param name The name or index of element of interest.
#'
#' @return The name of the underlying variable
#'
#' @aliases get_variable.listenv
#' @export
#' @keywords internal
get_variable <- function(...) UseMethod("get_variable")
#' @importFrom R.utils tempvar
#' @export
get_variable.listenv <- function(x, name, create=TRUE, ...) {
## str(list(method="get_variable", name))
if (length(name) != 1L) {
stop("Subscript must be a scalar: ", length(name), .call=FALSE)
}
map <- map(x)
## Existing variable?
var <- map[name]
if (!is.na(var)) return(var)
## Create new variable
if (is.character(name)) {
var <- name
## Non-existing name?
if (!is.element(name, names(map))) {
map <- c(map, var)
names(map)[length(map)] <- var
}
} else if (is.numeric(name)) {
i <- name
## Expand map?
if (i > length(map)) {
extra <- rep(NA_character_, times=i-length(map))
map <- c(map, extra)
}
## Create internal variable name
var <- tempvar(value=NULL, envir=x, inherits=FALSE)
map[i] <- var
} else {
stop("Subscript must be a name or an index: ", mode(name), .call=FALSE)
}
## Update map?
if (create) map(x) <- map
var
}

66
README.md

@ -0,0 +1,66 @@
# listenv: Environments Behaving As Lists
Copyright Henrik Bengtsson, 2015
## List environments
_List environments_ are environments that behaves as lists by
overriding the subsetting functions for environments such that they
also emulates some of the index subsetting that lists have. For example,
```r
x <- listenv()
for (i in 1:3) {
x[[i]] <- i^2
}
names(x) <- c("a", "b", "c")
```
The values of a list environment can be retrieved individually via
`x$b` and `x[["b"]]` just as with regular environments, but also via
`x[[2]]` as with regular lists.
To retrieve all values of an environment as a list, use `as.list(x)`.
### Examples
Here is a longer set of examples illustrating what the list environments provides:
```r
> x <- listenv()
> x[[1]] <- { 1 }
> x[[3]] <- { "Hello world!" }
> length(x)
3
> seq_along(x)
[1] 1 2 3
> names(x) <- c("a", "b", "c")
> x$b <- TRUE
> x[[1]]
1
> as.list(x)
$a
[1] 1
$b
[1] TRUE
$c
[1] "Hello world!"
```
It is possible to also specify the length upfront, e.g.
```r
> x <- listenv(length=4)
> seq_along(x)
[1] 1 2 3 4
```
## Installation
R package listenv is only available via [GitHub](https://github.com/HenrikBengtsson/listenv) and can be installed in R as:
```r
source('http://callr.org/install#HenrikBengtsson/listenv')
```
## Software quality
| Resource: | GitHub | Travis CI | Appveyor |
| ------------- | ------------------- | ---------------- | ---------------- |
| _Platforms:_ | _Multiple_ | _Linux_ | _Windows_ |
| R CMD check | | <a href="https://travis-ci.org/HenrikBengtsson/listenv"><img src="https://travis-ci.org/HenrikBengtsson/listenv.svg" alt="Build status"></a> | <a href="https://ci.appveyor.com/project/HenrikBengtsson/listenv"><img src="https://ci.appveyor.com/api/projects/status/github/HenrikBengtsson/listenv" alt="Build status"></a> |
| Test coverage | | <a href="https://coveralls.io/r/HenrikBengtsson/listenv"><img src="https://coveralls.io/repos/HenrikBengtsson/listenv/badge.png?branch=develop" alt="Coverage Status"/></a> | |

60
appveyor.yml

@ -0,0 +1,60 @@
#----------------------------------------------------------------
# AppVeyor configuration for R packages
#
# REFERENCES:
# * AppVeyor CI: https://ci.appveyor.com/
# * r-travis: https://github.com/craigcitro/r-travis
# * covr: https://github.com/jimhester/covr
# * Coveralls: https://coveralls.io/
#
# Validate your .appveyor.yml file at
# https://ci.appveyor.com/tools/validate-yaml
#----------------------------------------------------------------
environment:
_R_CHECK_FORCE_SUGGESTS_: false
# DO NOT CHANGE the "init" and "install" sections below
# Download script file from GitHub
init:
ps: |
$ErrorActionPreference = "Stop"
Invoke-WebRequest http://raw.github.com/HenrikBengtsson/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1"
Import-Module '..\appveyor-tool.ps1'
install:
ps: Bootstrap
# Adapt as necessary starting from here
build_script:
- travis-tool.sh install_r R.utils
test_script:
- travis-tool.sh run_tests
on_failure:
- travis-tool.sh dump_logs
artifacts:
- path: '*.Rcheck\**\*.log'
name: Logs
- path: '*.Rcheck\**\*.out'
name: Logs
- path: '*.Rcheck\**\*.fail'
name: Logs
- path: '*.Rcheck\**\*.Rout'
name: Logs
- path: '\*_*.tar.gz'
name: Bits
- path: '\*_*.zip'
name: Bits

21
man/as.list.listenv.Rd

@ -0,0 +1,21 @@
% Generated by roxygen2 (4.1.1): do not edit by hand
% Please edit documentation in R/listenv.R
\name{as.list.listenv}
\alias{as.list.listenv}
\title{List representation of a list environment}
\usage{
\method{as.list}{listenv}(x, ...)
}
\arguments{
\item{x}{A list environment.}
\item{...}{Not used.}
}
\value{
A list.
}
\description{
List representation of a list environment
}
\keyword{internal}

22
man/cash-.listenv.Rd

@ -0,0 +1,22 @@
% Generated by roxygen2 (4.1.1): do not edit by hand
% Please edit documentation in R/listenv.R
\name{$.listenv}
\alias{$.listenv}
\alias{[[.listenv}
\title{Get elements of list environment}
\usage{
\method{$}{listenv}(x, name)
}
\arguments{
\item{x}{A list environment.}
\item{name}{The name or index of the element to retrieve.}
}
\value{
The value of an element or NULL if the element does not exist
}
\description{
Get elements of list environment
}
\keyword{internal}

21
man/cash-set-.listenv.Rd

@ -0,0 +1,21 @@
% Generated by roxygen2 (4.1.1): do not edit by hand
% Please edit documentation in R/listenv.R
\name{$<-.listenv}
\alias{$<-.listenv}
\alias{[[<-.listenv}
\title{Set an element of list environment}
\usage{
\method{$}{listenv}(x, name) <- value
}
\arguments{
\item{x}{A list environment.}
\item{name}{Name or index of element}
\item{value}{The value to assign to the element}
}
\description{
Set an element of list environment
}
\keyword{internal}

22
man/get_variable.Rd

@ -0,0 +1,22 @@
% Generated by roxygen2 (4.1.1): do not edit by hand
% Please edit documentation in R/listenv.R
\name{get_variable}
\alias{get_variable}
\alias{get_variable.listenv}
\title{Get name of variable for a specific element of list environment}
\usage{
get_variable(...)
}
\arguments{
\item{x}{A list environment.}
\item{name}{The name or index of element of interest.}
}
\value{
The name of the underlying variable
}
\description{
Get name of variable for a specific element of list environment
}
\keyword{internal}

16
man/length.listenv.Rd

@ -0,0 +1,16 @@
% Generated by roxygen2 (4.1.1): do not edit by hand
% Please edit documentation in R/listenv.R
\name{length.listenv}
\alias{length.listenv}
\title{Number of elements in list environment}
\usage{
\method{length}{listenv}(x)
}
\arguments{
\item{x}{A list environment.}
}
\description{
Number of elements in list environment
}
\keyword{internal}

18
man/listenv.Rd

@ -0,0 +1,18 @@
% Generated by roxygen2 (4.1.1): do not edit by hand
% Please edit documentation in R/listenv.R
\name{listenv}
\alias{listenv}
\title{Create a list environment}
\usage{
listenv(length = 0L)
}
\arguments{
\item{length}{The number of NULL elements from start.}
}
\value{
An environment of class `listenv`.
}
\description{
Create a list environment
}

22
man/map.Rd

@ -0,0 +1,22 @@
% Generated by roxygen2 (4.1.1): do not edit by hand
% Please edit documentation in R/listenv.R
\name{map}
\alias{map}
\alias{map.listenv}
\alias{map<-}
\alias{map<-.listenv}
\title{Variable name map for elements of list environment}
\usage{
map(...)
}
\arguments{
\item{x}{A list environment.}
}
\value{
The a named character vector
}
\description{
Variable name map for elements of list environment
}
\keyword{internal}

17
man/names.listenv.Rd

@ -0,0 +1,17 @@
% Generated by roxygen2 (4.1.1): do not edit by hand
% Please edit documentation in R/listenv.R
\name{names.listenv}
\alias{names.listenv}
\alias{names<-.listenv}
\title{Names of elements in list environment}
\usage{
\method{names}{listenv}(x)
}
\arguments{
\item{x}{A list environment.}
}
\description{
Names of elements in list environment
}
\keyword{internal}

136
tests/listenv.R

@ -0,0 +1,136 @@
library("listenv")
ovars <- ls(envir=globalenv())
oopts <- options(warn=1)
x <- listenv()
print(length(x))
print(names(x))
stopifnot(length(x) == 0)
x$a <- 1
print(length(x))
print(names(x))
stopifnot(length(x) == 1)
stopifnot(identical(names(x), c("a")))
stopifnot(identical(x$a, 1), is.null(x$b))
x$b <- 2
print(length(x))
print(names(x))
stopifnot(length(x) == 2)
stopifnot(identical(names(x), c("a", "b")))
stopifnot(identical(x$b, 2))
x$a <- 0
print(length(x))
print(names(x))
stopifnot(length(x) == 2)
stopifnot(identical(names(x), c("a", "b")))
stopifnot(identical(x[["a"]], 0))
x$"a" <- 1
print(length(x))
print(names(x))
stopifnot(length(x) == 2)
stopifnot(identical(names(