print list nicely

print_list.rmd

``` r
#' print list nicely
#'
#' @param l list to print
#' @param n_named max number of named items to display if list/sublist contains only named items
#' @param n_unnamed max number of items to display if list/sublist contains unnamed items 
#' @param fun function to use to print items
#' @param ... additional arguments passed to fun
#'
#' @return unchanged input
#' @export
print_list <- function(l,
                       n_named = 20, 
                       n_unnamed = 6, 
                       fun = print,
                       ...){
  dots <- list(...)
  fun0 <- function(l) do.call(fun, c(list(l),dots))
  print_list0(l, nm = NULL, i = NULL, indent = -2,
              n_named = n_named, n_unnamed = n_unnamed , fun = fun0)
}
  
print_list0 <- function(l, nm = NULL, i = NULL, indent=-2, 
                       n_named = 20, 
                       n_unnamed = 6, 
                       fun){
  if(!is.null(nm)){
    if(nm!=""){ 
      cat(strrep(" ", indent), "$", nm,"\n",sep="")
    } else {
      cat(strrep(" ", indent), "[[", i,"]]\n",sep="")
    }
  }
  
  if(is.data.frame(l) || !is.list(l)){
    output <- capture.output(fun(l))
    output <- paste(strrep(" ", indent), output, collapse="\n")
    cat(output,"\n")
  } else {
    nm = allNames(l)
    named <- all(nm != "")
    if(named && length(l) > n_named){
      n_unshowed <- length(l) - n_named
      l  <- l[seq_len(n_named)]
      nm <- nm[seq_len(n_named)]
      Map(print_list0, l, nm, i = seq_along(l), indent=indent+2,
          n_named = n_named, n_unnamed = n_unnamed,
          fun = replicate(length(l), fun))
      cat(strrep(" ", indent+2), "# + ", n_unshowed, " named items\n",sep="")
    } else if(length(l) > n_unnamed){
      n_unshowed <- length(l) - n_unnamed
      l  <- l[seq_len(n_unnamed)]
      nm <- nm[seq_len(n_unnamed)]
      Map(print_list0, l, nm, i = seq_along(l), indent=indent+2,
          n_named = n_named, n_unnamed = n_unnamed,
          fun = replicate(length(l), fun))
      cat(strrep(" ", indent+2), "# + ", n_unshowed, " items\n",sep="")
    } else {
      Map(print_list0, l, nm, i = seq_along(l), indent=indent+2,
          n_named = n_named, n_unnamed = n_unnamed,
          fun = replicate(length(l), fun))
    }
  }
  invisible(l)
}

l1 <- list(a = factor("1"), b = c(u = 3, v = 4), d= list(x=5, y =6), e= 8, f = 9)
```

``` r
# default way of printing a short list
print_list(l1)
#> $a
#>  [1] 1
#>  Levels: 1 
#> $b
#>  u v 
#>  3 4  
#> $d
#>   $x
#>    [1] 5 
#>   $y
#>    [1] 6 
#> $e
#>  [1] 8 
#> $f
#>  [1] 9
```

``` r
# restrict to first 3 items when named
print_list(l1,n_named = 3)
#> $a
#>  [1] 1
#>  Levels: 1 
#> $b
#>  u v 
#>  3 4  
#> $d
#>   $x
#>    [1] 5 
#>   $y
#>    [1] 6 
#> # + 2 named items
```

``` r
# pass parameters to print
print_list(l1, quote = TRUE)
#> $a
#>  [1] "1"
#>  Levels: "1" 
#> $b
#>  u v 
#>  3 4  
#> $d
#>   $x
#>    [1] 5 
#>   $y
#>    [1] 6 
#> $e
#>  [1] 8 
#> $f
#>  [1] 9
```

``` r
# use str rather than print
print_list(l1, fun = str)
#> $a
#>   Factor w/ 1 level "1": 1 
#> $b
#>   Named num [1:2] 3 4
#>   - attr(*, "names")= chr [1:2] "u" "v" 
#> $d
#>   $x
#>     num 5 
#>   $y
#>     num 6 
#> $e
#>   num 8 
#> $f
#>   num 9
```

``` r
# build long list and print with restrictions
l2 <- replicate(100, l1, simplify = F)
print_list(l2,n_named = 3, n_unnamed = 2)
#> [[1]]
#>   $a
#>    [1] 1
#>    Levels: 1 
#>   $b
#>    u v 
#>    3 4  
#>   $d
#>     $x
#>      [1] 5 
#>     $y
#>      [1] 6 
#>   # + 2 named items
#> [[2]]
#>   $a
#>    [1] 1
#>    Levels: 1 
#>   $b
#>    u v 
#>    3 4  
#>   $d
#>     $x
#>      [1] 5 
#>     $y
#>      [1] 6 
#>   # + 2 named items
#> # + 98 items
```

<sup>Created on 2019-09-23 by the [reprex package](https://reprex.tidyverse.org) (v0.3.0)</sup>