rlist/ 0000755 0001751 0000144 00000000000 12700434260 011423 5 ustar hornik users rlist/tests/ 0000755 0001751 0000144 00000000000 12700425755 012576 5 ustar hornik users rlist/tests/testthat.R 0000644 0001751 0000144 00000000051 12700425755 014555 0 ustar hornik users library(testthat)
test_check("rlist")
rlist/tests/testthat/ 0000755 0001751 0000144 00000000000 12700434260 014425 5 ustar hornik users rlist/tests/testthat/test-internal.R 0000644 0001751 0000144 00000000364 12700425755 017355 0 ustar hornik users context("internal")
test_that("internal", {
e <- list2env(list(a = 1), parent = emptyenv())
expect_error(try_list(expression(symbol1, symbol2), envir = e))
expect_equal(try_list(expression(symbol1, symbol2), 0, envir = e), 0)
})
rlist/tests/testthat/test-utils.R 0000644 0001751 0000144 00000001176 12700425755 016703 0 ustar hornik users context("utils")
test_that("tryGet", {
e <- new.env()
e$x <- 1
expect_identical(tryGet(x, 0, envir = e), e$x)
expect_identical(with(e, tryGet(x, 0)), e$x)
expect_identical(tryGet(y, 0), 0)
expect_error(tryGet(y + 1, 0))
expect_identical(list.map(list(list(a = 1, b = 2), list(a = 1, c = 2)), a + tryGet(b,
0) + tryGet(c, 0)), list(3, 3))
})
test_that("tryEval", {
e <- new.env()
e$x <- 1
expect_identical(with(e, tryEval(x, 0)), e$x)
expect_identical(tryEval(y, 0), 0)
expect_identical(list.map(list(list(a = 1, b = 2), list(a = 1, c = 2)), tryEval(a +
b + c, 0)), list(0, 0))
})
rlist/tests/testthat/test-find.R 0000644 0001751 0000144 00000001764 12700425755 016466 0 ustar hornik users context("find")
test_that("list.findi", {
x <- list(1, 2, c(3, 4))
expect_identical(list.findi(x, any(. >= 2)), 2L)
expect_identical(list.findi(x, any(. >= 2), 2), c(2L, 3L))
expect_identical(list.findi(x, any(. >= 2), 3), c(2L, 3L))
expect_identical(list.findi(x, any(. >= 2), 4), c(2L, 3L))
})
test_that("list.find", {
# simple list
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(list.find(x, type == "B", 1), x[2])
expect_identical(list.find(x, type == "B", 2), x[c(2, 3)])
# list of vectors
x <- list(a = c(x = 1, y = 2), b = c(x = 3, y = 4))
expect_identical(list.find(x, sum(.) >= 4), x[2])
# list of lists
l1 <- list(a = list(x = 1, y = 2), b = list(x = 2, y = 3))
expect_identical(list.find(l1, sum(unlist(.)) <= 4), l1[1])
lapply(2:4, function(i) list.find(l1, sum(unlist(.)) <= i))
})
rlist/tests/testthat/test-group.R 0000644 0001751 0000144 00000004473 12700425755 016702 0 ustar hornik users context("group")
test_that("list.group", {
# simple list
x <- list(a = 1, b = 2, c = 3, d = 2, e = 3, f = 1)
expect_identical(list.group(x, .), list(`1` = list(a = 1, f = 1), `2` = list(b = 2,
d = 2), `3` = list(c = 3, e = 3)))
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(list.group(x, type), list(A = x["p1"], B = x[c("p2", "p3")]))
expect_identical(list.group(x, mean(unlist(score))), list(`8` = x["p3"], `9` = x[c("p1",
"p2")]))
expect_identical(list.group(1:10, . %% 3, . %% 2), structure(list(`0` = structure(list(`0` = 6L,
`1` = c(3L, 9L)), .Names = c("0", "1")), `1` = structure(list(`0` = c(4L,
10L), `1` = c(1L, 7L)), .Names = c("0", "1")), `2` = structure(list(`0` = c(2L,
8L), `1` = 5L), .Names = c("0", "1"))), .Names = c("0", "1", "2")))
expect_identical(list.group(c(3, 1, 3, 3, 2, 2), letters[.], sorted = FALSE),
list(c = c(3, 3, 3), a = 1, b = c(2, 2)))
expect_identical(list.group(c(3, 1, 3, 3, 2, 2), letters[.], sorted = TRUE),
list(a = 1, b = c(2, 2), c = c(3, 3, 3)))
# test dynamic scoping
lapply(2:4, function(i) list.group(x, sum(unlist(score)) <= i))
})
test_that("list.ungroup", {
xg <- list(`1` = list(a = 1, f = 1), `2` = list(b = 2, d = 2), `3` = list(c = 3,
e = 3))
xg2 <- list(a = list(a = 1, f = 1), c = list(b = 2, d = 2), b = list(c = 3, e = 3))
expect_identical(list.ungroup(xg, sort.names = TRUE), list(a = 1, b = 2, c = 3,
d = 2, e = 3, f = 1))
expect_identical(list.ungroup(xg2, sort.names = FALSE), list(a = 1, f = 1, b = 2,
d = 2, c = 3, e = 3))
x <- list(a = list(a1 = list(x=list(x1=2,x2=3),y=list(y1=1,y2=3)), a0 = list(x=list(x1=1,x2=5),y=list(y1=0,y2=1))),
b = list(b1 = list(x=list(x1=2,x2=6),y=list(y1=3,y2=2))))
expect_identical(list.ungroup(x, level = 1L), c(x$a, x$b))
expect_identical(list.ungroup(x, level = 2L), c(unlist(unname(x$a), recursive = FALSE), unlist(unname(x$b), recursive = FALSE)))
expect_identical(list.ungroup(x, level = 1L, group.names = TRUE), unlist(x, recursive = FALSE))
expect_identical(list.ungroup(x, level = 2L, group.names = TRUE), c(unlist(unlist(x, recursive = FALSE), recursive = FALSE)))
})
rlist/tests/testthat/test-io.R 0000644 0001751 0000144 00000003575 12700425755 016157 0 ustar hornik users context("io")
test_that("list.serialize", {
x <- list(a = 1, b = 2, c = 3, d = list(x = 1, y = 2))
f <- tempfile(fileext = ".json")
expect_identical(list.serialize(x, f), x)
expect_identical(list.unserialize(f), x)
file.remove(f)
f <- tempfile()
expect_identical(list.serialize(x, f), x)
expect_identical(list.unserialize(f), x)
file.remove(f)
})
test_that("list.save, list.load", {
x <- list(a = 1, b = 2, c = 3, d = list(x = 1, y = c(1, 2, 3)))
f <- tempfile(fileext = ".json")
expect_equal(list.save(x, file = f), x)
expect_equal(list.load(f), x)
file.remove(f)
f <- tempfile(fileext = ".yaml")
expect_equal(list.save(x, file = f), x)
expect_equal(list.load(f), x)
file.remove(f)
f <- tempfile(fileext = ".rds")
expect_equal(list.save(x, file = f), x)
expect_equal(list.load(f), x)
file.remove(f)
f <- tempfile(fileext = ".rdata")
expect_equal(list.save(x, file = f), x)
expect_equal(list.load(f), x)
file.remove(f)
f <- tempfile(fileext = ".xml")
writeLines("1", f)
expect_equal(list.load(f), list(a = "1"))
file.remove(f)
# guess
f <- tempfile()
expect_equal(list.save(x, file = f, type = "yaml"), x)
expect_equal(list.load(f), x)
file.remove(f)
f <- tempfile()
expect_error(list.save(x, file = f, type = "unsupported_file_type"))
f <- tempfile()
expect_error(list.load(f, "unsupported_file_type"))
n <- 3
fs <- vapply(seq_len(n), function(i) tempfile(fileext = ".json"), character(1L))
ds <- lapply(seq_len(n), function(i) list(a = i, b = i + 1L))
Map(function(d, f) {
list.save(d, f)
}, ds, fs)
expect_equal(unname(list.load(fs)), ds)
expect_equal(list.load(fs, action = "ungroup"), list.ungroup(lapply(fs, list.load)))
expect_equal(list.load(fs, action = "merge"), do.call("list.merge", ds))
file.remove(fs)
})
rlist/tests/testthat/test-join.R 0000644 0001751 0000144 00000001360 12700425755 016475 0 ustar hornik users context("join")
test_that("list.join", {
l1 <- list(p1 = list(name = "Ken", age = 20), p2 = list(name = "James", age = 21),
p3 = list(name = "Jenny", age = 20))
l2 <- list(p1 = list(name = "Jenny", age = 20, type = "A"), p2 = list(name = "Ken",
age = 20, type = "B"), p3 = list(name = "James", age = 21, type = "A"))
l3 <- list(p1 = list(name = "Ken", age = 20, type = "B"), p2 = list(name = "James",
age = 21, type = "A"), p3 = list(name = "Jenny", age = 20, type = "A"))
expect_identical(list.join(l1, l2, name), l3)
expect_identical(list.join(l1, l2, .[c("name", "age")]), l3)
expect_identical(list.join(l1, l2, .[c("name", "age")], .[c("name", "age")]),
l3)
expect_error(list.join(l1, l2, name, age))
})
rlist/tests/testthat/test-subset.R 0000644 0001751 0000144 00000003703 12700425755 017046 0 ustar hornik users context("subset")
test_that("subset.list", {
# simple list
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(subset(x, type == "B"), x[c(2, 3)])
expect_identical(subset(x, type == "B", score$c1), list(p2 = 9, p3 = 9))
expect_identical(subset(x, type == "B", item ~ item$score$c2), list(p2 = 9, p3 = 7))
# scoping
lapply(1:3, function(i) subset(x, score$c2 >= 7 + i, score$c1 + i))
# list of vectors
x <- list(a = c(x = 1, y = 2), b = c(x = 3, y = 4))
expect_identical(subset(x, .["x"] >= 2, .["y"]), list(b = c(y = 4)))
expect_identical(subset(x, sum(.) <= 4, max(.)), list(a = 2))
# list of lists
l1 <- list(a = list(x = 1, y = 2), b = list(x = 2, y = 3))
expect_identical(subset(l1, sum(unlist(.)) <= 4, unlist(.)), list(a = c(x = 1,
y = 2)))
# list of objects of list mode
l2 <- lapply(1:10, function(i) {
x <- rnorm(100)
y <- 2 * x + rnorm(100) * 0.2
lm(y ~ x)
})
expect_identical(subset(l2, mean(residuals) >= 0, mean(residuals^2)), {
lst <- lapply(l2, function(item) {
if (mean(item$residuals) >= 0) {
mean(item$residuals^2)
}
})
lst[vapply(lst, is.null, logical(1))] <- NULL
lst
})
expect_identical(subset(l2, mean(.$residuals) >= 0, mean(.$residuals^2)), {
lst <- lapply(l2, function(item) {
if (mean(item$residuals) >= 0) {
mean(item$residuals^2)
}
})
lst[vapply(lst, is.null, logical(1))] <- NULL
lst
})
expect_identical(subset(l2, mean(resid(.)) >= 0, mean(resid(.)^2)), {
lst <- lapply(l2, function(item) {
if (mean(item$residuals) >= 0) {
mean(item$residuals^2)
}
})
lst[vapply(lst, is.null, logical(1))] <- NULL
lst
})
# list of S4 objects
# list of other objects
})
rlist/tests/testthat/test-sort.R 0000644 0001751 0000144 00000003444 12700425755 016532 0 ustar hornik users context("sort")
test_that("list.sort", {
# simple list
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(list.sort(x, type, (score$c2)), x[c(1, 2, 3)])
expect_identical(list.sort(x, min(score$c1, score$c2)), x[c(3, 1, 2)])
# list of vectors
x <- list(a = c(x = 1, y = 2), b = c(x = 3, y = 4))
expect_identical(list.sort(x, sum(.)), x[c(1, 2)])
expect_identical(list.sort(x, (sum(.))), x[c(2, 1)])
expect_identical(list.sort(c("a", "b", "c")), c("a", "b", "c"))
expect_identical(list.sort(c("a", "b", "c"), (.)), c("c", "b", "a"))
expect_identical(list.sort(list("a", "b", "c"), .), list("a", "b", "c"))
expect_identical(list.sort(list("a", "b", "c"), (.)), list("c", "b", "a"))
# warning in irregular cases
expect_warning(list.sort(list(1, 2, c(2, 3)), .), "^Non-single value in column")
expect_warning(list.sort(list(1, 2, "a"), .), "^Inconsistent classes")
lapply(1:3, function(i) list.sort(x, sum(.) + i))
})
test_that("list.order", {
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_equal(list.order(x, type, (score$c2)), c(1, 2, 3))
expect_equal(list.order(x, min(score$c1, score$c2)), c(3, 1, 2))
x <- list(a = c(x = 1, y = 2), b = c(x = 3, y = 4))
expect_equal(lapply(1:3, function(i) list.order(x, sum(.) + i)), list(c(1, 2),
c(1, 2), c(1, 2)))
# warning in irregular cases
expect_warning(list.order(list(1, 2, c(2, 3)), .), "^Non-single value in column")
expect_warning(list.order(list(1, 2, "a"), .), "^Inconsistent classes")
})
rlist/tests/testthat/test-select.R 0000644 0001751 0000144 00000001371 12700425755 017017 0 ustar hornik users context("select")
test_that("list.select", {
# simple list
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(list.select(x, type), lapply(x, function(xi) {
xi["type"]
}))
expect_identical(list.select(x, type, score), lapply(x, function(xi) {
xi[c("type", "score")]
}))
expect_identical(list.select(x, range = range(unlist(score))), lapply(x, function(xi) {
list(range = range(unlist(xi$score)))
}))
expect_identical(list.select(x, n = length(.)), lapply(x, function(xi) {
list(n = length(xi))
}))
lapply(1:3, function(i) list.select(x, p = score$c1 + i))
})
rlist/tests/testthat/test-filter.R 0000644 0001751 0000144 00000002334 12700425755 017025 0 ustar hornik users context("filter")
test_that("list.is", {
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(list.is(x, type == "B"), unlist(lapply(x, function(item) item$type ==
"B")))
l1 <- list(a = list(x = 1, y = 2), b = list(x = 2, y = 3))
expect_identical(lapply(2:4, function(i) list.is(l1, sum(unlist(.)) <= i)),
list(c(a = FALSE, b = FALSE), c(a = TRUE, b = FALSE), c(a = TRUE, b = FALSE)))
})
test_that("list.filter", {
# simple list
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(list.filter(x, type == "B"), x[c(2, 3)])
# list of vectors
x <- list(a = c(x = 1, y = 2), b = c(x = 3, y = 4))
expect_identical(list.filter(x, sum(.) >= 4), x["b"])
# list of lists
l1 <- list(a = list(x = 1, y = 2), b = list(x = 2, y = 3))
expect_identical(list.filter(l1, sum(unlist(.)) <= 4), l1["a"])
# test dynamic scoping
lapply(2:4, function(i) list.filter(l1, sum(unlist(.)) <= i))
})
rlist/tests/testthat/test-basic.R 0000644 0001751 0000144 00000035656 12700425755 016636 0 ustar hornik users context("basic")
test_that("list.append", {
# atomic vector
expect_identical(list.append(c(1, 2, 3), 4, 5), c(1, 2, 3, 4, 5))
expect_identical(list.append(c(a = 1, b = 2), c = 3), c(a = 1, b = 2, c = 3))
# simple list
x <- list(a = 1, b = 2)
expect_identical(list.append(x, c = 3), c(x, c = 3))
expect_identical(lapply(1:2, function(i) list.append(x, d = i)), lapply(1:2,
function(i) c(x, d = i)))
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
p4 <- list(type = "A", score = list(c1 = 10, ce = 6))
expect_identical(list.append(x, p4 = p4), c(x, p4 = list(p4)))
})
test_that("list.prepend", {
# atomic vector
expect_identical(list.prepend(c(1, 2, 3), 4, 5), c(4, 5, 1, 2, 3))
expect_identical(list.prepend(c(a = 1, b = 2), c = 3), c(c = 3, a = 1, b = 2))
# simple list
x <- list(a = 1, b = 2)
expect_identical(list.prepend(x, c = 3), c(c = 3, x))
expect_identical(lapply(1:2, function(i) list.prepend(x, d = i)), lapply(1:2,
function(i) c(list(d = i), x)))
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
p0 <- list(type = "A", score = list(c1 = 10, ce = 6))
expect_identical(list.prepend(x, p0 = p0), c(p0 = list(p0), x))
})
test_that("list.insert", {
expect_identical(list.insert(c(1, 2, 3), 2, 0), c(1, 0, 2, 3))
x <- list(a = 1, b = 2, c = 3)
expect_identical(list.insert(x, 2, q = 0), list(a = 1, q = 0, b = 2, c = 3))
expect_identical(lapply(1:2, function(i) list.insert(x, 2, q = i)), lapply(1:2,
function(i) list(a = 1, q = i, b = 2, c = 3)))
})
test_that("list.extract", {
# simple list
x <- list(a = 1, b = 2, c = 3)
expect_identical(list.extract(x, 1), x[[1]])
expect_identical(list.extract(x, "a"), x[["a"]])
expect_identical(lapply(1:2, function(i) list.extract(x, i)), lapply(1:2, function(i) x[[i]]))
})
test_that("list.subset", {
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(list.subset(x, c("p1", "p2")), x[c("p1", "p2")])
expect_identical(list.subset(x, grepl("^p", names(x))), x[])
})
test_that("list.count", {
# simple list
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_equal(list.count(x, type == "B"), 2)
expect_equal(list.count(x, score$c1 < 10), 2)
expect_equal(lapply(c(8, 9, 10), function(i) list.count(x, score$c1 <= i)), list(0,
2, 3))
# list of vectors
x <- list(a = c(x = 1, y = 2), b = c(x = 3, y = 4))
expect_equal(list.count(x, sum(.) >= 3), 2)
expect_equal(list.count(x, mean(.) >= 3), 1)
})
test_that("list.reverse", {
# simple list
x <- list(a = 1, b = 2, c = 3)
expect_identical(list.reverse(x), x[c(3, 2, 1)])
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(list.reverse(x), x[c(3, 2, 1)])
})
test_that("list.merge", {
# simple list
x <- list(a = 1, b = 2, c = list(x = 1, y = 2))
expect_identical(list.merge(x, list(b = 5)), list(a = 1, b = 5, c = list(x = 1,
y = 2)))
expect_identical(list.merge(x, list(c = list(z = 3))), list(a = 1, b = 2, c = list(x = 1,
y = 2, z = 3)))
# multiple lists
l1 <- list(a = 1, b = list(x = 1, y = 1))
l2 <- list(a = 2, b = list(z = 2))
l3 <- list(a = 2, b = list(x = 3))
expect_identical(list.merge(l1, l2, l3), modifyList(modifyList(l1, l2), l3))
})
test_that("list.do", {
expect_equal(list.do(list(1, 2, 3), sum), sum(1:3))
expect_equal(list.do(list(1, 2, 3), "sum"), sum(1:3))
})
test_that("list.apply", {
expect_identical(list.apply(c(1, 2, 3), "+", 1), list(2, 3, 4))
expect_identical(list.apply(c(1, 2, 3), `+`, 1), list(2, 3, 4))
})
test_that("list.rbind", {
x <- lapply(1:10, function(i) c(a = i, b = i^2))
expect_identical(list.rbind(x), do.call(rbind, x))
})
test_that("list.cbind", {
x <- list(data.frame(a = rnorm(10), b = rnorm(10)), data.frame(c = rnorm(10),
d = rnorm(10)), data.frame(e = rnorm(10), f = rnorm(10)))
expect_identical(list.cbind(x), do.call(cbind, x))
})
test_that("list.stack", {
x <- lapply(1:10, function(i) list(a = i, b = i^2))
expect_false(is.null(list.stack(x)))
x <- lapply(1:10, function(i) list(a = c(i, i + 1), b = c(i^2, i^2 + 1)))
expect_false(is.null(list.stack(x)))
})
test_that("list.match", {
# simple list
x <- list(a = 1, b = 2)
expect_identical(list.match(x, "a"), x["a"])
expect_identical(list.match(x, "[ab]"), x)
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(list.match(x, "p[12]"), x[c("p1", "p2")])
})
test_that("list.take, list.skip", {
# simple list
x <- list(a = 1, b = 2)
expect_identical(list.take(x, 1), x[1])
expect_identical(list.take(x, 0), x[0])
expect_identical(list.take(x, -1), x[-1])
expect_identical(list.skip(x, 1), x[2])
expect_identical(list.skip(x, 0), x)
expect_identical(list.skip(x, -1), x[1])
})
test_that("list.takeWhile, list.skipWhile", {
# simple list
x <- list(a = 1, b = 2)
expect_identical(list.takeWhile(x, . <= 1), x[1])
expect_equal(length(list.takeWhile(x, . >= 3)), 0)
lapply(1:3, function(i) list.takeWhile(x, . <= i))
expect_error(list.takeWhile(x, . >= p))
expect_identical(list.skipWhile(x, . <= 1), x[2])
expect_equal(length(list.skipWhile(x, . >= 3)), 0)
lapply(1:3, function(i) list.skipWhile(x, . <= i))
expect_error(list.skipWhile(x, . >= p))
})
test_that("list.remove", {
x <- list(a = 1, b = 2)
expect_identical(list.remove(x, c(FALSE, TRUE)), x[1])
expect_identical(list.remove(x, 1), x[2])
expect_identical(list.remove(x, "b"), x["a"])
expect_identical(list.remove(x, c("a", "b")), x[0])
})
test_that("list.exclude", {
x <- list(a = 1, b = 2)
expect_identical(list.exclude(x, . >= 2), x[1])
})
test_that("list.sample", {
x <- list(a = 1, b = 2, c = 3)
expect_equal(length(list.sample(x, 2, weight = .)), 2)
lapply(1:2, function(n) list.sample(x, n))
})
test_that("list.cases", {
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_equal(list.cases(x, type, sort = T), c("A", "B"))
expect_equal(list.cases(x, mean(unlist(score))), c(8, 9))
expect_equal(lapply(c("A", "B"), function(i) list.cases(x, type == i)),
list(c(FALSE, TRUE), c(FALSE, TRUE)))
x <- list(x = LETTERS[1:3], y = LETTERS[3:5])
expect_equal(list.cases(x), Reduce(union, x))
})
test_that("list.common", {
x <- list(c("a", "b", "c"), c("a", "b"), c("b", "c"))
expect_equal(list.common(x, .), c("b"))
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_equal(list.common(x, names(.)), c("type", "score"))
expect_equal(list.common(x, names(score)), c("c1", "c2"))
x <- list(x = LETTERS[1:3], y = LETTERS[3:5])
expect_equal(list.common(x), Reduce(intersect, x))
})
test_that("list.all", {
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_equal(list.all(x, type == "B"), FALSE)
expect_equal(list.all(x, mean(unlist(score)) >= 6), TRUE)
expect_equal(sapply(8:10, function(i) list.all(x, score$c1 >= i)), c(TRUE, TRUE, FALSE))
expect_equal(list.all(logical()), all())
expect_equal(list.all(logical(), na.rm = TRUE), all(na.rm = TRUE))
expect_equal(list.all(c(TRUE, NA, TRUE)), all(c(TRUE, NA, TRUE)))
expect_equal(list.all(c(TRUE, NA, FALSE)), all(c(TRUE, NA, FALSE)))
expect_equal(list.all(c(TRUE, NA, TRUE), na.rm = TRUE), all(c(TRUE, NA, TRUE),
na.rm = TRUE))
expect_equal(list.all(c(TRUE, NA, FALSE), na.rm = TRUE), all(c(TRUE, NA, FALSE),
na.rm = TRUE))
expect_equal(list.all(list(c(1,2,3),c(2,3,4)), . <= 3, na.rm = FALSE), NA)
expect_equal(list.all(list(1,-2,10), x ~ x > 0), FALSE)
expect_equal(list.all(list(1,-2,10), x ~ x + 10 > 0), TRUE)
expect_error(list.all(list(1,2,3), . > p))
})
test_that("list.any", {
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_equal(list.any(x, type == "B"), TRUE)
expect_equal(list.any(x, mean(unlist(score)) >= 20), FALSE)
expect_equal(sapply(8:10, function(i) list.any(x, score$c1 >= i)), c(T, T, T))
expect_equal(list.any(logical()), any())
expect_equal(list.any(logical(), na.rm = TRUE), any(na.rm = TRUE))
expect_equal(list.any(c(TRUE, NA, TRUE)), any(c(TRUE, NA, TRUE)))
expect_equal(list.any(c(TRUE, NA, FALSE)), any(c(TRUE, NA, FALSE)))
expect_equal(list.any(c(TRUE, NA, TRUE), na.rm = TRUE), any(c(TRUE, NA, TRUE),
na.rm = TRUE))
expect_equal(list.any(c(TRUE, NA, FALSE), na.rm = TRUE), any(c(TRUE, NA, FALSE),
na.rm = TRUE))
expect_equal(list.any(list(1,-2,10), x ~ x > 0), TRUE)
expect_equal(list.any(list(1,-2,10), x ~ x - 10 > 0), FALSE)
expect_error(list.any(list(1,2,3), . > p))
})
test_that("list.first", {
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_equal(list.first(x, type == "B"), x[[2L]])
expect_equal(list.first(x, unlist(score$c1 <= 9)), x[[2L]])
expect_identical(list.first(x, score$c1 < 9 || score$c3 >= 5), NULL)
expect_equal(list.first(c(NA, NA, 1), . <= 1), 1)
expect_error(list.first(list(1,2,3), . > p))
})
test_that("list.last", {
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_equal(list.last(x, type == "B"), x[[3L]])
expect_equal(list.last(x, unlist(score$c1 <= 9)), x[[3L]])
expect_identical(list.last(x, score$c1 < 9 || score$c3 >= 5), NULL)
expect_error(list.last(list(1,2,3), . > p))
})
test_that("list.table", {
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
x.types <- c("A", "B", "B")
x.c1 <- c(10, 9, 9)
expect_identical(list.table(x, type), table(type = x.types))
expect_identical(list.table(x, type, c1 = score$c1), table(type = x.types, c1 = x.c1))
x <- list(list(a = 1, b = NULL), list(a = 2, b = 1), list(a = 3, b = 1))
expect_identical(as.integer(list.table(x, a, b)), c(0L, 1L, 1L, 1L, 0L, 0L))
})
test_that("list.zip", {
a <- list(1, 2)
b <- list("a", "b")
expect_identical(list.zip(a, b), list(list(a = 1, b = "a"), list(a = 2, b = "b")))
})
test_that("list.unzip", {
x <- list(p1 = list(a = 1, b = 5), p2 = list(a = 2, b = 3))
x1 <- list(p1 = list(a = 1, b = 5), p2 = list(a = 2, b = 3, c = 4))
expect_identical(list.unzip(x), list(a = c(p1 = 1, p2 = 2), b = c(p1 = 5, p2 = 3)))
expect_identical(list.unzip(x1, .fields = "union"), list(a = c(p1 = 1, p2 = 2),
b = c(p1 = 5, p2 = 3), c = c(p1 = NA, p2 = 4)))
expect_identical(list.unzip(x, a = "identity"), list(a = list(p1 = 1, p2 = 2),
b = c(p1 = 5, p2 = 3)))
expect_identical(list.unzip(x, a = NULL), list(b = c(p1 = 5, p2 = 3)))
})
test_that("list.flatten", {
p <- list(a = 1, b = list(b1 = 2, b2 = 3), c = list(c1 = list(c11 = "a", c12 = "x"),
c2 = 3))
q <- list(a = c(1, 2, 3), b = list(x = 1, y = list(z = 1, z2 = 2)))
expect_identical(list.flatten(p), list(a = 1, b.b1 = 2, b.b2 = 3, c.c1.c11 = "a",
c.c1.c12 = "x", c.c2 = 3))
expect_identical(list.flatten(q), list(a = c(1, 2, 3), b.x = 1, b.y.z = 1, b.y.z2 = 2))
p <- list(a=1,b=list(x="a",y="b",z=10))
expect_identical(list.flatten(p), list(a=1, b.x = "a", b.y = "b", b.z = 10))
expect_identical(list.flatten(p, classes = "numeric"), list(a = 1, b.z = 10))
expect_identical(list.flatten(p, classes = "character"), list(b.x = "a", b.y = "b"))
expect_identical(list.flatten(p, classes = "integer"), list())
expect_identical(list.flatten(p, use.names = FALSE), list(1, "a", "b", 10))
})
test_that("list.names", {
expect_identical(list.names(list(a = 1, b = 2)), c("a", "b"))
expect_identical(list.names(list(1, 2)), NULL)
expect_identical(list.names(list(1, 2), letters[.]), list(a = 1, b = 2))
expect_identical(list.names(list(a = 1, b = 2), NULL), list(1, 2))
})
test_that("list.parse", {
expect_identical(list.parse(c(a = 1)), list(a = 1))
expect_identical({
mat <- matrix(c(1, 2, 3, 4, 5, 6), nrow = 3)
rownames(mat) <- c("a", "b", "c")
colnames(mat) <- paste0("V", 1:2)
list.parse(mat)
}, list(a = list(V1 = 1, V2 = 4), b = list(V1 = 2, V2 = 5), c = list(V1 = 3,
V2 = 6)))
expect_identical(list.parse("hello"), list("hello"))
expect_identical(list.parse(data.frame(x = c(1, 2), y = c(2, 3))), list(`1` = list(x = 1,
y = 2), `2` = list(x = 2, y = 3)))
expect_equal(list.parse("a: 1", "yaml"), list(a = 1))
expect_equal(list.parse("{ \"a\": 1, \"b\": 2 }", "json"), list(a = 1, b = 2))
expect_equal(list.parse("12", "xml"), list(a = "1",
b = "2"))
expect_error(list.parse("a:1,b:2", "js"), "Unsupported type of data")
expect_equal(list.parse(c("a: 1", "{ \"a\": 1, \"b\": 2 }"), c("yaml", "json")),
list(list(a = 1), list(a = 1, b = 2)))
})
test_that("list.clean", {
expect_identical(list.clean(list(1, 2, NULL)), list(1, 2))
expect_identical(list.clean(list(1, 2, NA), is.na), list(1, 2))
expect_identical(list.clean(list(1, 2, numeric(), list(1, 2, NULL)), function(x) length(x) ==
0L, recursive = TRUE), list(1, 2, list(1, 2)))
expect_identical(list.clean(list(1, 2, list(1, 2, NULL), NULL), recursive = TRUE),
list(1, 2, list(1, 2)))
})
test_that("list.which", {
x <- c(1, 2, 3)
expect_identical(list.which(x, . >= 2), which(x >= 2))
})
test_that("list.expand", {
expect_identical(list.expand(), list())
expect_identical(list.expand(x = integer()), list())
expect_identical(list.expand(x = 1:3, y = integer()), list())
expect_identical(list.expand(x = c(1,2), y = c(2,3)),
list(list(x = 1, y = 2), list(x = 2, y = 2),
list(x = 1, y = 3), list(x = 2, y = 3)))
})
rlist/tests/testthat/test-search.R 0000644 0001751 0000144 00000005577 12700425755 017021 0 ustar hornik users context("search")
test_that("list.search", {
# logical search
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(list.search(x, identical(., "A")), list(p1.type = "A"))
expect_identical(list.search(x, identical(., "A"), unlist = TRUE), c(p1.type = "A"))
expect_identical(list.search(x, identical(., 9)), list(p2.score.c1 = 9, p2.score.c2 = 9,
p3.score.c1 = 9))
x <- list(p1 = list(x = c("A", "B", "C"), y = list(y1 = "A", y2 = c("B", "C"))),
p2 = list(a = c("A", "B"), b = list(b1 = c("B", "C"), b2 = list("C", "B"))))
expect_identical(list.search(x, all(. == "A")), list(p1.y.y1 = "A"))
expect_identical(list.search(x, any("A" %in% .)), list(p1.x = c("A", "B", "C"),
p1.y.y1 = "A", p2.a = c("A", "B")))
# fuzzy search
x <- list(p1 = list(name = "Ken", age = 24), p2 = list(name = "Kent", age = 26),
p3 = list(name = "Sam", age = 24), p4 = list(name = "Keynes", age = 30),
p5 = list(name = "Kwen", age = 31))
expect_equal(list.search(x, grepl("^K\\w+[ts]", .), "character", unlist = TRUE),
c(p2.name = "Kent", p4.name = "Keynes"))
expect_equal(list.search(x, any(stringdist::stringdist(., "Ken") <= 1), "character",
unlist = TRUE), c(p1.name = "Ken", p2.name = "Kent", p5.name = "Kwen"))
expect_identical(list.search(x, all(stringdist::stringdist(., "Ken") == 0), "character"),
list(p1.name = "Ken"))
x <- list(p1 = list(name = c("Ken", "Ren"), age = 24), p2 = list(name = c("Kent",
"Potter"), age = 26), p3 = list(name = c("Sam", "Lee"), age = 24), p4 = list(name = c("Keynes",
"Bond"), age = 30), p5 = list(name = c("Kwen", "Hu"), age = 31))
expect_equal(list.search(x, all(stringdist::stringdist(., "Ken") <= 1), "character"),
list(p1.name = c("Ken", "Ren")))
expect_equal(list.search(x, any(stringdist::stringdist(., "Ken") <= 1), "character"),
list(p1.name = c("Ken", "Ren"), p2.name = c("Kent", "Potter"), p5.name = c("Kwen",
"Hu")))
expect_equal(list.search(x, !any(stringdist::stringdist(., "Ken") <= 1), "character"),
list(p3.name = c("Sam", "Lee"), p4.name = c("Keynes", "Bond")))
y <- list(n = 1:10, list(df = data.frame(id = 1:10, letter = letters[1:10], stringsAsFactors = F)),
list("aa", "bb"))
expect_identical(list.search(y, .[grepl("a", .)], "character"), list(df.letter = "a",
"aa"))
expect_error(list.search(y, . <= p))
})
test_that("counting", {
x <- list(p1 = list(name = "Ken", age = 24), p2 = list(name = "Kent", age = 26),
p3 = list(name = "Sam", age = 24), p4 = list(name = "Keynes", age = 30),
p5 = list(name = "Kwen", age = 31))
expect_equal(list.search(x, n ~ n >= 25, "numeric", n = 2, unlist = TRUE), c(p2.age = 26,
p4.age = 30))
expect_error(list.search(x, . <= p))
})
rlist/tests/testthat/test-update.R 0000644 0001751 0000144 00000001536 12700425755 017025 0 ustar hornik users context("update")
test_that("list.update", {
# simple list
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(list.update(x, type = NULL), lapply(x, function(xi) {
xi[-1]
}))
expect_identical(list.update(x, score = list(min = min(unlist(score)))), lapply(x,
function(xi) {
modifyList(xi, list(score = list(min = min(unlist(xi$score)))))
}))
expect_identical(list.update(x, range = range(unlist(score))), lapply(x, function(xi) {
modifyList(xi, list(range = range(unlist(xi$score))))
}))
expect_identical(list.update(x, n = length(.)), lapply(x, function(xi) {
modifyList(xi, list(n = length(xi)))
}))
lapply(1:3, function(i) list.update(x, c = i))
})
rlist/tests/testthat/test-List.R 0000644 0001751 0000144 00000005662 12700425755 016462 0 ustar hornik users context("List")
test_that("List", {
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical({
List(x)$group(type)$map(g ~ List(g)$map(score)$call(unlist)$call(mean)$data)$data
}, list(A = 9, B = 8.5))
expect_identical({
local({
i <- 3
List(1:3)$map(x ~ x + i)[]
})
}, list(4, 5, 6))
expect_identical({
local({
i <- 1
List(1:3)$map(x ~ x + i)$filter(x ~ x <= 1 + i)[]
})
}, list(2))
expect_identical(List(1:3)$all(. >= 0)[], TRUE)
expect_identical(List(1:3)$any(. <= 5)[], TRUE)
expect_identical(List(x)$cases(type)[], c("A", "B"))
expect_identical(List(x)$class(type)[], list.class(x, type))
expect_identical(List(x)$common(names(score))[], c("c1", "c2"))
expect_identical(List(x)$count(type == "B")[], 2L)
expect_identical(List(x)$filter(type == "B")[], list.filter(x, type == "B"))
expect_identical(List(1:10)$find(.%%2 == 0, 3)[], c(2L, 4L, 6L))
expect_identical(List(1:10)$findi(.%%2 == 0, 3)[], c(2L, 4L, 6L))
expect_identical(List(1:10)$group(.%%3)[], list.group(1:10, .%%3))
expect_identical(List(list(1:10, 2:15))$search(any(. >= 11))[], list.search(list(1:10,
2:15), any(. >= 11)))
expect_identical(local({
i <- 12
List(list(1:10, 2:15))$search(any(. >= i))[]
}), list.search(list(1:10, 2:15), any(. >= 12)))
expect_identical(List(1:200)$table(.%%2, .%%3)[], list.table(1:200, .%%2, .%%3))
expect_identical(List(x)$update(mean = mean(unlist(score)))[], list.update(x,
mean = mean(unlist(score))))
expect_equal(List(c(1, 2, 3)) == c(1, 2, 3), c(TRUE, TRUE, TRUE))
expect_equal(subset(List(1:10), c(TRUE, FALSE)), subset(1:10, c(TRUE, FALSE)))
})
test_that("closure", {
expect_is(List_get_function(quote(`[`)), "function")
expect_is(List_set_function(quote(`[`)), "function")
})
test_that("subsetting", {
expect_identical(List(list(a = 1, b = 2))["a"]$data, list(a = 1))
expect_equal(List(c(a = 1, b = 2))["a"]$data, c(a = 1))
})
test_that("extracting", {
expect_equal(List(list(a = 1, b = 2))[["a"]]$data, 1)
expect_equal(List(list2env(list(a = 1, b = 2)))[["a"]]$data, 1)
})
test_that("assignment", {
expect_identical({
z <- List(list(a = 1, b = 2))
z$a <- 2
z$b <- NULL
z$data
}, list(a = 2))
expect_equal({
z <- new.env()
env <- List(z)
env$a <- 1
env$data$a
}, 1)
expect_identical({
z <- List(c(a = 1, b = 2))
z["a"] <- 2
z$data
}, c(a = 2, b = 2))
expect_identical({
z <- List(c(a = 1, b = 2))
z[["a"]] <- 2
z$data
}, c(a = 2, b = 2))
})
test_that("printing", {
expect_output(print(List(list(1, 2, 3))), "\\$data : list.+")
expect_output(str(List(list(1, 2, 3))), "\\$data : List of 3.+")
expect_output(print(summary(List(rnorm(100)))), "Min.+")
})
rlist/tests/testthat/test-map.R 0000644 0001751 0000144 00000003607 12700425755 016321 0 ustar hornik users context("map")
test_that("list.map", {
# simple list
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(list.map(x, score$c1), list(p1 = 10, p2 = 9, p3 = 9))
# list of vectors
x <- list(a = c(x = 1, y = 2), b = c(x = 3, y = 4))
expect_identical(list.map(x, sum(.)), list(a = 3, b = 7))
lapply(1:3, function(i) list.map(x, sum(.) + i))
})
test_that("list.mapv", {
# simple list
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_equal(list.mapv(x, score$c1), c(p1 = 10, p2 = 9, p3 = 9))
expect_equal(list.mapv(x, x ~ sum(unlist(x$score))), c(p1 = 18, p2 = 18, p3 = 16))
expect_identical(list.mapv(x, score$c1, "integer"), c(p1 = 10L, p2 = 9L, p3 = 9L))
expect_identical(list.mapv(x, score$c1, "integer", use.names = FALSE), c(10L,
9L, 9L))
# list of vectors
x <- list(a = c(x = 1, y = 2), b = c(x = 3, y = 4))
expect_equal(list.mapv(x, sum(.)), c(a = 3, b = 7))
lapply(1:3, function(i) list.mapv(x, sum(.) + i))
})
test_that("list.iter", {
l1 <- list(1, 2, 3)
expect_output(list.iter(l1, cat(.)), "123")
expect_equal(list.iter(l1, {
}), l1)
})
test_that("list.maps", {
l1 <- list(p1 = list(x = 1, y = 2), p2 = list(x = 3, y = 4), p3 = list(x = 1,
y = 3))
l2 <- list(2, 3, 5)
expect_equal(list.maps(a$x * b + a$y, a = l1, b = l2), list(p1 = 4, p2 = 13,
p3 = 8))
expect_equal(list.maps(..1$x * ..2 + ..1$y, l1, l2), list(p1 = 4, p2 = 13, p3 = 8))
expect_equal(list.maps(a * b, a = list(1, 2, 3), b = list(2, 3, 4)), list(2,
6, 12))
expect_equal(list.maps(..1 * ..2, list(1, 2, 3), list(2, 3, 4)), list(2, 6, 12))
})
rlist/tests/testthat/test-class.R 0000644 0001751 0000144 00000001161 12700425755 016642 0 ustar hornik users context("class")
test_that("list.class", {
# simple list
x <- list(a = 1, b = 2, c = 3, d = 2, e = 3, f = 1)
expect_identical(list.class(x, .), list(`1` = list(a = 1, f = 1), `2` = list(b = 2,
d = 2), `3` = list(c = 3, e = 3)))
x <- list(p1 = list(type = "A", score = list(c1 = 10, c2 = 8)), p2 = list(type = "B",
score = list(c1 = 9, c2 = 9)), p3 = list(type = "B", score = list(c1 = 9,
c2 = 7)))
expect_identical(list.class(x, unlist(score)), list(`7` = x["p3"], `8` = x["p1"],
`9` = x[c("p2", "p3")], `10` = x["p1"]))
lapply(8:10, function(i) list.class(x, score$c1 > i))
})
rlist/NAMESPACE 0000644 0001751 0000144 00000003365 12700425755 012662 0 ustar hornik users # Generated by roxygen2: do not edit by hand
S3method("$<-",List)
S3method("==",List)
S3method("[",List)
S3method("[<-",List)
S3method("[[",List)
S3method("[[<-",List)
S3method(list.parse,character)
S3method(list.parse,data.frame)
S3method(list.parse,default)
S3method(list.parse,matrix)
S3method(print,List)
S3method(str,List)
S3method(subset,List)
S3method(subset,list)
S3method(summary,List)
export(List)
export(list.all)
export(list.any)
export(list.append)
export(list.apply)
export(list.cases)
export(list.cbind)
export(list.class)
export(list.clean)
export(list.common)
export(list.count)
export(list.do)
export(list.exclude)
export(list.expand)
export(list.extract)
export(list.filter)
export(list.find)
export(list.findi)
export(list.first)
export(list.flatten)
export(list.group)
export(list.if)
export(list.insert)
export(list.is)
export(list.iter)
export(list.join)
export(list.last)
export(list.load)
export(list.map)
export(list.maps)
export(list.mapv)
export(list.match)
export(list.merge)
export(list.names)
export(list.order)
export(list.parse)
export(list.prepend)
export(list.rbind)
export(list.remove)
export(list.reverse)
export(list.sample)
export(list.save)
export(list.search)
export(list.select)
export(list.serialize)
export(list.skip)
export(list.skipWhile)
export(list.sort)
export(list.stack)
export(list.subset)
export(list.table)
export(list.take)
export(list.takeWhile)
export(list.ungroup)
export(list.unserialize)
export(list.unzip)
export(list.update)
export(list.which)
export(list.zip)
export(tryEval)
export(tryGet)
importFrom(data.table,rbindlist)
importFrom(stats,na.omit)
importFrom(utils,modifyList)
importFrom(utils,str)
importFrom(utils,txtProgressBar)
rlist/NEWS 0000644 0001751 0000144 00000013341 12700425755 012135 0 ustar hornik users Changes since version 0.4
===
* New features
* `list.ungroup` now supports `level` arguments to `unlist` a nested list recursively. (#102)
* `list.flatten` now accepts `classes` to filter list element recursively by class name.
* `list.expand` implements a list version of `expand.grid` (#107)
* Improvements
* Support loading and parsing from xml to list. (#43)
* `list.search` now uses `is.null` to clean the results.
* Add `list.unzip` to `List` object.
* `list.ungroup` now supports `group.names` to indicate whether to preserve group names.
* Implement better error handling mechanism in `list.all`, `list.takeWhile`, `list.skipWhile`, etc.
* `list.table` will directly call `table` upon input data if `...` is missing.
* Bug fixes
* Fix returned value of `list.unserialize`.
* `list.skip` returns the original data when asked to skip 0 elements.
* `list.skip` takes the first `n` elements when asked to skip a negative number of elements.
* Fix bug in lambda expression handling of `list.all` (#105)
Version 0.4
===
* New features
* Include a dataset `nyweather` scraped from [OpenWeatherMap](http://openweathermap.org/) (#2)
* `list.load` now supports text-based progress bar when `progress = TRUE` which is by default
enabled if over 5 files are to be loaded. (#92)
* New function `list.names` gives a list or vector names by mapping.
* New functions `list.first` and `list.last` find the first or last list element that meets a
given condition.
* New function `list.unzip` to transform a list of elements with similar structure into a
list of decoupled fields.
* Improvements
* Add error handling in several edge cases. (#18)
* `list.group` now supports grouping by multi-key which produces multi-level list. (#69)
* `list.load` now supports loading from multiple filenames given in character vector. (#74)
* `list.load` is now able to guess the file format even if the file type is not specified. (#76)
* `list.maps` now allows the usage of `..1`, `..2`, etc. to refer to unnamed arguments. (#80)
* `list.load` now supports merging and ungrouping as means to aggregating loaded results. (#82)
* `list.stack` now uses `data.table::setDF` to convert `data.table` to `data.frame` if
`data.table = FALSE`, which is done by reference and thus has higher performance.
* Bug fixes
* `list.search` now takes `n` as the number of returned vector rather than that of the
elements in all returned vectors, and is now able to jump out when the result set reaches
given capacity. (#47, #84)
* Fix how `list.table` deals with `NULL` values. (#73)
* Fix how wrapper functions deal with default arguments. (#75)
* Fix the dynamic scoping issues in `list.table`. (#86)
* `list.all` and `list.any` behave the same as `all` and `any` respectively when the input is empty. (#87)
* One-sided formula does not result in error now. (#89)
* `list.flatten` now preserves names as specified. (#90)
* Fix incorrect processing for fallback in `list.findi`. (#91)
* Fix the implementation in `list.group` working with multi-key. (#93)
* Fix incorrect ordering if some entries are multi-valued vectors and others and single-
valued. If `list.order` and `list.sort` encounter such situation, they now report
error rather than silently produced unreliable results. (#94)
* Fix inconsistencies in `list.all`, `list.any`, `list.first` and `list.last`.
* Deprecation
* `equal()` is removed and related packages are now suggested rather than imported. (#70)
* `summary.list()` is deprecated. (#70)
* No longer interprets `x -> f(x)` as a form a lambda expression. Use `x ~ f(x)` instead. (#54)
* `desc(x)` is no longer supported in `list.sort` and `list.order`. Use `-x` or `(x)` instead. (#66)
Version 0.3
===
API Break: `list.search` now evaluates expression recursively in a list and supports lambda expression.
Add `equal()` function for logical and fuzzy filtering and searching which supports exact equality, atomic equality, inclusion, pattern matching, string-distance tolerance.
Add `List()` to provide an environment in which most list functions are defined for light-weight chaining that does not rely on external operators.
Version 0.2.5
===
Add `list.apply` which is a wrapper function of lapply.
Add `list.search` that searches a list recursively.
Add exact search functions: `equal`, `unequal`, `unidentical`, `include`, and `exclude`.
Add fuzzy search functions: `like` and `unlike` based on stringdist package.
Enhance `list.clean` which now supports recursive cleaning.
Version 0.2.4
===
Add `list.common` that returns the common cases of all list member by expression.
Version 0.2.3
===
Improve performance (#26, #27)
Add `list.flatten` that flattens a nested list to one-level.
Version 0.2.2
===
Add `list.stack` that binds list members to a data.frame.
Add `list.zip` that combines multiple lists element-wisely.
Add `list.maps` that performs mapping over multiple lists.
Performance improvements.
Minor maintainence updates.
`list.cases` supports list-like cases
Fixed [#23](https://github.com/renkun-ken/rlist/issues/23)
Fixed [#25](https://github.com/renkun-ken/rlist/issues/25)
`list.select` no longer accepts explicit lambda expressions.
Vignettes updated
Version 0.2.1
===
Add new function `list.table`
Minor maintainence updates.
Fixed [#6](https://github.com/renkun-ken/rlist/issues/6)
Fixed [#11](https://github.com/renkun-ken/rlist/issues/11)
Fixed [#20](https://github.com/renkun-ken/rlist/issues/20)
Fixed [#21](https://github.com/renkun-ken/rlist/issues/21)
Version 0.2
===
Add `list.join`, `list.mapv`, `list.do`, `list.clean`, `list.parse`
Add vignettes
Version 0.1
===
Implement functions
rlist/data/ 0000755 0001751 0000144 00000000000 12700425754 012344 5 ustar hornik users rlist/data/nyweather.rda 0000644 0001751 0000144 00000044623 12700425754 015053 0 ustar hornik users BZh91AY&SYQY9} a># ɀXӫglֶim>g1VMlC 1UX x@x )=YWBP
QH5ӛ\O\aJ5T ` 0
z
f( 4= ꄔ 8ws@(4D444AѠ`F##S MF&@
F)OSM4& # FE L xj4OjLOI=A
h
="MOTh@
=A@ z
P @ 4 I" C&z h 4Aш =FC@SM M 4 h RDi4M1FdҞSOHm&DS6hI?SF5?SP~MGOL4&oI?Rii~=Fh#&L&MIɢx2h414FBif'ƩSOA 7MSMzzI#@i
44
4 P{5wu-]x~W|{=E:_Ch"nA"A J(#㨌TZUU,IyPTڕKoSH[𮚂Sl5ZP("{O <n^:/e.usxN|O{zn ' t oվ>ˊO ݯW<5s~]17g;..D ":"6ACfcbUUU5hҦEF0),P?." 뼡k ERD iJ' /]IglGrs^}[ \iq (ABzj/ ^;
_8M=3» v-}hxnDճ646+
TY454OeP|89OOR)] gScGH2>/.]/tSH5 ;CRӜf2Nou<}׆^:(O]GV~ϗ B;,E3˲* N|n~4@=FZ ̠۞rg9m18k
h1@!x h6vdx0{Q'ۍoM8"fس^NX AʂcPukl ~r^t ӧ
P
9C#!,_>Br<`f@ ~YuC,
A o[ʏnH8IAWǕhT ~ҹm*v;7C C 4 =333Rv֡;u *{D |+3]f4 FO[A\lfh:4ډ#Xѵ9s#lFW;L ƗF.$)+n|5⌳mWhZ/|3Wۨ]흝EgG+#
V6hlϕe`a\ ie\lEڳmw_E'} =kwe:!M'
Һ%(< jԻ&{rO3 i8hO ǎ06G1=)8ogm6[C+Uxʭ UR\Hp5K
pYq+]]LI⸭/f,%[DaByHW }0hG1Ë 4EyK6ǚP)xZ&(͘kv}3Y
5~fW
}=02e|l# ցvãŕ[mχpacٚ<`vsސ-8wm<;X\CjK.3 ZZ*qokؽOl ~]
A{jF5!b uC Qڑ" &)с` 1$SʪΖ#˧5TrY8JPkdoNWqL) Vd
HP& Tja`D>-i(!~sq0 0%$
(fW[Q41VtTi2nT(Gr? p$BD4qq x;~'/'|( "SL];ysn 1j'rm)o`nOӏ֕ j3# ;7yRa2:iPf%B h!Ai HQC}P/2 U4G~p- < niFJp =) - \[+1cCrݟyi "y$ 4a$@s]
e8"Nbʓ}wT 9 ӥc#$$]k =2 _CbYZ=WTyIZo@#ƘP9!;RVY }+=/)ggt$<2uI*@`e P As@}qq\OvƽIx4\N`*Q_?-f Ϩ Eg &ܦ< A!z/yH%~)tnǞ
~/*t Ty +ێ=fy^v)(}
ezGӯH@ 8
7 =TN 9^\yA' ^zx +}:$7 i -o@@w{Oqx0>jA|;O!:$,b0d AecLвOI|P[q
y-}x !h8.w oݯ:n؏?zCS,b nws` Wio}S q#0C*>xL-{W|To/Ɖ x\Xz[- eʃlz%C "6ڞA ˣE.{ [}^yx~ u<~[txGQ \uS#4KJ Ȇyvqs1
G ; v{df@ԓ]]wpE|Oi9v; ]л"Fҍ4Y̮$4CGs"c | 8N}C4B:sm ;hVT c, mɾ5 =-kS3v*K5ҍȄZQ.`"%2 'wsolt+!?F
gr!jrB" xeB5 wjdðWٟޕ+Ÿq0=e @CPcR>GÛ9 q'9dENu33:7 c꒡cQrjA~bq
Ĵ RoYp| oMzY%+?
w{0vN@Lw( ga>(f` #Cn^o7DHʆAFD>gE"
> u W̞L!\I'YtrffbDfĘ{
ZT"z =
L ?HZjI
8
=< &q] U^cne+*j fUU> GĢĪx̣N
eXCafc68bR-FXAlkf&Q rXYUnTh_"E'gK<ó"qTG b auҮ!t5#QЩ:"&R*kdP̈ED:Zk#(ޟؓ~
L#3c1vK
$F`9 >`]~P#Y
fA[фh-%Q3al12tb ]&ݱf;&
Pۡ6 m
;DdY4bHv$=䮳F0*WI+) (bq \ֶ!ur(xϩz\42+l!qpkphn ?eCˆigr8*hP͂o ]+yT!휓%Ȟc~UGD.ǀq*H@}fy./AuvZ Q.AB!: w8 +LӲoZЈ׳> OPSHpNP:J:j!rZ,(>FL#a"h2.#!
Rmtn 89-/\NJ?K9VAL e}'(^5S:@r]J\3&&1CNԹp'FA2ƯZ\+aCWF9䪌JB)%K
#M*(|Ͻaz7XJ9l|hҳe\Bl-+bQ9EHTmå[4QeY 07iU9 R:ދWVgӤ&%IV^~)w4ڇg'58QԢ(JItt]wZg )&1*0NXmޮiDXEVwMCY,hJTѺDH @Jz5Ƒ9ޒpt:TM,+ 9:ktjMaIbZ/{RZN8}gX8dj֚|(NҬch_rZYV7|A ZDŽG=9][G ƉV`)UQ(u^/nt>Ϟ9.@7C8 fFd 0_ "( \e]1W\σQӭ*bժj\gJ+[Z|v ?=An,YQ*R$PHz(zDrYaW`P-jT.u0!c VԓLfDiU[
Q[RCPSBJ'H[)Rmh-#1H[VbڱkQEQ5Z-UZH ЅȬ!$2Ŵ6!JÈ!yx4į[J⮃$ʴ#8J l21XѶmLMc[TIQXXFѵElF(űmbحZ*ű K%(AZ,Ej-ch$! R&C53K ƻ` 0` 0`R)JR)JR)JR D r J5BZQX$"i@ZdEHL"di]cdt(&m?l\ :%$?3lMJ>΄" fڪfUUY&B
Cf5L+\ʭt[U,PƴT+JTZe1-(.{!7]H?()_`Bjĺ̑VJR{{, F uϽyܛYFFaə b5taF4
B(Q.
4{nlQ&mlk{hh ui(EJJmV)UMi
p*" v2(ɚ3*2KUhFjT(A" EFDUbj6KjUIZ&DXԳS+&EAUV&Ul`)XDhTQH3Aou R>B;f &oX2&0**2
&-g eX\`Id*YȠ
*z{/ko9Tn]M #fTlKKqK|wAQlk Fm%*KniZxhU4}OSpMF/'0 ڡƐH#-F4:>!tթjjj|%/p]`-7o߽D3ɿP1I6fjŻnm1|8 HZ_^L=}~zw&D%X)I #3]ox&ҋ[ʩhk}M]]m˥Oיt0{ nR5I~Y8zN ?P B
*Bib@f#u7NEJ?ټ[S . w
=_I) A$YVRDc
C Rn7 7.xњ-i8
VT͚=N8OQ jbYHU1QK WܦcѬfr;B&s5! 7DP" AtAڰOFA[窷ϳFV` M~ȃͭȭ[DɯUȯIO#'ΘC1#8U`fb0!!g 84`DZP& y]g_spD#w 8q"llFGu9E p'g&exsͬ'͢~P=GM\;='h{س0 M`o>@xu )W HUvj"#c0 v؍ y@Ϡ*6,+NKm2xt;\tM{v75Q${Oc6_t[ahq46Q=&3ܑq3;N c_L8xF0 qO @#$ xIE) %%))6BJD4C@Pf JL5L4"c04`D)LBɩ J!2m~܂\0
CE8Eͭ]{ 磁 1Ao67cFF5a^2 `: Ђ_>~.7 \Dx {KnMlޣ 58C-6=G9X9 6[ H uZQq^E;E^$rc<[_$_n.`F{~sD; .w0l~PuGCv>6g`@+4@@ tEܼE77UjyT^U<1yb;{4线O g /Θ M|`K#߭Ɓ6/a"]3#^y#o'E;sIZn4[u6cE3[8Oyw7XGT1DJA!`H^ B/*%$ |=Tϗ_g?&3'qsĿJ~7קՕf 4~eΈ*mW@*|_D6JcĻwkqKcdMgW%oΟ? l( lh o;%:gؽ\ S<HUAT@͵zNmU ɡ(2mIok<8fqWA3U_#\ Xr rrrfn_ཿxxDͅ c0f M/K$ f ĂײW16'm "mi藣
%IĦa3jp 4A9[/B6mr-(: x.mHghjp guz9"I@W*wүY ZGW-9 TssÛgܨ=6zj@AUAHBisTViJ7P
_ib}" 2m Hn9}9!R {p
|W;lq 8
"ZC,BCZF= ES\ HQHT\VThvyd IT
)"p&RŴ,@0oMDB!yK Y0 x:A_:]/Ua}^qDB $=
Is(7 HnfG}@[{w<`TT? b"1kc;wdxn3xNE1vt
x'!]}E_kk+{y;7my]FnK_b v
O̫z+]TL(~W*< 9ш[e#zTiFR:êﾇww!F '+gKwdP ,Cԕts* "(o rvz>. 9~zVe lb#L*2J2]m6bhL%SbubQ:"!P.DFBcme+)D(%i
N])X(G DhC.])1(L؊;jGT 1:Ne\ 9Ydn(BB*HRhqїWM]EeULXTі@DHDUɩ(qRGhU lC^3Te/pP.Dr3_S*:Ϥ"?YU $U*s~fQ"~(U Zp R" RQj e`ZU[KJVF® q/f*}?:jzиj\ Hݘ.:1CۚP PCs y'Xe+}XJQ0F sC ,̩
':r̳ s245m&uؙMZdʶ(;&ei
(֢j6R#RE#V.)!FRZճM^Jř1jj!^T;(ON1y&q;74mHF\nbePM|BP͙1NiM1nD
. uvcvk-xXWcۼa n%Cvը]6"6%ՒK',GZ]
Be\VW0k[ #݁ D 9+* [Bl#e6} ICQ)_*)ڑQFJ4 'N36Zf @:M*8=:986 U
nS wXbH"(<=!jqAs*gŕg`I-de@+
RBЦJ1d4XFfp|J@}$#A1 saYZ%#8N8+RoWB}8ژsWE+8Np뺧iQH>N{QapSs)%g'za΅
ƳAϒّ}`G*8dgp`4X!+ A>$А8^Ή .A:g'5HNsEa*Rq,ϴn&բEglvK=kcdMz\]D!%A1cIVeD w9t!% \[pAs
ۨUc CBR eD.X0hMq JN@v`\ANSHwXq .jRVwRI܈dH{*ఊ־蟐E_ 8nw^F_U }$y&ݏ{;U j]FUӽ G
$zDq9|? (*8]--j(eTVyqmHW"v( gI$ǀI^ zPktCF߷.]qG"ɀ}G(~-'sEaW)O/)TQ=F Wݰ w;| e Đ ٧%]
__I>nܛ;/'b J/5ڎn ;D+
zzbwݰ
o uuz_nSv.33a5vӏb`fQw^~ρw~ {z/5(!VP< P9^SNeHe
{lri7 ̸eK+m?ͱ֗UL ;P8'axqC \;UH O^@5 Z2*
=OwCr۞>#xZ8l,<7O\=,F/!n'|>zybi}5 9 t]]꪿\5_6PY5* {;^ם}9.;} X[>y@ 4 VfҠId|5h
%O] +I ¢';riٷ|-!^(Zπt]B }K].*(Pj]UZև;r,
ZcniuntWRuJeO>*2h
FjOJK ^ /HŠzHVZynffeGy3+X+&bڹ0yֳN_.SY̡*goޗW@fcܠ\n뷹Xm--Xr`Ma-9 uvh/n^}rKm\waY7y,v?ɤ5dNg}t]۟Ѳ 6ɠIo;zo}1^AJ&J// d%R
JL88X+=?Uyde9(yc3\ga=M>Az{*WM`Mr4bP BRAr$>dmcHQ-b ?
_V˺VWd 6 L2Z1 -#|70'<:|+ lT<Aƒ #7?]w|ha0zr]S. ŀ䵸:Bkb_۟줥]R!S}7a
ɤNYh-fha~yLBr♛bf&l79-vj% +Y#|C_R:PH*{'a[-D 9
fW@l뽻:߿)1Pst_{?3̨l-%Q /}}降Y¥m$z7ˎQ-\GTrJc;$ 8SCH@ Dw5Z,ŦEgKv53'e۷yb|zu( _9I&]Qqd::D G+X҃Lp{Z_jpzy3xXiw%3āK&Cp=>{nTx|V]ҏuvx>=gU=t 퍇w15TR6>yo8{ ٞC^ PPreAP Y(3XSR-_J|Vo[
5t}75k̹m 1r/TMPK U MvKͮ֠*;fX7ϯR</%'{ w2>m5O7jxv G
w>nypTS
w}dwq0.p!i% rlist/R/ 0000755 0001751 0000144 00000000000 12700425755 011635 5 ustar hornik users rlist/R/list.insert.R 0000644 0001751 0000144 00000003524 12700425755 014242 0 ustar hornik users #' Insert a series of lists at the given index
#'
#' @param .data A \code{list} or \code{vector}
#' @param index The index at which the lists are inserted
#' @param ... A group of lists
#' @export
#' @seealso \code{\link{list.append}}, \code{\link{list.prepend}}
#' @examples
#' \dontrun{
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.insert(x, 2, p2.1 = list(type='B',score=list(c1=8,c2=9)))
#' }
list.insert <- function(.data, index, ...) {
values <- if (is.list(.data))
list(...) else c(..., recursive = FALSE)
n <- length(.data)
if (index < -n)
stop("Invalid index")
if (index < 0L)
index <- n + index + 1L
c(.data[0L:max(0L, index - 1L)], values, if (index <= n) .data[index:length(.data)] else NULL)
}
#' Append elements to a list
#'
#' @param .data A \code{list} or \code{vector}
#' @param ... A \code{vector} or \code{list} to append after \code{x}
#' @export
#' @seealso \code{\link{list.prepend}}, \code{\link{list.insert}}
#' @examples
#' \dontrun{
#' x <- list(a=1,b=2,c=3)
#' list.append(x,d=4,e=5)
#' list.append(x,d=4,f=c(2,3))
#' }
list.append <- function(.data, ...) {
if (is.list(.data)) {
c(.data, list(...))
} else {
c(.data, ..., recursive = FALSE)
}
}
#' Prepend elements to a list
#'
#' @param .data A \code{list} or \code{vector}
#' @param ... The \code{vector} or \code{list} to prepend before \code{x}
#' @export
#' @seealso \code{\link{list.append}}, \code{\link{list.insert}}
#' @examples
#' x <- list(a=1,b=2,c=3)
#' list.prepend(x, d=4, e=5)
#' list.prepend(x, d=4, f=c(2,3))
list.prepend <- function(.data, ...) {
if (is.list(.data)) {
c(list(...), .data)
} else {
c(..., .data, recursive = FALSE)
}
}
rlist/R/List.R 0000644 0001751 0000144 00000014040 12700425755 012672 0 ustar hornik users createListClosure <- function(f, data) {
f <- substitute(f)
function(...) {
dots <- match.call(expand.dots = FALSE)$...
rcall <- as.call(c(f, quote(data), dots))
data <- eval(rcall, list(data = data), parent.frame())
List(data)
}
}
createCallClosure <- function(data) {
function(f, ...) {
f <- substitute(f)
dots <- match.call(expand.dots = FALSE)$...
rcall <- as.call(c(f, quote(data), dots))
data <- eval(rcall, list(data = data), parent.frame())
List(data)
}
}
#' Create a \code{List environment} that wraps given \code{data} and
#' most list functions are defined for chainable operations.
#'
#' @param data A \code{list} or \code{vector}
#' @export
#' @details
#' Most list functions are defined in \code{List environment}.
#' In addition to these functions, \code{call(fun,...)} calls
#' external function \code{fun} with additional parameters specifies in
#' \code{...}.
#'
#' To extract the data from List \code{x}, call \code{x$data} or simply
#' \code{x[]}.
#'
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' m <- List(x)
#' m$filter(type=='B')$
#' map(score$c1) []
#'
#' m$group(type)$
#' map(g ~ List(g)$
#' map(score)$
#' call(unlist)$
#' call(mean) []) []
#'
#' # Subsetting, extracting, and assigning
#'
#' p <- List(list(a=1,b=2))
#' p['a']
#' p[['a']]
#' p$a <- 2
#' p['b'] <- NULL
#' p[['a']] <- 3
List <- function(data = list()) {
call <- createCallClosure(data)
all <- createListClosure(list.all, data)
any <- createListClosure(list.any, data)
append <- createListClosure(list.append, data)
apply <- createListClosure(list.apply, data)
cases <- createListClosure(list.cases, data)
cbind <- createListClosure(list.cbind, data)
class <- createListClosure(list.class, data)
clean <- createListClosure(list.clean, data)
common <- createListClosure(list.common, data)
count <- createListClosure(list.count, data)
do <- createListClosure(list.do, data)
exclude <- createListClosure(list.exclude, data)
extract <- createListClosure(list.extract, data)
filter <- createListClosure(list.filter, data)
find <- createListClosure(list.find, data)
findi <- createListClosure(list.findi, data)
first <- createListClosure(list.first, data)
flatten <- createListClosure(list.flatten, data)
group <- createListClosure(list.group, data)
is <- createListClosure(list.is, data)
insert <- createListClosure(list.insert, data)
iter <- createListClosure(list.iter, data)
join <- createListClosure(list.join, data)
last <- createListClosure(list.last, data)
load <- createListClosure(list.load, data)
map <- createListClosure(list.map, data)
mapv <- createListClosure(list.mapv, data)
match <- createListClosure(list.match, data)
merge <- createListClosure(list.merge, data)
names <- createListClosure(list.names, data)
order <- createListClosure(list.order, data)
parse <- createListClosure(list.parse, data)
prepend <- createListClosure(list.prepend, data)
rbind <- createListClosure(list.rbind, data)
remove <- createListClosure(list.remove, data)
reverse <- createListClosure(list.reverse, data)
sample <- createListClosure(list.sample, data)
save <- createListClosure(list.save, data)
search <- createListClosure(list.search, data)
select <- createListClosure(list.select, data)
serialize <- createListClosure(list.serialize, data)
skip <- createListClosure(list.skip, data)
skipWhile <- createListClosure(list.skipWhile, data)
sort <- createListClosure(list.sort, data)
stack <- createListClosure(list.stack, data)
table <- createListClosure(list.table, data)
take <- createListClosure(list.take, data)
takeWhile <- createListClosure(list.takeWhile, data)
ungroup <- createListClosure(list.ungroup, data)
unserialize <- createListClosure(list.unserialize, data)
upzip <- createListClosure(list.unzip, data)
update <- createListClosure(list.update, data)
which <- createListClosure(list.which, data)
zip <- createListClosure(list.zip, data)
subset <- createListClosure(list.subset, data)
envir <- environment()
setclass(envir, c("List", "environment"))
}
#' @export
print.List <- function(x, ..., header = getOption("List.header", TRUE)) {
if (!is.null(x$data)) {
if (header)
cat("$data :", class(x$data), "\n------\n")
print(x$data, ...)
}
}
#' @importFrom utils str
#' @export
str.List <- function(object, ..., header = getOption("List.header", TRUE)) {
if (header)
cat("$data : ")
str(object$data, ...)
}
#' @export
summary.List <- function(object, ...) {
summary(object$data, ...)
}
#' @export
`==.List` <- function(e1, e2) {
e1$data == e2
}
#' @export
subset.List <- function(x, ...) {
subset(x$data, ...)
}
ndots <- function(dots) {
length(dots) >= 1L && any(nzchar(dots))
}
List_get <- function(f, data, dots, envir) {
if (!ndots(dots))
return(data)
rcall <- as.call(c(f, quote(data), dots))
data <- eval(rcall, list(data = data), envir)
List(data)
}
List_get_function <- function(op) {
op <- as.symbol(op)
function(x, ...) {
dots <- match.call(expand.dots = FALSE)$...
List_get(op, x$data, dots, parent.frame())
}
}
#' @export
`[.List` <- List_get_function("[")
#' @export
`[[.List` <- List_get_function("[[")
List_set <- function(f, x, dots, value, envir) {
if (!ndots(dots))
return(value)
rcall <- as.call(c(f, quote(x), dots, quote(value)))
data <- eval(rcall, list(x = x, value = value), envir)
List(data)
}
List_set_function <- function(op) {
op <- as.symbol(op)
function(x, ..., value) {
dots <- match.call(expand.dots = FALSE)$...
List_set(op, x$data, dots, value, parent.frame())
}
}
#' @export
`$<-.List` <- List_set_function("$<-")
#' @export
`[<-.List` <- List_set_function("[<-")
#' @export
`[[<-.List` <- List_set_function("[[<-")
rlist/R/utils.R 0000644 0001751 0000144 00000002717 12700425755 013127 0 ustar hornik users #' Try to get the value of a symbol if exists or return a default value
#' @details
#' By default, the symbol is examined in \code{envir} without inheritance,
#' that is, if the symbol does not exist in \code{envir} the default value
#' \code{def} will be returned.
#' @param symbol the symbol to examine
#' @param def the default value if the symbol does not exist
#' @param ... additional parameters passed to \code{exists} and \code{get}
#' @param envir the environment to examine whether the symbol exists
#' and get the symbol
#' @export
#' @examples
#' x <- list(a=c(x=1,y=2),b=c(x=2,p=3))
#' list.map(x, tryGet(y,0))
tryGet <- function(symbol, def = NULL, ..., envir = parent.frame()) {
symbol <- substitute(symbol)
if (is.symbol(symbol)) symbol <- as.character(symbol)
if (is.character(symbol)) {
if (exists(symbol, inherits = FALSE, ..., envir = envir))
get(symbol, inherits = FALSE, ..., envir = envir) else def
} else stop("symbol must be a name or character", call. = FALSE)
}
#' Try to evaluate an expression and return a default value if
#' an error occurs or otherwise return its value.
#' @param expr the expression to evaluate
#' @param def the default value if an error occurs in the evaluation
#' of \code{expr}
#' @export
#' @examples
#' x <- list(a=c(x=1,y=2),b=c(x=2,p=3))
#' list.map(x, tryEval(x+y, NA))
tryEval <- function(expr, def = NULL) {
x <- try(expr, silent = TRUE)
if (is.error(x)) def else x
}
rlist/R/list.subset.R 0000644 0001751 0000144 00000000612 12700425755 014236 0 ustar hornik users #' Subset a list
#'
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.subset(x, c('p1','p2'))
#' list.subset(x, grepl('^p', names(x)))
#' \dontrun{
#' list.subset(x, stringdist::stringdist(names(x), 'x1') <= 1)
#' }
list.subset <- `[`
rlist/R/list.clean.R 0000644 0001751 0000144 00000003457 12700425755 014025 0 ustar hornik users #' Clean a list by a function
#'
#' This function removes all elements evaluated to be
#' \code{TRUE} by an indicator function. The removal can be recursive
#' so that the resulted list surely does not include such elements in
#' any level.
#'
#' @details
#' Raw data is usually not completely ready for analysis, and needs to
#' be cleaned up to certain standards. For example, some data operations
#' require that the input does not include \code{NULL} values in any
#' level, therefore \code{fun = "is.null"} and \code{recursive = TRUE}
#' can be useful to clean out all \code{NULL} values in a list at any
#' level.
#'
#' Sometimes, not only \code{NULL} values are undesired,
#' empty vectors or lists are also unwanted. In this case,
#' \code{fun = function(x) length(x) == 0L} can be useful to remove
#' all empty elements of zero length. This works because
#' \code{length(NULL) == 0L}, \code{length(list()) == 0L} and
#' \code{length(numeric()) == 0L} are all \code{TRUE}.
#'
#' @param .data A \code{list} or \code{vector} to operate over.
#'
#' @param fun A \code{character} or a \code{function} that returns
#' \code{TRUE} or \code{FALSE} to indicate if an element of
#' \code{.data} should be removed.
#'
#' @param recursive \code{logical}. Should the list be
#' cleaned recursively? Set to FALSE by default.
#' @export
#' @examples
#' x <- list(a=NULL,b=list(x=NULL,y=character()),d=1,e=2)
#' list.clean(x)
#' list.clean(x, recursive = TRUE)
#' list.clean(x, function(x) length(x) == 0L, TRUE)
list.clean <- function(.data, fun = is.null, recursive = FALSE) {
if (recursive) {
.data <- lapply(.data, function(.item) {
if (is.list(.item))
list.clean(.item, fun, recursive = TRUE) else .item
})
}
setmembers(.data, vapply(.data, fun, logical(1L)), NULL)
}
rlist/R/list.parse.R 0000644 0001751 0000144 00000004467 12700425755 014057 0 ustar hornik users #' Convert an object to list with identical structure
#'
#' This function converts an object representing data to
#' list that represents the same data. For example, a
#' \code{data.frame} stored tabular data column-wisely,
#' that is, each column represents a vector of a certain
#' type. \code{list.parse} converts a \code{data.frame} to
#' a list which represents the data row-wisely so that it
#' can be more convinient to perform other non-tabular data
#' manipulation methods.
#' @param x \code{An object}
#' @param ... Additional parameters passed to converter function
#' @return \code{list} object representing the data in \code{x}
#' @export
#' @examples
#' x <- data.frame(a=1:3,type=c('A','C','B'))
#' list.parse(x)
#'
#' x <- matrix(rnorm(1000),ncol=5)
#' rownames(x) <- paste0('item',1:nrow(x))
#' colnames(x) <- c('a','b','c','d','e')
#' list.parse(x)
#'
#' z <- '
#' a:
#' type: x
#' class: A
#' registered: yes
#' '
#' list.parse(z, type='yaml')
list.parse <- function(x, ...) UseMethod("list.parse")
#' @export
#' @rdname list.parse
list.parse.default <- function(x, ...) {
as.list(x, ...)
}
#' @export
#' @rdname list.parse
list.parse.matrix <- function(x, ...) {
apply(x, 1L, as.vector, mode = "list")
}
#' @export
#' @rdname list.parse
list.parse.data.frame <- function(x, ...) {
cols <- colnames(x)
items <- map(function(...) setnames(list(...), cols), x)
setnames(items, rownames(x))
}
#' @export
#' @rdname list.parse
#' @param type The type of data to parse. Currently json and yaml are supported.
list.parse.character <- function(x, type, ...) {
if (length(x) == 0L)
return(list()) else if (length(x) == 1L) {
if (missing(type) || length(type) == 0L || is.na(type)) {
list.parse.default(x, ...)
} else if (tolower(type) == "yaml") {
yaml::yaml.load(x, ...)
} else if (tolower(type) == "json") {
callwith(jsonlite::fromJSON, list(x, simplifyVector = FALSE, simplifyDataFrame = FALSE,
simplifyMatrix = FALSE), list(...))
} else if (tolower(type) == "xml") {
XML::xmlToList(XML::xmlParseString(x, ...))
} else {
stop("Unsupported type of data", call. = FALSE)
}
} else if (length(x) > 1L) {
map(list.parse.character, list(x, type), list(...), use.names = FALSE)
}
}
rlist/R/list.stack.R 0000644 0001751 0000144 00000001607 12700425755 014043 0 ustar hornik users #' Stack all list elements to tabular data
#'
#' @param .data \code{list} of \code{vector}s, \code{list}s,
#' \code{data.frame}s or \code{data.table}s.
#' @param ... additional parameters passed to \code{data.table::rbindlist}.
#' @param data.table \code{TRUE} to keep the result as \code{data.table}
#' @export
#' @importFrom data.table rbindlist
#' @examples
#' \dontrun{
#' x <- lapply(1:3, function(i) { list(a=i,b=i^2) })
#' list.stack(x)
#'
#' x <- lapply(1:3, function(i) { list(a=i,b=i^2,c=letters[i])})
#' list.stack(x)
#'
#' x <- lapply(1:3, function(i) { data.frame(a=i,b=i^2,c=letters[i]) })
#' list.stack(x)
#'
#' x <- lapply(1:3, function(i) { data.frame(a=c(i,i+1), b=c(i^2,i^2+1))})
#' list.stack(x)
#' }
list.stack <- function(.data, ..., data.table = FALSE) {
dt <- data.table::rbindlist(.data, ...)
if (!data.table)
data.table::setDF(dt)
dt
}
rlist/R/list.map.R 0000644 0001751 0000144 00000006115 12700425755 013512 0 ustar hornik users #' Map each element in a list or vector by an expression.
#'
#' @param .data a \code{list} or \code{vector}
#' @param expr A lambda expression
#' @return A \code{list} in which each element is mapped by \code{expr} in \code{.data}
#' @export
#' @seealso \code{\link{list.mapv}}
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.map(x, type)
#' list.map(x, min(score$c1,score$c2))
list.map <- function(.data, expr) {
list.map.internal(.data, substitute(expr), parent.frame())
}
#' Map each member of a list by an expression to a vector.
#'
#' @param .data a \code{list} or \code{vector}
#' @param expr a lambda expression
#' @param as the mode to corece. Missing to \code{unlist}
#' the mapped results.
#' @param use.names Should the names of the results be preserved?
#' @return A \code{vector} in which each element is mapped by \code{expr} in \code{.data}
#' @export
#' @seealso \code{\link{list.map}}
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.mapv(x, type)
#' list.mapv(x, min(score$c1,score$c2))
list.mapv <- function(.data, expr, as, use.names = TRUE) {
res <- list.map.internal(.data, substitute(expr), parent.frame())
if (missing(as))
unlist(res, use.names = use.names) else {
res <- as.vector(res, as)
if (use.names && !is.null(nm <- names(.data)))
names(res) <- nm
res
}
}
#' Map multiple lists with an expression
#'
#' @param expr An implicit lambda expression where only \code{.i} and
#' \code{.name} are defined.
#' @param ... Named arguments of lists with equal length. The names of the
#' lists are available as symbols that represent the element for each list.
#' @name list.maps
#' @export
#' @examples
#' \dontrun{
#' l1 <- list(p1=list(x=1,y=2), p2=list(x=3,y=4), p3=list(x=1,y=3))
#' l2 <- list(2,3,5)
#' list.maps(a$x*b+a$y,a=l1,b=l2)
#' list.maps(..1$x*..2+..1$y,l1,l2)
#' }
list.maps <- function(expr, ...) {
expr <- substitute(expr)
envir <- parent.frame()
lists <- list(...)
if (is.empty(lists))
return(list())
list1 <- lists[[1L]]
xnames <- getnames(list1, character(1L))
fun <- with(envir, function(..., .expr) eval(.expr, list(...)))
args <- c(lists, list(.i = seq_along(list1), .name = xnames, .expr = list(expr)))
map(fun, args)
}
#' Iterate a list by evaluating an expression on
#' each list element
#'
#' @param .data \code{list}
#' @param expr A lambda expression
#' @name list.iter
#' @export
#' @return \code{invisible(.data)}
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.iter(x,cat(paste(type,'\n')))
#' list.iter(x,cat(str(.)))
list.iter <- function(.data, expr) {
list.map.internal(.data, substitute(expr), parent.frame())
invisible(.data)
}
rlist/R/list.do.R 0000644 0001751 0000144 00000004117 12700425755 013337 0 ustar hornik users #' Call a function with a list of arguments
#'
#' @param .data \code{list}. \code{vector} will be coreced to \code{list} before
#' being passed to \code{fun}.
#' @param fun The \code{function} to call
#' @param ... The additional parameters passed to \code{do.call}
#' @export
#' @examples
#' x <- lapply(1:3, function(i) { c(a=i,b=i^2)})
#' df <- lapply(1:3, function(i) { data.frame(a=i,b=i^2,c=letters[i])})
#' list.do(x, rbind)
list.do <- function(.data, fun, ...) {
do.call(what = fun, args = as.list(.data), ...)
}
#' Bind all list elements by row
#'
#' The function binds all list elements by row. Each element of the list is expected
#' to be an atomic vector, \code{data.frame}, or \code{data.table}. If list elements
#' are also lists, the result can be a list-valued matrix. In this case,
#' \code{list.stack} may produce a better result.
#'
#' @param .data \code{list}
#' @export
#' @seealso \code{\link{list.cbind}}, \code{\link{list.stack}}
#' @examples
#' x <- lapply(1:3,function(i) { c(a=i,b=i^2)})
#' df <- lapply(1:3,function(i) { data.frame(a=i,b=i^2,c=letters[i])})
#' list.rbind(x)
#' list.rbind(df)
list.rbind <- function(.data) {
list.do(.data, "rbind")
}
#' Bind all list elements by column
#'
#' The function binds all list elements by column. Each element of the list is expected
#' to be an atomic vector, \code{data.frame}, or \code{data.table} of the same length.
#' If list elements are also lists, the binding will flatten the lists and may produce
#' undesired results.
#'
#' @param .data \code{list}
#' @export
#' @seealso \code{\link{list.cbind}}, \code{\link{list.stack}}
#' @examples
#' x <- list(data.frame(i=1:5,x=rnorm(5)),
#' data.frame(y=rnorm(5),z=rnorm(5)))
#' list.cbind(x)
list.cbind <- function(.data) {
list.do(.data, "cbind")
}
#' Apply a function to each list element (\code{lapply})
#' @export
#' @param .data A \code{list} or \code{vector}
#' @param .fun \code{function}
#' @param ... Additional parameters passed to \code{FUN}.
list.apply <- function(.data, .fun, ...) lapply(X = .data, FUN = .fun, ...)
rlist/R/list.expand.R 0000644 0001751 0000144 00000001506 12700425755 014213 0 ustar hornik users #' Create a list from all combinations of factors
#'
#' Create a list from all combinations of the supplied
#' vectors or lists, extending the functionality of
#' \link{expand.grid} from data frame to list.
#'
#' @param ... vectors or lists
#'
#' @return
#' A list of all combinations of the supplied vectors or
#' lists.
#' @export
#' @examples
#' list.expand(x=1:10, y=c("a","b","c"))
#' list.expand(x=list(c(1,2), c(2,3)), y = c("a","b","c"))
#' list.expand(
#' a=list(list(x=1,y="a"), list(x=2, y="b")),
#' b=list(c("x","y"), c("y","z","w")))
list.expand <- function(...) {
args <- list(...)
expand_args <- lapply(args, seq_along)
expand_df <- do.call(expand.grid, expand_args)
.mapply(function(...) {
mapply(`[[`, args, list(...), USE.NAMES = TRUE, SIMPLIFY = FALSE)
}, expand_df, NULL)
}
rlist/R/list.all.R 0000644 0001751 0000144 00000004206 12700425755 013504 0 ustar hornik users #' Examine if a condition is true for all elements of a list
#'
#' @param .data A \code{list} or \code{vector}
#' @param cond A logical lambda expression
#' @param na.rm logical. If true \code{NA} values are ignored in
#' the evaluation.
#' @seealso \code{\link{list.any}}
#' @return \code{TRUE} if \code{cond} is evaluated to be \code{TRUE}
#' for all elements in \code{.data}.
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.all(x, type=='B')
#' list.all(x, mean(unlist(score))>=6)
#' list.all(x, score$c2 > 8 || score$c3 > 5, na.rm = TRUE)
#' list.all(x, score$c2 > 8 || score$c3 > 5, na.rm = FALSE)
list.all <- function(.data, cond, na.rm = FALSE) {
if (missing(.data))
return(all(na.rm = na.rm))
if (is.empty(.data) || missing(cond))
return(all(.data, na.rm = na.rm))
l <- lambda(substitute(cond))
l$expr <- as.call(list(quote(`!`), l$expr))
res <- list.first.internal(.data, l, parent.frame(), na.rm = na.rm)
!res$state
}
#' Examine if a condition is true for at least one list element
#'
#' @param .data A \code{list} or \code{vector}
#' @param cond A logical lambda expression
#' @param na.rm logical. If true \code{NA} values are ignored in
#' the evaluation.
#' @seealso \code{\link{list.all}}
#' @return \code{TRUE} if \code{cond} is evaluated to be \code{TRUE}
#' for any element in \code{.data}.
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.any(x,type=='B')
#' list.any(x,mean(unlist(score))>=6)
#' list.any(x, score$c2 > 8 || score$c3 > 5, na.rm = TRUE)
#' list.any(x, score$c2 > 8 || score$c3 > 5, na.rm = FALSE)
list.any <- function(.data, cond, na.rm = FALSE) {
if (missing(.data))
return(any(na.rm = na.rm))
if (is.empty(.data) || missing(cond))
return(any(.data, na.rm = na.rm))
res <- list.first.internal(.data, substitute(cond), parent.frame(), na.rm = na.rm)
res$state
}
rlist/R/list.sample.R 0000644 0001751 0000144 00000001625 12700425755 014217 0 ustar hornik users #' Sample a list or vector
#'
#' @param .data A \code{list} or \code{vector}
#' @param size \code{integer}. The size of the sample
#' @param replace \code{logical}. Should sampling be with replacement?
#' @param weight A lambda expression to determine the weight of
#' each list member, which only takes effect if \code{prob}
#' is \code{NULL}.
#' @param prob A \code{vector} of probability weights for
#' obtaining the elements of the list being sampled.
#' @export
#' @examples
#' x <- list(a = 1, b = c(1,2,3), c = c(2,3,4))
#' list.sample(x, 2, weight = sum(.))
list.sample <- function(.data, size, replace = FALSE, weight = 1, prob = NULL) {
if (is.null(prob)) {
ws <- c(list.map.internal(.data, substitute(weight), parent.frame()), recursive = TRUE)
if (any(ws < 0))
stop("Negative weight is not allowed")
prob <- ws/sum(ws)
}
sample(.data, size, replace, prob)
}
rlist/R/list.order.R 0000644 0001751 0000144 00000003311 12700425755 014043 0 ustar hornik users #' Give the order of each list element by expression
#'
#' @param .data A \code{list} or \code{vector}
#' @param ... A group of lambda expressions
#' @param keep.names Whether to keep the names of \code{x} in the result
#' @param na.last The way to deal with \code{NA}s.
#' @export
#' @return an \code{integer} vector.
#' @seealso \code{\link{list.sort}}
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.order(x, type, (score$c2)) # order by type (ascending) and score$c2 (descending)
#' list.order(x, min(score$c1,score$c2))
#' list.order(x, min(score$c1,score$c2), keep.names=TRUE)
list.order <- function(.data, ..., keep.names = FALSE, na.last = TRUE) {
result <- list.order.internal(.data, dots(...), parent.frame(), na.last = na.last)
if (keep.names) setnames(result, names(.data)) else result
}
#' Sort a list by given expressions
#'
#' @param .data a \code{list} or \code{vector}
#' @param ... A group of lambda expressions. For each expression, the data
#' is sorted ascending by default unless the expression is enclosed by ().
#' @param na.last The way to deal with \code{NA}s.
#' @seealso \code{\link{list.order}}
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.sort(x, type, (score$c2)) # sort by score$c2 in descending order
#' list.sort(x, min(score$c1,score$c2))
list.sort <- function(.data, ..., na.last = NA) {
.data[list.order.internal(.data, dots(...), parent.frame(), na.last = na.last)]
}
rlist/R/list.skip.R 0000644 0001751 0000144 00000003064 12700425755 013703 0 ustar hornik users #' Skip a number of elements
#'
#' Skip the first \code{n} elements of a list or vector and
#' return the remaining elements if any.
#'
#' @param .data A \code{list} or \code{vector}
#' @param n \code{integer}. The number of elements to skip
#' @export
#' @seealso \code{\link{list.skipWhile}}, \code{\link{list.take}},
#' \code{\link{list.takeWhile}}
#' @examples
#' x <- list(a=1,b=2,c=3)
#' list.skip(x, 1)
#' list.skip(x, 2)
list.skip <- function(.data, n) {
if(!is.numeric(n)) stop("n must be numeric or integer", call. = FALSE)
if(n > 0L) .data[-(1L:n)]
else if(n < 0L) .data[1L:(-n)]
else .data
}
#' Keep skipping elements while a condition holds
#'
#' Keep skipping elements in a list or vector while a
#' condition holds for the element. As long as the condition
#' is violated, the element will be kept and all remaining
#' elements are returned.
#'
#' @param .data A \code{list} or \code{vector}
#' @param cond A logical lambda expression
#' @export
#' @seealso \code{\link{list.skip}}, \code{\link{list.take}},
#' \code{\link{list.takeWhile}}
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.skipWhile(x, type=='A')
#' list.skipWhile(x, min(score$c1,score$c2) >= 8)
list.skipWhile <- function(.data, cond) {
args <- args_env(i = 0L)
tryWithCondition(list.map.internal(.data, substitute(cond), parent.frame(), list.while.fun,
args), rlist.finished = NULL)
.data[-(0L:args$i)]
}
rlist/R/list.take.R 0000644 0001751 0000144 00000003106 12700425755 013656 0 ustar hornik users #' Take a number of elements
#'
#' Take the first \code{n} elements out from a list or
#' vector.
#'
#' @param .data \code{list} or \code{vector}
#' @param n \code{integer}. The number of elements to take
#' @param force \code{TRUE} to disable the length check
#' @export
#' @seealso \code{\link{list.takeWhile}}, \code{\link{list.skip}},
#' \code{\link{list.skipWhile}}
#' @examples
#' x <- list(a=1,b=2,c=3)
#' list.take(x,1)
#' list.take(x,10)
list.take <- function(.data, n, force = FALSE) {
if(!is.numeric(n)) stop("n must be numeric or integer", call. = FALSE)
.data[0L:if(force) n else min(length(.data), n)]
}
#' Keep taking elements while a condition holds
#'
#' Keep taking elements out from a list or vector while
#' a condition holds for the element. If the condition is
#' violated for an element, the element will not be taken and
#' all taken elements will be returned.
#'
#' @param .data \code{list} or \code{vector}
#' @param cond A logical lambda expression
#' @export
#' @seealso \code{\link{list.take}}, \code{\link{list.skip}},
#' \code{\link{list.skipWhile}}
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.takeWhile(x, type=='B')
#' list.takeWhile(x, min(score$c1,score$c2) >= 8)
list.takeWhile <- function(.data, cond) {
args <- args_env(i = 0L)
tryWithCondition(list.map.internal(.data, substitute(cond), parent.frame(), list.while.fun,
args), rlist.finished = NULL)
.data[0L:args$i]
}
rlist/R/list.match.R 0000644 0001751 0000144 00000001122 12700425755 014022 0 ustar hornik users #' Select members of a list that match given regex pattern
#'
#' @param .data A \code{list} or \code{vector}
#' @param pattern \code{character}. The regex pattern to match the name of the members
#' @param ... Additional parameters to pass to \code{grep}
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.match(x,'p[12]')
#' list.match(x,'3')
list.match <- function(.data, pattern, ...) {
.data[grep(pattern, names(.data), ...)]
}
rlist/R/list.filter.R 0000644 0001751 0000144 00000002174 12700425755 014223 0 ustar hornik users #' Filter a list or vector by a series of conditions
#'
#' The function recursively filters the data by a given series of
#' conditions. The filter can be a single condition or multiple
#' conditions. \code{.data} will be filtered by the first condition;
#' then the results will be filtered by the second condition, if any;
#' then the results will be filtered by the third, if any, etc. The
#' results only contain elements satisfying all conditions specified
#' in \code{...}.
#' @param .data A \code{list} or \code{vector}
#' @param ... logical conditions
#' @export
#' @return elements in \code{.data} satisfying all conditions
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.filter(x, type=='B')
#' list.filter(x, min(score$c1, score$c2) >= 8)
#' list.filter(x, type=='B', score$c2 >= 8)
list.filter <- function(.data, ...) {
conds <- dots(...)
envir <- parent.frame()
reduce(function(data, cond) {
data[which(list.is.internal(data, cond, envir))]
}, conds, .data)
}
rlist/R/list.group.R 0000644 0001751 0000144 00000011673 12700425755 014076 0 ustar hornik users #' Divide list/vector elements into exclusive groups
#'
#' @param .data A \code{list} or \code{vector}
#' @param ... One or more expressions in the scope of each element to evaluate
#' as keys
#' @param sorted \code{TRUE} to sort the group keys. Ignored when the key has
#' multiple entries.
#' @seealso \code{\link{list.ungroup}}
#' @export
#' @return A list of group elements each contain all the elements in \code{.data}
#' belonging to the group
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.group(x, type)
#' list.group(x, mean(unlist(score)))
list.group <- function(.data, ..., sorted = TRUE) {
list.group.internal(.data, dots(...), parent.frame(), compare = "identical",
sorted = sorted)
}
#' Ungroup a list by taking out second-level elements
#'
#' This functon reverses the grouping operation by taking out
#' second-level elements of a nested list and removing the labels
#' of the first-level elements. For example, a list may be created
#' from paged data, that is, its first-level elements only indicate
#' the page container. To unpage the list, the first-level elements
#' must be removed and their inner elements should be taken out to
#' to the first level.
#' @param .data \code{list}
#' @param level {integer} to indicate to which level of list elements
#' should be ungroupped to the first level.
#' @param ... Preserved use of parameter passing
#' @param group.names \code{logical}. Should the group names be
#' preserved?
#' @param sort.names \code{logical}. Should the members be sorted
#' after ungrouping?
#' @seealso \code{\link{list.group}}
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' xg <- list.group(x, type)
#' list.ungroup(xg)
#'
#' x <- list(a = list(a1 = list(x=list(x1=2,x2=3),y=list(y1=1,y2=3))),
#' b = list(b1 = list(x=list(x1=2,x2=6),y=list(y1=3,y2=2))))
#' list.ungroup(x, level = 1)
#' list.ungroup(x, level = 2)
#' list.ungroup(x, level = 2, group.names = TRUE)
list.ungroup <- function(.data, level = 1L, ..., group.names = FALSE, sort.names = FALSE) {
result <- .data
for(i in seq_len(level)) {
if(!group.names) names(result) <- NULL
result <- unlist(result, recursive = FALSE)
}
result.names <- names(result)
if (sort.names && !is.null(result.names)) {
result[sort(result.names)]
} else {
result
}
}
#' Classify list elments into unique but non-exclusive cases
#'
#' In non-tabular data, a certain field may take multiple values in a
#' collection non-exclusively. To classify these elements into different
#' cases, this function detects all possible cases and for each case all
#' elements are examined whether to belong to that case.
#' @param .data A \code{list} or \code{vector}
#' @param ... keys
#' @param sorted \code{TRUE} to sort the group keys. Ignored when the key has
#' multiple entries.
#' @export
#' @return a list of possible cases each of which contains elements belonging to
#' the case non-exclusively.
#' @examples
#' x <-
#' list(
#' p1=list(name='Ken',age=24,
#' interest=c('reading','music','movies'),
#' lang=list(r=2,csharp=4,python=3)),
#' p2=list(name='James',age=25,
#' interest=c('sports','music'),
#' lang=list(r=3,java=2,cpp=5)),
#' p3=list(name='Penny',age=24,
#' interest=c('movies','reading'),
#' lang=list(r=1,cpp=4,python=2)))
#' list.class(x,interest)
#' list.class(x,names(lang))
list.class <- function(.data, ..., sorted = TRUE) {
list.group.internal(.data, dots(...), parent.frame(), proc = "unlist", compare = "contains",
sorted = sorted)
}
#' Get all unique cases of a list field by expression
#'
#' @param .data A \code{list} or \code{vector}
#' @param expr A lambda expression. The function will returns all cases
#' of the elements if \code{expr} is missing.
#' @param simplify \code{logical}. Should atomic vectors be simplified
#' by \code{unlist}?
#' @param sorted \code{logical}. Should the cases be sorted in ascending order?
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.cases(x,type)
#' list.cases(x,mean(unlist(score)))
#'
#' foo <- list(x = LETTERS[1:3], y = LETTERS[3:5])
#' list.cases(foo)
list.cases <- function(.data, expr, simplify = TRUE, sorted = TRUE) {
expr <- if(missing(expr)) quote(.) else substitute(expr)
values <- list.map.internal(.data, expr, parent.frame())
if (simplify && all(vapply(values, is.atomic, logical(1L)))) {
values <- c(values, recursive = TRUE)
}
cases <- unique(values)
if (sorted && is.atomic(cases))
cases <- sort(cases)
cases
}
rlist/R/lambda.R 0000644 0001751 0000144 00000000777 12700425755 013213 0 ustar hornik users lambda_symbols <- c(".", ".i", ".name")
lambda_class <- "lambda_expression"
lambda <- function(expr) {
if (inherits(expr, lambda_class)) return(expr)
if (is.formula(expr)) {
if (length(expr) == 2L) return(Recall(expr[[2L]]))
lhs <- expr[[2L]]
expr <- expr[[3L]]
lhs_symbols <- as.character(if (is.symbol(lhs)) lhs else lhs[-1L])
lambda_symbols[which(nzchar(lhs_symbols))] <- lhs_symbols
}
structure(list(expr = expr, symbols = lambda_symbols), class = lambda_class)
}
rlist/R/data.R 0000644 0001751 0000144 00000000611 12700425755 012667 0 ustar hornik users #' New York hourly weather data
#'
#' A non-tabular data of the hourly weather conditions of the New York City
#' from 2013-01-01 to 2013-03-01.
#'
#' Fetch date: 2014-11-23.
#'
#' Processed by rlist.
#'
#' To retrieve the data, please visit \url{http://openweathermap.org/api} for
#' API usage.
#' @format
#' See \url{http://openweathermap.org/weather-data#current}
"nyweather"
rlist/R/list.load.R 0000644 0001751 0000144 00000007040 12700425755 013652 0 ustar hornik users #' Load a list from file
#'
#' @param file a \code{character} vector. The file as input.
#' @param type The type of input which, by default, is determined
#' by file extension. Currently supports RData, RDS, JSON, YAML.
#' @param ... Additional parameters passed to the loader function
#' @param guess a \code{character} vector to guess iteratively if
#' \code{type} of \code{file} is unrecognized, \code{NA} or empty
#' string.
#' @param action The post-processing action if multiple files are
#' supplied. This parameter will be ignored if only a single file
#' is supplied.
#'
#' \code{'none'} (default) to leave the resulted list as
#' a list of elements corresponding to elements in \code{file}
#' vector.
#'
#' \code{'merge'} to merge the list elements iteratively,
#' the later lists always modify the former ones through
#' \code{modifyList}.
#'
#' \code{'ungroup'} to ungroup the list elements, especially when
#' each file is a page of elements with identical structure.
#' @param progress \code{TRUE} to show a text progress bar in console
#' while loading files. By default, if \code{file} contains 5 elements,
#' then the progress bar will automatically be triggered to indicate
#' loading progress.
#' @importFrom utils txtProgressBar
#' @export
#' @examples
#' \dontrun{
#' list.load('list.rds')
#' list.load('list.rdata')
#' list.load('list.yaml')
#' list.load('list.json')
#' }
list.load <- function(file, type = tools::file_ext(file), ..., guess = c("json",
"yaml", "rds", "rdata", "xml"), action = c("none", "merge", "ungroup"), progress = length(file) >=
5L) {
if (length(file) == 0L)
return(list())
nztype <- !is.na(type) & nzchar(type)
fun <- paste("list.loadfile", tolower(type), sep = ".")
fun[!nztype] <- NA_character_
guess <- tolower(guess)
pb <- if (progress)
txtProgressBar(min = 0L, max = length(file), style = 3L) else NULL
res <- if (length(file) == 1L)
list.loadfile(file, fun, guess, ..., pb = pb, index = 1L) else {
items <- map(list.loadfile, list(file, fun, index = seq_along(file)), list(guess = guess,
..., pb = pb))
switch(match.arg(action), merge = do.call("list.merge", items), ungroup = list.ungroup(items),
items)
}
if (!is.null(pb))
close(pb)
res
}
list.loadfile <- function(file, fun, guess, ..., pb = NULL, index = NULL) {
res <- NULL
if (is.na(fun)) {
if (!missing(guess) && length(guess) > 0L) {
exprs <- lapply(paste("list.loadfile", guess, sep = "."), function(f) call(f,
file))
res <- try_list(exprs, stop("Unrecognized type of file: ", file, call. = FALSE))
if (!is.null(pb))
pb$up(index)
} else stop("Unrecognized type of file: ", file, call. = FALSE)
} else if (exists(fun, mode = "function")) {
fun <- get(fun, mode = "function")
res <- fun(file, ...)
if (!is.null(pb))
pb$up(index)
} else {
stop("Unrecognized type of file: ", file, call. = FALSE)
}
res
}
list.loadfile.json <- function(file, ...) {
callwith(jsonlite::fromJSON, list(file, simplifyDataFrame = FALSE), list(...))
}
list.loadfile.yaml <- function(file, ...) {
yaml::yaml.load_file(file, ...)
}
list.loadfile.yml <- list.loadfile.yaml
list.loadfile.xml <- function(file, ...) {
xmlData <- XML::xmlParse(file, ...)
XML::xmlToList(xmlData)
}
list.loadfile.rdata <- function(file, name = "x") {
env <- new.env(parent = parent.frame(), size = 1L)
load(file, env)
env[[name]]
}
list.loadfile.rds <- function(file, ...) readRDS(file, ...)
rlist/R/functions.R 0000644 0001751 0000144 00000007076 12700425755 014002 0 ustar hornik users # compatibility for data.table functions
.datatable.aware <- TRUE
# Substitute ... @param ... parameters to substitute
dots <- function(...) {
eval(substitute(alist(...)))
}
# Evaluate a function with a modified default values @param fun either a function
# or a non-empty character string naming the function to be called @param args a
# list of values to modify the default arguments of the function @param dots the
# user-specific input (usually from ...) @param keep.null \code{TRUE} to keep
# \code{NULL} values after argument modifications @param envir the environment
# to evaluate the function call
#' @importFrom utils modifyList
callwith <- function(fun, args, dots = list(), keep.null = FALSE, envir = parent.frame()) {
do.call(fun, modifyList(args, dots, keep.null = keep.null), envir = envir)
}
setnames <- `names<-`
setclass <- `class<-`
setmembers <- `[<-`
is.formula <- function(expr) {
inherits(expr, "formula") || (is.call(expr) && expr[[1L]] == "~")
}
is.error <- function(x) {
inherits(x, "try-error")
}
# Test if a vector contains certain values @param table the values to be matched
# against @param x the values to be matched
contains <- function(table, x) {
match(x, table, nomatch = 0L) > 0L
}
# Get the names of an object @details This function is used in vectorization when
# the names of an object is to be supplied. \code{NULL} value will break the
# vectorization while setting \code{def = character(1L)} makes the names
# vectorizable. @param x the object to extract names @param def the value to
# return if the object has \code{NULL} names. For vectorization purpose, set
# this to \code{character(1L)}.
getnames <- function(x, def = NULL) if (is.null(names(x))) def else names(x)
# Check if an object is empty (has length 0) @details A \code{NULL} value,
# zero-length vector or list have length zero, which is called empty. @param x
# the object
is.empty <- function(x) length(x) == 0L
# Make names for unnamed symbol arguments @details The elements of an unevaluated
# list of arguments may or may not have names as given by user. For example,
# \code{list.select} requires user to specify the fields to select. These fields
# are unevaluated arguments, some of which are symbols and others are calls. For
# the symbols, it is natural to make the resulted lists to have the same name for
# the particular arguments. @param args the unevaluated argument list @param
# data the list to be named (\code{args} by default)
set_argnames <- function(args, data = args) {
argnames <- getnames(args, character(length(args)))
indices <- !nzchar(argnames) & vapply(args, is.name, logical(1L))
argnames[indices] <- as.character(args[indices])
setnames(data, argnames)
}
try_list <- function(exprs, finally, envir = NULL, enclos = parent.frame()) {
for (expr in exprs) {
result <- try(eval(expr, envir, enclos), silent = TRUE)
if (!inherits(result, "try-error"))
return(result)
}
if (missing(finally))
stop("No valid results produced", call. = FALSE)
eval(substitute(finally), envir, enclos)
}
# Convert an object to evaluating environment for list elements Users should not
# directly use this function @param x the object
.evalwith <- function(x) {
if (is.null(names(x)))
NULL else if (is.list(x))
x else if (is.vector(x))
setclass(x, "list") else NULL
}
# create an environment for args
args_env <- function(..., parent = parent.frame()) {
list2env(list(...), parent = parent)
}
# create a list for args
args_list <- function(...) {
list(...)
}
rlist/R/list.zip.R 0000644 0001751 0000144 00000007557 12700425755 013552 0 ustar hornik users #' Combine multiple lists element-wisely.
#'
#' @param ... \code{list}s
#' @param use.argnames \code{logical}. Should the names of the
#' arguments be used as the names of list items?
#' @param use.names \code{logical}. Should the names of the first
#' argument be used as the zipped list?
#' @export
#' @seealso \code{\link{list.unzip}}
#' @examples
#' x <- list(1,2,3)
#' y <- list('x','y','z')
#' list.zip(num=x,sym=y)
list.zip <- function(..., use.argnames = TRUE, use.names = TRUE) {
args <- list(...)
if (use.argnames)
args <- set_argnames(dots(...), args)
results <- map(args_list, args)
if (!use.names)
names(results) <- NULL
results
}
#' Transform a list of elements with similar structure into a list of decoupled fields
#'
#' @param .data A \code{list} of elements containing common fields
#' @param .fields \code{'intersect'} to select only common fields for
#' all \code{.data}'s elements. \code{'union'} to select any field that
#' is defined in any elements in \code{.data}.
#' @param ... The custom aggregate functions. Can be a named list of functions or
#' character vectors. If a function is specified as a list of functions, then the
#' functions will be evaluated recursively on the result of the field. Use \code{identity} to
#' avoid aggregating results. Use \code{NULL} to remove certain field.
#' @param .aggregate The default aggregate function, by default, \code{simplify2array}.
#' Can be a function, character vector or a list of functions. Use \code{identity} to avoid
#' aggregating results.
#' @param .missing When \code{.fields} is \code{'union'} and some elements do not contain
#' certain fields, then \code{NULL} will be replaced by the value of \code{.missing},
#' by default, \code{NA}. This often makes the result more friendly.
#' @importFrom stats na.omit
#' @export
#' @seealso \code{\link{list.zip}}
#' @examples
#' list.unzip(list(p1 = list(a = 1, b = 2), p2 = list(a = 2, b = 3)))
#' list.unzip(list(p1 = list(a = 1, b = 2), p2 = list(a = 2, b = 3, c = 4)))
#' list.unzip(list(p1 = list(a = 1, b = 2), p2 = list(a = 2, b = 3, c = 4)), 'union')
#' list.unzip(list(p1 = list(a = 1, b = 2), p2 = list(a = 2, b = 3, c = 4)), 'union', a = 'identity')
#' list.unzip(list(p1 = list(a = 1, b = 2), p2 = list(a = 2, b = 3, c = 4)), 'intersect', a = NULL)
#'
#' x <-
#' list(april = list(n_days = 30,
#' holidays = list(list('2015-04-01', 'april fools'),
#' list('2015-04-05', 'easter')),
#' month_info = c(number = '4', season = 'spring')),
#' july = list(n_days = 31,
#' holidays = list(list('2014-07-04', 'july 4th')),
#' month_info = c(number = '7', season = 'summer')))
#' list.unzip(x, holidays = c('list.ungroup', 'unname', 'list.stack',
#' function(df) setNames(df, c("date", "name"))))
list.unzip <- function(.data, .fields = c("intersect", "union"), ..., .aggregate = "simplify2array",
.missing = NA) {
data_names <- lapply(.data, names)
aggregator <- lapply(.aggregate, match.fun)
args <- list(...)
if (length(args) >= 1L && (is.null(names(args)) || !all(nzchar(names(args)))))
stop("Custom aggregate function must have a name", call. = FALSE)
args <- lapply(args, function(f) {
if (is.null(f))
NULL else if (is.vector(f))
lapply(f, match.fun) else match.fun(f)
})
fields <- Reduce(match.fun(match.arg(.fields)), data_names)
names(fields) <- fields
fields[names(args)[vapply(args, is.null, logical(1L))]] <- NA
fields <- na.omit(fields)
lapply(fields, function(field) {
items <- lapply(.data, "[[", field)
if (!is.null(.missing)) {
missings <- vapply(items, is.null, logical(1L))
items[missings] <- .missing
}
agg_fun <- if (!is.null(args[[field]]))
args[[field]] else aggregator
if (is.list(agg_fun)) {
reduce(function(res, f) f(res), agg_fun, items)
} else agg_fun(items)
})
}
rlist/R/list.save.R 0000644 0001751 0000144 00000002714 12700425755 013674 0 ustar hornik users #' Save a list to a file
#'
#' @param x The list to save
#' @param file The file for output
#' @param type The type of output which, by default, is determined
#' by file extension. Currently supports RData, RDS, JSON, YAML.
#' @param ... Additional parameters passed to the output function
#' @export
#' @return \code{x} will be returned.
#' @examples
#' \dontrun{
#' x <- lapply(1:5,function(i) data.frame(a=i,b=i^2))
#' list.save(x, 'list.rds')
#' list.save(x, 'list.rdata')
#' list.save(x, 'list.yaml')
#' list.save(x, 'list.json')
#' }
list.save <- function(x, file, type = tools::file_ext(file), ...) {
fun <- paste("list.savefile", tolower(type), sep = ".")
if (exists(fun, mode = "function")) {
fun <- get(fun, mode = "function")
fun(x, file, ...)
} else {
stop("Unrecognized type of file: ", file, call. = FALSE)
}
invisible(x)
}
list.savefile.json <- function(x, file, ...) {
json <- jsonlite::toJSON(x, ...)
writeLines(json, file)
}
list.savefile.yaml <- function(x, file, ...) {
yaml <- yaml::as.yaml(x, ...)
writeLines(yaml, file)
}
list.savefile.yml <- list.savefile.yaml
list.savefile.rdata <- function(x, file, name = "x", ...) {
if (!is.list(x))
stop("x is not a list")
env <- new.env(parent = parent.frame(), size = 1L)
assign(name, x, envir = env)
save(list = name, file = file, envir = env, ...)
}
list.savefile.rds <- function(x, file, ...) saveRDS(x, file, ...)
rlist/R/list.table.R 0000644 0001751 0000144 00000002112 12700425755 014015 0 ustar hornik users #' Generate a table for a list by expression
#' @param .data A \code{list} or \code{vector}
#' @param ... A group of lambda expressions. If missing,
#' \code{table} will be directly called upon \code{.data} with
#' \code{table.args}.
#' @param table.args \code{list}. The additional parameters
#' passed to \code{table}
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.table(x, type)
#' list.table(x, type, c1 = score$c1)
#' list.table(x, type, score$c1, table.args = list(dnn=c('type','c1')))
list.table <- function(.data, ..., table.args = list(useNA = "ifany")) {
if (missing(...)) return(do.call(table, c(list(.data), table.args)))
args <- set_argnames(dots(...))
envir <- parent.frame()
items <- lapply(args, function(arg) {
values <- list.map.internal(.data, arg, envir)
values[vapply(values, is.null, logical(1L))] <- NA
c(values, recursive = TRUE)
})
do.call(table, c(items, table.args))
}
rlist/R/internal.R 0000644 0001751 0000144 00000012535 12700425755 013602 0 ustar hornik users .expr <- NULL
map <- function(f, dots, more = NULL, use.names = TRUE) {
res <- .mapply(f, dots, more)
if (use.names && length(dots)) {
if (!is.null(names1 <- names(dot1 <- dots[[1L]])))
names(res) <- names1 else if (is.character(dot1))
names(res) <- dot1
}
res
}
reduce <- function(f, x, init, ...) {
y <- init
for (xi in x) y <- f(y, xi, ...)
y
}
tryWithCondition <- function(expr, ...) {
tryCatch(expr, condition = function(e) switch(e$message, ..., stop(e)))
}
list.map.fun <- function(.data, ., .i, .name) {
eval(.expr, .evalwith(.data), environment())
}
list.map.internal <- function(.data, expr, envir, fun = list.map.fun, args = NULL) {
if (is.empty(.data)) return(list())
l <- lambda(expr)
xnames <- getnames(.data, character(1L))
environment(fun) <- args_env(.expr = l$expr, .args = args, .evalwith = .evalwith,
parent = envir)
formals(fun) <- setnames(formals(fun), c(".data", l$symbols))
map(fun, list(.data, .data, seq_along(.data), xnames))
}
list.is.fun <- function(.data, ., .i, .name) {
x <- eval(.expr, .evalwith(.data), environment())
if (is.logical(x) && length(x) == 1L)
x else NA
}
list.is.internal <- function(.data, cond, envir) {
as.logical(list.map.internal(.data, cond, envir, list.is.fun))
}
list.findi.fun <- function(.data, ., .i, .name) {
.args$i <- .args$i + 1L
x <- eval(.expr, .evalwith(.data), environment())
if (is.logical(x) && length(x) == 1L && !is.na(x)) {
if (x) {
.args$n <- .args$n + 1L
.args$indices[[.args$n]] <- .args$i
if (.args$n == .args$N)
stop(simpleError("rlist.finished"))
}
} else if (.args$na.stop)
stop(simpleError("rlist.stopped"))
}
list.findi.internal <- function(.data, cond, envir, n, na.stop = FALSE) {
n <- min(n, length(.data))
args <- args_env(i = 0L, n = 0L, N = n, na.stop = na.stop, indices = integer(n))
tryWithCondition(list.map.internal(.data, cond, envir, list.findi.fun, args),
rlist.finished = NULL,
rlist.stopped = warning("Encountered value that is not TRUE or FALSE"))
args$indices[0L:args$n]
}
list.first.fun <- function(.data, ., .i, .name) {
x <- eval(.expr, .evalwith(.data), environment())
if (is.logical(x) && length(x) == 1L && !is.na(x)) {
if (x) {
.args$res <- list(state = TRUE, value = .data)
stop(simpleError("rlist.finished"))
}
} else if (!.args$na.rm) {
.args$res <- list(state = NA, value = .data)
}
}
list.first.internal <- function(.data, cond, envir, na.rm) {
args <- args_env(res = list(state = FALSE), na.rm = na.rm)
tryWithCondition(list.map.internal(.data, cond, envir, list.first.fun, args), rlist.finished = NULL)
args$res
}
list.while.fun <- function(.data, ., .i, .name) {
x <- eval(.expr, .evalwith(.data), environment())
if (is.logical(x) && length(x) == 1L && !is.na(x) && x)
.args$i <- .args$i + 1L else stop(simpleError("rlist.finished"))
}
list.order.internal <- function(.data, args, envir, na.last = TRUE) {
if (is.empty(.data))
return(integer())
if (is.empty(args))
return(order(.data))
cols <- lapply(args, function(arg) {
if (is.null(arg)) stop("NULL condition")
desc <- class(arg) == "("
if (desc) arg <- arg[[2L]]
col <- list.map.internal(.data, arg, envir)
if (length(unique.default(vapply(col, "class", character(1L)))) > 1L) {
warning("Inconsistent classes of values in column [", deparse(arg),
"]. The column will be coerced to the same class.", call. = FALSE)
}
lens <- vapply(col, length, integer(1L))
if (any(lens != 1L)) {
warning("Non-single value in column [", deparse(arg), "]. Use NA instead to order.",
call. = FALSE)
col[lens != 1L] <- NA
}
col <- unlist(col, recursive = FALSE, use.names = FALSE)
if (desc)
col <- -xtfrm(col)
col
})
do.call(order, c(cols, na.last = na.last))
}
list.search.fun <- function(.data, .expr, .args, .n = .args$n, . = .data, .i = .args$i,
.name = NULL) {
.args$i <- .args$i + 1L
q <- eval(.expr, NULL, environment())
vq <- !is.na(q)
if (is.logical(q) && length(q) == 1L && !is.na(q)) {
if (q) {
.args$n <- .args$n + 1L
.args$indices[[.args$n]] <- .args$i
.args$result[[.args$n]] <- .data
if (.args$n == .args$N) stop(simpleError("rlist.finished"))
}
} else if (length(q) >= 1L && any(vq)) {
.args$n <- .args$n + 1L
.args$indices[[.args$n]] <- .args$i
.args$result[[.args$n]] <- q[vq]
if (.args$n == .args$N) stop(simpleError("rlist.finished"))
}
}
list.group.internal <- function(.data, keys, envir, proc = NULL, compare = "identical",
sorted = TRUE) {
if (is.empty(keys))
return(.data)
values <- list.map.internal(.data, keys[[1L]], envir)
proc <- if (!missing(proc) && !is.null(proc) && !is.function(proc))
match.fun(proc) else NULL
uvalues <- if (is.function(proc)) proc(values) else values
uniques <- unique.default(uvalues)
names(uniques) <- uniques
if (sorted && all(vapply(uniques, length, integer(1L)) == 1L))
uniques <- sort(c(uniques, recursive = TRUE))
lapply(uniques, function(key, ...) {
selector <- vapply(values, compare, logical(1L), key, USE.NAMES = FALSE)
list.group.internal(.data[selector], keys[-1L], ...)
}, envir, proc, compare, sorted)
}
rlist/R/list.join.R 0000644 0001751 0000144 00000003675 12700425755 013704 0 ustar hornik users #' Join two lists by single or multiple keys
#' @param x The first list
#' @param y The second list
#' @param xkey A lambda expression that determines the key for list \code{x}
#' @param ykey A lambda expression that determines the key for list \code{y},
#' same to \code{xkey} if missing
#' @param ... The additional parameters passed to \code{merge.data.frame}
#' @param keep.order Should the order of \code{x} be kept?
#' @export
#' @importFrom utils modifyList
#' @examples
#' l1 <- list(p1=list(name='Ken',age=20),
#' p2=list(name='James',age=21),
#' p3=list(name='Jenny',age=20))
#' l2 <- list(p1=list(name='Jenny',age=20,type='A'),
#' p2=list(name='Ken',age=20,type='B'),
#' p3=list(name='James',age=22,type='A'))
#' list.join(l1, l2, name)
#' list.join(l1, l2, .[c('name','age')])
list.join <- function(x, y, xkey, ykey, ..., keep.order = TRUE) {
if (missing(xkey) && missing(ykey))
stop("At least one key should be specified")
sxkey <- substitute(xkey)
sykey <- substitute(ykey)
dfsxkey <- substitute(data.frame(xkey))
if (missing(sykey)) {
sykey <- sxkey
dfsykey <- substitute(data.frame(xkey))
} else {
dfsykey <- substitute(data.frame(ykey))
}
xkeys.list <- list.map.internal(x, dfsxkey, parent.frame())
ykeys.list <- list.map.internal(y, dfsykey, parent.frame())
xkeys.df <- list.rbind(xkeys.list)
ykeys.df <- list.rbind(ykeys.list)
if (is.name(sxkey))
colnames(xkeys.df) <- as.character(sxkey)
if (is.name(sykey))
colnames(ykeys.df) <- as.character(sykey)
if (!identical(colnames(xkeys.df), colnames(ykeys.df))) {
stop("Inconsistent keys")
}
xkeys <- cbind(.xi = seq_along(xkeys.list), xkeys.df)
ykeys <- cbind(.yi = seq_along(ykeys.list), ykeys.df)
df <- merge.data.frame(xkeys, ykeys, by = colnames(xkeys)[-1L], ...)
if (keep.order)
df <- df[order(df$.xi), ]
map(modifyList, list(x[df$.xi], y[df$.yi]))
}
rlist/R/list.find.R 0000644 0001751 0000144 00000002766 12700425755 013665 0 ustar hornik users #' Find a specific number of elements in a list or vector
#' satisfying a given condition
#'
#' @param .data A \code{list} or \code{vector}
#' @param cond A logical lambda expression
#' @param n The number of items to find. (\code{n = 1L} by default)
#' @return A list or vector of at most \code{n} elements in \code{.data}
#' found to satisfy \code{cond}.
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.find(x, type=='B', 1)
#' list.find(x, min(score$c1,score$c2) >= 9)
list.find <- function(.data, cond, n = 1L) {
.data[list.findi.internal(.data, substitute(cond), parent.frame(), n)]
}
#' Find the indices of a number of elements in a list or vector
#' satisfying a given condition
#'
#' @param .data A \code{list} or \code{vector}
#' @param cond A logical lambda expression
#' @param n The number of items to find. (\code{n = 1L} by default)
#' @return an integer vector consisting of the elements indices
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.findi(x, type=='B')
#' list.findi(x, min(score$c1,score$c2) >= 8)
#' list.findi(x, min(score$c1,score$c2) <= 8, n = 2)
list.findi <- function(.data, cond, n = 1L) {
list.findi.internal(.data, substitute(cond), parent.frame(), n)
}
rlist/R/list.serialize.R 0000644 0001751 0000144 00000003566 12700425755 014733 0 ustar hornik users #' Serialize a list
#'
#' @param x \code{list}
#' @param file The file for output
#' @param type The type of serialization, including native serializer and
#' json serializer, which is by default determined by file extension
#' @param ... Additional parameters passed to the serializer function
#' @seealso \code{\link{list.unserialize}}
#' @export
#' @examples
#' \dontrun{
#' x <- list(a=1,b=2,c=3)
#' list.serialize(x,'test.dat')
#' list.serialize(x,'test.json')
#' }
list.serialize <- function(x, file, type = tools::file_ext(file), ...) {
fun <- paste("list.serialize", tolower(type), sep = ".")
if (exists(fun, mode = "function")) {
fun <- get(fun, mode = "function")
fun(x, file, ...)
} else {
conn <- file(file, open = "w")
serialize(x, conn)
close(conn)
}
invisible(x)
}
list.serialize.json <- function(x, file, ...) {
json <- jsonlite::serializeJSON(x, ...)
writeLines(json, file)
}
#' Unserialize a file
#'
#' @param file The file as input
#' @param type The type of serialization, including native unserializer and
#' json unserializer, which is by default determined by file extension
#' @param ... Additional parameters passed to the unserializer function
#' @seealso \code{\link{list.serialize}}
#' @export
#' @examples
#' \dontrun{
#' list.unserialize('test.dat')
#' list.unserialize('test.json')
#' }
list.unserialize <- function(file, type = tolower(tools::file_ext(file)), ...) {
fun <- paste("list.unserialize", type, sep = ".")
if (exists(fun, mode = "function")) {
fun <- get(fun, mode = "function")
fun(file, ...)
} else {
conn <- file(file, open = "r")
res <- unserialize(conn)
close(conn)
res
}
}
list.unserialize.json <- function(file, ...) {
info <- file.info(file)
txt <- readChar(file, info$size)
jsonlite::unserializeJSON(txt, ...)
}
rlist/R/list.update.R 0000644 0001751 0000144 00000002450 12700425755 014215 0 ustar hornik users #' Update a list by appending or modifying its elements.
#'
#' The function updates each element of a list by evaluating
#' a group of expressions in the scope of the element. If the
#' name of an expression alreadys exists in an list element,
#' then the field with the name will be updated. Otherwise,
#' the value with the name will be appended to the list
#' element. The functionality is essentially done by
#' \code{modifyList}.
#'
#' @param .data \code{list}
#' @param ... A group of labmda expressions
#' @param keep.null Should \code{NULL} values be preserved
#' for \code{modifyList}
#' @importFrom utils modifyList
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.update(x, high=max(score$c1,score$c2), low=min(score$c1,score$c2))
#' list.update(x, exams=length(score))
#' list.update(x, grade=ifelse(type=='A', score$c1, score$c2))
#' list.update(x, score=list(min=0, max=10))
list.update <- function(.data, ..., keep.null = FALSE) {
items <- lapply(dots(...), list.map.internal, .data = .data, envir = parent.frame())
map(function(.data, ...) modifyList(.data, list(...), keep.null = keep.null),
c(list(.data), items))
}
rlist/R/list.select.R 0000644 0001751 0000144 00000001244 12700425755 014212 0 ustar hornik users #' Select by name or expression for each member of a list
#'
#' @param .data A \code{list} or \code{vector}
#' @param ... A group of implicit labmda expressions
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.select(x, type)
#' list.select(x, tp = type)
#' list.select(x, type, score)
#' list.select(x, type, score.range = range(unlist(score)))
list.select <- function(.data, ...) {
args <- set_argnames(dots(...))
quote <- as.call(c(quote(list), args))
list.map.internal(.data, quote, parent.frame())
}
rlist/R/list.names.R 0000644 0001751 0000144 00000001401 12700425755 014031 0 ustar hornik users #' Get or set the names of a list by expression
#' @param .data A \code{list} or \code{vector}
#' @param expr the expression whose value will be set as the name
#' for each list element. If missing then the names of the list will be
#' returned. If \code{NULL} then the names of the list will be removed.
#' @export
#' @examples
#' list.names(c(1,2,3))
#' list.names(c(a=1,b=2,c=3))
#' list.names(c(1,2,3),letters[.])
#' list.names(list(list(name='A',value=10),list(name='B',value=20)), name)
list.names <- function(.data, expr) {
if (missing(expr))
return(names(.data))
expr <- substitute(expr)
if (is.null(expr))
return(setnames(.data, NULL))
values <- list.map.internal(.data, expr, parent.frame())
setnames(.data, values)
}
rlist/R/list.common.R 0000644 0001751 0000144 00000001706 12700425755 014226 0 ustar hornik users #' Get all common cases by expression for a list
#'
#' @param .data \code{list}
#' @param expr An anonymous (or "lambda") expression to determine common cases. If one
#' is not specified, \code{list.common} simply returns all identical sub-elements within lists.
#' @export
#' @examples
#' x <- list(c('a','b','c'),c('a','b'),c('b','c'))
#' list.common(x, .)
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.common(x,type)
#' list.common(x,names(score))
#'
#' foo <- list(x = LETTERS[1:3], y = LETTERS[3:5])
#' list.common(foo)
list.common <- function(.data, expr) {
if (!length(.data)) {
return(NULL)
}
if(missing(expr)){
expr <- quote(.)
} else {
expr <- substitute(expr)
}
values <- list.map.internal(.data, expr, parent.frame())
return(reduce(intersect, values, values[[1L]]))
}
rlist/R/list.first.R 0000644 0001751 0000144 00000002637 12700425755 014071 0 ustar hornik users #' Find the first element that meets a condition
#' @param .data A \code{list} or \code{vector}
#' @param cond a logical lambda expression
#' @export
#' @seealso \code{\link{list.last}}
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.first(x, score$c1 < 10)
#' list.first(x, score$c1 < 9 || score$c3 >= 5) # NULL for all results are NA or FALSE
list.first <- function(.data, cond) {
if (is.empty(.data)) return(NULL)
if (missing(cond)) return(.data[[1L]])
res <- list.first.internal(.data, substitute(cond), parent.frame(), na.rm = TRUE)
res$value
}
#' Find the last element that meets a condition
#' @param .data A \code{list} or \code{vector}
#' @param cond a logical lambda expression
#' @seealso \code{\link{list.first}}
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.last(x, score$c1 < 10)
#' list.last(x, score$c1 < 9 || score$c3 >= 5) # NULL for all results are NA or FALSE
list.last <- function(.data, cond) {
if (is.empty(.data)) return(NULL)
if (missing(cond)) return(.data[[length(.data)]])
res <- list.first.internal(rev(.data), substitute(cond), parent.frame(), na.rm = TRUE)
res$value
}
rlist/R/list.reverse.R 0000644 0001751 0000144 00000000337 12700425755 014410 0 ustar hornik users #' Reverse a list
#'
#' @param .data A \code{list} or \code{vector}
#' @export
#' @examples
#' x <- list(a=1,b=2,c=3)
#' list.reverse(x)
list.reverse <- function(.data) {
.data[rev.default(seq_along(.data))]
}
rlist/R/list.remove.R 0000644 0001751 0000144 00000002512 12700425755 014227 0 ustar hornik users #' Remove members from a list by index or name
#'
#' @param .data A \code{list} or \code{vector}
#' @param range A numeric vector of indices or
#' a character vector of names to remove from \code{.data}
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.remove(x, 'p1')
#' list.remove(x, c(1,2))
list.remove <- function(.data, range = integer()) {
if (is.logical(range)) {
.data[!range]
} else if (is.numeric(range)) {
.data[-range]
} else if (is.character(range)) {
names <- names(.data)
m <- vapply(range, "==", logical(length(.data)), names)
selector <- apply(m, 1L, any)
.data[!selector]
}
}
#' Exclude members of a list that meet given condition.
#'
#' @param .data A \code{list} or \code{vector}
#' @param cond A logical lambda expression to exclude items
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.exclude(x, type=='B')
#' list.exclude(x, min(score$c1,score$c2) >= 8)
list.exclude <- function(.data, cond) {
.data[!list.is.internal(.data, substitute(cond), parent.frame())]
}
rlist/R/list.flatten.R 0000644 0001751 0000144 00000002204 12700425755 014365 0 ustar hornik users #' Flatten a nested list to a one-level list
#'
#' @details
#' The function is essentially a slightly modified version of \code{flatten2}
#' provided by Tommy at \href{http://stackoverflow.com/a/8139959/2906900}{stackoverflow.com} who
#' has full credit of the implementation of this function.
#' @param x \code{list}
#' @param use.names \code{logical}. Should the names of \code{x} be kept?
#' @param classes A character vector of class names, or "ANY" to match any class.
#' @author \href{http://stackoverflow.com/users/662787/tommy}{Tommy}
#' @export
#' @examples
#' p <- list(a=1,b=list(b1=2,b2=3),c=list(c1=list(c11='a',c12='x'),c2=3))
#' list.flatten(p)
#'
#' p <- list(a=1,b=list(x="a",y="b",z=10))
#' list.flatten(p, classes = "numeric")
#' list.flatten(p, classes = "character")
list.flatten <- function(x, use.names = TRUE, classes = "ANY") {
len <- sum(rapply(x, function(x) 1L, classes = classes))
y <- vector("list", len)
i <- 0L
items <- rapply(x, function(x) {
i <<- i + 1L
y[[i]] <<- x
TRUE
}, classes = classes)
if (use.names && !is.null(nm <- names(items)))
names(y) <- nm
y
}
rlist/R/list.merge.R 0000644 0001751 0000144 00000002545 12700425755 014037 0 ustar hornik users #' Merge a number of named lists in sequential order
#'
#' The function merges a number of lists in sequential order
#' by \code{modifyList}, that is, the later list always
#' modifies the former list and form a merged list, and the
#' resulted list is again being merged with the next list.
#' The process is repeated until all lists in \code{...} or
#' \code{list} are exausted.
#'
#' @details
#' List merging is usually useful in the merging of program
#' settings or configuraion with multiple versions across time,
#' or multiple administrative levels. For example, a program
#' settings may have an initial version in which most keys are
#' defined and specified. In later versions, partial modifications
#' are recorded. In this case, list merging can be useful to merge
#' all versions of settings in release order of these versions. The
#' result is an fully updated settings with all later modifications
#' applied.
#' @param ... named lists
#' @importFrom utils modifyList
#' @export
#' @examples
#' l1 <- list(a=1,b=list(x=1,y=1))
#' l2 <- list(a=2,b=list(z=2))
#' l3 <- list(a=2,b=list(x=3))
#' list.merge(l1,l2,l3)
list.merge <- function(...) {
lists <- list(...)
if (any(vapply(lists, function(x) is.null(names(x)), logical(1L))))
stop("All arguments must be named list", call. = FALSE)
reduce(modifyList, lists, list())
}
rlist/R/subset.list.R 0000644 0001751 0000144 00000001777 12700425755 014253 0 ustar hornik users #' Subset a list by a logical condition
#'
#' @param x The list to subset
#' @param subset A logical lambda expression of subsetting condition
#' @param select A lambda expression to evaluate for each selected item
#' @param ... Additional parameters
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' subset(x, type == 'B')
#' subset(x, select = score)
#' subset(x, min(score$c1, score$c2) >= 8, data.frame(score))
#' subset(x, type == 'B', score$c1)
#' do.call(rbind,
#' subset(x, min(score$c1, score$c2) >= 8, data.frame(score)))
subset.list <- function(x, subset, select, ...) {
envir <- parent.frame()
subset.items <- if(missing(subset)) x else
x[list.is.internal(x, substitute(subset), envir)]
select.items <- if(missing(select)) subset.items else
list.map.internal(subset.items, substitute(select), envir)
list.clean(select.items)
}
rlist/R/list.which.R 0000644 0001751 0000144 00000001110 12700425755 014025 0 ustar hornik users #' Give the indices of list elements satisfying
#' a given condition
#'
#' @param .data A \code{list} or \code{vector}
#' @param cond A logical lambda expression
#' @return an \code{integer} vector
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.which(x, type == 'B')
#' list.which(x, min(score$c1,score$c2) >= 8)
list.which <- function(.data, cond) {
which(list.is.internal(.data, substitute(cond), parent.frame()))
}
rlist/R/list.count.R 0000644 0001751 0000144 00000001520 12700425755 014060 0 ustar hornik users #' Count the number of elements that satisfy given condition
#'
#' @param .data A \code{list} or \code{vector}
#' @param cond A logical lambda expression for each element of \code{.data} to evaluate. If
#' \code{cond} is missing then the total number of elements in \code{.data} will be returned.
#' @return An integer that indicates the number of elements with which \code{cond} is evaluated
#' to be \code{TRUE}.
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.count(x, type=='B')
#' list.count(x, min(unlist(score)) >= 9)
list.count <- function(.data, cond) {
if (missing(cond)) return(length(.data))
length(which(list.is.internal(.data, substitute(cond), parent.frame())))
}
rlist/R/list.is.R 0000644 0001751 0000144 00000001372 12700425755 013350 0 ustar hornik users #' Return a logical vector that indicates if each member of a list
#' satisfies a given condition
#'
#' @param .data \code{list}
#' @param cond A logical lambda expression
#' @param use.names \code{logical} Should the names of \code{.data} be kept?
#' @export
#' @examples
#' x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
#' p2 = list(type='B',score=list(c1=9,c2=9)),
#' p3 = list(type='B',score=list(c1=9,c2=7)))
#' list.is(x,type=='B')
#' list.is(x,min(score$c1,score$c2) >= 8)
list.is <- function(.data, cond, use.names = TRUE) {
items <- list.is.internal(.data, substitute(cond), parent.frame())
if (use.names)
setnames(items, names(.data)) else items
}
#' @export
#' @rdname list.is
list.if <- list.is
rlist/R/list.search.R 0000644 0001751 0000144 00000007100 12700425755 014175 0 ustar hornik users #' Search a list recusively by an expression
#'
#' @param .data A \code{list} or \code{vector}
#' @param expr a lambda expression
#' @param classes a character vector of class names that restrict the search.
#' By default, the range is unrestricted (\code{ANY}).
#' @param n the maximal number of vectors to return
#' @param unlist \code{logical} Should the result be unlisted?
#' @details
#' \code{list.search} evaluates an expression (\code{expr}) recursively
#' along a list (\code{.data}).
#'
#' If the expression results in a single-valued logical vector and its
#' value is \code{TRUE}, the whole vector will be collected If it results
#' in multi-valued or non-logical vector, the non-\code{NA} values
#' resulted from the expression will be collected.
#'
#' To search whole vectors that meet certain condition, specify the
#' expression that returns a single logical value.
#'
#' To search the specific values within the vectors, use subsetting in the
#' expression, that is, \code{.[cond]} or lambda expression like
#' \code{x -> x[cond]} where \code{cond} is a logical vector used to
#' select the elements in the vector.
#' @name list.search
#' @export
#' @examples
#' # Exact search
#'
#' x <- list(p1 = list(type='A',score=c(c1=9)),
#' p2 = list(type=c('A','B'),score=c(c1=8,c2=9)),
#' p3 = list(type=c('B','C'),score=c(c1=9,c2=7)),
#' p4 = list(type=c('B','C'),score=c(c1=8,c2=NA)))
#'
#' ## Search exact values
#' list.search(x, identical(., 'A'))
#' list.search(x, identical(., c('A','B')))
#' list.search(x, identical(., c(9,7)))
#' list.search(x, identical(., c(c1=9,c2=7)))
#'
#' ## Search all equal values
#' list.search(x, all(. == 9))
#' list.search(x, all(. == c(8,9)))
#' list.search(x, all(. == c(8,9), na.rm = TRUE))
#'
#' ## Search any equal values
#' list.search(x, any(. == 9))
#' list.search(x, any(. == c(8,9)))
#'
#' # Fuzzy search
#'
#' data <- list(
#' p1 = list(name='Ken',age=24),
#' p2 = list(name='Kent',age=26),
#' p3 = list(name='Sam',age=24),
#' p4 = list(name='Keynes',age=30),
#' p5 = list(name='Kwen',age=31)
#' )
#'
#' list.search(data, grepl('^K\\w+n$', .), 'character')
#'
#' \dontrun{
#' library(stringdist)
#' list.search(data, stringdist(., 'Ken') <= 1, 'character')
#' list.search(data, stringdist(., 'Man') <= 2, 'character')
#' list.search(data, stringdist(., 'Man') > 2, 'character')
#' }
#'
#' data <- list(
#' p1 = list(name=c('Ken', 'Ren'),age=24),
#' p2 = list(name=c('Kent', 'Potter'),age=26),
#' p3 = list(name=c('Sam', 'Lee'),age=24),
#' p4 = list(name=c('Keynes', 'Bond'),age=30),
#' p5 = list(name=c('Kwen', 'Hu'),age=31))
#'
#' list.search(data, .[grepl('e', .)], 'character')
#'
#' \dontrun{
#' list.search(data, all(stringdist(., 'Ken') <= 1), 'character')
#' list.search(data, any(stringdist(., 'Ken') > 1), 'character')
#' }
list.search <- function(.data, expr, classes = "ANY", n, unlist = FALSE) {
vec <- rapply(.data, function(x) TRUE, classes = classes)
if (missing(n)) n <- sum(vec)
l <- lambda(substitute(expr))
args <- args_env(i = 0L, n = 0L, N = n, indices = integer(n), result = vector("list", n))
fun <- list.search.fun
environment(fun) <- parent.frame()
formals(fun) <- setnames(formals(fun), c(".data", ".expr", ".args", ".n", l$symbols))
tryWithCondition(rapply(.data, fun, classes = classes, .expr = l$expr, .args = args), rlist.finished = NULL)
result <- list.clean(args$result, recursive = FALSE)
names(result) <- names(vec)[args$indices]
if (unlist)
result <- c(result, recursive = TRUE)
result
}
rlist/R/list.extract.R 0000644 0001751 0000144 00000000252 12700425755 014403 0 ustar hornik users #' Extract an element from a list or vector
#' @export
#' @examples
#' x <- list(a=1, b=2, c=3)
#' list.extract(x, 1)
#' list.extract(x, 'a')
list.extract <- `[[`
rlist/R/rlist.R 0000644 0001751 0000144 00000001262 12700425755 013116 0 ustar hornik users #' The rlist package
#' @name rlist-package
#' @docType package
#' @details
#' rlist is a set of tools for working with list objects. Its goal
#' is to make it easier to work with lists by providing a wide range
#' of functions that operate on non-tabular data stored in them.
#'
#' The package provides a set of functions for data manipulation with
#' list objects, including mapping, filtering, grouping, sorting,
#' updating, searching, and other useful functions. Most functions
#' are designed to be pipeline friendly so that data processing with
#' lists can be chained.
#'
#' rlist Tutorial (\url{http://renkun.me/rlist-tutorial}) is a complete guide to rlist.
NULL
rlist/README.md 0000644 0001751 0000144 00000013743 12700425755 012723 0 ustar hornik users
# rlist
[](https://travis-ci.org/renkun-ken/rlist)
[](https://ci.appveyor.com/project/renkun-ken/rlist)
[](http://codecov.io/github/renkun-ken/rlist?branch=master)
[](https://cran.r-project.org/package=rlist)
rlist is a set of tools for working with list objects. Its goal is to make it easier to work with lists by providing a wide range of functions that operate on non-tabular data stored in them.
This package supports list mapping, filtering, grouping, sorting, updating, searching, file input/output, and many other functions. Most functions in the package are designed to be pipeline friendly so that data processing with lists can be chained.
**[rlist Tutorial](http://renkun.me/rlist-tutorial) is a highly recommended complete guide to rlist.**
This document is also translated into [日本語](https://github.com/renkun-ken/rlist/blob/master/README.ja.md) (by [@teramonagi](https://github.com/teramonagi)).
## Installation
Install the latest version from GitHub:
```r
devtools::install_github("renkun-ken/rlist")
```
Install from [CRAN](https://cran.r-project.org/package=rlist):
```r
install.packages("rlist")
```
## Motivation
In R, there are numerous powerful tools to deal with structured data stored in tabular form such as data frame. However, a variety of data is non-tabular: different records may have different fields; for each field they may have different number of values.
It is hard or no longer straightforward to store such data in data frame, but the `list` object in R is flexible enough to represent such records of diversity. rlist is a toolbox to deal with non-structured data stored in `list` objects, providing a collection of high-level functions which are pipeline friendly.
## Getting started
Suppose we have a list of developers, each of whom has a name, age, a few interests, a list of programming languages they use and the number of years they have been using them.
```r
library(rlist)
devs <-
list(
p1=list(name="Ken",age=24,
interest=c("reading","music","movies"),
lang=list(r=2,csharp=4)),
p2=list(name="James",age=25,
interest=c("sports","music"),
lang=list(r=3,java=2,cpp=5)),
p3=list(name="Penny",age=24,
interest=c("movies","reading"),
lang=list(r=1,cpp=4,python=2)))
```
This type of data is non-relational since it does not well fit the shape of a data frame, yet it can be easily stored in JSON or YAML format. In R, list objects are flexible enough to represent a wide range of non-relational datasets like this. This package provides a wide range of functions to query and manipulate this type of data.
The following examples use `str()` to show the structure of the output.
### Filtering
Filter those who like music and has been using R for more than 3 years.
```r
str( list.filter(devs, "music" %in% interest & lang$r >= 3) )
```
```
List of 1
$ p2:List of 4
..$ name : chr "James"
..$ age : num 25
..$ interest: chr [1:2] "sports" "music"
..$ lang :List of 3
.. ..$ r : num 3
.. ..$ java: num 2
.. ..$ cpp : num 5
```
### Selecting
Select their names and ages.
```r
str( list.select(devs, name, age) )
```
```
List of 3
$ p1:List of 2
..$ name: chr "Ken"
..$ age : num 24
$ p2:List of 2
..$ name: chr "James"
..$ age : num 25
$ p3:List of 2
..$ name: chr "Penny"
..$ age : num 24
```
### Mapping
Map each of them to the number of interests.
```r
str( list.map(devs, length(interest)) )
```
```
List of 3
$ p1: int 3
$ p2: int 2
$ p3: int 2
```
### More functions
In addition to these basic functions, rlist also supports various types of grouping, joining, searching, sorting, updating, etc. For the introduction to more functionality, please go through the [rlist Tutorial](http://renkun.me/rlist-tutorial).
## Lambda expression
In this package, almost all functions that work with expressions accept the following forms of lambda expressions:
- Implicit lambda expression: `expression`
- Univariate lambda expressions:
* `x ~ expression`
* `f(x) ~ expression`
- Multivariate lambda expressions:
* `f(x,i) ~ expression`
* `f(x,i,name) ~ expression`
where `x` refers to the list member itself, `i` denotes the index, `name` denotes the name. If the symbols are not explicitly declared, `.`, `.i` and `.name` will by default be used to represent them, respectively.
```r
nums <- list(a=c(1,2,3),b=c(2,3,4),c=c(3,4,5))
list.map(nums, c(min=min(.),max=max(.)))
list.filter(nums, x ~ mean(x)>=3)
list.map(nums, f(x,i) ~ sum(x,i))
```
## Using pipeline
### Working with pipeR
Query the name of each developer who likes music and uses R, and put the results in a data frame.
```r
library(pipeR)
devs %>>%
list.filter("music" %in% interest & "r" %in% names(lang)) %>>%
list.select(name,age) %>>%
list.stack
```
```
name age
1 Ken 24
2 James 25
```
The example above uses `pipeR`(http://renkun.me/pipeR/) package for pipeline operator `%>>%` that chains commands in a fluent style.
### List environment
`List()` function wraps a list within an environment where almost all list functions are defined. Here is the List-environment version of the previous example.
```r
ldevs <- List(devs)
ldevs$filter("music" %in% interest & "r" %in% names(lang))$
select(name,age)$
stack()$
data
```
```
name age
1 Ken 24
2 James 25
```
## Help overview
```r
help(package = rlist)
```
or view the documentation on [CRAN](http://cran.r-project.org/web/packages/rlist/rlist.pdf)
## License
This package is under [MIT License](http://opensource.org/licenses/MIT).
rlist/MD5 0000644 0001751 0000144 00000015163 12700434260 011741 0 ustar hornik users 41b217ef1764c0895cff1f944199691e *DESCRIPTION
a4c33df13d06112959c410208abc57a2 *LICENSE
b53c4a4f2ed2efa3dc5e280bb0a92fce *NAMESPACE
a7dfd526bddf8bf1e9e37567accd449c *NEWS
6a8ddd1536ec1b109c2a20e7566d1de3 *R/List.R
19e66c5edb711338ae836abbf32eaaf2 *R/data.R
82d8c71be71fab7133b934a8be60be25 *R/functions.R
2371c6de75ae2d09058d4f2a022ea338 *R/internal.R
82a6df4939fe35769a555cc869ee7bcd *R/lambda.R
17162c16cdf54eba06053f0eadafc542 *R/list.all.R
eb54704e688d2dea835b125bd388cfd9 *R/list.clean.R
d34f47c5566bc9439dca3d0bb201b9f1 *R/list.common.R
9b7694f1a725cd2e96712fda555b3bea *R/list.count.R
d677deb59184bffd0fa9273072ec1107 *R/list.do.R
f1b1abc581de401f45723938d46cd1ca *R/list.expand.R
ae60d49b4d579db925abb8a33d330da9 *R/list.extract.R
a09da39bb73fae146f5c36f21ffe7707 *R/list.filter.R
570086fd4f91b96a5909c44aa67d83ec *R/list.find.R
2490f2ef026bb4b92bf83001e69f42f5 *R/list.first.R
a91bcee391eebe2510c23219002bc048 *R/list.flatten.R
cffff947d2d9382b886fc3b457846d21 *R/list.group.R
71fd79de89c2be2e174b7baf75474a2f *R/list.insert.R
efd3e1b2bffe4ce18ccdca570b9883d7 *R/list.is.R
d16ac62754889889d06c3f41cf0e09eb *R/list.join.R
2351725c1ca87e3598021a4082bc6059 *R/list.load.R
4fe3e986da2f6558b68d1d57ae2981e0 *R/list.map.R
dc484338a1e8f0df6a990c60d45aa33f *R/list.match.R
f4f314e91beb34fbc6222eb0fbd7722d *R/list.merge.R
e150b84813b11743151589867d1edd49 *R/list.names.R
320a8718956e595852d338dcbb3e55c1 *R/list.order.R
2edde82ad0c793a8ae427db17857fc8a *R/list.parse.R
f4aa73fad2e52794be0a74f0990740de *R/list.remove.R
25a7eaf7f8838a43f8e1ab815720f059 *R/list.reverse.R
03f13474f1e922a6e3954d0864f3ab97 *R/list.sample.R
7f95e19f5c2ed462aad21a365d1a55f3 *R/list.save.R
d33944830f1c6262b1229412c3b6e17d *R/list.search.R
69a1adf8dcd5c40a76e4c3173231e420 *R/list.select.R
4c66030a44383b87e0805fc1e8c55d84 *R/list.serialize.R
79c40a87f55e932a64b0db6f0b41af9c *R/list.skip.R
34aa77a044e4d07b8e692a8a6b108edc *R/list.stack.R
63ab27b1f879ca0858bfd6b114ed2df7 *R/list.subset.R
0f7e3076beceb4f23e84a01fa5ce9aae *R/list.table.R
5eaf45f67b913a79c3bf2a76a5e6d1bb *R/list.take.R
573f8f839ab8964f870a8f4f21d38565 *R/list.update.R
a92c928cd557ab8ea7d7d7e16708c04b *R/list.which.R
73304904351e8aca63e53fcc804de78f *R/list.zip.R
f53f8f70404ddfb2b83bb850c96f92e8 *R/rlist.R
ce56f2a354e4c168e66d840d88d1a8a4 *R/subset.list.R
5ab1934cf580dcac4013d2805d740eb1 *R/utils.R
c7c00a20e25fce3f33411897b026548c *README.md
ee6b654954dc06fd53ba6a6fec4dce85 *data/nyweather.rda
cdc9465e211f80118ba2493ced046d7a *man/List.Rd
64ced205c7b5e16ff360b01767404150 *man/list.all.Rd
ceda245e5dccacc7e3b19c5a01763447 *man/list.any.Rd
9d30f4bb86b4c30064681f4d0d9cfae5 *man/list.append.Rd
b8e44d07af0cb753f48e041e131362ab *man/list.apply.Rd
f7455026d3c2d7fe4ef16579160ec99b *man/list.cases.Rd
9b0a17e86b9b1ac098bb6924f843f49a *man/list.cbind.Rd
fe8219dba8744b2923e0ffd4eb192d59 *man/list.class.Rd
f58c2bac354b52a681626e0144592f55 *man/list.clean.Rd
c6263c40deb247dc2c99384518867d23 *man/list.common.Rd
29d0b960ed194837b2bb4b84aaf41087 *man/list.count.Rd
6d7430bec6e53dfdf37fcae5c6e0fe1d *man/list.do.Rd
795f6d73f437d61e938688c83fc0166c *man/list.exclude.Rd
9fe3091e9c1a201402cb8be8e0cc270f *man/list.expand.Rd
9ee96421a11441d7a9c18295c17bf0a0 *man/list.extract.Rd
f22d1c7fd00ce9e39f47ab3262d9eb8d *man/list.filter.Rd
fdf17a0ecec9d03df2653a993f9f03ad *man/list.find.Rd
533b27a3d6afa89955c54a5c2832980e *man/list.findi.Rd
533795643d92201f4228752ea3466d98 *man/list.first.Rd
f6079f82803c199d17c22f8071356951 *man/list.flatten.Rd
04d45751e40d1b7dd85993f48a18d497 *man/list.group.Rd
9f501d938be5823be754fa1e97a53462 *man/list.insert.Rd
53bde0a8ecb0eb70628f514f7bb06401 *man/list.is.Rd
eaa37b8c0b758b9919a09b7894202572 *man/list.iter.Rd
f27d81ccbab60d8f0b1f1be8d67a7142 *man/list.join.Rd
ad287501a9c6d081f9c367da0392813a *man/list.last.Rd
5e024592906c90c8f84745cb4fdeda3b *man/list.load.Rd
9ca3b07159fbfbbb1cdbfdb67a47458d *man/list.map.Rd
c6ff1dd8d2932ccee9d100e4797d26f8 *man/list.maps.Rd
81c179e2d753012673830d4b0aa5fa44 *man/list.mapv.Rd
10d79ecad17716ab2ba15abbdcb87677 *man/list.match.Rd
328bf2a8ed384ba0fdc2c01572d3668a *man/list.merge.Rd
bd19003b8966e784d54e943aafecab89 *man/list.names.Rd
2de7125d41482a3eacd2ea0a16ca4624 *man/list.order.Rd
95febb75b9f91233900c6cbc762012bc *man/list.parse.Rd
8324132508e6a66f790ae4798dfa41ba *man/list.prepend.Rd
939f9459a5a57795a429922313168a3c *man/list.rbind.Rd
ed2e6184e3966428b456461d1042805c *man/list.remove.Rd
27d795f523ec3155f88a1ea4dc2d99d2 *man/list.reverse.Rd
3569a184f17d2927862166450298a588 *man/list.sample.Rd
e41f3ac1a4cda47a5efcbee80a63afff *man/list.save.Rd
6b2ff9e5ce62d59b5d5fb5217a3de789 *man/list.search.Rd
314091a94c893325c85841a7ef4988eb *man/list.select.Rd
2a9afb389173c0600dfd2c72a221e125 *man/list.serialize.Rd
885128c28e951059cfa6cb8a29fb9719 *man/list.skip.Rd
2d992bb0699e93fc9f93914ae6cc1804 *man/list.skipWhile.Rd
827bbd1d5cb16e978f2d14ee6ed464d7 *man/list.sort.Rd
f17377a65f3c4ad6662ea9e781cba09d *man/list.stack.Rd
64ed2a7c39c110c68a83ec1d6e52bf1f *man/list.subset.Rd
2920af68e72545a027011af1ab8bc816 *man/list.table.Rd
033388cb8d1f5573767bd4233d27be08 *man/list.take.Rd
6c77163304c1080c0fc7a4800a8aa110 *man/list.takeWhile.Rd
18cfda8bcc9f269f5c48399b91d55632 *man/list.ungroup.Rd
0c9958add7cf429cb945990c31d25cb6 *man/list.unserialize.Rd
4d95b433e000ca50b5c56a1f4a785cc8 *man/list.unzip.Rd
2d75d11401eb623e37f6ac719a7914d6 *man/list.update.Rd
ae4f6841964163ed2cd7b5df63d84ba8 *man/list.which.Rd
44ac2b52651d1936aaa3bf513a484728 *man/list.zip.Rd
71b162b6da088bdcba6d80f432072773 *man/nyweather.Rd
8aae061e460a3ac7d2ed3e1ac99b1ea6 *man/rlist-package.Rd
abd0aec3648ea3d8d5fd5c72b90a99cb *man/subset.list.Rd
1e8b1c56b76e8c52c7db4752894e2154 *man/tryEval.Rd
9dd5ae8d8d125c1cd708a2264a454a02 *man/tryGet.Rd
29fbd7bf65b6c7230d27e8ab87fe57f2 *tests/testthat.R
fab9264304142f0e880270471055c50b *tests/testthat/test-List.R
9404fc82f65429df00dcb3a3a487cbec *tests/testthat/test-basic.R
3312b1af9f652c532cc40a4f9f1059d5 *tests/testthat/test-class.R
8259b58b4326274e2a0decfd4ef3bfb0 *tests/testthat/test-filter.R
6239e8f07a4b00bdb818b3c702d894ed *tests/testthat/test-find.R
a23b934b5f6c853bb09fe00393657e0d *tests/testthat/test-group.R
916587318fb3be81f443a878e0d5a731 *tests/testthat/test-internal.R
3e093c7f22c55e29ed7443e2ab81327c *tests/testthat/test-io.R
3a2cac4dec7fc1647c807f073d349064 *tests/testthat/test-join.R
4c78653738eab183be26ea3096edf696 *tests/testthat/test-map.R
4a2ce5fa56f998bc19b88c1ef260862c *tests/testthat/test-search.R
1ee0f8154ff60b0ebf2bbcc878270025 *tests/testthat/test-select.R
7178434621568a7c772e4c1ce0dad355 *tests/testthat/test-sort.R
2fcfcb0733308ce69350d1e9183c225f *tests/testthat/test-subset.R
8ed12f2367174cbb7cb7f4b802eb7268 *tests/testthat/test-update.R
7eb5f00fee51870bea2daa071bf7ab5f *tests/testthat/test-utils.R
rlist/DESCRIPTION 0000644 0001751 0000144 00000001653 12700434260 013136 0 ustar hornik users Package: rlist
Type: Package
Title: A Toolbox for Non-Tabular Data Manipulation
Version: 0.4.6.1
Author: Kun Ren
Maintainer: Kun Ren
Description: Provides a set of functions for data manipulation with
list objects, including mapping, filtering, grouping, sorting,
updating, searching, and other useful functions. Most functions
are designed to be pipeline friendly so that data processing with
lists can be chained.
Depends: R (>= 2.15)
Date: 2016-04-04
Suggests: testthat, stringdist, pipeR
Imports: yaml, jsonlite, XML, data.table
License: MIT + file LICENSE
URL: https://renkun.me/rlist, https://github.com/renkun-ken/rlist,
https://renkun.me/rlist-tutorial
BugReports: https://github.com/renkun-ken/rlist/issues
ByteCompile: TRUE
LazyData: true
RoxygenNote: 5.0.1
NeedsCompilation: no
Packaged: 2016-04-04 08:55:10 UTC; Kun
Repository: CRAN
Date/Publication: 2016-04-04 11:49:36
rlist/man/ 0000755 0001751 0000144 00000000000 12700425755 012207 5 ustar hornik users rlist/man/list.update.Rd 0000644 0001751 0000144 00000002250 12700425755 014731 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.update.R
\name{list.update}
\alias{list.update}
\title{Update a list by appending or modifying its elements.}
\usage{
list.update(.data, ..., keep.null = FALSE)
}
\arguments{
\item{.data}{\code{list}}
\item{...}{A group of labmda expressions}
\item{keep.null}{Should \code{NULL} values be preserved
for \code{modifyList}}
}
\description{
The function updates each element of a list by evaluating
a group of expressions in the scope of the element. If the
name of an expression alreadys exists in an list element,
then the field with the name will be updated. Otherwise,
the value with the name will be appended to the list
element. The functionality is essentially done by
\code{modifyList}.
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.update(x, high=max(score$c1,score$c2), low=min(score$c1,score$c2))
list.update(x, exams=length(score))
list.update(x, grade=ifelse(type=='A', score$c1, score$c2))
list.update(x, score=list(min=0, max=10))
}
rlist/man/list.zip.Rd 0000644 0001751 0000144 00000001246 12700425755 014255 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.zip.R
\name{list.zip}
\alias{list.zip}
\title{Combine multiple lists element-wisely.}
\usage{
list.zip(..., use.argnames = TRUE, use.names = TRUE)
}
\arguments{
\item{...}{\code{list}s}
\item{use.argnames}{\code{logical}. Should the names of the
arguments be used as the names of list items?}
\item{use.names}{\code{logical}. Should the names of the first
argument be used as the zipped list?}
}
\description{
Combine multiple lists element-wisely.
}
\examples{
x <- list(1,2,3)
y <- list('x','y','z')
list.zip(num=x,sym=y)
}
\seealso{
\code{\link{list.unzip}}
}
rlist/man/list.unserialize.Rd 0000644 0001751 0000144 00000001271 12700425755 016003 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.serialize.R
\name{list.unserialize}
\alias{list.unserialize}
\title{Unserialize a file}
\usage{
list.unserialize(file, type = tolower(tools::file_ext(file)), ...)
}
\arguments{
\item{file}{The file as input}
\item{type}{The type of serialization, including native unserializer and
json unserializer, which is by default determined by file extension}
\item{...}{Additional parameters passed to the unserializer function}
}
\description{
Unserialize a file
}
\examples{
\dontrun{
list.unserialize('test.dat')
list.unserialize('test.json')
}
}
\seealso{
\code{\link{list.serialize}}
}
rlist/man/List.Rd 0000644 0001751 0000144 00000002344 12700425754 013413 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/List.R
\name{List}
\alias{List}
\title{Create a \code{List environment} that wraps given \code{data} and
most list functions are defined for chainable operations.}
\usage{
List(data = list())
}
\arguments{
\item{data}{A \code{list} or \code{vector}}
}
\description{
Create a \code{List environment} that wraps given \code{data} and
most list functions are defined for chainable operations.
}
\details{
Most list functions are defined in \code{List environment}.
In addition to these functions, \code{call(fun,...)} calls
external function \code{fun} with additional parameters specifies in
\code{...}.
To extract the data from List \code{x}, call \code{x$data} or simply
\code{x[]}.
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
m <- List(x)
m$filter(type=='B')$
map(score$c1) []
m$group(type)$
map(g ~ List(g)$
map(score)$
call(unlist)$
call(mean) []) []
# Subsetting, extracting, and assigning
p <- List(list(a=1,b=2))
p['a']
p[['a']]
p$a <- 2
p['b'] <- NULL
p[['a']] <- 3
}
rlist/man/list.any.Rd 0000644 0001751 0000144 00000001756 12700425754 014247 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.all.R
\name{list.any}
\alias{list.any}
\title{Examine if a condition is true for at least one list element}
\usage{
list.any(.data, cond, na.rm = FALSE)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{cond}{A logical lambda expression}
\item{na.rm}{logical. If true \code{NA} values are ignored in
the evaluation.}
}
\value{
\code{TRUE} if \code{cond} is evaluated to be \code{TRUE}
for any element in \code{.data}.
}
\description{
Examine if a condition is true for at least one list element
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.any(x,type=='B')
list.any(x,mean(unlist(score))>=6)
list.any(x, score$c2 > 8 || score$c3 > 5, na.rm = TRUE)
list.any(x, score$c2 > 8 || score$c3 > 5, na.rm = FALSE)
}
\seealso{
\code{\link{list.all}}
}
rlist/man/list.clean.Rd 0000644 0001751 0000144 00000003215 12700425754 014532 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.clean.R
\name{list.clean}
\alias{list.clean}
\title{Clean a list by a function}
\usage{
list.clean(.data, fun = is.null, recursive = FALSE)
}
\arguments{
\item{.data}{A \code{list} or \code{vector} to operate over.}
\item{fun}{A \code{character} or a \code{function} that returns
\code{TRUE} or \code{FALSE} to indicate if an element of
\code{.data} should be removed.}
\item{recursive}{\code{logical}. Should the list be
cleaned recursively? Set to FALSE by default.}
}
\description{
This function removes all elements evaluated to be
\code{TRUE} by an indicator function. The removal can be recursive
so that the resulted list surely does not include such elements in
any level.
}
\details{
Raw data is usually not completely ready for analysis, and needs to
be cleaned up to certain standards. For example, some data operations
require that the input does not include \code{NULL} values in any
level, therefore \code{fun = "is.null"} and \code{recursive = TRUE}
can be useful to clean out all \code{NULL} values in a list at any
level.
Sometimes, not only \code{NULL} values are undesired,
empty vectors or lists are also unwanted. In this case,
\code{fun = function(x) length(x) == 0L} can be useful to remove
all empty elements of zero length. This works because
\code{length(NULL) == 0L}, \code{length(list()) == 0L} and
\code{length(numeric()) == 0L} are all \code{TRUE}.
}
\examples{
x <- list(a=NULL,b=list(x=NULL,y=character()),d=1,e=2)
list.clean(x)
list.clean(x, recursive = TRUE)
list.clean(x, function(x) length(x) == 0L, TRUE)
}
rlist/man/list.apply.Rd 0000644 0001751 0000144 00000000716 12700425754 014600 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.do.R
\name{list.apply}
\alias{list.apply}
\title{Apply a function to each list element (\code{lapply})}
\usage{
list.apply(.data, .fun, ...)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{.fun}{\code{function}}
\item{...}{Additional parameters passed to \code{FUN}.}
}
\description{
Apply a function to each list element (\code{lapply})
}
rlist/man/list.rbind.Rd 0000644 0001751 0000144 00000001406 12700425754 014546 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.do.R
\name{list.rbind}
\alias{list.rbind}
\title{Bind all list elements by row}
\usage{
list.rbind(.data)
}
\arguments{
\item{.data}{\code{list}}
}
\description{
The function binds all list elements by row. Each element of the list is expected
to be an atomic vector, \code{data.frame}, or \code{data.table}. If list elements
are also lists, the result can be a list-valued matrix. In this case,
\code{list.stack} may produce a better result.
}
\examples{
x <- lapply(1:3,function(i) { c(a=i,b=i^2)})
df <- lapply(1:3,function(i) { data.frame(a=i,b=i^2,c=letters[i])})
list.rbind(x)
list.rbind(df)
}
\seealso{
\code{\link{list.cbind}}, \code{\link{list.stack}}
}
rlist/man/list.remove.Rd 0000644 0001751 0000144 00000001261 12700425754 014744 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.remove.R
\name{list.remove}
\alias{list.remove}
\title{Remove members from a list by index or name}
\usage{
list.remove(.data, range = integer())
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{range}{A numeric vector of indices or
a character vector of names to remove from \code{.data}}
}
\description{
Remove members from a list by index or name
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.remove(x, 'p1')
list.remove(x, c(1,2))
}
rlist/man/list.last.Rd 0000644 0001751 0000144 00000001315 12700425754 014412 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.first.R
\name{list.last}
\alias{list.last}
\title{Find the last element that meets a condition}
\usage{
list.last(.data, cond)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{cond}{a logical lambda expression}
}
\description{
Find the last element that meets a condition
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.last(x, score$c1 < 10)
list.last(x, score$c1 < 9 || score$c3 >= 5) # NULL for all results are NA or FALSE
}
\seealso{
\code{\link{list.first}}
}
rlist/man/list.serialize.Rd 0000644 0001751 0000144 00000001330 12700425754 015433 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.serialize.R
\name{list.serialize}
\alias{list.serialize}
\title{Serialize a list}
\usage{
list.serialize(x, file, type = tools::file_ext(file), ...)
}
\arguments{
\item{x}{\code{list}}
\item{file}{The file for output}
\item{type}{The type of serialization, including native serializer and
json serializer, which is by default determined by file extension}
\item{...}{Additional parameters passed to the serializer function}
}
\description{
Serialize a list
}
\examples{
\dontrun{
x <- list(a=1,b=2,c=3)
list.serialize(x,'test.dat')
list.serialize(x,'test.json')
}
}
\seealso{
\code{\link{list.unserialize}}
}
rlist/man/list.unzip.Rd 0000644 0001751 0000144 00000004536 12700425755 014625 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.zip.R
\name{list.unzip}
\alias{list.unzip}
\title{Transform a list of elements with similar structure into a list of decoupled fields}
\usage{
list.unzip(.data, .fields = c("intersect", "union"), ...,
.aggregate = "simplify2array", .missing = NA)
}
\arguments{
\item{.data}{A \code{list} of elements containing common fields}
\item{.fields}{\code{'intersect'} to select only common fields for
all \code{.data}'s elements. \code{'union'} to select any field that
is defined in any elements in \code{.data}.}
\item{...}{The custom aggregate functions. Can be a named list of functions or
character vectors. If a function is specified as a list of functions, then the
functions will be evaluated recursively on the result of the field. Use \code{identity} to
avoid aggregating results. Use \code{NULL} to remove certain field.}
\item{.aggregate}{The default aggregate function, by default, \code{simplify2array}.
Can be a function, character vector or a list of functions. Use \code{identity} to avoid
aggregating results.}
\item{.missing}{When \code{.fields} is \code{'union'} and some elements do not contain
certain fields, then \code{NULL} will be replaced by the value of \code{.missing},
by default, \code{NA}. This often makes the result more friendly.}
}
\description{
Transform a list of elements with similar structure into a list of decoupled fields
}
\examples{
list.unzip(list(p1 = list(a = 1, b = 2), p2 = list(a = 2, b = 3)))
list.unzip(list(p1 = list(a = 1, b = 2), p2 = list(a = 2, b = 3, c = 4)))
list.unzip(list(p1 = list(a = 1, b = 2), p2 = list(a = 2, b = 3, c = 4)), 'union')
list.unzip(list(p1 = list(a = 1, b = 2), p2 = list(a = 2, b = 3, c = 4)), 'union', a = 'identity')
list.unzip(list(p1 = list(a = 1, b = 2), p2 = list(a = 2, b = 3, c = 4)), 'intersect', a = NULL)
x <-
list(april = list(n_days = 30,
holidays = list(list('2015-04-01', 'april fools'),
list('2015-04-05', 'easter')),
month_info = c(number = '4', season = 'spring')),
july = list(n_days = 31,
holidays = list(list('2014-07-04', 'july 4th')),
month_info = c(number = '7', season = 'summer')))
list.unzip(x, holidays = c('list.ungroup', 'unname', 'list.stack',
function(df) setNames(df, c("date", "name"))))
}
\seealso{
\code{\link{list.zip}}
}
rlist/man/list.insert.Rd 0000644 0001751 0000144 00000001401 12700425754 014747 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.insert.R
\name{list.insert}
\alias{list.insert}
\title{Insert a series of lists at the given index}
\usage{
list.insert(.data, index, ...)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{index}{The index at which the lists are inserted}
\item{...}{A group of lists}
}
\description{
Insert a series of lists at the given index
}
\examples{
\dontrun{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.insert(x, 2, p2.1 = list(type='B',score=list(c1=8,c2=9)))
}
}
\seealso{
\code{\link{list.append}}, \code{\link{list.prepend}}
}
rlist/man/list.stack.Rd 0000644 0001751 0000144 00000001630 12700425754 014554 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.stack.R
\name{list.stack}
\alias{list.stack}
\title{Stack all list elements to tabular data}
\usage{
list.stack(.data, ..., data.table = FALSE)
}
\arguments{
\item{.data}{\code{list} of \code{vector}s, \code{list}s,
\code{data.frame}s or \code{data.table}s.}
\item{...}{additional parameters passed to \code{data.table::rbindlist}.}
\item{data.table}{\code{TRUE} to keep the result as \code{data.table}}
}
\description{
Stack all list elements to tabular data
}
\examples{
\dontrun{
x <- lapply(1:3, function(i) { list(a=i,b=i^2) })
list.stack(x)
x <- lapply(1:3, function(i) { list(a=i,b=i^2,c=letters[i])})
list.stack(x)
x <- lapply(1:3, function(i) { data.frame(a=i,b=i^2,c=letters[i]) })
list.stack(x)
x <- lapply(1:3, function(i) { data.frame(a=c(i,i+1), b=c(i^2,i^2+1))})
list.stack(x)
}
}
rlist/man/list.prepend.Rd 0000644 0001751 0000144 00000001062 12700425754 015103 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.insert.R
\name{list.prepend}
\alias{list.prepend}
\title{Prepend elements to a list}
\usage{
list.prepend(.data, ...)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{...}{The \code{vector} or \code{list} to prepend before \code{x}}
}
\description{
Prepend elements to a list
}
\examples{
x <- list(a=1,b=2,c=3)
list.prepend(x, d=4, e=5)
list.prepend(x, d=4, f=c(2,3))
}
\seealso{
\code{\link{list.append}}, \code{\link{list.insert}}
}
rlist/man/list.reverse.Rd 0000644 0001751 0000144 00000000535 12700425754 015125 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.reverse.R
\name{list.reverse}
\alias{list.reverse}
\title{Reverse a list}
\usage{
list.reverse(.data)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
}
\description{
Reverse a list
}
\examples{
x <- list(a=1,b=2,c=3)
list.reverse(x)
}
rlist/man/list.class.Rd 0000644 0001751 0000144 00000002337 12700425754 014561 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.group.R
\name{list.class}
\alias{list.class}
\title{Classify list elments into unique but non-exclusive cases}
\usage{
list.class(.data, ..., sorted = TRUE)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{...}{keys}
\item{sorted}{\code{TRUE} to sort the group keys. Ignored when the key has
multiple entries.}
}
\value{
a list of possible cases each of which contains elements belonging to
the case non-exclusively.
}
\description{
In non-tabular data, a certain field may take multiple values in a
collection non-exclusively. To classify these elements into different
cases, this function detects all possible cases and for each case all
elements are examined whether to belong to that case.
}
\examples{
x <-
list(
p1=list(name='Ken',age=24,
interest=c('reading','music','movies'),
lang=list(r=2,csharp=4,python=3)),
p2=list(name='James',age=25,
interest=c('sports','music'),
lang=list(r=3,java=2,cpp=5)),
p3=list(name='Penny',age=24,
interest=c('movies','reading'),
lang=list(r=1,cpp=4,python=2)))
list.class(x,interest)
list.class(x,names(lang))
}
rlist/man/list.search.Rd 0000644 0001751 0000144 00000005640 12700425754 014721 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.search.R
\name{list.search}
\alias{list.search}
\title{Search a list recusively by an expression}
\usage{
list.search(.data, expr, classes = "ANY", n, unlist = FALSE)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{expr}{a lambda expression}
\item{classes}{a character vector of class names that restrict the search.
By default, the range is unrestricted (\code{ANY}).}
\item{n}{the maximal number of vectors to return}
\item{unlist}{\code{logical} Should the result be unlisted?}
}
\description{
Search a list recusively by an expression
}
\details{
\code{list.search} evaluates an expression (\code{expr}) recursively
along a list (\code{.data}).
If the expression results in a single-valued logical vector and its
value is \code{TRUE}, the whole vector will be collected If it results
in multi-valued or non-logical vector, the non-\code{NA} values
resulted from the expression will be collected.
To search whole vectors that meet certain condition, specify the
expression that returns a single logical value.
To search the specific values within the vectors, use subsetting in the
expression, that is, \code{.[cond]} or lambda expression like
\code{x -> x[cond]} where \code{cond} is a logical vector used to
select the elements in the vector.
}
\examples{
# Exact search
x <- list(p1 = list(type='A',score=c(c1=9)),
p2 = list(type=c('A','B'),score=c(c1=8,c2=9)),
p3 = list(type=c('B','C'),score=c(c1=9,c2=7)),
p4 = list(type=c('B','C'),score=c(c1=8,c2=NA)))
## Search exact values
list.search(x, identical(., 'A'))
list.search(x, identical(., c('A','B')))
list.search(x, identical(., c(9,7)))
list.search(x, identical(., c(c1=9,c2=7)))
## Search all equal values
list.search(x, all(. == 9))
list.search(x, all(. == c(8,9)))
list.search(x, all(. == c(8,9), na.rm = TRUE))
## Search any equal values
list.search(x, any(. == 9))
list.search(x, any(. == c(8,9)))
# Fuzzy search
data <- list(
p1 = list(name='Ken',age=24),
p2 = list(name='Kent',age=26),
p3 = list(name='Sam',age=24),
p4 = list(name='Keynes',age=30),
p5 = list(name='Kwen',age=31)
)
list.search(data, grepl('^K\\\\w+n$', .), 'character')
\dontrun{
library(stringdist)
list.search(data, stringdist(., 'Ken') <= 1, 'character')
list.search(data, stringdist(., 'Man') <= 2, 'character')
list.search(data, stringdist(., 'Man') > 2, 'character')
}
data <- list(
p1 = list(name=c('Ken', 'Ren'),age=24),
p2 = list(name=c('Kent', 'Potter'),age=26),
p3 = list(name=c('Sam', 'Lee'),age=24),
p4 = list(name=c('Keynes', 'Bond'),age=30),
p5 = list(name=c('Kwen', 'Hu'),age=31))
list.search(data, .[grepl('e', .)], 'character')
\dontrun{
list.search(data, all(stringdist(., 'Ken') <= 1), 'character')
list.search(data, any(stringdist(., 'Ken') > 1), 'character')
}
}
rlist/man/list.select.Rd 0000644 0001751 0000144 00000001340 12700425754 014724 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.select.R
\name{list.select}
\alias{list.select}
\title{Select by name or expression for each member of a list}
\usage{
list.select(.data, ...)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{...}{A group of implicit labmda expressions}
}
\description{
Select by name or expression for each member of a list
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.select(x, type)
list.select(x, tp = type)
list.select(x, type, score)
list.select(x, type, score.range = range(unlist(score)))
}
rlist/man/list.count.Rd 0000644 0001751 0000144 00000001626 12700425754 014604 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.count.R
\name{list.count}
\alias{list.count}
\title{Count the number of elements that satisfy given condition}
\usage{
list.count(.data, cond)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{cond}{A logical lambda expression for each element of \code{.data} to evaluate. If
\code{cond} is missing then the total number of elements in \code{.data} will be returned.}
}
\value{
An integer that indicates the number of elements with which \code{cond} is evaluated
to be \code{TRUE}.
}
\description{
Count the number of elements that satisfy given condition
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.count(x, type=='B')
list.count(x, min(unlist(score)) >= 9)
}
rlist/man/list.do.Rd 0000644 0001751 0000144 00000001222 12700425754 014046 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.do.R
\name{list.do}
\alias{list.do}
\title{Call a function with a list of arguments}
\usage{
list.do(.data, fun, ...)
}
\arguments{
\item{.data}{\code{list}. \code{vector} will be coreced to \code{list} before
being passed to \code{fun}.}
\item{fun}{The \code{function} to call}
\item{...}{The additional parameters passed to \code{do.call}}
}
\description{
Call a function with a list of arguments
}
\examples{
x <- lapply(1:3, function(i) { c(a=i,b=i^2)})
df <- lapply(1:3, function(i) { data.frame(a=i,b=i^2,c=letters[i])})
list.do(x, rbind)
}
rlist/man/list.load.Rd 0000644 0001751 0000144 00000003231 12700425754 014365 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.load.R
\name{list.load}
\alias{list.load}
\title{Load a list from file}
\usage{
list.load(file, type = tools::file_ext(file), ..., guess = c("json", "yaml",
"rds", "rdata", "xml"), action = c("none", "merge", "ungroup"),
progress = length(file) >= 5L)
}
\arguments{
\item{file}{a \code{character} vector. The file as input.}
\item{type}{The type of input which, by default, is determined
by file extension. Currently supports RData, RDS, JSON, YAML.}
\item{...}{Additional parameters passed to the loader function}
\item{guess}{a \code{character} vector to guess iteratively if
\code{type} of \code{file} is unrecognized, \code{NA} or empty
string.}
\item{action}{The post-processing action if multiple files are
supplied. This parameter will be ignored if only a single file
is supplied.
\code{'none'} (default) to leave the resulted list as
a list of elements corresponding to elements in \code{file}
vector.
\code{'merge'} to merge the list elements iteratively,
the later lists always modify the former ones through
\code{modifyList}.
\code{'ungroup'} to ungroup the list elements, especially when
each file is a page of elements with identical structure.}
\item{progress}{\code{TRUE} to show a text progress bar in console
while loading files. By default, if \code{file} contains 5 elements,
then the progress bar will automatically be triggered to indicate
loading progress.}
}
\description{
Load a list from file
}
\examples{
\dontrun{
list.load('list.rds')
list.load('list.rdata')
list.load('list.yaml')
list.load('list.json')
}
}
rlist/man/list.mapv.Rd 0000644 0001751 0000144 00000001645 12700425754 014420 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.map.R
\name{list.mapv}
\alias{list.mapv}
\title{Map each member of a list by an expression to a vector.}
\usage{
list.mapv(.data, expr, as, use.names = TRUE)
}
\arguments{
\item{.data}{a \code{list} or \code{vector}}
\item{expr}{a lambda expression}
\item{as}{the mode to corece. Missing to \code{unlist}
the mapped results.}
\item{use.names}{Should the names of the results be preserved?}
}
\value{
A \code{vector} in which each element is mapped by \code{expr} in \code{.data}
}
\description{
Map each member of a list by an expression to a vector.
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.mapv(x, type)
list.mapv(x, min(score$c1,score$c2))
}
\seealso{
\code{\link{list.map}}
}
rlist/man/subset.list.Rd 0000644 0001751 0000144 00000001631 12700425755 014756 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/subset.list.R
\name{subset.list}
\alias{subset.list}
\title{Subset a list by a logical condition}
\usage{
\method{subset}{list}(x, subset, select, ...)
}
\arguments{
\item{x}{The list to subset}
\item{subset}{A logical lambda expression of subsetting condition}
\item{select}{A lambda expression to evaluate for each selected item}
\item{...}{Additional parameters}
}
\description{
Subset a list by a logical condition
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
subset(x, type == 'B')
subset(x, select = score)
subset(x, min(score$c1, score$c2) >= 8, data.frame(score))
subset(x, type == 'B', score$c1)
do.call(rbind,
subset(x, min(score$c1, score$c2) >= 8, data.frame(score)))
}
rlist/man/list.expand.Rd 0000644 0001751 0000144 00000001320 12700425754 014722 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.expand.R
\name{list.expand}
\alias{list.expand}
\title{Create a list from all combinations of factors}
\usage{
list.expand(...)
}
\arguments{
\item{...}{vectors or lists}
}
\value{
A list of all combinations of the supplied vectors or
lists.
}
\description{
Create a list from all combinations of the supplied
vectors or lists, extending the functionality of
\link{expand.grid} from data frame to list.
}
\examples{
list.expand(x=1:10, y=c("a","b","c"))
list.expand(x=list(c(1,2), c(2,3)), y = c("a","b","c"))
list.expand(
a=list(list(x=1,y="a"), list(x=2, y="b")),
b=list(c("x","y"), c("y","z","w")))
}
rlist/man/list.cbind.Rd 0000644 0001751 0000144 00000001315 12700425754 014526 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.do.R
\name{list.cbind}
\alias{list.cbind}
\title{Bind all list elements by column}
\usage{
list.cbind(.data)
}
\arguments{
\item{.data}{\code{list}}
}
\description{
The function binds all list elements by column. Each element of the list is expected
to be an atomic vector, \code{data.frame}, or \code{data.table} of the same length.
If list elements are also lists, the binding will flatten the lists and may produce
undesired results.
}
\examples{
x <- list(data.frame(i=1:5,x=rnorm(5)),
data.frame(y=rnorm(5),z=rnorm(5)))
list.cbind(x)
}
\seealso{
\code{\link{list.cbind}}, \code{\link{list.stack}}
}
rlist/man/list.flatten.Rd 0000644 0001751 0000144 00000002034 12700425754 015103 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.flatten.R
\name{list.flatten}
\alias{list.flatten}
\title{Flatten a nested list to a one-level list}
\usage{
list.flatten(x, use.names = TRUE, classes = "ANY")
}
\arguments{
\item{x}{\code{list}}
\item{use.names}{\code{logical}. Should the names of \code{x} be kept?}
\item{classes}{A character vector of class names, or "ANY" to match any class.}
}
\description{
Flatten a nested list to a one-level list
}
\details{
The function is essentially a slightly modified version of \code{flatten2}
provided by Tommy at \href{http://stackoverflow.com/a/8139959/2906900}{stackoverflow.com} who
has full credit of the implementation of this function.
}
\examples{
p <- list(a=1,b=list(b1=2,b2=3),c=list(c1=list(c11='a',c12='x'),c2=3))
list.flatten(p)
p <- list(a=1,b=list(x="a",y="b",z=10))
list.flatten(p, classes = "numeric")
list.flatten(p, classes = "character")
}
\author{
\href{http://stackoverflow.com/users/662787/tommy}{Tommy}
}
rlist/man/tryGet.Rd 0000644 0001751 0000144 00000001613 12700425755 013755 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R
\name{tryGet}
\alias{tryGet}
\title{Try to get the value of a symbol if exists or return a default value}
\usage{
tryGet(symbol, def = NULL, ..., envir = parent.frame())
}
\arguments{
\item{symbol}{the symbol to examine}
\item{def}{the default value if the symbol does not exist}
\item{...}{additional parameters passed to \code{exists} and \code{get}}
\item{envir}{the environment to examine whether the symbol exists
and get the symbol}
}
\description{
Try to get the value of a symbol if exists or return a default value
}
\details{
By default, the symbol is examined in \code{envir} without inheritance,
that is, if the symbol does not exist in \code{envir} the default value
\code{def} will be returned.
}
\examples{
x <- list(a=c(x=1,y=2),b=c(x=2,p=3))
list.map(x, tryGet(y,0))
}
rlist/man/list.filter.Rd 0000644 0001751 0000144 00000002124 12700425754 014733 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.filter.R
\name{list.filter}
\alias{list.filter}
\title{Filter a list or vector by a series of conditions}
\usage{
list.filter(.data, ...)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{...}{logical conditions}
}
\value{
elements in \code{.data} satisfying all conditions
}
\description{
The function recursively filters the data by a given series of
conditions. The filter can be a single condition or multiple
conditions. \code{.data} will be filtered by the first condition;
then the results will be filtered by the second condition, if any;
then the results will be filtered by the third, if any, etc. The
results only contain elements satisfying all conditions specified
in \code{...}.
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.filter(x, type=='B')
list.filter(x, min(score$c1, score$c2) >= 8)
list.filter(x, type=='B', score$c2 >= 8)
}
rlist/man/list.skipWhile.Rd 0000644 0001751 0000144 00000001603 12700425754 015406 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.skip.R
\name{list.skipWhile}
\alias{list.skipWhile}
\title{Keep skipping elements while a condition holds}
\usage{
list.skipWhile(.data, cond)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{cond}{A logical lambda expression}
}
\description{
Keep skipping elements in a list or vector while a
condition holds for the element. As long as the condition
is violated, the element will be kept and all remaining
elements are returned.
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.skipWhile(x, type=='A')
list.skipWhile(x, min(score$c1,score$c2) >= 8)
}
\seealso{
\code{\link{list.skip}}, \code{\link{list.take}},
\code{\link{list.takeWhile}}
}
rlist/man/list.take.Rd 0000644 0001751 0000144 00000001203 12700425755 014370 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.take.R
\name{list.take}
\alias{list.take}
\title{Take a number of elements}
\usage{
list.take(.data, n, force = FALSE)
}
\arguments{
\item{.data}{\code{list} or \code{vector}}
\item{n}{\code{integer}. The number of elements to take}
\item{force}{\code{TRUE} to disable the length check}
}
\description{
Take the first \code{n} elements out from a list or
vector.
}
\examples{
x <- list(a=1,b=2,c=3)
list.take(x,1)
list.take(x,10)
}
\seealso{
\code{\link{list.takeWhile}}, \code{\link{list.skip}},
\code{\link{list.skipWhile}}
}
rlist/man/list.first.Rd 0000644 0001751 0000144 00000001323 12700425754 014575 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.first.R
\name{list.first}
\alias{list.first}
\title{Find the first element that meets a condition}
\usage{
list.first(.data, cond)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{cond}{a logical lambda expression}
}
\description{
Find the first element that meets a condition
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.first(x, score$c1 < 10)
list.first(x, score$c1 < 9 || score$c3 >= 5) # NULL for all results are NA or FALSE
}
\seealso{
\code{\link{list.last}}
}
rlist/man/list.names.Rd 0000644 0001751 0000144 00000001331 12700425754 014550 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.names.R
\name{list.names}
\alias{list.names}
\title{Get or set the names of a list by expression}
\usage{
list.names(.data, expr)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{expr}{the expression whose value will be set as the name
for each list element. If missing then the names of the list will be
returned. If \code{NULL} then the names of the list will be removed.}
}
\description{
Get or set the names of a list by expression
}
\examples{
list.names(c(1,2,3))
list.names(c(a=1,b=2,c=3))
list.names(c(1,2,3),letters[.])
list.names(list(list(name='A',value=10),list(name='B',value=20)), name)
}
rlist/man/list.maps.Rd 0000644 0001751 0000144 00000001306 12700425754 014407 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.map.R
\name{list.maps}
\alias{list.maps}
\title{Map multiple lists with an expression}
\usage{
list.maps(expr, ...)
}
\arguments{
\item{expr}{An implicit lambda expression where only \code{.i} and
\code{.name} are defined.}
\item{...}{Named arguments of lists with equal length. The names of the
lists are available as symbols that represent the element for each list.}
}
\description{
Map multiple lists with an expression
}
\examples{
\dontrun{
l1 <- list(p1=list(x=1,y=2), p2=list(x=3,y=4), p3=list(x=1,y=3))
l2 <- list(2,3,5)
list.maps(a$x*b+a$y,a=l1,b=l2)
list.maps(..1$x*..2+..1$y,l1,l2)
}
}
rlist/man/list.merge.Rd 0000644 0001751 0000144 00000002340 12700425754 014545 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.merge.R
\name{list.merge}
\alias{list.merge}
\title{Merge a number of named lists in sequential order}
\usage{
list.merge(...)
}
\arguments{
\item{...}{named lists}
}
\description{
The function merges a number of lists in sequential order
by \code{modifyList}, that is, the later list always
modifies the former list and form a merged list, and the
resulted list is again being merged with the next list.
The process is repeated until all lists in \code{...} or
\code{list} are exausted.
}
\details{
List merging is usually useful in the merging of program
settings or configuraion with multiple versions across time,
or multiple administrative levels. For example, a program
settings may have an initial version in which most keys are
defined and specified. In later versions, partial modifications
are recorded. In this case, list merging can be useful to merge
all versions of settings in release order of these versions. The
result is an fully updated settings with all later modifications
applied.
}
\examples{
l1 <- list(a=1,b=list(x=1,y=1))
l2 <- list(a=2,b=list(z=2))
l3 <- list(a=2,b=list(x=3))
list.merge(l1,l2,l3)
}
rlist/man/list.subset.Rd 0000644 0001751 0000144 00000001030 12700425754 014746 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.subset.R
\name{list.subset}
\alias{list.subset}
\title{Subset a list}
\usage{
list.subset()
}
\description{
Subset a list
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.subset(x, c('p1','p2'))
list.subset(x, grepl('^p', names(x)))
\dontrun{
list.subset(x, stringdist::stringdist(names(x), 'x1') <= 1)
}
}
rlist/man/list.findi.Rd 0000644 0001751 0000144 00000001632 12700425754 014542 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.find.R
\name{list.findi}
\alias{list.findi}
\title{Find the indices of a number of elements in a list or vector
satisfying a given condition}
\usage{
list.findi(.data, cond, n = 1L)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{cond}{A logical lambda expression}
\item{n}{The number of items to find. (\code{n = 1L} by default)}
}
\value{
an integer vector consisting of the elements indices
}
\description{
Find the indices of a number of elements in a list or vector
satisfying a given condition
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.findi(x, type=='B')
list.findi(x, min(score$c1,score$c2) >= 8)
list.findi(x, min(score$c1,score$c2) <= 8, n = 2)
}
rlist/man/list.sample.Rd 0000644 0001751 0000144 00000001475 12700425754 014737 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.sample.R
\name{list.sample}
\alias{list.sample}
\title{Sample a list or vector}
\usage{
list.sample(.data, size, replace = FALSE, weight = 1, prob = NULL)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{size}{\code{integer}. The size of the sample}
\item{replace}{\code{logical}. Should sampling be with replacement?}
\item{weight}{A lambda expression to determine the weight of
each list member, which only takes effect if \code{prob}
is \code{NULL}.}
\item{prob}{A \code{vector} of probability weights for
obtaining the elements of the list being sampled.}
}
\description{
Sample a list or vector
}
\examples{
x <- list(a = 1, b = c(1,2,3), c = c(2,3,4))
list.sample(x, 2, weight = sum(.))
}
rlist/man/list.table.Rd 0000644 0001751 0000144 00000001607 12700425755 014543 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.table.R
\name{list.table}
\alias{list.table}
\title{Generate a table for a list by expression}
\usage{
list.table(.data, ..., table.args = list(useNA = "ifany"))
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{...}{A group of lambda expressions. If missing,
\code{table} will be directly called upon \code{.data} with
\code{table.args}.}
\item{table.args}{\code{list}. The additional parameters
passed to \code{table}}
}
\description{
Generate a table for a list by expression
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.table(x, type)
list.table(x, type, c1 = score$c1)
list.table(x, type, score$c1, table.args = list(dnn=c('type','c1')))
}
rlist/man/list.save.Rd 0000644 0001751 0000144 00000001411 12700425754 014402 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.save.R
\name{list.save}
\alias{list.save}
\title{Save a list to a file}
\usage{
list.save(x, file, type = tools::file_ext(file), ...)
}
\arguments{
\item{x}{The list to save}
\item{file}{The file for output}
\item{type}{The type of output which, by default, is determined
by file extension. Currently supports RData, RDS, JSON, YAML.}
\item{...}{Additional parameters passed to the output function}
}
\value{
\code{x} will be returned.
}
\description{
Save a list to a file
}
\examples{
\dontrun{
x <- lapply(1:5,function(i) data.frame(a=i,b=i^2))
list.save(x, 'list.rds')
list.save(x, 'list.rdata')
list.save(x, 'list.yaml')
list.save(x, 'list.json')
}
}
rlist/man/list.is.Rd 0000644 0001751 0000144 00000001521 12700425754 014061 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.is.R
\name{list.is}
\alias{list.if}
\alias{list.is}
\title{Return a logical vector that indicates if each member of a list
satisfies a given condition}
\usage{
list.is(.data, cond, use.names = TRUE)
list.if(.data, cond, use.names = TRUE)
}
\arguments{
\item{.data}{\code{list}}
\item{cond}{A logical lambda expression}
\item{use.names}{\code{logical} Should the names of \code{.data} be kept?}
}
\description{
Return a logical vector that indicates if each member of a list
satisfies a given condition
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.is(x,type=='B')
list.is(x,min(score$c1,score$c2) >= 8)
}
rlist/man/list.join.Rd 0000644 0001751 0000144 00000002021 12700425754 014401 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.join.R
\name{list.join}
\alias{list.join}
\title{Join two lists by single or multiple keys}
\usage{
list.join(x, y, xkey, ykey, ..., keep.order = TRUE)
}
\arguments{
\item{x}{The first list}
\item{y}{The second list}
\item{xkey}{A lambda expression that determines the key for list \code{x}}
\item{ykey}{A lambda expression that determines the key for list \code{y},
same to \code{xkey} if missing}
\item{...}{The additional parameters passed to \code{merge.data.frame}}
\item{keep.order}{Should the order of \code{x} be kept?}
}
\description{
Join two lists by single or multiple keys
}
\examples{
l1 <- list(p1=list(name='Ken',age=20),
p2=list(name='James',age=21),
p3=list(name='Jenny',age=20))
l2 <- list(p1=list(name='Jenny',age=20,type='A'),
p2=list(name='Ken',age=20,type='B'),
p3=list(name='James',age=22,type='A'))
list.join(l1, l2, name)
list.join(l1, l2, .[c('name','age')])
}
rlist/man/tryEval.Rd 0000644 0001751 0000144 00000001171 12700425755 014124 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R
\name{tryEval}
\alias{tryEval}
\title{Try to evaluate an expression and return a default value if
an error occurs or otherwise return its value.}
\usage{
tryEval(expr, def = NULL)
}
\arguments{
\item{expr}{the expression to evaluate}
\item{def}{the default value if an error occurs in the evaluation
of \code{expr}}
}
\description{
Try to evaluate an expression and return a default value if
an error occurs or otherwise return its value.
}
\examples{
x <- list(a=c(x=1,y=2),b=c(x=2,p=3))
list.map(x, tryEval(x+y, NA))
}
rlist/man/list.skip.Rd 0000644 0001751 0000144 00000001141 12700425754 014412 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.skip.R
\name{list.skip}
\alias{list.skip}
\title{Skip a number of elements}
\usage{
list.skip(.data, n)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{n}{\code{integer}. The number of elements to skip}
}
\description{
Skip the first \code{n} elements of a list or vector and
return the remaining elements if any.
}
\examples{
x <- list(a=1,b=2,c=3)
list.skip(x, 1)
list.skip(x, 2)
}
\seealso{
\code{\link{list.skipWhile}}, \code{\link{list.take}},
\code{\link{list.takeWhile}}
}
rlist/man/list.all.Rd 0000644 0001751 0000144 00000001753 12700425754 014225 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.all.R
\name{list.all}
\alias{list.all}
\title{Examine if a condition is true for all elements of a list}
\usage{
list.all(.data, cond, na.rm = FALSE)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{cond}{A logical lambda expression}
\item{na.rm}{logical. If true \code{NA} values are ignored in
the evaluation.}
}
\value{
\code{TRUE} if \code{cond} is evaluated to be \code{TRUE}
for all elements in \code{.data}.
}
\description{
Examine if a condition is true for all elements of a list
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.all(x, type=='B')
list.all(x, mean(unlist(score))>=6)
list.all(x, score$c2 > 8 || score$c3 > 5, na.rm = TRUE)
list.all(x, score$c2 > 8 || score$c3 > 5, na.rm = FALSE)
}
\seealso{
\code{\link{list.any}}
}
rlist/man/list.ungroup.Rd 0000644 0001751 0000144 00000003060 12700425755 015146 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.group.R
\name{list.ungroup}
\alias{list.ungroup}
\title{Ungroup a list by taking out second-level elements}
\usage{
list.ungroup(.data, level = 1L, ..., group.names = FALSE,
sort.names = FALSE)
}
\arguments{
\item{.data}{\code{list}}
\item{level}{{integer} to indicate to which level of list elements
should be ungroupped to the first level.}
\item{...}{Preserved use of parameter passing}
\item{group.names}{\code{logical}. Should the group names be
preserved?}
\item{sort.names}{\code{logical}. Should the members be sorted
after ungrouping?}
}
\description{
This functon reverses the grouping operation by taking out
second-level elements of a nested list and removing the labels
of the first-level elements. For example, a list may be created
from paged data, that is, its first-level elements only indicate
the page container. To unpage the list, the first-level elements
must be removed and their inner elements should be taken out to
to the first level.
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
xg <- list.group(x, type)
list.ungroup(xg)
x <- list(a = list(a1 = list(x=list(x1=2,x2=3),y=list(y1=1,y2=3))),
b = list(b1 = list(x=list(x1=2,x2=6),y=list(y1=3,y2=2))))
list.ungroup(x, level = 1)
list.ungroup(x, level = 2)
list.ungroup(x, level = 2, group.names = TRUE)
}
\seealso{
\code{\link{list.group}}
}
rlist/man/list.group.Rd 0000644 0001751 0000144 00000001655 12700425754 014612 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.group.R
\name{list.group}
\alias{list.group}
\title{Divide list/vector elements into exclusive groups}
\usage{
list.group(.data, ..., sorted = TRUE)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{...}{One or more expressions in the scope of each element to evaluate
as keys}
\item{sorted}{\code{TRUE} to sort the group keys. Ignored when the key has
multiple entries.}
}
\value{
A list of group elements each contain all the elements in \code{.data}
belonging to the group
}
\description{
Divide list/vector elements into exclusive groups
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.group(x, type)
list.group(x, mean(unlist(score)))
}
\seealso{
\code{\link{list.ungroup}}
}
rlist/man/list.exclude.Rd 0000644 0001751 0000144 00000001251 12700425754 015077 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.remove.R
\name{list.exclude}
\alias{list.exclude}
\title{Exclude members of a list that meet given condition.}
\usage{
list.exclude(.data, cond)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{cond}{A logical lambda expression to exclude items}
}
\description{
Exclude members of a list that meet given condition.
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.exclude(x, type=='B')
list.exclude(x, min(score$c1,score$c2) >= 8)
}
rlist/man/list.map.Rd 0000644 0001751 0000144 00000001364 12700425754 014230 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.map.R
\name{list.map}
\alias{list.map}
\title{Map each element in a list or vector by an expression.}
\usage{
list.map(.data, expr)
}
\arguments{
\item{.data}{a \code{list} or \code{vector}}
\item{expr}{A lambda expression}
}
\value{
A \code{list} in which each element is mapped by \code{expr} in \code{.data}
}
\description{
Map each element in a list or vector by an expression.
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.map(x, type)
list.map(x, min(score$c1,score$c2))
}
\seealso{
\code{\link{list.mapv}}
}
rlist/man/list.which.Rd 0000644 0001751 0000144 00000001313 12700425755 014550 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.which.R
\name{list.which}
\alias{list.which}
\title{Give the indices of list elements satisfying
a given condition}
\usage{
list.which(.data, cond)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{cond}{A logical lambda expression}
}
\value{
an \code{integer} vector
}
\description{
Give the indices of list elements satisfying
a given condition
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.which(x, type == 'B')
list.which(x, min(score$c1,score$c2) >= 8)
}
rlist/man/list.find.Rd 0000644 0001751 0000144 00000001601 12700425754 014365 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.find.R
\name{list.find}
\alias{list.find}
\title{Find a specific number of elements in a list or vector
satisfying a given condition}
\usage{
list.find(.data, cond, n = 1L)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{cond}{A logical lambda expression}
\item{n}{The number of items to find. (\code{n = 1L} by default)}
}
\value{
A list or vector of at most \code{n} elements in \code{.data}
found to satisfy \code{cond}.
}
\description{
Find a specific number of elements in a list or vector
satisfying a given condition
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.find(x, type=='B', 1)
list.find(x, min(score$c1,score$c2) >= 9)
}
rlist/man/list.parse.Rd 0000644 0001751 0000144 00000002721 12700425754 014563 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.parse.R
\name{list.parse}
\alias{list.parse}
\alias{list.parse.character}
\alias{list.parse.data.frame}
\alias{list.parse.default}
\alias{list.parse.matrix}
\title{Convert an object to list with identical structure}
\usage{
list.parse(x, ...)
\method{list.parse}{default}(x, ...)
\method{list.parse}{matrix}(x, ...)
\method{list.parse}{data.frame}(x, ...)
\method{list.parse}{character}(x, type, ...)
}
\arguments{
\item{x}{\code{An object}}
\item{...}{Additional parameters passed to converter function}
\item{type}{The type of data to parse. Currently json and yaml are supported.}
}
\value{
\code{list} object representing the data in \code{x}
}
\description{
This function converts an object representing data to
list that represents the same data. For example, a
\code{data.frame} stored tabular data column-wisely,
that is, each column represents a vector of a certain
type. \code{list.parse} converts a \code{data.frame} to
a list which represents the data row-wisely so that it
can be more convinient to perform other non-tabular data
manipulation methods.
}
\examples{
x <- data.frame(a=1:3,type=c('A','C','B'))
list.parse(x)
x <- matrix(rnorm(1000),ncol=5)
rownames(x) <- paste0('item',1:nrow(x))
colnames(x) <- c('a','b','c','d','e')
list.parse(x)
z <- '
a:
type: x
class: A
registered: yes
'
list.parse(z, type='yaml')
}
rlist/man/list.takeWhile.Rd 0000644 0001751 0000144 00000001617 12700425755 015372 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.take.R
\name{list.takeWhile}
\alias{list.takeWhile}
\title{Keep taking elements while a condition holds}
\usage{
list.takeWhile(.data, cond)
}
\arguments{
\item{.data}{\code{list} or \code{vector}}
\item{cond}{A logical lambda expression}
}
\description{
Keep taking elements out from a list or vector while
a condition holds for the element. If the condition is
violated for an element, the element will not be taken and
all taken elements will be returned.
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.takeWhile(x, type=='B')
list.takeWhile(x, min(score$c1,score$c2) >= 8)
}
\seealso{
\code{\link{list.take}}, \code{\link{list.skip}},
\code{\link{list.skipWhile}}
}
rlist/man/nyweather.Rd 0000644 0001751 0000144 00000001066 12700425755 014507 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/data.R
\docType{data}
\name{nyweather}
\alias{nyweather}
\title{New York hourly weather data}
\format{See \url{http://openweathermap.org/weather-data#current}}
\usage{
nyweather
}
\description{
A non-tabular data of the hourly weather conditions of the New York City
from 2013-01-01 to 2013-03-01.
}
\details{
Fetch date: 2014-11-23.
Processed by rlist.
To retrieve the data, please visit \url{http://openweathermap.org/api} for
API usage.
}
\keyword{datasets}
rlist/man/list.match.Rd 0000644 0001751 0000144 00000001347 12700425754 014550 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.match.R
\name{list.match}
\alias{list.match}
\title{Select members of a list that match given regex pattern}
\usage{
list.match(.data, pattern, ...)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{pattern}{\code{character}. The regex pattern to match the name of the members}
\item{...}{Additional parameters to pass to \code{grep}}
}
\description{
Select members of a list that match given regex pattern
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.match(x,'p[12]')
list.match(x,'3')
}
rlist/man/rlist-package.Rd 0000644 0001751 0000144 00000001444 12700425755 015227 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/rlist.R
\docType{package}
\name{rlist-package}
\alias{rlist-package}
\title{The rlist package}
\description{
The rlist package
}
\details{
rlist is a set of tools for working with list objects. Its goal
is to make it easier to work with lists by providing a wide range
of functions that operate on non-tabular data stored in them.
The package provides a set of functions for data manipulation with
list objects, including mapping, filtering, grouping, sorting,
updating, searching, and other useful functions. Most functions
are designed to be pipeline friendly so that data processing with
lists can be chained.
rlist Tutorial (\url{http://renkun.me/rlist-tutorial}) is a complete guide to rlist.
}
rlist/man/list.cases.Rd 0000644 0001751 0000144 00000001723 12700425754 014550 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.group.R
\name{list.cases}
\alias{list.cases}
\title{Get all unique cases of a list field by expression}
\usage{
list.cases(.data, expr, simplify = TRUE, sorted = TRUE)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{expr}{A lambda expression. The function will returns all cases
of the elements if \code{expr} is missing.}
\item{simplify}{\code{logical}. Should atomic vectors be simplified
by \code{unlist}?}
\item{sorted}{\code{logical}. Should the cases be sorted in ascending order?}
}
\description{
Get all unique cases of a list field by expression
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.cases(x,type)
list.cases(x,mean(unlist(score)))
foo <- list(x = LETTERS[1:3], y = LETTERS[3:5])
list.cases(foo)
}
rlist/man/list.iter.Rd 0000644 0001751 0000144 00000001243 12700425754 014412 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.map.R
\name{list.iter}
\alias{list.iter}
\title{Iterate a list by evaluating an expression on
each list element}
\usage{
list.iter(.data, expr)
}
\arguments{
\item{.data}{\code{list}}
\item{expr}{A lambda expression}
}
\value{
\code{invisible(.data)}
}
\description{
Iterate a list by evaluating an expression on
each list element
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.iter(x,cat(paste(type,'\\n')))
list.iter(x,cat(str(.)))
}
rlist/man/list.extract.Rd 0000644 0001751 0000144 00000000551 12700425754 015122 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.extract.R
\name{list.extract}
\alias{list.extract}
\title{Extract an element from a list or vector}
\usage{
list.extract()
}
\description{
Extract an element from a list or vector
}
\examples{
x <- list(a=1, b=2, c=3)
list.extract(x, 1)
list.extract(x, 'a')
}
rlist/man/list.append.Rd 0000644 0001751 0000144 00000001062 12700425754 014715 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.insert.R
\name{list.append}
\alias{list.append}
\title{Append elements to a list}
\usage{
list.append(.data, ...)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{...}{A \code{vector} or \code{list} to append after \code{x}}
}
\description{
Append elements to a list
}
\examples{
\dontrun{
x <- list(a=1,b=2,c=3)
list.append(x,d=4,e=5)
list.append(x,d=4,f=c(2,3))
}
}
\seealso{
\code{\link{list.prepend}}, \code{\link{list.insert}}
}
rlist/man/list.common.Rd 0000644 0001751 0000144 00000001557 12700425754 014747 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.common.R
\name{list.common}
\alias{list.common}
\title{Get all common cases by expression for a list}
\usage{
list.common(.data, expr)
}
\arguments{
\item{.data}{\code{list}}
\item{expr}{An anonymous (or "lambda") expression to determine common cases. If one
is not specified, \code{list.common} simply returns all identical sub-elements within lists.}
}
\description{
Get all common cases by expression for a list
}
\examples{
x <- list(c('a','b','c'),c('a','b'),c('b','c'))
list.common(x, .)
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.common(x,type)
list.common(x,names(score))
foo <- list(x = LETTERS[1:3], y = LETTERS[3:5])
list.common(foo)
}
rlist/man/list.sort.Rd 0000644 0001751 0000144 00000001533 12700425754 014440 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.order.R
\name{list.sort}
\alias{list.sort}
\title{Sort a list by given expressions}
\usage{
list.sort(.data, ..., na.last = NA)
}
\arguments{
\item{.data}{a \code{list} or \code{vector}}
\item{...}{A group of lambda expressions. For each expression, the data
is sorted ascending by default unless the expression is enclosed by ().}
\item{na.last}{The way to deal with \code{NA}s.}
}
\description{
Sort a list by given expressions
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.sort(x, type, (score$c2)) # sort by score$c2 in descending order
list.sort(x, min(score$c1,score$c2))
}
\seealso{
\code{\link{list.order}}
}
rlist/man/list.order.Rd 0000644 0001751 0000144 00000001747 12700425754 014573 0 ustar hornik users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list.order.R
\name{list.order}
\alias{list.order}
\title{Give the order of each list element by expression}
\usage{
list.order(.data, ..., keep.names = FALSE, na.last = TRUE)
}
\arguments{
\item{.data}{A \code{list} or \code{vector}}
\item{...}{A group of lambda expressions}
\item{keep.names}{Whether to keep the names of \code{x} in the result}
\item{na.last}{The way to deal with \code{NA}s.}
}
\value{
an \code{integer} vector.
}
\description{
Give the order of each list element by expression
}
\examples{
x <- list(p1 = list(type='A',score=list(c1=10,c2=8)),
p2 = list(type='B',score=list(c1=9,c2=9)),
p3 = list(type='B',score=list(c1=9,c2=7)))
list.order(x, type, (score$c2)) # order by type (ascending) and score$c2 (descending)
list.order(x, min(score$c1,score$c2))
list.order(x, min(score$c1,score$c2), keep.names=TRUE)
}
\seealso{
\code{\link{list.sort}}
}
rlist/LICENSE 0000644 0001751 0000144 00000000047 12700425754 012441 0 ustar hornik users YEAR: 2014
COPYRIGHT HOLDER: Kun Ren