')
20 | )
21 | ),
22 | tags$div(
23 | class="collapse navbar-collapse",
24 | id="menu",
25 | tags$ul(
26 | class="navbar-nav mr-4",
27 | tagList(
28 | purrr::imap(
29 | x, nav_item
30 | )
31 | )
32 | )
33 | )
34 | ) %>% tags$div(class = "plpl")
35 | }
36 |
37 | #' @importFrom htmltools tags
38 | #' @importFrom glue glue
39 | nav_item <- function(label, id){
40 | tags$li(
41 | class="nav-item",
42 | tags$a(
43 | class="nav-link",
44 | `data-value` = label,
45 | onclick = glue(
46 | '$( "a.nav-link" ).removeClass("active");
47 | $( this ).addClass("active");
48 | $( ".row" ).hide();
49 | $( "#{id}" ).show();
50 | $( "#{id}" ).trigger("show");
51 | $( "#{id}" ).trigger("shown")'
52 | ),
53 | label
54 | )
55 | )
56 | }
--------------------------------------------------------------------------------
/R/globals.R:
--------------------------------------------------------------------------------
1 | globalVariables(
2 | c(
3 | "big_epa_cars"
4 | )
5 | )
--------------------------------------------------------------------------------
/R/golem_utils_server.R:
--------------------------------------------------------------------------------
1 | # Inverted versions of in, is.null and is.na
2 | `%not_in%` <- Negate(`%in%`)
3 |
4 | not_null <- Negate(is.null)
5 |
6 | not_na <- Negate(is.na)
7 |
8 | # Removes the null from a vector
9 | drop_nulls <- function(x){
10 | x[!sapply(x, is.null)]
11 | }
12 |
13 | # If x is null, return y, otherwise return x
14 | "%||%" <- function(x, y){
15 | if (is.null(x)) {
16 | y
17 | } else {
18 | x
19 | }
20 | }
21 | # If x is NA, return y, otherwise return x
22 | "%|NA|%" <- function(x, y){
23 | if (is.na(x)) {
24 | y
25 | } else {
26 | x
27 | }
28 | }
29 |
30 | # typing reactiveValues is too long
31 | rv <- shiny::reactiveValues
32 | rvtl <- shiny::reactiveValuesToList
--------------------------------------------------------------------------------
/R/golem_utils_ui.R:
--------------------------------------------------------------------------------
1 | # Turn an R list into an HTML list
2 | #
3 | # @param list An R list
4 | # @param class a class for the list
5 | # @return an HTML list
6 | # @examples
7 | # list_to_li(c("a","b"))
8 | #
9 | #' @importFrom htmltools tags tagAppendAttributes tagList
10 | list_to_li <- function(list, class = NULL){
11 | if (is.null(class)){
12 | tagList(lapply(list, tags$li))
13 | } else {
14 | res <- lapply(list, tags$li)
15 | res <- lapply(res, function(x) tagAppendAttributes(x, class = class))
16 | tagList(res)
17 | }
18 |
19 | }
20 |
21 | #' @importFrom htmltools tags tagAppendAttributes tagList
22 | list_to_p <- function(list, class = NULL){
23 | if (is.null(class)){
24 | tagList(lapply(list, tags$p))
25 | } else {
26 | res <- lapply(list, tags$p)
27 | res <- lapply(res, function(x) tagAppendAttributes(x, class = class))
28 | tagList(res)
29 | }
30 |
31 | }
32 |
33 | #' @importFrom glue glue
34 | #' @importFrom htmltools tags tagAppendAttributes tagList
35 | named_to_li <- function(list, class = NULL){
36 | if(is.null(class)){
37 | res <- mapply(
38 | function(x, y){
39 | tags$li(HTML(glue("{y}: {x}")))
40 | },
41 | list, names(list), SIMPLIFY = FALSE)
42 | #res <- lapply(res, HTML)
43 | tagList(res)
44 | } else {
45 | res <- mapply(
46 | function(x, y){
47 | tags$li(HTML(glue("{y}: {x}")))
48 | },
49 | list, names(list), SIMPLIFY = FALSE)
50 | res <- lapply(res, function(x) tagAppendAttributes(x, class = class))
51 | tagList(res)
52 | }
53 | }
54 |
55 | # Remove a tag attribute
56 | #
57 | # @param tag the tag
58 | # @param ... the attributes to remove
59 | #
60 | # @return a new tag
61 | # @export
62 | #
63 | # @examples
64 | # a <- shiny::tags$p(src = "plop", "pouet")
65 | # tagRemoveAttributes(a, "src")
66 | tagRemoveAttributes <- function(tag, ...) {
67 | attrs <- as.character(list(...))
68 | for (i in seq_along(attrs)) {
69 | tag$attribs[[ attrs[i] ]] <- NULL
70 | }
71 | tag
72 | }
73 |
74 | # Hide or display a tag
75 | # @param tag the tag
76 | # @return a tag
77 | # @examples
78 | # ## Hide
79 | # a <- shiny::tags$p(src = "plop", "pouet")
80 | # undisplay(a)
81 | # b <- shiny::actionButton("go_filter", "go")
82 | # undisplay(b)
83 |
84 | #' @importFrom htmltools tagList
85 | undisplay <- function(tag) {
86 | # if not already hidden
87 | if (!is.null(tag$attribs$style) && !grepl("display:\\s+none", tag$attribs$style)) {
88 | tag$attribs$style <- paste("display: none;", tag$attribs$style)
89 | } else {
90 | tag$attribs$style <- "display: none;"
91 | }
92 | tag
93 | }
94 |
95 | #' @importFrom htmltools tagList
96 | display <- function(tag) {
97 | if (!is.null(tag$attribs$style) && grepl("display:\\s+none", tag$attribs$style)) {
98 | tag$attribs$style <- gsub("(\\s)*display:(\\s)*none(\\s)*(;)*(\\s)*", "", tag$attribs$style)
99 | }
100 | tag
101 | }
102 |
103 | # Hide an elements by calling jquery hide on it
104 | #' @importFrom htmltools tags
105 | jq_hide <- function(id) {
106 | tags$script(sprintf("$('#%s').hide()", id))
107 | }
108 |
109 | # Add a red star at the end of the text
110 | #
111 | # Adds a red star at the end of the text
112 | # (for example for indicating mandatory fields).
113 | #
114 | # @param text the HTLM text to put before the red star
115 | #
116 | # @return an html element
117 | #
118 | # @examples
119 | # with_red_star("Enter your name here")
120 | #
121 | #' @importFrom htmltools tags HTML
122 | with_red_star <- function(text) {
123 | htmltools::tags$span(
124 | HTML(
125 | paste0(
126 | text,
127 | htmltools::tags$span(
128 | style = "color:red", "*"
129 | )
130 | )
131 | )
132 | )
133 | }
134 |
135 |
136 |
137 | # Repeat tags$br
138 | #
139 | # @param times the number of br to return
140 | #
141 | # @return the number of br specified in times
142 | # @export
143 | #
144 | # @examples
145 | # rep_br(5)
146 | #
147 | #' @importFrom htmltools HTML
148 | rep_br <- function(times = 1) {
149 | HTML(rep("This application allows you to build your own dataviz for #TidyTuesday, 2019-10-15. 12 | 13 |
Tidy Tuesday is a weekly social data project in R. Find more about this project on rfordatasci.com and on the GitHub repo. 14 | 15 |
This week dataset is a larger version of the well-known mtcars dataset. With this application, you'll be able to build your own {ggplot2} graph out of this dataset.
On each plot, once it's rendered, you'll be able to see the code used by clicking on the image. You can use it as a starting point for more customisation.
18 | 19 |For a deeper understanding of the dataset, feel free to unfold the data dictionnary on the bottom of this page.
20 | 21 | 22 |You can also jump to:
23 | 24 |