Skip to contents

[Experimental]

This R6 class is designed to store and manage report cards, facilitating the creation, manipulation, and serialization of report-related data.

Note

The function has to be used in the shiny reactive context.

if Report has an id when converting to JSON then It will be compared to the currently available one.

if Report has an id when converting to JSON then It will be compared to the currently available one.

Methods


Method new()

Initialize a Reporter object.

Usage

Reporter$new()

Returns

Object of class Reporter, invisibly.

Examples

reporter <- Reporter$new()


Method append_cards()

Append one or more ReportCard objects to the Reporter.

Usage

Reporter$append_cards(cards)

Arguments

cards

(ReportCard) or a list of such objects

Returns

self, invisibly.


Method get_cards()

Retrieves all ReportCard objects contained in the Reporter.

Usage

Reporter$get_cards()

Returns

A (list) of ReportCard objects.


Method get_blocks()

Compiles and returns all content blocks from the ReportCard in the Reporter.

Usage

Reporter$get_blocks(sep = NewpageBlock$new())

Arguments

sep

An optional separator to insert between each content block. Default is a NewpageBlock$new()object.

Returns

list() list of TableBlock, TextBlock, PictureBlock and NewpageBlock.


Method reset()

Resets the Reporter, removing all ReportCard objects and metadata.

Usage

Reporter$reset()

Returns

self, invisibly.


Method remove_cards()

Removes specific ReportCard objects from the Reporter by their indices.

Usage

Reporter$remove_cards(ids = NULL)

Arguments

ids

(integer(id)) the indexes of cards

Returns

self, invisibly.


Method swap_cards()

Swaps the positions of two ReportCard objects within the Reporter.

Usage

Reporter$swap_cards(start, end)

Arguments

start

(integer) the index of the first card

end

(integer) the index of the second card

Returns

self, invisibly.


Method get_reactive_add_card()

Gets the current value of the reactive variable for adding cards.

Usage

Reporter$get_reactive_add_card()

Returns

reactive_add_card current numeric value of the reactive variable.

Examples

library(shiny)

isolate(Reporter$new()$get_reactive_add_card())


Method get_metadata()

Get the metadata associated with this Reporter.

Usage

Reporter$get_metadata()

Returns

named list of metadata to be appended.

Examples

reporter <- Reporter$new()$append_metadata(list(sth = "sth"))
reporter$get_metadata()


Method append_metadata()

Appends metadata to this Reporter.

Usage

Reporter$append_metadata(meta)

Arguments

meta

(named list) of metadata to be appended.

Returns

self, invisibly.

Examples

reporter <- Reporter$new()$append_metadata(list(sth = "sth"))
reporter$get_metadata()


Method from_reporter()

Reinitializes a Reporter instance by copying the report cards and metadata from another Reporter.

Usage

Reporter$from_reporter(reporter)

Arguments

reporter

(Reporter) instance to copy from.

Returns

invisibly self

Examples

reporter <- Reporter$new()
reporter$from_reporter(reporter)


Method to_list()

Convert a Reporter to a list and transfer any associated files to specified directory.

Usage

Reporter$to_list(output_dir)

Arguments

output_dir

(character(1)) a path to the directory where files will be copied.

Returns

named list representing the Reporter instance, including version information, metadata, and report cards.

Examples

reporter <- Reporter$new()
tmp_dir <- file.path(tempdir(), "testdir")
dir.create(tmp_dir)
reporter$to_list(tmp_dir)


Method from_list()

Reinitializes a Reporter from a list representation and associated files in a specified directory.

Usage

Reporter$from_list(rlist, output_dir)

Arguments

rlist

(named list) representing a Reporter instance.

output_dir

(character(1)) a path to the directory from which files will be copied.

Returns

self, invisibly.

Examples

reporter <- Reporter$new()
tmp_dir <- file.path(tempdir(), "testdir")
unlink(tmp_dir, recursive = TRUE)
dir.create(tmp_dir)
reporter$from_list(reporter$to_list(tmp_dir), tmp_dir)


Method to_jsondir()

Serializes the Reporter to a JSON file and copies any associated files to a specified directory.

Usage

Reporter$to_jsondir(output_dir)

