File: print.R

package info (click to toggle)
r-cran-ggvis 0.4.4%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 1,716 kB
  • sloc: sh: 25; makefile: 2
file content (178 lines) | stat: -rw-r--r-- 5,580 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
# There are five way to display a ggvis plot:
#   * static html file (static plot)
#     * print.ggvis -> view_static -> ggvisLayout -> ggvisElements
#     * Doesn't need shiny
#     * Needs embedded spec
#
#   * temporary shiny app (dynamic plot)
#     * print.ggvis -> view_dynamic -> ggvis_app -> ggvisLayout -> ggvisElements
#     * Needs shiny
#     * Doesn't need embedded spec
#
#   * static html embedded in Rmarkdown
#     * knit_print.ggvis -> ggvisElements
#     * Doesn't need shiny
#     * Needs embedded spec
#
#   * shiny app embedded in Rmarkdown
#     * knit_print.ggvis -> ggvis_app -> ggvisLayout -> ggvisElements
#     * Needs shiny
#     * Doesn't need embedded spec
#
#   * embedded in regular shiny app
#     * call ggvisOutput in ui.R
#     * Needs shiny
#     * Doesn't need embedded spec

#' View in a ggvis plot in the browser.
#'
#' \code{view_static} creates a static web page in a temporary directory;
#' \code{view_dynamic} generate a dynamic shiny app and launches it.
#' \code{print} automatically picks between the two.
#'
#' If \code{view_static} is used on a ggvis object that has dynamic components,
#' it will output a static plot.
#'
#' @param x A ggvis object.
#' @param dynamic Uses \code{view_dynamic} if \code{TRUE}, \code{view_static} if
#'   \code{FALSE}. The default, \code{NA}, chooses automatically based on the
#'   presence of reactives or interactive inputs in \code{x}.
#' @param launch If \code{TRUE}, will launch plot in a viewer/browser. If
#'   \code{FALSE} returns an object that you can \code{print()} to launch.
#' @param ... Other arguments passed on to \code{view_dynamic} and
#'   \code{view_static} ?from \code{print}.
#' @keywords internal
#' @method print ggvis
#' @export
print.ggvis <- function(x, dynamic = NA, launch = interactive(), ...) {
  if (is.na(dynamic)) {
    dynamic <- is.dynamic(x) && interactive()
  }

  if (dynamic) {
    out <- view_dynamic(x, ...)
  } else {
    out <- view_static(x, ...)
  }

  if (launch) print(out)
  out
}

#' @rdname print.ggvis
#' @export
#' @param plot_id Unique identifier used to identify the plot on the page.
#' @param dest Deprecated (this no longer works).
#' @examples
#' # In most cases view_static is unnecessary; these will do the same thing:
#' mtcars %>% ggvis(~wt, ~mpg)
#' mtcars %>% ggvis(~wt, ~mpg) %>% view_static()
#'
#' # Can find the output file with view_static() and html_print()
#' outfile <- mtcars %>% ggvis(~wt, ~mpg) %>%
#'   view_static() %>% htmltools::html_print(viewer = NULL)
view_static <- function(x, plot_id = rand_id("plot_"), dest = NULL) {


  if (!missing(dest)) {
    deprecated("dest", msg = " Please see ?view_static for more information.")
  }

  spec <- as.vega(x, dynamic = FALSE)
  htmltools::browsable(
    ggvisLayout(plot_id, length(x$controls) > 0, spec, shiny = FALSE)
  )
}

#' @rdname print.ggvis
#' @export
#' @param port the port on which to start the shiny app. If NULL (the default),
#'   Shiny will select a random port.
#' @param quiet If \code{TRUE} show status messages from Shiny. (Default is
#'   \code{FALSE}.)
view_dynamic <- function(x, plot_id = rand_id("plot_"), port = NULL,
                         quiet = FALSE) {

  ggvis_app(x,
    plot_id = plot_id,
    port = port,
    quiet = TRUE,
    launch.browser = function(url) {
      if (!quiet) {
        message("Showing dynamic visualisation. Press Escape/Ctrl + C to stop.")
      }
      view_plot(url, 350 + control_height(x))
    }
  )
}


# Dynamically registered. See zzz.R.
#' Knit print method for ggvis plots.
#'
#' @keywords internal
knit_print.ggvis <- function(x, options = list(), inline = FALSE, ...) {
  # Set height and width from knitr chunk options
  knitr_opts <- list(
    width = options$out.width.px,
    height = options$out.height.px
  )
  x <- add_options(x, knitr_opts, replace = FALSE)

  # If this is a dynamic object, check to see if we're rendering in a Shiny R
  # Markdown document and have an appropriate version of Shiny; emit a Shiny
  # application if we are, and a warning if we aren't.
  if (is.dynamic(x)) {
    if (identical(runtime(), "shiny")) {
      # create the application object and allocate space for the controls
      app <- ggvis_app(x,
        width = knitr_opts$width,
        height = knitr_opts$height + control_height(x)
      )
      return(knitr::knit_print(app))
    }

    warning(
      "Can't output dynamic/interactive ggvis plots in a knitr document.\n",
      "Generating a static (non-dynamic, non-interactive) version of the plot.",
      call. = FALSE
    )
  }

  # If we got here, it's static
  spec <- as.vega(x, dynamic = FALSE)
  knitr::knit_print(ggvisOutputElements(spec = spec, shiny = FALSE))
}

# Helper functions -------------------------------------------------------------

runtime <- function() {
  knitr::opts_knit$get("rmarkdown.runtime")
}

#' Determine if an ggvis is dynamic (i.e. needs to be run in a shiny app)
#'
#' @export
#' @keywords internal
is.dynamic <- function(x) {
  any_apply(x$data, shiny::is.reactive) || length(x$reactives) > 0
}

# View using either an internal viewer or fallback to utils::browseURL
view_plot <- function(url, height) {
  viewer <- getOption("viewer")
  if (!is.null(viewer)) {
    viewer(url, height)
  } else {
    utils::browseURL(url)
  }
}

# given a ggvis object, return the number of pixels to reserve for its controls.
control_height <- function(x) {
  n_controls <- length(x$controls)

  # Request 70 vertical pixels for each pair of control items, since there are
  # two on a row.
  70 * ceiling(n_controls / 2)
}