I'm trying to execute a function that uses the names of passed parameters with purrr::pmap. Unlike purrr::map (see below), pmap doesn't preserve these names. The below MWE captures the issue:
print_names <- function(x) {
print(names(x))
}
namedVec <- c(nameA = "valueA")
purrr::map(list(namedVec), print_names)
# [1] "nameA"
# [[1]]
# [1] "nameA"
purrr::pmap(list(namedVec), print_names)
# NULL
# $nameA
# NULL
Note that, in pmap, the .l argument needs to be a list of listed arguments, but in your function call it's just a list:
print_names <- function(x) {
print(names(x))
}
namedVec <- c(nameA = "valueA")
purrr::map(list(namedVec), ~print_names(.))
#> [1] "nameA"
#> [[1]]
#> [1] "nameA"
purrr::pmap(list(list(namedVec)), print_names)
#> [1] "nameA"
#> [[1]]
#> [1] "nameA"
Created on 2018-10-07 by the reprex package (v0.2.1)
Related
I have a multiple lists in my environment(all start with "CDS_"). Each list is conducted of multiple sub lists.I want to call the lists one by one to apply a function for each of these objects.
This is what I am trying:
lists<-grep("CDS_",names(.GlobalEnv),value=TRUE) #Lists all objectrs staring with "CDS_"
for (i in seq_along(lists)){
data<-do.call("list",mget(lists[i])) #this line blends all sub lists into one list
assign(paste("Df_", lists[i], sep = "_"), my_function(data) # my_function requires a list with multiple sub lists
}
but the issue is the do.call("list",mget(lists[i])) blends all sub lists into one. For example if there is a list with one sub list it returns the list but all sub lists go into one!
Any solutions how to make this work?
here is a sample to test:
#Defining my_function pulling out the sub list which contains "sample1"
my_function<-function(.data){
# pull out the undergraduate data
grep("sample1", .data, value = TRUE)
}
# 1st list
list_1 <- list(1:54,
c("This","is","sample1","for","list1"),
c("This","is","sample2","for","list1"),
"Hi")
# 2nd list
list_2 <- list(51:120,
c("This","is","sample1","for","list1"),
c("This","is","sample2","for","list1"),
"Bus")
# 3rd list
list_3 <- list(90:120,
letters[16:11],
2025)
lists<-grep("list_",names(.GlobalEnv),value=TRUE)
for (i in seq_along(lists)){
data<-do.call("list",mget(lists[i]))
assign(paste("sample1_", lists[i], sep = ""), my_function(data))
}
As mentioned by #MrFlick, R has a ton of list functionality. It is usually the case that you are better off storing your lists in a list than trying to directly edit them in the environment. Here is one possible solution using base R:
l <- mget(ls(pattern = "^list_\\d$")) # store lists in a list
lapply(l, \(x) lapply(x, my_function))
$list_1
$list_1[[1]]
character(0)
$list_1[[2]]
[1] "sample1"
$list_1[[3]]
character(0)
$list_1[[4]]
character(0)
$list_2
$list_2[[1]]
character(0)
$list_2[[2]]
[1] "sample1"
$list_2[[3]]
character(0)
$list_2[[4]]
character(0)
$list_3
$list_3[[1]]
character(0)
$list_3[[2]]
character(0)
$list_3[[3]]
character(0)
Update
Sticking with base R to remove non-matches you could do:
lapply(l, \(x) Filter(length, lapply(x, my_function)))
$list_1
$list_1[[1]]
[1] "sample1"
$list_2
$list_2[[1]]
[1] "sample1"
$list_3
list()
A purrr solution would be:
library(purrr)
map(map_depth(l, 2, my_function), compact)
When you have lists of lists, and option is rapply, the recursive version of lapply.
my_function<-function(.data){
# pull out the undergraduate data
grep("sample1", .data, value = TRUE)
}
lists <- mget(ls(pattern = "^list_"))
rapply(lists, my_function, how = "list")
#> $list_1
#> $list_1[[1]]
#> character(0)
#>
#> $list_1[[2]]
#> [1] "sample1"
#>
#> $list_1[[3]]
#> character(0)
#>
#> $list_1[[4]]
#> character(0)
#>
#>
#> $list_2
#> $list_2[[1]]
#> character(0)
#>
#> $list_2[[2]]
#> [1] "sample1"
#>
#> $list_2[[3]]
#> character(0)
#>
#> $list_2[[4]]
#> character(0)
#>
#>
#> $list_3
#> $list_3[[1]]
#> character(0)
#>
#> $list_3[[2]]
#> character(0)
#>
#> $list_3[[3]]
#> character(0)
Created on 2022-05-13 by the reprex package (v2.0.1)
Edit
To answer to the OP's comment to another answer, to keep only the matches, save the rapply result and a lapply loop calling lengths, the list version of vector length is used to extract the matches.
r <- rapply(lists, my_function, how = "list")
lapply(r, \(x) x[lengths(x) > 0])
#> $list_1
#> $list_1[[1]]
#> [1] "sample1"
#>
#>
#> $list_2
#> $list_2[[1]]
#> [1] "sample1"
#>
#>
#> $list_3
#> list()
Created on 2022-05-13 by the reprex package (v2.0.1)
I want to replace the for loop with a foreach loop but I get an error "unexpected token in". Below you can see my code. Just to mention that all the f's are file names. Do you have any idea?
for (f in file) {
print(f)
analyze(f)
tmp <- res4
y <- rbind(y, tmp)
}
Here is a simple foreach loop using the sequential %do% operator.
Note that the first 2 values of vector file are the output of print.
library(foreach)
file <- c("/data/an_01h.dat", "/data/an_01h.dat")
foreach (f=file) %do% {
print(f)
}
#> [1] "/data/an_01h.dat"
#> [1] "/data/an_01h.dat"
#> [[1]]
#> [1] "/data/an_01h.dat"
#>
#> [[2]]
#> [1] "/data/an_01h.dat"
Created on 2022-04-21 by the reprex package (v2.0.1)
And a parallelized loop. The %dopar% operator is a parallelizable operator. This time print doesn't show its output, see this SO question on this.
library(foreach)
library(doParallel)
#> Loading required package: iterators
#> Loading required package: parallel
file <- c("/data/an_01h.dat", "/data/an_01h.dat")
ncores <- detectCores() - 1L
registerDoParallel(ncores) # use multicore, set to the number of our cores
foreach (f=file) %dopar% {
print(f)
}
#> [[1]]
#> [1] "/data/an_01h.dat"
#>
#> [[2]]
#> [1] "/data/an_01h.dat"
Created on 2022-04-21 by the reprex package (v2.0.1)
I'm been working with nested lists and recursive functions in R following this instructions. Now there is just one piece I miss to design an own function, which is getting a vector with the respective names sorted from the highest to the deepest level.
The input list is:
lst <- list(
title = "References and Plant Communities in 'SWEA-Dataveg'",
author = "Miguel Alvarez",
date = "Dezember 28, 2019",
"header-includes" = c(
"- \\usepackage[utf8]{inputenc}",
"- \\usepackage[T1]{fontenc}", "- \\usepackage{bibentry}",
"- \\nobibliography{sweareferences.bib}"),
output = list(pdf_document=list(citation_package="natbib")),
"biblio-style" = "unsrtnat",
bibliography = "sweareferences.bib",
papersize = "a4")
The structure of the output list will then looks like this (printed in the console). Herewith note the vector at lst$output$pdf_document$citation_package:
$title
[1] "title"
$author
[1] "author"
$date
[1] "date"
$`header-includes`
[1] "header-includes"
$output
$output$pdf_document
$output$pdf_document$citation_package
[1] "output"
[2] "pdf_document"
[3] "citation_package"
$`biblio-style`
[1] "biblio-style"
$bibliography
[1] "bibliography"
$papersize
[1] "papersize"
Of course, the function has to be recursive to be applied in any different case.
Here is one possible approach, using only base R. The following function f replaces each terminal node (or "leaf") of a recursive list x with the sequence of names leading up to it. It treats unnamed lists like named lists with all names equal to "", which is a useful generalization.
f <- function(x, s = NULL) {
if (!is.list(x)) {
return(s)
}
nms <- names(x)
if (is.null(nms)) {
nms <- character(length(x))
}
Map(f, x = x, s = Map(c, list(s), nms))
}
f(lst)
$title
[1] "title"
$author
[1] "author"
$date
[1] "date"
$`header-includes`
[1] "header-includes"
$output
$output$pdf_document
$output$pdf_document$citation_package
[1] "output" "pdf_document" "citation_package"
$`biblio-style`
[1] "biblio-style"
$bibliography
[1] "bibliography"
$papersize
[1] "papersize"
Using an external package, this can be done quite efficiently with rrapply() in the rrapply-package:
rrapply::rrapply(lst, f = function(x, .xparents) .xparents)
#> $title
#> [1] "title"
#>
#> $author
#> [1] "author"
#>
#> $date
#> [1] "date"
#>
#> $`header-includes`
#> [1] "header-includes"
#>
#> $output
#> $output$pdf_document
#> $output$pdf_document$citation_package
#> [1] "output" "pdf_document" "citation_package"
#>
#>
#>
#> $`biblio-style`
#> [1] "biblio-style"
#>
#> $bibliography
#> [1] "bibliography"
#>
#> $papersize
#> [1] "papersize"
I have a simulation model that takes parameters.
Instead of passing all parameters to a main function (which is complicated for the user since the dimensions of some of the parameters depend on themselves, e.g. if n=2, vec_n is length 2), I wanted an internal PARAMETERS object within the package, which all functions could access, and the users can change.
I made a package Test with two functions and an internal list INTERNAL=list(a=2) which is saved in sysdata.rda.
test_function<-function(b){
INTERNAL$a = b
print(INTERNAL)
second_function()
}
second_function<-function(){
print(INTERNAL$a)
}
However on loading the package, and running it I get the following output:
> test_function(5)
$a
[1] 5
[1] 2
Clearly, the object itself doesn't change outside the function.
I'd appreciate any help / advice in getting this to work.
INTERNAL$a = b creates a local copy of INTERNAL in your function, and modifies that. Since you want to modify the global copy, you could use
INTERNAL$a <<- b
but this is a bad idea, and probably wouldn't work in a package: you can't modify most values in a package after it is installed.
Alternatives to this are to make INTERNAL into an environment (which you can modify), or create a function that returns the values you want, e.g.
INTERNAL <- function(a = "default", b = "default") {
list(a = a, b = b)
}
INTERNAL(a = 2)
#> $a
#> [1] 2
#>
#> $b
#> [1] "default"
Created on 2021-04-19 by the reprex package (v1.0.0)
You can combine these two ideas:
INTERNAL <- local({
saved <- list(a = "default", b = "default")
function(...) {
saved <<- modifyList(saved, list(...))
saved
}
})
INTERNAL(a = 1)
#> $a
#> [1] 1
#>
#> $b
#> [1] "default"
INTERNAL(b = 2)
#> $a
#> [1] 1
#>
#> $b
#> [1] 2
INTERNAL(c = 3)
#> $a
#> [1] 1
#>
#> $b
#> [1] 2
#>
#> $c
#> [1] 3
Created on 2021-04-19 by the reprex package (v1.0.0)
I am trying to reproduce the tibble-way of printing, for an object of class foo (which is basically a list).
When printing each list element separately, there is no issue. But when I try to use a programmatic approach for each list element, it adds a blank line in the console, which I don't want. How do I prevent this from happening?
foo_obj <- list(a = "hello", b = "world")
class(foo_obj) <- c("fooclass")
myfooter <- function(x, width) {
footer <- paste0(cli::symbol$ellipsis, " ", x)
pillar::style_subtle(paste("#", footer))
}
print.fooclass <- function(x, ...) {
print(x$a)
cat(myfooter("s\n\n", 40))
print(x$b)
cat(myfooter("s", 40))
}
## This is the desired output
foo_obj
#> [1] "hello"
#> # … s
#>
#> [1] "world"
#> # … s
print.fooclass_ls <- function(x, ...) {
lapply(1:length(x), function(i){
print(x[i])
cat(myfooter("s\n", 40))
}
)
}
class(foo_obj) <- c("fooclass_ls")
## The empty lines after the print are NOT desired
foo_obj
#> $a
#> [1] "hello"
#>
#> # … s
#> $b
#> [1] "world"
#>
#> # … s
Created on 2021-03-10 by the reprex package (v1.0.0)
Thanks to user20650's great idea! - I will follow their suggestion and self-answer.
The list object prints with a line break - but if we print the sub-element [[i]], there is no line break. In order to get the names printed, you still need to add the names as well!
foo_obj <- list(a = "hello", b = "world")
class(foo_obj) <- c("fooclass")
myfooter <- function(x) {
footer <- paste0(cli::symbol$ellipsis, " ", x)
pillar::style_subtle(paste("#", footer))
}
print.fooclass <- function(x, ...) {
lapply(1:length(x), function(i){
cat(paste0("$", names(x)[i], "\n")) # for the names, which I want
print(x[[i]])
cat(myfooter("s\n\n"))
}
)
}
foo_obj
#> $a
#> [1] "hello"
#> # … s
#>
#> $b
#> [1] "world"
#> # … s
Created on 2021-03-11 by the reprex package (v1.0.0)