Arguments

output_dir

(character(1)) a path to the directory where files will be copied, JSON and statics.

Returns

output_dir argument.

Examples

reporter <- Reporter$new()
tmp_dir <- file.path(tempdir(), "jsondir")
dir.create(tmp_dir)
reporter$to_jsondir(tmp_dir)


Method from_jsondir()

Reinitializes a Reporter from a JSON file and files in a specified directory.

Usage

Reporter$from_jsondir(output_dir)

Arguments

output_dir

(character(1)) a path to the directory with files, JSON and statics.

Returns

self, invisibly.

Examples

reporter <- Reporter$new()
tmp_dir <- file.path(tempdir(), "jsondir")
dir.create(tmp_dir)
unlink(list.files(tmp_dir, recursive = TRUE))
reporter$to_jsondir(tmp_dir)
reporter$from_jsondir(tmp_dir)


Method set_id()

Set the Reporter id Optionally add id to a Reporter which will be compared when it is rebuilt from a list. The id is added to the downloaded file name.

Usage

Reporter$set_id(id)

Arguments

id

(character(1)) a Report id.

Returns

self, invisibly.


Method get_id()

Get the Reporter id

Usage

Reporter$get_id()

Returns

character(1) the Reporter id.


Method clone()

The objects of this class are cloneable with this method.

Usage

Reporter$clone(deep = FALSE)

Arguments

deep

Whether to make a deep clone.

Examples

library(ggplot2)
library(rtables)

card1 <- ReportCard$new()

card1$append_text("Header 2 text", "header2")
card1$append_text("A paragraph of default text", "header2")
card1$append_plot(
  ggplot(iris, aes(x = Petal.Length)) + geom_histogram()
)
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

card2 <- ReportCard$new()

card2$append_text("Header 2 text", "header2")
card2$append_text("A paragraph of default text", "header2")
lyt <- analyze(split_rows_by(basic_table(), "Day"), "Ozone", afun = mean)
table_res2 <- build_table(lyt, airquality)
#> Split var [Day] was not character or factor. Converting to factor
card2$append_table(table_res2)
card2$append_table(iris)

reporter <- Reporter$new()
reporter$append_cards(list(card1, card2))
library(ggplot2)
library(rtables)

card1 <- ReportCard$new()

card1$append_text("Header 2 text", "header2")
card1$append_text("A paragraph of default text", "header2")
card1$append_plot(
 ggplot(iris, aes(x = Petal.Length)) + geom_histogram()
)
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

card2 <- ReportCard$new()

card2$append_text("Header 2 text", "header2")
card2$append_text("A paragraph of default text", "header2")
lyt <- analyze(split_rows_by(basic_table(), "Day"), "Ozone", afun = mean)
table_res2 <- build_table(lyt, airquality)
#> Split var [Day] was not character or factor. Converting to factor
card2$append_table(table_res2)
card2$append_table(iris)

reporter <- Reporter$new()
reporter$append_cards(list(card1, card2))
reporter$get_cards()
#> [[1]]
#> <ReportCard>
#>   Public:
#>     append_content: function (content) 
#>     append_metadata: function (key, value) 
#>     append_plot: function (plot, dim = NULL) 
#>     append_rcode: function (text, ...) 
#>     append_table: function (table) 
#>     append_text: function (text, style = TextBlock$new()$get_available_styles()[1]) 
#>     clone: function (deep = FALSE) 
#>     from_list: function (card, output_dir) 
#>     get_content: function () 
#>     get_metadata: function () 
#>     get_name: function () 
#>     initialize: function () 
#>     reset: function () 
#>     set_name: function (name) 
#>     to_list: function (output_dir) 
#>   Private:
#>     content: list
#>     deep_clone: function (name, value) 
#>     dispatch_block: function (block_class) 
#>     metadata: list
#>     name: 
#> 
#> [[2]]
#> <ReportCard>
#>   Public:
#>     append_content: function (content) 
#>     append_metadata: function (key, value) 
#>     append_plot: function (plot, dim = NULL) 
#>     append_rcode: function (text, ...) 
#>     append_table: function (table) 
#>     append_text: function (text, style = TextBlock$new()$get_available_styles()[1]) 
#>     clone: function (deep = FALSE) 
#>     from_list: function (card, output_dir) 
#>     get_content: function () 
#>     get_metadata: function () 
#>     get_name: function () 
#>     initialize: function () 
#>     reset: function () 
#>     set_name: function (name) 
#>     to_list: function (output_dir) 
#>   Private:
#>     content: list
#>     deep_clone: function (name, value) 
#>     dispatch_block: function (block_class) 
#>     metadata: list
#>     name: 
#> 
library(ggplot2)
library(rtables)

