Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

knitr: output hook with an output.lines= option that works like echo=2:6

Tags:

r

hook

knitr

In a book project, I have lots of output I'd like to abbreviate, by selecting only a subset of the lines, and adding ... to indicate that some output has been elided. For example, in the output from summary(lm()), I might want to print just the table of coefficients, and have it appear as follows:

 >summary(lm(Sepal.Length ~ Species, data=iris))
...
Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)         5.0060     0.0728  68.762  < 2e-16 ***
Speciesversicolor   0.9300     0.1030   9.033 8.77e-16 ***
Speciesvirginica    1.5820     0.1030  15.366  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
...

I wrote the following output hook that works with a chunk option, output.lines= and accepts a single number, n, meaning print only lines 1:n, sort of like head() would do:

  # get the default output hook
  hook_output <- knit_hooks$get("output")

  knit_hooks$set(output = function(x, options) {
    lines <- options$output.lines
    if (is.null(lines)) {
      hook_output(x, options)  # pass to default hook
    }
    else {
      x <- unlist(stringr::str_split(x, "\n"))
      if (length(x) > lines) {
        # truncate the output, but add ....
        x <- c(head(x, lines), "...\n")
      }
      # paste these lines together
      x <- paste(x, collapse = "\n")
      hook_output(x, options)
    }
  })

I've tried to generalize this to accept a (consecutive) vector of line numbers as shown below, but it doesn't seem to work and I can't tell why. It is also not as general as I'd like, because passing output.lines=1:12 should print only lines 1:12 ..., and like the option echo=, it would be nice to use output.lines = -1:3 to get ... followed by all remaining lines.

  # knitr hook function to allow an output.lines option
  # e.g., 
  #   output.lines=12 prints lines 1:12 ...
  #   output.lines=3:15 prints lines ... 3:15 ...

   knit_hooks$set(output = function(x, options) {
     lines <- options$output.lines
     if (is.null(lines)) {
       hook_output(x, options)  # pass to default hook
     }
     else {
       x <- unlist(stringr::str_split(x, "\n"))
       more <- "...\n"
       if (length(lines)==1) {        # first n lines
         if (length(x) > lines) {
           # truncate the output, but add ....
           x <- c(head(x, lines), more)
         }
       }
       else {
         x <- c(more, x[lines], more)
      }
       # paste these lines together
       x <- paste(x, collapse = "\n")
       hook_output(x, options)
     }
   })

I think this is a more general problem than just mine, so maybe this would be a welcome addition to knitr.

-Michael

like image 455
user101089 Avatar asked Apr 16 '14 16:04

user101089


2 Answers

I do not see why it should not work, either. Thell pointed out a mistake in the comment above (-1:3 should be -(1:3)), which might be the reason. Other than that, it works well for me:

```{r}
library(knitr)
hook_output <- knit_hooks$get("output")
knit_hooks$set(output = function(x, options) {
   lines <- options$output.lines
   if (is.null(lines)) {
     return(hook_output(x, options))  # pass to default hook
   }
   x <- unlist(strsplit(x, "\n"))
   more <- "..."
   if (length(lines)==1) {        # first n lines
     if (length(x) > lines) {
       # truncate the output, but add ....
       x <- c(head(x, lines), more)
     }
   } else {
     x <- c(more, x[lines], more)
   }
   # paste these lines together
   x <- paste(c(x, ""), collapse = "\n")
   hook_output(x, options)
 })
```

Normal output.

```{r test}
summary(lm(Sepal.Length ~ Species, data=iris))
```

The first 4 lines.

```{r test, output.lines=4}
```

Remove the first 8 lines.

```{r test, output.lines=-(1:8)}
```

From 8 to 15.

```{r test, output.lines=8:15}
```

results after modifying the the output hook

like image 155
Yihui Xie Avatar answered Nov 04 '22 22:11

Yihui Xie


Thell's comment and Yihui's test case allowed me to generalize this slightly so it now does just what I want.

In particular, output.lines=1:12 works the same as output.lines=12 and omits the initial .... Similarly for the case of output.lines=-(1:8) which prints the initial ... but omits it if the last line is included in the range.

This now meets my needs, and might be sufficiently useful to others to include as a new knitr chunk option. From a design point of view, the only thing that might be changed is to only supply the range of desired lines, e.g., output.lines=c(1,8) or output.lines=-c(1,8), since it would be very messy and possibly confusing to allow for the ...s in non-consecutive line selections.

E.g., with the current function, output.lines=sample(1:15,10) will work, and actually do something useful for a chunk that prints a data frame, similarly to some(iris) from the car package. But, when I want that, I use some() directly. This output hook is only designed to select a range of lines from printed output from a function that is too long to usefully include in a printed document, or when you want to focus attention on just a part of the output and indicate that some lines have been omitted.

  # knitr hook function to allow an output.lines option
  # e.g., 
  #   output.lines=12 prints lines 1:12 ...
  #   output.lines=1:12 does the same
  #   output.lines=3:15 prints lines ... 3:15 ...
  #   output.lines=-(1:8) removes lines 1:8 and prints ... 9:n ...
  #   No allowance for anything but a consecutive range of lines

library(knitr)
hook_output <- knit_hooks$get("output")
knit_hooks$set(output = function(x, options) {
   lines <- options$output.lines
   if (is.null(lines)) {
     return(hook_output(x, options))  # pass to default hook
   }
   x <- unlist(strsplit(x, "\n"))
   more <- "..."
   if (length(lines)==1) {        # first n lines
     if (length(x) > lines) {
       # truncate the output, but add ....
       x <- c(head(x, lines), more)
     }
   } else {
     x <- c(if (abs(lines[1])>1) more else NULL, 
            x[lines], 
            if (length(x)>lines[abs(length(lines))]) more else NULL
           )
   }
   # paste these lines together
   x <- paste(c(x, ""), collapse = "\n")
   hook_output(x, options)
 })
like image 30
user101089 Avatar answered Nov 04 '22 22:11

user101089