hafen / trelliscopejs

Compare b69e92f ... +12 ... 6b148a0

No flags found

Use flags to group coverage reports by test type, project and/or folders.
Then setup custom commit statuses and notifications for each flag.

e.g., #unittest #integration

#production #enterprise

#frontend #backend

Learn more about Codecov Flags here.


@@ -11,7 +11,8 @@
Loading
11 11
    self_contained = self_contained,
12 12
    latest_display = latest_display,
13 13
    spa = spa,
14 -
    in_knitr = getOption("knitr.in.progress", FALSE),
14 +
    in_knitr = is_in_knitr(),
15 +
    in_shiny = is_in_shiny(),
15 16
    in_notebook = in_rmarkdown_notebook())
16 17
17 18
  if (spa) {

@@ -30,16 +30,16 @@
Loading
30 30
make_png <- function(p, file, width, height, orig_width = width, res = 72,
31 31
  base_point_size = 12, pixelratio = 2) {
32 32
33 -
  if (capabilities("aqua")) {
34 -
    pngfun <- grDevices::png
35 -
  } else {
36 -
    pkg <- "Cairo" # nolint
37 -
    if (suppressWarnings(suppressMessages(require(pkg, character.only = TRUE)))) {
38 -
      pngfun <- Cairo::CairoPNG
39 -
    } else {
40 -
      pngfun <- grDevices::png
41 -
    }
42 -
  }
33 +
  pngfun <- grDevices::png
34 +
  # if (capabilities("aqua")) {
35 +
  # } else {
36 +
  #   pkg <- "Cairo" # nolint
37 +
  #   if (suppressWarnings(suppressMessages(require(pkg, character.only = TRUE)))) {
38 +
  #     pngfun <- Cairo::CairoPNG
39 +
  #   } else {
40 +
  #     pngfun <- grDevices::png
41 +
  #   }
42 +
  # }
43 43
44 44
  units <- get_png_units(width, height, orig_width, res,
45 45
    base_point_size, pixelratio)
@@ -50,6 +50,7 @@
Loading
50 50
    height = units$height,
51 51
    pointsize = units$pointsize)
52 52
53 +
  unknown_object <- FALSE
53 54
  dv <- grDevices::dev.cur()
54 55
  tryCatch({
55 56
    if (inherits(p, "trellis")) {
@@ -59,13 +60,21 @@
Loading
59 60
      print(p)
60 61
    } else if (inherits(p, "gtable")) {
61 62
      grid::grid.draw(p)
63 +
    } else {
64 +
      unknown_object <- TRUE
65 +
      try(print(p), silent = TRUE)
62 66
    }
63 67
  },
64 68
  finally = grDevices::dev.off(dv))
65 69
66 70
  # if panel function didn't plot anything then make a blank panel
67 71
  # res = res * pixelratio,
68 72
  if (!file.exists(file)) {
73 +
    if (unknown_object) {
74 +
      cls <- paste(class(p), collapse = ", ")
75 +
      message("The panel object of class'", cls,
76 +
        "' is not a standard plot object and did not produce a panel file.")
77 +
    }
69 78
    pngfun(filename = file, width = width * pixelratio, height = height * pixelratio,
70 79
      pointsize = units$pointsize)
71 80
    blank_image("no panel")

@@ -128,6 +128,31 @@
Loading
128 128
  type
129 129
}
130 130
131 +
#' Helper function for creating a cognostic for a link to another display in a filtered state
132 +
#' @param display A string indicating the name of the display to link to.
133 +
#' @param var A string indicating the variable name to filter on.
134 +
#' @param val A string indicating the value of the filter.
135 +
#' @param desc a description for this cognostic value
136 +
#' @param group optional categorization of the cognostic for organizational purposes in the viewer (currently not implemented in the viewer)
137 +
#' @param default_label should this cognostic be used as a panel label in the viewer by default?
138 +
#' @param default_active should this cognostic be active (available for sort / filter / sample) by default?
139 +
#' @param filterable should this cognostic be filterable?  Default is \code{TRUE}.  It can be useful to set this to \code{FALSE} if the cognostic is categorical with many unique values and is only desired to be used as a panel label.
140 +
#' @param sortable should this cognostic be sortable?
141 +
#' @export
142 +
cog_disp_filter <- function(display, var, val,
143 +
  desc = "link", group = "common",
144 +
  default_label = FALSE, default_active = FALSE,
145 +
  filterable = FALSE, sortable = FALSE) {
146 +
  x <- paste0("#display=", display, "&filter=var:",
147 +
    var, ";type:select;val:", val)
148 +
149 +
  cog(x, type = "href", desc = desc, group = group, 
150 +
    default_label = default_label,
151 +
    default_active = default_active,
152 +
    filterable = filterable, sortable = sortable,
153 +
    log = FALSE)
154 +
}
155 +
131 156
#' Href Cognostic
132 157
#'
133 158
#' Create href to be used as cognostics in a trelliscope display
@@ -274,7 +299,6 @@
Loading
274 299
  )