card1 <- ReportCard$new()

card1$append_text("Header 2 text", "header2")
card1$append_text("A paragraph of default text", "header2")
card1$append_plot(
 ggplot(iris, aes(x = Petal.Length)) + geom_histogram()
)
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

card2 <- ReportCard$new()

card2$append_text("Header 2 text", "header2")
card2$append_text("A paragraph of default text", "header2")
lyt <- analyze(split_rows_by(basic_table(), "Day"), "Ozone", afun = mean)
table_res2 <- build_table(lyt, airquality)
#> Split var [Day] was not character or factor. Converting to factor
card2$append_table(table_res2)
card2$append_table(iris)

reporter <- Reporter$new()
reporter$append_cards(list(card1, card2))
reporter$get_blocks()
#> [[1]]
#> <TextBlock>
#>   Inherits from: <ContentBlock>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     from_list: function (x) 
#>     get_available_styles: function () 
#>     get_content: function () 
#>     get_style: function () 
#>     initialize: function (content = character(0), style = private$styles[1]) 
#>     set_content: function (content) 
#>     set_style: function (style) 
#>     to_list: function () 
#>   Private:
#>     content: Header 2 text
#>     deep_clone: function (name, value) 
#>     style: header2
#>     styles: default header2 header3 verbatim
#> 
#> [[2]]
#> <TextBlock>
#>   Inherits from: <ContentBlock>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     from_list: function (x) 
#>     get_available_styles: function () 
#>     get_content: function () 
#>     get_style: function () 
#>     initialize: function (content = character(0), style = private$styles[1]) 
#>     set_content: function (content) 
#>     set_style: function (style) 
#>     to_list: function () 
#>   Private:
#>     content: A paragraph of default text
#>     deep_clone: function (name, value) 
#>     style: header2
#>     styles: default header2 header3 verbatim
#> 
#> [[3]]
#> <PictureBlock>
#>   Inherits from: <FileBlock>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     finalize: function () 
#>     from_list: function (x, output_dir) 
#>     get_content: function () 
#>     get_dim: function () 
#>     get_title: function () 
#>     initialize: function (plot) 
#>     set_content: function (content) 
#>     set_dim: function (dim) 
#>     set_title: function (title) 
#>     to_list: function (output_dir) 
#>   Private:
#>     content: /tmp/Rtmp6zo0Jn/file39341333b7d.png
#>     deep_clone: function (name, value) 
#>     dim: 800 600
#>     supported_plots: ggplot grob trellis Heatmap
#>     title: 
#>     type: 
#> 
#> [[4]]
#> <NewpageBlock>
#>   Inherits from: <ContentBlock>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     from_list: function (x) 
#>     get_content: function () 
#>     initialize: function () 
#>     set_content: function (content) 
#>     to_list: function () 
#>   Private:
#>     content: 
#>     \newpage
#> 
#>     deep_clone: function (name, value) 
#> 
#> [[5]]
#> <TextBlock>
#>   Inherits from: <ContentBlock>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     from_list: function (x) 
#>     get_available_styles: function () 
#>     get_content: function () 
#>     get_style: function () 
#>     initialize: function (content = character(0), style = private$styles[1]) 
#>     set_content: function (content) 
#>     set_style: function (style) 
#>     to_list: function () 
#>   Private:
#>     content: Header 2 text
#>     deep_clone: function (name, value) 
#>     style: header2
#>     styles: default header2 header3 verbatim
#> 
#> [[6]]
#> <TextBlock>
#>   Inherits from: <ContentBlock>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     from_list: function (x) 
#>     get_available_styles: function () 
#>     get_content: function () 
#>     get_style: function () 
#>     initialize: function (content = character(0), style = private$styles[1]) 
#>     set_content: function (content) 
#>     set_style: function (style) 
#>     to_list: function () 
#>   Private:
#>     content: A paragraph of default text
#>     deep_clone: function (name, value) 
#>     style: header2
#>     styles: default header2 header3 verbatim
#> 
#> [[7]]
#> <TableBlock>
#>   Inherits from: <FileBlock>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     finalize: function () 
#>     from_list: function (x, output_dir) 
#>     get_content: function () 
#>     initialize: function (table) 
#>     set_content: function (content) 
#>     to_list: function (output_dir) 
#>   Private:
#>     content: /tmp/Rtmp6zo0Jn/file39321ff7aa4.rds
#>     deep_clone: function (name, value) 
#>     supported_tables: data.frame rtables TableTree ElementaryTable listing_df
#> 
#> [[8]]
#> <TableBlock>
#>   Inherits from: <FileBlock>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     finalize: function () 
#>     from_list: function (x, output_dir) 
#>     get_content: function () 
#>     initialize: function (table) 
#>     set_content: function (content) 
#>     to_list: function (output_dir) 
#>   Private:
#>     content: /tmp/Rtmp6zo0Jn/file393706d3945.rds
#>     deep_clone: function (name, value) 
#>     supported_tables: data.frame rtables TableTree ElementaryTable listing_df
#> 

## ------------------------------------------------
## Method `Reporter$new`
## ------------------------------------------------

reporter <- Reporter$new()


## ------------------------------------------------
## Method `Reporter$get_reactive_add_card`
## ------------------------------------------------

library(shiny)

isolate(Reporter$new()$get_reactive_add_card())
#> [1] 0

## ------------------------------------------------
## Method `Reporter$get_metadata`
## ------------------------------------------------

reporter <- Reporter$new()$append_metadata(list(sth = "sth"))
reporter$get_metadata()
#> $sth
#> [1] "sth"
#> 


## ------------------------------------------------
## Method `Reporter$append_metadata`
## ------------------------------------------------

reporter <- Reporter$new()$append_metadata(list(sth = "sth"))
reporter$get_metadata()
#> $sth
#> [1] "sth"
#> 


## ------------------------------------------------
## Method `Reporter$from_reporter`
## ------------------------------------------------

reporter <- Reporter$new()
reporter$from_reporter(reporter)

## ------------------------------------------------
## Method `Reporter$to_list`
## ------------------------------------------------

reporter <- Reporter$new()
tmp_dir <- file.path(tempdir(), "testdir")
dir.create(tmp_dir)
reporter$to_list(tmp_dir)
#> $name
#> [1] "teal Reporter"
#> 
#> $version
#> [1] "1"
#> 
#> $id
#> [1] ""
#> 
#> $cards
#> list()
#> 
#> $metadata
#> list()
#> 

## ------------------------------------------------
## Method `Reporter$from_list`
## ------------------------------------------------

reporter <- Reporter$new()
tmp_dir <- file.path(tempdir(), "testdir")
unlink(tmp_dir, recursive = TRUE)
dir.create(tmp_dir)
reporter$from_list(reporter$to_list(tmp_dir), tmp_dir)

## ------------------------------------------------
## Method `Reporter$to_jsondir`
## ------------------------------------------------

reporter <- Reporter$new()
tmp_dir <- file.path(tempdir(), "jsondir")
dir.create(tmp_dir)
reporter$to_jsondir(tmp_dir)
#> [1] "/tmp/Rtmp6zo0Jn/jsondir"

## ------------------------------------------------
## Method `Reporter$from_jsondir`
## ------------------------------------------------

reporter <- Reporter$new()
tmp_dir <- file.path(tempdir(), "jsondir")
dir.create(tmp_dir)
#> Warning: '/tmp/Rtmp6zo0Jn/jsondir' already exists
unlink(list.files(tmp_dir, recursive = TRUE))
reporter$to_jsondir(tmp_dir)
#> [1] "/tmp/Rtmp6zo0Jn/jsondir"
reporter$from_jsondir(tmp_dir)