275 300
}
276 301
277 -
278 302
#' @importFrom autocogs panel_cogs
279 303
cog_df_info <- function(x, panel_col, state, auto_cog = FALSE, nested_data_list = NULL,
280 304
  nested_cog_attrs = NULL) {

@@ -18,6 +18,7 @@
Loading
18 18
#' @param as_plotly should the panels be written as plotly objects?
19 19
#' @param plotly_args optional named list of arguments to send to \code{ggplotly}
20 20
#' @param plotly_cfg optional named list of arguments to send to plotly's \code{config} method
21 +
#' @param split_sig optional string that specifies the "signature" of the data splitting. If not specified, this is calculated as the md5 hash of the sorted unique facet variables. This is used to identify "related displays" - different displays that are based on the same faceting scheme. This parameter should only be specified manually if a display's faceting is mostly similar to another display's.
21 22
#' @param self_contained should the Trelliscope display be a self-contained html document? (see note)
22 23
#' @param thumb should a thumbnail be created?
23 24
#' @param auto_cog should auto cogs be computed (if possible)?
@@ -27,13 +28,14 @@
Loading
27 28
#' @export
28 29
#' @example man-roxygen/ex-facet_trelliscope.R
29 30
#' @importFrom ggplot2 facet_wrap
31 +
#' @importFrom rlang as_name
30 32
facet_trelliscope <- function(
31 33
  facets,
32 34
  nrow = 1, ncol = 1, scales = "same", name = NULL, group = "common",
33 35
  desc = ggplot2::waiver(), md_desc = ggplot2::waiver(), path = NULL,
34 36
  height = 500, width = 500,
35 37
  state = NULL, jsonp = TRUE, as_plotly = FALSE,
36 -
  plotly_args = NULL, plotly_cfg = NULL,
38 +
  plotly_args = NULL, plotly_cfg = NULL, split_sig = NULL,
37 39
  self_contained = FALSE, thumb = TRUE, auto_cog = FALSE,
38 40
  split_layout = FALSE, data = ggplot2::waiver()
39 41
) {
@@ -61,6 +63,7 @@
Loading
61 63
    width = width,
62 64
    state = state,
63 65
    jsonp = jsonp,
66 +
    split_sig = split_sig,
64 67
    path = path,
65 68
    self_contained = self_contained,
66 69
    nrow = nrow,
@@ -79,27 +82,40 @@
Loading
79 82
  ret
80 83
}
81 84
82 -
#' Add method for gg / facet_trelliscope
83 -
#' @param e1 a object with class gg
84 -
#' @param e2 if object is of class 'facet_trelliscope', then 'facet_trelliscope' will be appended to the class of e1
85 85
#' @export
86 -
#' @importFrom ggplot2 %+%
87 -
`+.gg` <- function (e1, e2) {
88 -
  if (inherits(e2, "facet_trelliscope")) {
89 -
90 -
    # e1 <- e1 %+% (e2$facet_wrap)
91 -
    attr(e1, "trelliscope") <- e2[c("facets", "facet_cols", "name", "group",
86 +
ggplot_add.facet_trelliscope <- function(object, plot, object_name) {
87 +
  attr(plot, "trelliscope") <- object[
88 +
    c("facets", "facet_cols", "name", "group",
92 89
      "desc", "md_desc", "height", "width", "state", "jsonp", "self_contained",
93 90
      "path", "state", "nrow", "ncol", "scales", "thumb", "as_plotly",
94 -
      "plotly_args", "plotly_cfg", "auto_cog", "split_layout", "data")]
95 -
    class(e1) <- c("facet_trelliscope", class(e1))
96 -
    return(e1)
97 -
    # return(print(e1))
98 -
  }
99 -
100 -
  e1 %+% e2
91 +
      "split_sig", "plotly_args", "plotly_cfg", "auto_cog", "split_layout",
92 +
      "data")]
93 +
  class(plot) <- c("facet_trelliscope", class(plot))
94 +
  return(plot)
101 95
}
102 96
97 +
# #' Add method for gg / facet_trelliscope
98 +
# #' @param e1 a object with class gg
99 +
# #' @param e2 if object is of class 'facet_trelliscope', then 'facet_trelliscope' will be appended to the class of e1
100 +
# #' @export
101 +
# #' @importFrom ggplot2 %+%
102 +
# `+.gg` <- function (e1, e2) {
103 +
#   if (inherits(e2, "facet_trelliscope")) {
104 +
105 +
#     # e1 <- e1 %+% (e2$facet_wrap)
106 +
#     attr(e1, "trelliscope") <- e2[c("facets", "facet_cols", "name", "group",
107 +
#       "desc", "md_desc", "height", "width", "state", "jsonp", "self_contained",
108 +
#       "path", "state", "nrow", "ncol", "scales", "thumb", "as_plotly",
109 +
#       "split_sig", "plotly_args", "plotly_cfg", "auto_cog", "split_layout",
110 +
#       "data")]
111 +
#     class(e1) <- c("facet_trelliscope", class(e1))
112 +
#     return(e1)
113 +
#     # return(print(e1))
114 +
#   }
115 +
116 +
#   e1 %+% e2
117 +
# }
118 +
103 119
104 120
#' Print facet trelliscope object
105 121
#'
@@ -149,9 +165,9 @@
Loading
149 165
      "or in the 'data' parameter")
150 166
  }
151 167
152 -
  # character vect of facet columns
168 +
  # character vector of facet columns
153 169
  # TODO need to work with facet_trelliscope(~ disp < 5)
154 -
  facet_cols <- unlist(lapply(attrs$facet_cols, as.character))
170 +
  facet_cols <- unlist(lapply(attrs$facet_cols, rlang::as_name))
155 171
  facet_cols <- setdiff(facet_cols, "~")
156 172
  if (!all(facet_cols %in% names(data))) {
157 173
    stop("all facet_trelliscope facet columns must be found in the ",
@@ -181,7 +197,18 @@
Loading
181 197
  # wrapper function that swaps out the data with a subset and removes the facet
182 198
  make_plot_obj <- function(dt, pos = -1) {
183 199
    q <- p
184 -
    q$data <- tidyr::unnest(dt)
200 +
    # dt$data <- lapply(dt$data, function(x) {
201 +
    #   idx <- which(unlist(lapply(x, function(a) inherits(a, "cog"))))
202 +
    #   for (ii in idx) {
203 +
    #     class(x[[ii]]) <- setdiff(class(x[[ii]]), "cog")
204 +
    #   }
205 +
    #   x
206 +
    # })
207 +
    # q$data <- tidyr::unnest(dt, data)
208 +
    nms <- setdiff(names(dt), "data")
209 +
    tmp <- dt$data[[1]]
210 +
    for (nm in nms) tmp[[nm]] <- dt[[nm]]
211 +
    q$data <- tmp[, c(nms, setdiff(names(tmp), nms))]
185 212
    q <- add_trelliscope_scales(q, scales_info, show_warnings = (pos == 1))
186 213
    q
187 214
  }
@@ -224,8 +251,8 @@
Loading
224 251
    name <- paste("by_", paste(facet_cols, collapse = "_"), sep = "")
225 252
226 253
  params <- resolve_app_params(attrs$path, attrs$self_contained, attrs$jsonp,
227 -
    name, attrs$group, attrs$state, attrs$nrow, attrs$ncol, attrs$thumb,
228 -
    attrs$split_layout)
254 +
    attrs$split_sig, name, attrs$group, attrs$state, attrs$nrow, attrs$ncol,
255 +
    attrs$thumb, attrs$split_layout)
229 256
230 257
  pb <- progress::progress_bar$new(
231 258
    format = ":what [:bar] :percent :current/:total eta::eta",
@@ -289,6 +316,7 @@
Loading
289 316
    split_layout = params$split_layout,
290 317
    split_aspect = split_aspect,
291 318
    has_legend,
319 +
    split_sig = params$split_sig,
292 320
    pb = pb
293 321
  )
294 322
@@ -307,8 +335,8 @@
Loading
307 335
    spa = params$spa
308 336
  )
309 337
310 -
  # return early for knitr
311 -
  if (params$in_knitr) {
338 +
  # return early for knitr or shiny
339 +
  if (params$in_knitr || params$in_shiny) {
312 340
    return(res)
313 341
  }
314 342

@@ -10,3 +10,23 @@
Loading
10 10
sort_spec <- function(name, dir = "asc") {
11 11
  list(name = name, dir = dir)
12 12
}
13 +
14 +
# #' Specify how a display should be filtered
15 +
# #'
16 +
# #' @param name variable name to sort on
17 +
# #' @param type either "select" or "regex"
18 +
# #' @param value If \code{type} is "select", a vector of values to select. If \code{type} is "regex", a string indicating a regular expression
19 +
# filter_cat_spec <- function(name, type = c("select", "regex"), value) {
20 +
#   if (type == "regex" && length(value) > 1)
21 +
#     stop_nice("If specifying a filter of type 'regex', the value must be a string.")
22 +
#   list(name = name, type = type, value = value)
23 +
# }
24 +
25 +
# #' Specify how a display should be filtered
26 +
# #'
27 +
# #' @param name variable name to sort on
28 +
# #' @param type either "select" or "regex"
29 +
# #' @param value If \code{type} is "select", a vector of values to select. If \code{type} is "regex", a string indicating a regular expression
30 +
# filter_num_spec <- function(name, from = NA, to = NA) {
31 +
#   list(name = name, from = from, to = to)
32 +
# }

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Learn more Showing 9 files with coverage changes found.

Changes in R/tidy.R
-6
-2
Loading file...
Changes in R/helpers.R
-23
Loading file...
Changes in R/json_writers.R
-10
Loading file...
Changes in R/trelliscope.R
-8
Loading file...
Changes in R/make_png.R
-1
Loading file...
Changes in R/cog.R
-14
Loading file...
Changes in R/facet_trelliscope.R
-21
-11
Loading file...
Changes in R/thumbnail.R
-1
Loading file...
Changes in R/htmlwidget.R
-3
-1
Loading file...
Files Coverage
R -1.39% 75.82%
Project Totals (11 files) 75.82%
Loading