├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS.md ├── R ├── dygraph.R ├── dygraph_sidebar.R ├── infrastructure.R ├── read_delim.R ├── read_delim_sidebar.R ├── utils.R ├── write_delim.R ├── write_delim_sidebar.R └── wx_ames.R ├── README.md ├── data-raw ├── wx_ames_parse.Rmd ├── wx_ames_parse.html ├── wx_ames_wxunderground.Rmd └── wx_ames_wxunderground.html ├── data └── wx_ames.rda ├── inst ├── extdata │ └── wx_ames.csv ├── help │ └── read_delim │ │ ├── tz.Rmd │ │ └── tz.html ├── shiny │ ├── read_delim │ │ ├── DESCRIPTION │ │ ├── LICENSE │ │ ├── README.md │ │ ├── rsconnect │ │ │ └── shinyapps.io │ │ │ │ └── ijlyttle │ │ │ │ └── read_delim.dcf │ │ ├── server.R │ │ └── ui.R │ ├── read_delim_dygraph │ │ ├── DESCRIPTION │ │ ├── LICENSE │ │ ├── README.md │ │ ├── rsconnect │ │ │ └── shinyapps.io │ │ │ │ └── ijlyttle │ │ │ │ └── read_delim_dygraph.dcf │ │ ├── server.R │ │ └── ui.R │ ├── read_delim_dygraph_panel │ │ ├── server.R │ │ └── ui.R │ ├── test_update_selected │ │ ├── server.R │ │ └── ui.R │ └── write_delim │ │ ├── server.R │ │ └── ui.R └── templates │ ├── pod.R │ └── pod_sidebar.R ├── man ├── df_names_inherits.Rd ├── df_with_tz.Rd ├── dygraph_server.Rd ├── dygraph_sidebar_side.Rd ├── dygraph_ui_input.Rd ├── dygraph_ui_misc.Rd ├── dygraph_ui_output.Rd ├── isValidy.Rd ├── observe_class_swap.Rd ├── pre_scroll.Rd ├── reactive_validate.Rd ├── read_delim_server.Rd ├── read_delim_sidebar_side.Rd ├── read_delim_ui_input.Rd ├── read_delim_ui_misc.Rd ├── read_delim_ui_output.Rd ├── static.Rd ├── status_content.Rd ├── text_html.Rd ├── tibble_html.Rd ├── update_selected.Rd ├── use_pod.Rd ├── write_delim_server.Rd ├── write_delim_sidebar_side.Rd ├── write_delim_ui_input.Rd ├── write_delim_ui_output.Rd └── wx_ames.Rd ├── packrat ├── init.R ├── packrat.lock └── packrat.opts ├── scratch └── test_textoutput │ └── app.R ├── shinypod.Rproj ├── tests ├── testthat.R └── testthat │ ├── test-utils-select.R │ └── test-utils.R └── vignettes ├── server-modules.Rmd ├── ui-layers.Rmd └── using-shinypods.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^packrat/ 4 | ^\.Rprofile$ 5 | ^data-raw$ 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | packrat/lib*/ 5 | packrat/src*/ 6 | inst/doc 7 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: shinypod 2 | Type: Package 3 | Title: Reusable shiny modules 4 | Version: 0.0.99 5 | Authors@R: c( 6 | person(given = "Ian", family = "Lyttle", email = "ian.lyttle@schneider-electric.com", role = c("aut", "cre")), 7 | person(given = "Alex", family = "Shum", email = "alex@ALShum.com", role = c("aut")) 8 | ) 9 | URL: https://github.com/ijlyttle/shinypod 10 | BugReports: https://github.com/ijlyttle/shinypod/issues 11 | Description: Reusable shiny modules 12 | License: MIT + file LICENSE 13 | LazyData: TRUE 14 | Imports: 15 | shiny (>= 0.13.0), 16 | shinyjs, 17 | readr, 18 | lubridate (>= 1.5.6), 19 | withr, 20 | dplyr, 21 | stringr, 22 | bsplus, 23 | tibble 24 | Suggests: 25 | testthat, 26 | knitr, 27 | rmarkdown, 28 | rprojroot 29 | Remotes: ijlyttle/bsplus 30 | RoxygenNote: 6.0.1.9000 31 | VignetteBuilder: knitr 32 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2016 2 | COPYRIGHT HOLDER: Ian Lyttle 3 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(df_names_inherits) 4 | export(df_with_tz) 5 | export(dygraph_server) 6 | export(dygraph_sidebar_main) 7 | export(dygraph_sidebar_server) 8 | export(dygraph_sidebar_side) 9 | export(dygraph_ui_input) 10 | export(dygraph_ui_misc) 11 | export(dygraph_ui_output) 12 | export(isValidy) 13 | export(observe_class_swap) 14 | export(pre_scroll) 15 | export(reactive_validate) 16 | export(read_delim_server) 17 | export(read_delim_sidebar_main) 18 | export(read_delim_sidebar_server) 19 | export(read_delim_sidebar_side) 20 | export(read_delim_ui_input) 21 | export(read_delim_ui_misc) 22 | export(read_delim_ui_output) 23 | export(static) 24 | export(status_content) 25 | export(text_html) 26 | export(tibble_html) 27 | export(update_selected) 28 | export(use_pod) 29 | export(write_delim_server) 30 | export(write_delim_sidebar_main) 31 | export(write_delim_sidebar_server) 32 | export(write_delim_sidebar_side) 33 | export(write_delim_ui_input) 34 | export(write_delim_ui_output) 35 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # shinypod 2 | 3 | ## 0.0.99 4 | 5 | * adds alert classes to status outputs (read_delim only) 6 | * moves server logic concerning presentation to presentation layer 7 | * adds `wx_ames` dataset and `extdata/wx_ames.csv` 8 | * adds `read_delim` functions to parse a csv file into a data-frame 9 | -------------------------------------------------------------------------------- /R/dygraph.R: -------------------------------------------------------------------------------- 1 | #' UI input elements for dygraph module. 2 | #' 3 | #' Used to define the UI input elements within the \code{dygraph} shiny module. 4 | #' 5 | #' This function returns a \code{shiny::\link[shiny]{tagList}} with members: 6 | #' 7 | #' \describe{ 8 | #' \item{time}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify time variable} 9 | #' \item{y1}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify y1-axis variable} 10 | #' \item{y2}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify y2-axis variable} 11 | #' } 12 | #' 13 | #' The purpose is to specify the UI elements - another set of functions can be used to specify layout. 14 | #' 15 | #' @family dygraph module functions 16 | # 17 | #' @param id, character used to specify namesapce, see \code{shiny::\link[shiny]{NS}} 18 | #' 19 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 20 | #' 21 | #' @export 22 | # 23 | dygraph_ui_input <- function(id) { 24 | 25 | ns <- shiny::NS(id) 26 | 27 | ui_input <- shiny::tagList() 28 | 29 | ui_input$time <- 30 | shiny::selectizeInput( 31 | inputId = ns("time"), 32 | label = "Time", 33 | choices = NULL, 34 | selected = NULL, 35 | multiple = FALSE 36 | ) 37 | 38 | ui_input$y1 <- 39 | shiny::selectizeInput( 40 | inputId = ns("y1"), 41 | label = "Y1 axis", 42 | choices = NULL, 43 | selected = NULL, 44 | multiple = TRUE 45 | ) 46 | 47 | ui_input$y2 <- 48 | shiny::selectizeInput( 49 | inputId = ns("y2"), 50 | label = "Y2 axis", 51 | choices = NULL, 52 | selected = NULL, 53 | multiple = TRUE 54 | ) 55 | 56 | ui_input 57 | } 58 | 59 | #' UI output elements for dygraph module. 60 | #' 61 | #' Used to define the UI output elements within the \code{dygraph} shiny module. 62 | #' 63 | #' This function returns a \code{shiny::\link[shiny]{tagList}} with members: 64 | #' 65 | #' \describe{ 66 | #' \item{status}{\code{shiny::\link[shiny]{htmlOutput}}, used to display status of the module} 67 | #' } 68 | #' 69 | #' The purpose is to specify the UI elements - another set of functions can be used to specify layout. 70 | #' 71 | #' @family dygraph module functions 72 | # 73 | #' @param id, character used to specify namesapce, see \code{shiny::\link[shiny]{NS}} 74 | #' 75 | #' @return a \code{shiny::\link[shiny]{tagList}} 76 | #' 77 | #' @export 78 | # 79 | dygraph_ui_output <- function(id) { 80 | 81 | ns <- shiny::NS(id) 82 | 83 | ui_output <- shiny::tagList() 84 | 85 | ui_output$status <- 86 | shiny::htmlOutput( 87 | outputId = ns("status"), 88 | container = pre_scroll 89 | ) 90 | 91 | ui_output 92 | } 93 | 94 | #' UI miscellaneous elements for dygraph module. 95 | #' 96 | #' Used to define the UI input elements within the \code{dygraph} shiny module. 97 | #' 98 | #' This function returns a \code{shiny::\link[shiny]{tagList}} with members: 99 | #' 100 | #' \describe{ 101 | #' \item{help}{\code{shiny::\link[shiny]{tags}$pre}, contains guidance for using dygraph} 102 | #' } 103 | #' 104 | #' The purpose is to specify the UI elements - another set of functions can be used to specify layout. 105 | #' 106 | #' @family dygraph module functions 107 | # 108 | #' @param id, character used to specify namesapce, see \code{shiny::\link[shiny]{NS}} 109 | #' 110 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 111 | #' 112 | #' @export 113 | # 114 | dygraph_ui_misc <- function(id) { 115 | 116 | ui_misc <- shiny::tagList() 117 | 118 | # ui_misc$help <- 119 | # shiny::tags$pre("Zoom: Click-drag\tPan: Shift-Click-Drag\tReset: Double-Click") 120 | 121 | ui_misc 122 | } 123 | 124 | 125 | #' Server function for dygraph module. 126 | #' 127 | #' Used to define the server within the \code{dygraph} shiny module. 128 | #' 129 | #' @family dygraph module functions 130 | # 131 | #' @param input standard \code{shiny} input 132 | #' @param output standard \code{shiny} output 133 | #' @param session standard \code{shiny} session 134 | #' @param data data frame or \code{shiny::\link[shiny]{reactive}} that returns a data frame 135 | #' 136 | #' @return a \code{shiny::\link[shiny]{reactive}} that returns a dygraph 137 | #' 138 | #' @examples 139 | #' 140 | #' @export 141 | # 142 | dygraph_server <- function( 143 | input, output, session, 144 | data) { 145 | 146 | ns <- session$ns 147 | 148 | ### reactives ### 149 | ################# 150 | 151 | rct_data <- 152 | shinypod::reactive_validate(data, is.data.frame, "Cannot display graph: no data") 153 | 154 | # names of time variables 155 | rct_var_time <- reactive({ 156 | 157 | if (!isValidy(rct_data())) return(character(0)) 158 | 159 | var_time <- df_names_inherits(rct_data(), c("POSIXct")) 160 | 161 | shiny::validate( 162 | shiny::need(var_time, "Cannot display graph: dataset has no time variables") 163 | ) 164 | 165 | var_time 166 | }) 167 | 168 | # names of numeric variables 169 | rct_var_num <- reactive({ 170 | 171 | if (!isValidy(rct_data())) return(character(0)) 172 | 173 | var_num <- df_names_inherits(rct_data(), c("numeric", "integer")) 174 | 175 | shiny::validate( 176 | shiny::need(var_num, "Cannot display graph: dataset has no numeric variables") 177 | ) 178 | 179 | var_num 180 | }) 181 | 182 | # names of variables available to y1-axis control 183 | rct_choice_y1 <- reactive({ 184 | choice_y1 <- setdiff(rct_var_num(), input[["y2"]]) 185 | 186 | choice_y1 187 | }) 188 | 189 | # names of variables available to y2-axis control 190 | rct_choice_y2 <- reactive({ 191 | choice_y2 <- setdiff(rct_var_num(), input[["y1"]]) 192 | 193 | choice_y2 194 | }) 195 | 196 | # basic dygraph 197 | rct_dyg <- reactive({ 198 | 199 | var_time <- input[["time"]] 200 | var_y1 <- input[["y1"]] 201 | var_y2 <- input[["y2"]] 202 | 203 | shiny::validate( 204 | shiny::need( 205 | var_time %in% names(rct_data()), 206 | "Graph cannot display without a time-variable" 207 | ), 208 | shiny::need( 209 | c(var_y1, var_y2) %in% names(rct_data()), 210 | "Graph cannot display without any y-variables" 211 | ) 212 | ) 213 | 214 | dyg <- .dygraph(rct_data(), var_time, var_y1, var_y2) 215 | 216 | dyg 217 | }) 218 | 219 | rct_state = reactive({ 220 | list( 221 | has_data = isValidy(rct_data()), 222 | has_var_time = isValidy(rct_var_time()), 223 | has_var_num = isValidy(rct_var_num()), 224 | has_dyg = isValidy(rct_dyg()) 225 | ) 226 | }) 227 | 228 | # status 229 | rctval_status <- 230 | shiny::reactiveValues( 231 | input = list(index = 0, is_valid = NULL, message = ""), 232 | result = list(index = 0, is_valid = NULL, message = "") 233 | ) 234 | 235 | rct_status_content <- shiny::reactive(status_content(rctval_status)) 236 | 237 | ### observers ### 238 | ################# 239 | 240 | shiny::observe({ 241 | shinyjs::toggleState("time", condition = rct_state()$has_var_time) 242 | shinyjs::toggleState("y1", condition = rct_state()$has_var_num) 243 | shinyjs::toggleState("y2", condition = rct_state()$has_var_num) 244 | }) 245 | 246 | # input 247 | observeEvent( 248 | eventExpr = { 249 | isValidy(rct_data()) 250 | input$time 251 | input$y1 252 | input$y2 253 | }, 254 | handlerExpr = { 255 | 256 | rctval_status$input$index <- rctval_status$input$index + 1 257 | 258 | if (!isValidy(rct_data())){ 259 | rctval_status$input$is_valid <- FALSE 260 | rctval_status$input$message <- "Please supply a dataset to graph" 261 | } else if (!isValidy(input$time)){ 262 | rctval_status$input$is_valid <- FALSE 263 | rctval_status$input$message <- "Please supply a time variable to graph" 264 | } else if (!isValidy(input$y1) && !isValidy(input$y2)){ 265 | rctval_status$input$is_valid <- FALSE 266 | rctval_status$input$message <- "Please supply a y-variable to graph" 267 | } else { 268 | rctval_status$input$is_valid <- TRUE 269 | rctval_status$input$message <- "" 270 | } 271 | 272 | }, 273 | ignoreNULL = FALSE, # makes sure we evaluate on initialization 274 | priority = 1 # always execute before others 275 | ) 276 | 277 | # result 278 | observeEvent( 279 | eventExpr = rct_dyg(), 280 | handlerExpr = { 281 | 282 | rctval_status$result$index <- rctval_status$input$index 283 | 284 | if (!isValidy(rct_dyg())){ 285 | rctval_status$result$is_valid <- FALSE 286 | rctval_status$result$message <- "Cannot construct graph" 287 | } else { 288 | rctval_status$result$is_valid <- TRUE 289 | rctval_status$result$message <- "Zoom: Click-drag\tPan: Shift-Click-Drag\tReset: Double-Click" 290 | } 291 | 292 | } 293 | ) 294 | 295 | # update choices for time variable 296 | shiny::observeEvent( 297 | eventExpr = rct_var_time(), 298 | handlerExpr = { 299 | updateSelectInput( 300 | session, 301 | inputId = "time", 302 | choices = rct_var_time(), 303 | selected = update_selected(input[["time"]], rct_var_time(), index = 1) 304 | ) 305 | }, 306 | ignoreNULL = FALSE 307 | ) 308 | 309 | # update choices for y1 variable 310 | shiny::observeEvent( 311 | eventExpr = rct_choice_y1(), 312 | handlerExpr = { 313 | updateSelectInput( 314 | session, 315 | inputId = "y1", 316 | choices = rct_choice_y1(), 317 | selected = update_selected(input[["y1"]], rct_choice_y1(), index = 1) 318 | ) 319 | }, 320 | ignoreNULL = FALSE 321 | ) 322 | 323 | # update choices for y2 variable 324 | shiny::observeEvent( 325 | eventExpr = rct_choice_y2(), 326 | handlerExpr = { 327 | updateSelectInput( 328 | session, 329 | inputId = "y2", 330 | choices = rct_choice_y2(), 331 | selected = update_selected(input[["y2"]], rct_choice_y2(), index = NULL) 332 | ) 333 | }, 334 | ignoreNULL = FALSE 335 | ) 336 | 337 | observe_class_swap(id = "status", rct_status_content()$class) 338 | 339 | ## outputs ## 340 | ############# 341 | 342 | output$status <- 343 | shiny::renderText(rct_status_content()$message) 344 | 345 | list( 346 | rct_dyg = rct_dyg, 347 | rct_state = rct_state 348 | ) 349 | } 350 | 351 | # function that builds basic dygraph 352 | # .dygraph(wx_ames, "date", "temp", "hum") 353 | .dygraph <- function(data, var_time, var_y1, var_y2){ 354 | 355 | # create the mts object 356 | vec_time <- data[[var_time]] 357 | df_num <- data[c(var_y1, var_y2)] 358 | 359 | # if no tz, use UTC 360 | tz <- lubridate::tz(vec_time) 361 | if (identical(tz, "")) { 362 | tz <- "UTC" 363 | } 364 | 365 | dy_xts <- xts::xts(df_num, order.by = vec_time, tzone = tz) 366 | 367 | dyg <- dygraphs::dygraph(dy_xts) 368 | dyg <- dygraphs::dyAxis(dyg, "x", label = var_time) 369 | dyg <- dygraphs::dyAxis(dyg, "y", label = paste(var_y1, collapse = ", ")) 370 | dyg <- dygraphs::dyAxis(dyg, "y2", label = paste(var_y2, collapse = ", ")) 371 | 372 | # put stuff on y2 axis 373 | for(i in seq_along(var_y2)) { 374 | dyg <- dygraphs::dySeries(dyg, var_y2[i], axis = "y2") 375 | } 376 | 377 | dyg 378 | } 379 | 380 | -------------------------------------------------------------------------------- /R/dygraph_sidebar.R: -------------------------------------------------------------------------------- 1 | #' Sidebar layout for dygraph module 2 | #' 3 | #' These functions return the ui elements for a side panel and a main panel. 4 | #' 5 | #' The side elements are the inputs; the main elements are the outputs. 6 | #' 7 | #' @param id character, used to identify a namespace 8 | #' @param help logical, indicates if help panels to be displayed 9 | #' 10 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 11 | #' 12 | #' @examples 13 | #' 14 | #' @export 15 | # 16 | dygraph_sidebar_side <- function(id){ 17 | sidebar_elems <- dygraph_ui_input(id) 18 | 19 | sidebar_elems 20 | } 21 | 22 | #' @rdname dygraph_sidebar_side 23 | #' @export 24 | # 25 | dygraph_sidebar_main <- function(id, help = TRUE){ 26 | 27 | main_elems <- dygraph_ui_output(id) 28 | 29 | main_elems 30 | } 31 | 32 | #' @export 33 | # 34 | dygraph_sidebar_server <- function( 35 | input, output, session, 36 | data) { 37 | 38 | list_rct <- dygraph_server(input, output, session, data) 39 | 40 | rct_dyg <- list_rct$rct_dyg 41 | rct_state <- list_rct$rct_state 42 | 43 | # shows and hides controls based on the availabilty and nature of data 44 | # shiny::observe({ 45 | # shinyjs::toggle("time", condition = rct_state()$has_var_time) 46 | # shinyjs::toggle("y1", condition = rct_state()$has_var_num) 47 | # shinyjs::toggle("y2", condition = rct_state()$has_var_num) 48 | # }) 49 | 50 | rct_dyg 51 | } 52 | 53 | 54 | 55 | -------------------------------------------------------------------------------- /R/infrastructure.R: -------------------------------------------------------------------------------- 1 | #' create a shinypod from a template 2 | #' 3 | #' This function is used to write out a template function for a shinypod, 4 | #' both for the functional layer, in \code{foo_pod.R}, and a presentation layer, in 5 | #' \code{foo_pod_sidebar.R} 6 | #' 7 | #' This assumes that you are working in a directory in an R package; the files will be written to 8 | #' the \code{R} directory. 9 | #' 10 | #' @param name character, name to prepend to the filenames 11 | #' @param description character, short description to use in the function documentation 12 | #' @param overwrite logical, indicates if an existing file can be overwritten 13 | #' 14 | #' @return list of TRUE values 15 | #' @export 16 | # 17 | use_pod <- function(name, description, overwrite = FALSE){ 18 | 19 | list_template_name <- c("pod.R", "pod_sidebar.R") 20 | 21 | fn_template <- function(template_name){ 22 | use_template( 23 | template = template_name, 24 | save = file.path("R", paste(name, template_name, sep = "_")), 25 | data = list(name = name, description = description), 26 | overwrite = overwrite 27 | ) 28 | } 29 | 30 | lapply(list_template_name, fn_template) 31 | 32 | invisible(TRUE) 33 | } 34 | 35 | 36 | 37 | # template function based on use_template from Hadley's devtools 38 | 39 | use_template <- function(template, save_as, data = list(), overwrite = FALSE) { 40 | 41 | path <- file.path(rprojroot::find_root("DESCRIPTION"), save_as) 42 | if (file.exists(path) && !identical(overwrite, TRUE)) { 43 | stop("`", save_as, "` already exists.", call. = FALSE) 44 | } 45 | 46 | template_path <- system.file("templates", template, package = "shinypod", 47 | mustWork = TRUE) 48 | template_out <- whisker::whisker.render(readLines(template_path), data) 49 | 50 | message("* Creating `", save_as, "` from template.") 51 | writeLines(template_out, path) 52 | 53 | invisible(TRUE) 54 | } 55 | -------------------------------------------------------------------------------- /R/read_delim.R: -------------------------------------------------------------------------------- 1 | #' UI input elements for delimited-file reader. 2 | #' 3 | #' Used to define the UI input elements within the \code{read_delim} shiny module. 4 | #' 5 | #' This function returns a \code{shiny::\link[shiny]{tagList}} with members: 6 | #' 7 | #' \describe{ 8 | #' \item{file}{\code{shiny::\link[shiny]{fileInput}}, used to specify file} 9 | #' \item{delim}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify delimiter character} 10 | #' \item{decimal_mark}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify decimal mark} 11 | #' \item{tz_parse}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify timezone to parse} 12 | #' \item{tz_parse_modal}{\code{shinyBS::\link[shinyBS]{bsModal}}, used explain timezone-parsing} 13 | #' \item{tz_display}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify timezone to display} 14 | #' \item{tz_display_modal}{\code{shinyBS::\link[shinyBS]{bsModal}}, used explain timezone-parsing} 15 | #' } 16 | #' 17 | #' The purpose is to specify the UI elements - another set of functions can be used to specify layout. 18 | #' 19 | #' @family read_delim module functions 20 | # 21 | #' @param id, character used to specify namesapce, see \code{shiny::\link[shiny]{NS}} 22 | #' 23 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 24 | #' 25 | #' @export 26 | # 27 | read_delim_ui_input <- function(id){ 28 | 29 | ns <- shiny::NS(id) 30 | 31 | ui_input <- shiny::tagList() 32 | 33 | # specify file 34 | ui_input$file <- 35 | shiny::fileInput( 36 | inputId = ns("file"), 37 | label = "File", 38 | accept = c("text/csv", ".csv", "text/comma-separated-values", "text/plain") 39 | ) 40 | 41 | # specify delim 42 | ui_input$delim <- 43 | shiny::selectizeInput( 44 | inputId = ns("delim"), 45 | label = "Delimiter", 46 | choices = c(Comma = ",", Semicolon = ";", Tab = "\t") 47 | ) 48 | 49 | # specify decimal 50 | ui_input$decimal_mark <- 51 | shiny::selectizeInput( 52 | inputId = ns("decimal_mark"), 53 | label = "Decimal mark", 54 | choices = c(Point = ".", Comma = ",") 55 | ) 56 | 57 | # specify timezones 58 | tz_choice <- c("UTC", OlsonNames()) 59 | 60 | # timezone to parse 61 | ui_input$tz_parse <- 62 | shiny::selectizeInput( 63 | inputId = ns("tz_parse"), 64 | label = "Timezone to parse", 65 | choices = tz_choice 66 | ) 67 | 68 | # timezone to display 69 | ui_input$tz_display <- 70 | shiny::selectizeInput( 71 | inputId = ns("tz_display"), 72 | label = "Timezone to display", 73 | choices = tz_choice 74 | ) 75 | 76 | ui_input 77 | } 78 | 79 | #' UI output elements for delimited-file reader. 80 | #' 81 | #' Used to define the UI output elements within the \code{read_delim} shiny module. 82 | #' 83 | #' This function returns a \code{shiny::\link[shiny]{tagList}} with members: 84 | #' 85 | #' \describe{ 86 | #' \item{status}{\code{shiny::\link[shiny]{htmlOutput}}, used to display status of the module} 87 | #' \item{text}{\code{shiny::\link[shiny]{htmlOutput}}, used to display first few lines of text from file} 88 | #' \item{data}{\code{shiny::\link[shiny]{htmlOutput}}, used to display first few lines of the parsed dataframe} 89 | #' } 90 | #' 91 | #' The purpose is to specify the UI elements - another set of functions can be used to specify layout. 92 | #' 93 | #' @family read_delim module functions 94 | # 95 | #' @param id, character used to specify namesapce, see \code{shiny::\link[shiny]{NS}} 96 | #' 97 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 98 | #' 99 | #' @export 100 | # 101 | read_delim_ui_output <- function(id){ 102 | 103 | ns <- shiny::NS(id) 104 | 105 | ui_output <- shiny::tagList() 106 | 107 | ui_output$status <- 108 | shiny::htmlOutput( 109 | outputId = ns("status"), 110 | container = pre_scroll 111 | ) 112 | 113 | # text output 114 | ui_output$text <- 115 | shiny::htmlOutput( 116 | outputId = ns("text"), 117 | container = pre_scroll 118 | ) 119 | 120 | # data-frame output 121 | ui_output$data <- 122 | shiny::htmlOutput( 123 | outputId = ns("data"), 124 | container = pre_scroll 125 | ) 126 | 127 | ui_output 128 | } 129 | 130 | #' UI miscellaneous elements for delimited-file reader. 131 | #' 132 | #' Used to define the UI miscellaneous elements within the \code{read_delim} shiny module. 133 | #' 134 | #' This function returns a \code{shiny::\link[shiny]{tagList}} with members: 135 | #' 136 | #' \describe{ 137 | #' \item{tz_help}{\code{htmltools::\link[htmltools]{HTML}}, contains help for time parsing 138 | #' } 139 | #' 140 | #' The purpose is to specify the UI elements - another set of functions can be used to specify layout. 141 | #' 142 | #' @family read_delim module functions 143 | # 144 | #' @param id, character used to specify namesapce, see \code{shiny::\link[shiny]{NS}} 145 | #' 146 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 147 | #' 148 | #' @export 149 | # 150 | read_delim_ui_misc <- function(id){ 151 | 152 | ui_misc <- shiny::tagList() 153 | 154 | ui_misc$tz_help <- 155 | htmltools::HTML( 156 | readr::read_lines( 157 | system.file("help", "read_delim", "tz.html", package = "shinypod") 158 | ) 159 | ) 160 | 161 | ui_misc 162 | } 163 | 164 | #' Server function for delimted-file reader. 165 | #' 166 | #' Used to define the server within the \code{read_delim} shiny module. 167 | #' 168 | #' @family read_delim module functions 169 | # 170 | #' @param input standard \code{shiny} input 171 | #' @param output standard \code{shiny} output 172 | #' @param session standard \code{shiny} session 173 | #' @param delim character, default for parsing delimiter 174 | #' @param decimal_mark character, default for decimal mark 175 | #' 176 | #' @return a list with members: 177 | #' \code{rct_txt} \code{shiny::\link[shiny]{reactive}}, returns raw text 178 | #' \code{rct_data} \code{shiny::\link[shiny]{reactive}}, returns tbl_df of the parsed text 179 | #' 180 | #' @examples 181 | #' shinyServer(function(input, output, session) { 182 | #' 183 | #' list_rct <- callModule( 184 | #' module = read_delim_server, 185 | #' id = "foo" 186 | #' ) 187 | #' 188 | #' observe(print(list_rct$rct_data())) 189 | #' }) 190 | #' 191 | #' @export 192 | # 193 | read_delim_server <- function( 194 | input, output, session, 195 | delim = ",", 196 | decimal_mark = "." 197 | ){ 198 | 199 | ns <- session$ns 200 | 201 | ## input updates ## 202 | ################### 203 | 204 | shiny::updateSelectizeInput( 205 | session, 206 | inputId = "delim", 207 | selected = delim 208 | ) 209 | 210 | shiny::updateSelectizeInput( 211 | session, 212 | inputId = "decimal_mark", 213 | selected = decimal_mark 214 | ) 215 | 216 | ## reactives ## 217 | ############### 218 | 219 | rct_delim <- reactive({ 220 | 221 | shiny::validate( 222 | shiny::need(input$delim, message = "Need a delimiter") 223 | ) 224 | 225 | input$delim 226 | }) 227 | 228 | rct_decimal_mark <- reactive({ 229 | 230 | shiny::validate( 231 | shiny::need(input$decimal_mark, message = "Need a decimal mark") 232 | ) 233 | 234 | input$decimal_mark 235 | }) 236 | 237 | 238 | 239 | rct_tz_parse <- reactive({ 240 | 241 | result <- input$tz_parse 242 | if (!result %in% c("UTC", OlsonNames())){ 243 | result <- "UTC" 244 | } 245 | 246 | result 247 | }) 248 | 249 | rct_tz_display <- reactive({ 250 | 251 | result <- input$tz_display 252 | if (!result %in% c("UTC", OlsonNames())){ 253 | result <- "UTC" 254 | } 255 | 256 | result 257 | }) 258 | 259 | # reactive to read in the raw text from the file-specification input 260 | rct_txt <- reactive({ 261 | 262 | shiny::validate( 263 | shiny::need(input$file, "File not selected") 264 | ) 265 | 266 | infile <- input$file$datapath 267 | 268 | readr::read_file(infile) 269 | }) 270 | 271 | rct_data <- reactive({ 272 | 273 | df <- 274 | readr::read_delim( 275 | file = rct_txt(), 276 | delim = rct_delim(), 277 | locale = readr::locale( 278 | decimal_mark = rct_decimal_mark(), 279 | tz = rct_tz_parse() 280 | ) 281 | ) 282 | 283 | df <- lubridate::with_tz(df, tzone = rct_tz_display()) 284 | 285 | shiny::validate( 286 | shiny::need(is.data.frame(df), "No data") 287 | ) 288 | 289 | df 290 | }) 291 | 292 | rct_state = reactive({ 293 | list( 294 | has_data = isValidy(rct_data()), 295 | has_txt = isValidy(rct_txt()), 296 | has_delim = isValidy(rct_delim()), 297 | has_decimal_mark = isValidy(rct_decimal_mark()), 298 | has_tz_parse = isValidy(rct_tz_parse()), 299 | has_tz_display = isValidy(rct_tz_display()), 300 | has_numeric = 301 | isValidy(length(df_names_inherits(rct_data(), "numeric")) > 0), 302 | has_time_non_8601 = 303 | isValidy(df_has_time_non_8601(rct_txt(), delim = input$delim)), 304 | has_time = 305 | isValidy(length(df_names_inherits(rct_data(), "POSIXct")) > 0) 306 | ) 307 | }) 308 | 309 | # status 310 | rctval_status <- 311 | shiny::reactiveValues( 312 | input = list(index = 0, is_valid = NULL, message = NULL), 313 | result = list(index = 0, is_valid = NULL, message = NULL) 314 | ) 315 | 316 | rct_status_content <- shiny::reactive(status_content(rctval_status)) 317 | 318 | ## observers ## 319 | ############### 320 | 321 | # input 322 | observeEvent( 323 | eventExpr = { 324 | input$file 325 | rct_state() 326 | }, 327 | handlerExpr = { 328 | 329 | rctval_status$input$index <- rctval_status$input$index + 1 330 | 331 | if (is.null(input$file)){ 332 | rctval_status$input$is_valid <- FALSE 333 | rctval_status$input$message <- "Please select a file" 334 | } else if (!rct_state()$has_delim){ 335 | rctval_status$input$is_valid <- FALSE 336 | rctval_status$input$message <- "Please select a delimiter" 337 | } else if (!rct_state()$has_decimal_mark){ 338 | rctval_status$input$is_valid <- FALSE 339 | rctval_status$input$message <- "Please select a decimal mark" 340 | } else if (!rct_state()$has_tz_parse){ 341 | rctval_status$input$is_valid <- FALSE 342 | rctval_status$input$message <- "Please select a timezone for parsing" 343 | } else if (!rct_state()$has_tz_display){ 344 | rctval_status$input$is_valid <- FALSE 345 | rctval_status$input$message <- "Please select a timezone for display" 346 | } else { 347 | rctval_status$input$is_valid <- TRUE 348 | rctval_status$input$message <- "" 349 | } 350 | 351 | }, 352 | ignoreNULL = FALSE, # makes sure we evaluate on initialization 353 | priority = 1 # always execute before others 354 | ) 355 | 356 | # result 357 | observeEvent( 358 | eventExpr = { 359 | rct_data() 360 | }, 361 | handlerExpr = { 362 | 363 | rctval_status$result$index <- rctval_status$input$index 364 | 365 | if (is.null(input$file$datapath)){ 366 | rctval_status$result$is_valid <- FALSE 367 | rctval_status$result$message <- paste("Cannot find file:", input$file$name) 368 | } else { 369 | rctval_status$result$is_valid <- TRUE 370 | rctval_status$result$message <- paste("Uploaded and parsed file:", input$file$name) 371 | } 372 | 373 | } 374 | ) 375 | 376 | # observe(print(paste(rctval_status$input$index, rctval_status$result$index))) 377 | 378 | # updates the display tz if the parse tz changes 379 | shiny::observeEvent( 380 | eventExpr = input$tz_parse, 381 | handlerExpr = { 382 | shiny::updateSelectInput( 383 | session, 384 | inputId = "tz_display", 385 | selected = input$tz_parse 386 | ) 387 | } 388 | ) 389 | 390 | observe_class_swap(id = "status", rct_status_content()$class) 391 | 392 | ## outputs ## 393 | ############# 394 | 395 | output$status <- 396 | shiny::renderText(rct_status_content()$message) 397 | 398 | # sets the output for the raw text 399 | output$text <- 400 | shiny::renderUI({text_html(rct_txt())}) 401 | 402 | # sets the output for the parsed dataframe 403 | output$data <- shiny::renderUI({tibble_html(rct_data())}) 404 | 405 | # returns a list 406 | list(rct_data = rct_data, rct_state = rct_state) 407 | } 408 | -------------------------------------------------------------------------------- /R/read_delim_sidebar.R: -------------------------------------------------------------------------------- 1 | #' Sidebar layout for read_delim module 2 | #' 3 | #' These functions return the ui elements for a side panel and a main panel. 4 | #' 5 | #' The side elements are the inputs; the main elements are the outputs. 6 | #' 7 | #' @param id character, used to identify a namespace 8 | #' 9 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 10 | #' 11 | #' @examples 12 | #' shinyUI( 13 | #' fluidPage( 14 | #' shinyjs::useShinyjs(), 15 | #' sidebarLayout( 16 | #' sidebarPanel(read_delim_sidebar_side("foo")), 17 | #' mainPanel(read_delim_sidebar_main("foo")) 18 | #' ) 19 | #' ) 20 | #' ) 21 | #' 22 | #' @export 23 | # 24 | read_delim_sidebar_side <- function(id){ 25 | 26 | ns <- shiny::NS(id) 27 | 28 | sidebar_elems <- read_delim_ui_input(id) 29 | misc_elems <- read_delim_ui_misc(id) 30 | 31 | tz_modal <- 32 | bsplus::bs_modal( 33 | id = ns("tz_help"), 34 | title = "Timezones", 35 | size = "large", 36 | misc_elems$tz_help 37 | ) 38 | 39 | # note: order is imporant here! 40 | # - first, make hidden 41 | # - then, bs_modal_helpify 42 | # 43 | # not necessary to hide - observe-toggle takes care of it 44 | # 45 | # sidebar_elems$delim <- shinyjs::hidden(sidebar_elems$delim) 46 | # sidebar_elems$decimal_mark <- shinyjs::hidden(sidebar_elems$decimal_mark) 47 | # sidebar_elems$tz_parse <- shinyjs::hidden(sidebar_elems$tz_parse) 48 | # sidebar_elems$tz_display <- shinyjs::hidden(sidebar_elems$tz_display) 49 | 50 | # sidebar_elems$tz_parse <- 51 | # bsplus::bs_modal_helpify( 52 | # input = sidebar_elems$tz_parse, 53 | # bs_modal = tz_modal 54 | # ) 55 | # 56 | # sidebar_elems$tz_display <- 57 | # bsplus::bs_modal_helpify( 58 | # input = sidebar_elems$tz_display, 59 | # bs_modal = tz_modal 60 | # ) 61 | 62 | sidebar_elems$tz_parse <- sidebar_elems$tz_parse 63 | sidebar_elems$tz_display <- sidebar_elems$tz_display 64 | 65 | sidebar_elems 66 | } 67 | 68 | #' @rdname read_delim_sidebar_side 69 | #' @export 70 | # 71 | read_delim_sidebar_main <- function(id){ 72 | 73 | main_elems <- read_delim_ui_output(id) 74 | 75 | main_elems$text <- shinyjs::hidden(main_elems$text) 76 | main_elems$data <- shinyjs::hidden(main_elems$data) 77 | 78 | main_elems 79 | } 80 | 81 | # note we are initializing the show/hide functions here, but controlling at the definition level 82 | 83 | #' @seealso read_delim_sidebar_main 84 | #' @rdname read_delim_server 85 | #' @export 86 | # 87 | read_delim_sidebar_server <- function( 88 | input, output, session, 89 | delim = ",", 90 | decimal_mark = "." 91 | ){ 92 | 93 | ## reactives ## 94 | ############### 95 | 96 | list_rct <- read_delim_server(input, output, session, delim, decimal_mark) 97 | 98 | rct_data <- list_rct$rct_data 99 | rct_state <- list_rct$rct_state 100 | 101 | ## observers ## 102 | ############### 103 | 104 | # shows and hides controls based on the availabilty and nature of data 105 | shiny::observe({ 106 | # inputs 107 | shinyjs::toggle("delim", condition = rct_state()$has_txt) 108 | shinyjs::toggle("decimal_mark", condition = rct_state()$has_txt) 109 | shinyjs::toggle("tz_parse", condition = rct_state()$has_time_non_8601) 110 | shinyjs::toggle("tz_display", condition = rct_state()$has_time) 111 | # outputs 112 | shinyjs::toggle("text", condition = rct_state()$has_txt) 113 | shinyjs::toggle("data", condition = rct_state()$has_data) 114 | }) 115 | 116 | rct_data 117 | } 118 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | #' html for scrollable pre-formatted text 2 | #' 3 | #' This is used as the \code{container} argument in \code{shiny::\link[shiny]{htmlOutput}} 4 | #' 5 | #' @param ... expression used to fill text 6 | #' 7 | #' @source \url{http://stackoverflow.com/questions/10374171/how-to-make-twitter-bootstraps-pre-blocks-scroll-horizontally} 8 | #' @export 9 | # 10 | pre_scroll <- function(...){ 11 | shiny::pre( 12 | ..., 13 | style = "overflow: auto; word-wrap: normal; white-space: pre;" 14 | ) 15 | } 16 | 17 | #' Sets the timezone of all time-based columns in a dataframe 18 | #' 19 | #' @param data dataframe 20 | #' @param tz timezone, an Olson timezone or "UTC" (default) 21 | #' 22 | #' @return dataframe 23 | #' 24 | #' @examples 25 | #' df_with_tz(wx_ames, tz = "UTC") 26 | #' 27 | #' @export 28 | # 29 | df_with_tz <- function(data, tz = "UTC"){ 30 | 31 | .Deprecated(new = "lubridate::with_tz", package = "shinypod") 32 | data <- lubridate::with_tz(time = data, tzone = tz) 33 | 34 | data 35 | } 36 | 37 | # returns TRUE if the dataframe parsed using the text has any POSIXct columns 38 | # not parsed from ISO-8601 39 | # 40 | # detects if any time columns in dataframe 41 | # 42 | # @param txt character, text used to make the dataframe 43 | # @param delim character, delimiter 44 | # 45 | # @return logical, indicating if there are any non ISO-8601 time columns 46 | # 47 | df_has_time_non_8601 <- function(txt, delim){ 48 | 49 | df <- readr::read_delim(txt, delim = delim) 50 | 51 | has_posixct <- (length(df_names_inherits(df, "POSIXct"))) 52 | 53 | if (has_posixct) { 54 | 55 | # identify time columns of dataframe 56 | col_sum <- lapply(df, dplyr::type_sum) 57 | col_sum <- unlist(col_sum) 58 | 59 | # turn this into a col_types specification 60 | col_types <- ifelse(col_sum == "time", "c", "_") 61 | col_types <- paste0(col_types, collapse = "") 62 | 63 | # parse the text into character 64 | df_txt <- readr::read_delim(txt, delim = delim, col_types = col_types) 65 | 66 | # put into a matrix (limit to first 1000 rows) 67 | mat_txt <- as.matrix(head(df_txt, 1000)) 68 | 69 | # test for iso_8601 pattern 70 | all_8601 <- all(is_time_8601(mat_txt), na.rm = TRUE) 71 | 72 | x <- !all_8601 73 | } else { 74 | x <- FALSE 75 | } 76 | 77 | x 78 | } 79 | 80 | # detects if a character string is in ISO-8601 format 81 | is_time_8601 <- function(x){ 82 | 83 | # \\d{4} exactly 4 digits 84 | # -? optional "-" 85 | # \\d{2} exactly 2 digits 86 | # -? optional "-" 87 | # \\d{2} exactly 2 digits 88 | regex_8601_date <- "\\d{4}-?\\d{2}-?\\d{2}" 89 | 90 | # \\d{2} exactly 2 digits 91 | # (:?\\d{2})? optional (optional ":", exactly 2 digits) 92 | # (:?\\d{2})? optional (optional ":", exactly 2 digits) 93 | # (\\.\\d{3})? optional (".", exactly 3 digits) 94 | regex_8601_time <- "\\d{2}(:?\\d{2})?(:?\\d{2})?(\\.\\d{3})?" 95 | 96 | # Z "Z" 97 | # | or 98 | # ([+-]\\d{2}(:?\\d{2})?) (one of "+,-", exactly 2 digits, 99 | # optional (optional ":", exactly 2 digits)) 100 | regex_8601_zone <- "Z|([+-]\\d{2}(:?\\d{2})?)" 101 | 102 | # ^ beginning of string 103 | # [T ] "T" or " " 104 | # $ end of string 105 | regex_8601 <- paste0("^", regex_8601_date, "[T ]", regex_8601_time, regex_8601_zone, "$") 106 | 107 | stringr::str_detect(x, regex_8601) 108 | } 109 | 110 | #' Get the names of all the columns of the dataframe 111 | #' that inherit from the supplied class name 112 | #' 113 | #' @param data dataframe 114 | #' @param what character, vector of class we wish to find 115 | #' 116 | #' @return character vector 117 | #' @export 118 | # 119 | df_names_inherits <- function(data, what){ 120 | 121 | inherits_class <- vapply(data, inherits, logical(1), what = what) 122 | 123 | names_class <- names(inherits_class)[inherits_class] 124 | 125 | names_class 126 | } 127 | 128 | 129 | #' determine the proper selection 130 | #' 131 | #' Used for \code{shiny::\link[shiny]{selectInput}} to allow you to 132 | #' update its selection when its choices change. 133 | #' 134 | #' @param value character vector, current value of an input 135 | #' @param choices character vector, new choices for an input 136 | #' @param index integer, if \code{value} is not in defualt \code{choices}, 137 | #' uses this index of \code{choices}. 138 | #' 139 | #' @return character vector of proposed selection 140 | #' @examples 141 | #' update_selected("a", c("a", "b", "c")) 142 | #' update_selected("a", NULL) 143 | #' update_selected("d", c("a", "b", "c")) 144 | #' update_selected("d", c("a", "b", "c"), index = 1) 145 | #' 146 | #' @export 147 | # 148 | update_selected <- function(value, choices, index = NULL){ 149 | 150 | if (!isValidy(choices)){ 151 | 152 | # we have no choices, select NULL 153 | selected <- NULL 154 | } else { 155 | 156 | # see if our current value is one of our choices 157 | selected <- value[value %in% choices] 158 | 159 | if (length(selected) == 0){ 160 | # no - look at defaults 161 | 162 | if (is.null(index)){ 163 | selected <- NULL 164 | } else { 165 | selected <- choices[index] 166 | } 167 | } 168 | 169 | } 170 | 171 | selected 172 | } 173 | 174 | #' swap out classes on an html element 175 | #' 176 | #' This function stores the value of the last class to be added (using this function), 177 | #' then removes that class before addding the new class. For example, this may be useful 178 | #' if you want to modify a panel to show an alert. 179 | #' 180 | #' As this is an observer, there is no return value. It is called for the side-effect of 181 | #' changing the class of the html element. 182 | #' 183 | #' This is based on \code{shiny::renderText()} 184 | #' 185 | #' @param id A character vector to identify the html element to operate on. 186 | #' @param expr An expression that returns a character vector to add to the html element. 187 | #' @param env The environment in which to evaluate \code{expr}. 188 | #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This 189 | #' is useful if you want to save an expression in a variable. 190 | #' @return nothing 191 | #' @export 192 | # 193 | observe_class_swap <- function(id, expr, env = parent.frame(), quoted = FALSE){ 194 | 195 | func <- shiny::exprToFunction(expr, env, quoted) 196 | 197 | # we use a reactive value to persist the value of the class we added previously 198 | rctval <- reactiveValues(class_current = NULL) 199 | 200 | shiny::observeEvent( 201 | eventExpr = func(), 202 | handlerExpr = { 203 | # print(paste(rctval$class_current, func(), sep = " -> ")) 204 | shinyjs::removeClass(id = id, rctval$class_current) 205 | shinyjs::addClass(id = id, func()) 206 | rctval$class_current <- func() 207 | }, 208 | ignoreNULL = FALSE 209 | ) 210 | 211 | } 212 | 213 | #' use input and result to generate message and class of status 214 | #' 215 | #' The argument \code{status} shall be a list with two members: \code{input} and \code{result}. 216 | #' Each of those lists shall have components \code{index}, \code{is_valid}, and \code{message}. 217 | #' 218 | #' This return value is a list with members \code{class} and \code{message}. The \code{class} can be used by 219 | #' \link{observe_class_swap} to change the appearance of an output. The \code{message} can be used as the 220 | #' text displayed by the output. 221 | #' 222 | #' @param status list with components \code{input} and \code{result} 223 | #' 224 | #' @return list with components \code{class} and \code{message} 225 | #' @export 226 | # 227 | status_content <- function(status){ 228 | 229 | if (shiny::is.reactivevalues(status)) { 230 | status <- shiny::reactiveValuesToList(status) 231 | } 232 | 233 | # print(status) 234 | 235 | is_danger <- 236 | identical(status$result$is_valid, FALSE) && 237 | identical(status$result$index, status$input$index) 238 | 239 | is_warning <- identical(status$input$is_valid, FALSE) 240 | 241 | is_info <- 242 | !is.null(status$result$is_valid) && 243 | !identical(status$input$index, status$result$index) 244 | 245 | is_success <- identical(status$result$is_valid, TRUE) 246 | 247 | # print(paste("is_danger:", is_danger)) 248 | # print(paste("is_warning:", is_warning)) 249 | # print(paste("is_info:", is_info)) 250 | # print(paste("is_success:", is_success)) 251 | 252 | if (is_danger) { 253 | class <- "alert-danger" 254 | message <- status$result$message 255 | } else if (is_warning) { 256 | class <- "alert-warning" 257 | message <- status$input$message 258 | } else if (is_info) { 259 | class <- "alert-info" 260 | message <- paste("Inputs have changed since generation of results", 261 | status$input$message, 262 | sep = "\n\n") 263 | } else if (is_success){ 264 | class <- "alert-success" 265 | message <- status$result$message 266 | } else { 267 | class <- NULL 268 | message <- status$input$message 269 | } 270 | 271 | list(class = class, message = message) 272 | } 273 | 274 | #' checks to see that an expression passes shiny validation 275 | #' 276 | #' Useful if you need to return \code{TRUE}/\code{FALSE} on the validity of a 277 | #' shiny reactive expression 278 | #' 279 | #' @param ... expression to pass to \code{shiny::req()} 280 | #' 281 | #' @return logical, returns \code{TRUE} if shiny validation passes 282 | #' @export 283 | # 284 | isValidy <- function(...){ 285 | result <- tryCatch( 286 | expr = { 287 | shiny::req(...) 288 | TRUE 289 | }, 290 | error = function(e){FALSE} 291 | ) 292 | 293 | result 294 | } 295 | 296 | #' convert a tbl_df printout into an html fragment 297 | #' 298 | #' @param data, data.frame 299 | #' 300 | #' @return html fragment 301 | #' @export 302 | # 303 | tibble_html <- function(data){ 304 | h <- 305 | withr::with_options( 306 | list(width = 10000, tibble.width = Inf, tibble.print_min = 6), 307 | utils::capture.output(print(data)) 308 | ) 309 | h <- paste(h, collapse = "
") 310 | h <- shiny::HTML(h) 311 | 312 | h 313 | } 314 | 315 | #' convert text into an html fragment 316 | #' 317 | #' @param text, text with newline character 318 | #' @param n, number of lines to keep 319 | #' 320 | #' @return html fragment 321 | #' @export 322 | # 323 | text_html <- function(text, n = 6){ 324 | 325 | # do more with n 326 | h <- stringr::str_split(text, "\\n") 327 | h <- h[[1]] 328 | h <- h[seq(min(n, length(h)))] 329 | h <- paste(h, collapse = "
") 330 | h <- shiny::HTML(h) 331 | 332 | h 333 | } 334 | 335 | #' strip away the reactivity 336 | #' 337 | #' This is useful for functions where you want to be able to take either reactive 338 | #' arguements or static arguments. 339 | #' 340 | #' @param x 341 | #' 342 | #' @return \code{x}, if not reactive, \code{x()} if reactive 343 | #' @export 344 | # 345 | static <- function(x){ 346 | 347 | if (shiny::is.reactive(x)) { 348 | static_x <- x() 349 | } else { 350 | static_x <- x 351 | } 352 | 353 | static_x 354 | } 355 | 356 | #' combines handling of reactive and validating the contents 357 | #' 358 | #' @param expr expression, or reactive that returns an expressiondo 359 | #' @param .f function that takes a single arg (object), returns TRUE if valid 360 | #' @param message passed to need 361 | #' @param label passed to need 362 | #' @param ... other args to pass along to .f 363 | #' 364 | #' @return reactive that returns the expression 365 | #' @export 366 | # 367 | reactive_validate <- function(expr, .f = identity, message, label = NULL, ...){ 368 | 369 | shiny::reactive( 370 | { 371 | static_x <- static(expr) 372 | 373 | shiny::validate( 374 | shiny::need(do.call(.f, list(static_x, ...)), message, label) 375 | ) 376 | 377 | static_x 378 | } 379 | ) 380 | 381 | } 382 | -------------------------------------------------------------------------------- /R/write_delim.R: -------------------------------------------------------------------------------- 1 | #' UI input elements for delimited-file writer. 2 | #' 3 | #' Used to define the UI input elements within the \code{write_delim} shiny module. 4 | #' 5 | #' This function returns a \code{shiny::\link[shiny]{tagList}} with members: 6 | #' 7 | #' \describe{ 8 | #' \item{delim}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify delimiter character} 9 | #' \item{filename}{\code{shiny::\link[shiny]{textInput}}, used to specify file name} 10 | #' \item{download}{\code{shiny::\link[shiny]{downloadButton}}, download button} 11 | #' } 12 | #' 13 | #' The purpose is to specify the UI elements - another set of functions can be used to specify layout. 14 | #' 15 | #' @family write_delim module functions 16 | # 17 | #' @param id, character used to specify namesapce, see \code{shiny::\link[shiny]{NS}} 18 | #' 19 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 20 | #' 21 | #' @export 22 | # 23 | write_delim_ui_input <- function(id) { 24 | ns <- NS(id) 25 | ui_input <- shiny::tagList() 26 | 27 | ui_input$delim <- 28 | shiny::selectizeInput( 29 | inputId = ns("delim"), 30 | label = "Delimiter", 31 | choices = c(Comma = ",", Semicolon = ";", Tab = "\t") 32 | ) 33 | 34 | # specify filename 35 | ui_input$filename <- 36 | shiny::textInput( 37 | inputId = ns("file"), 38 | label = "Filename", 39 | value = "data.csv" 40 | ) 41 | 42 | # download button 43 | ui_input$download <- 44 | shiny::downloadButton( 45 | outputId = ns("download"), 46 | label = "Download", 47 | class = "btn-primary" 48 | ) 49 | 50 | ui_input 51 | } 52 | 53 | 54 | #' UI output elements for delimited-file writer. 55 | #' 56 | #' Used to define the UI output elements within the \code{write_delim} shiny module. 57 | #' 58 | #' This function returns a \code{shiny::\link[shiny]{tagList}} with members: 59 | #' 60 | #' \describe{ 61 | #' \item{data}{\code{shiny::\link[shiny]{htmlOutput}}, used to display first few lines of the dataframe} 62 | #' \item{text}{\code{shiny::\link[shiny]{htmlOutput}}, used to display first few lines of text from file} 63 | #' \item{text}{\code{shiny::\link[shiny]{htmlOutput}}, used to display first text status } 64 | #' } 65 | #' 66 | #' The purpose is to specify the UI elements - another set of functions can be used to specify layout. 67 | #' 68 | #' @family write_delim module functions 69 | # 70 | #' @param id, character used to specify namesapce, see \code{shiny::\link[shiny]{NS}} 71 | #' 72 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 73 | #' 74 | #' @export 75 | # 76 | write_delim_ui_output <- function(id) { 77 | ns <- NS(id) 78 | 79 | ## ui_view ## 80 | ui_output <- shiny::tagList() 81 | 82 | ui_output$status <- 83 | shiny::htmlOutput( 84 | outputId = ns("status"), 85 | container = pre_scroll 86 | ) 87 | 88 | # shows the first few lines of the data-frame 89 | ui_output$data <- 90 | shiny::htmlOutput( 91 | outputId = ns("text_data"), 92 | container = pre_scroll 93 | ) 94 | 95 | # shows the raw text of the file (first few lines) 96 | ui_output$text <- 97 | shiny::htmlOutput( 98 | outputId = ns("text_preview"), 99 | container = pre_scroll 100 | ) 101 | 102 | ui_output 103 | } 104 | 105 | #' Server function for delimted-file writer. 106 | #' 107 | #' Used to define the server within the \code{write_delim} shiny module. 108 | #' 109 | #' @family write_delim module functions 110 | # 111 | #' @param input standard \code{shiny} input 112 | #' @param output standard \code{shiny} output 113 | #' @param session standard \code{shiny} session 114 | #' @param data data.frame 115 | #' @param delim character, possibly reactive, delimiter mark to use as a default 116 | #' @param status_alert logical, possibly reactive, indicates if to change alert-class of status output 117 | #' 118 | #' @return a \code{shiny::\link[shiny]{reactive}} containing a tbl_df of the parsed text 119 | #' 120 | #' @examples 121 | #' shinyServer(function(input, output, session) { 122 | #' 123 | #' rct_data <- callModule( 124 | #' module = read_delim_server, 125 | #' id = "foo" 126 | #' ) 127 | #' 128 | #' observe(print(rct_data())) 129 | #' }) 130 | #' 131 | #' @export 132 | # 133 | write_delim_server <- function( 134 | input, output, session, 135 | data, 136 | filename = "data.csv", 137 | delim = ",", 138 | status_alert = TRUE 139 | ) { 140 | 141 | ns <- session$ns 142 | 143 | # reactives 144 | rct_data <- shiny::reactive({ 145 | 146 | if (shiny::is.reactive(data)) { 147 | static_data = data() 148 | } else { 149 | static_data = data 150 | } 151 | 152 | shiny::validate( 153 | shiny::need(is.data.frame(static_data), "No data") 154 | ) 155 | 156 | dplyr::tbl_df(static_data) 157 | }) 158 | 159 | rct_filename_default <- shiny::reactive({ 160 | 161 | if (shiny::is.reactive(filename)) { 162 | static_filename = filename() 163 | } else { 164 | static_filename = filename 165 | } 166 | 167 | static_filename 168 | }) 169 | 170 | rct_delim_default <- shiny::reactive({ 171 | static(delim) 172 | }) 173 | 174 | rct_static_alert <- shiny::reactive({ 175 | static(status_alert) 176 | }) 177 | 178 | rct_txt <- shiny::reactive({ 179 | 180 | shiny::validate( 181 | shiny::need(input$delim, "No delimiter") 182 | ) 183 | 184 | txt <- 185 | readr::format_delim( 186 | x = rct_data(), 187 | delim = input$delim 188 | ) 189 | 190 | # put here for compatibility with Windows 191 | txt <- stringr::str_replace_all(txt, pattern = "\n", replacement = "\r\n") 192 | 193 | txt 194 | }) 195 | 196 | rct_filename <- shiny::reactive({ 197 | 198 | # just for the reactive dependency (why?) 199 | # rct_data() 200 | 201 | # http://stackoverflow.com/questions/17262493/ 202 | # check for /\:*?"<>| 203 | 204 | shiny::validate( 205 | shiny::need( 206 | input$file, 207 | "Need a valid filename" 208 | ) 209 | ) 210 | 211 | input$file 212 | }) 213 | 214 | rct_state = shiny::reactive({ 215 | list( 216 | has_data = isValidy(rct_data()), 217 | has_txt = isValidy(rct_txt()), 218 | has_filename = isValidy(rct_filename()) 219 | ) 220 | }) 221 | 222 | # #downloads 223 | rctval <- shiny::reactiveValues(download = 0) 224 | 225 | # status 226 | rctval_status <- 227 | shiny::reactiveValues( 228 | input = list(index = 0, is_valid = NULL, message = NULL), 229 | result = list(index = 0, is_valid = NULL, message = NULL) 230 | ) 231 | 232 | rct_status_content <- shiny::reactive(status_content(rctval_status)) 233 | 234 | ## observers ## 235 | ############### 236 | 237 | # update filename input 238 | shiny::observeEvent( 239 | eventExpr = rct_filename_default(), 240 | handlerExpr = { 241 | shiny::updateTextInput( 242 | session, 243 | inputId = "file", 244 | value = rct_filename_default() 245 | ) 246 | } 247 | ) 248 | 249 | # input 250 | observeEvent( 251 | eventExpr = { 252 | rct_state()$has_data 253 | input$delim 254 | input$file 255 | }, 256 | handlerExpr = { 257 | 258 | rctval_status$input$index <- rctval_status$input$index + 1 259 | 260 | if (!rct_state()$has_data){ 261 | rctval_status$input$is_valid <- FALSE 262 | rctval_status$input$message <- "No data are available" 263 | } else if (!isValidy(input$delim)){ 264 | rctval_status$input$is_valid <- FALSE 265 | rctval_status$input$message <- "Please specify a delimiter" 266 | } else if (!isValidy(rct_filename())){ 267 | rctval_status$input$is_valid <- FALSE 268 | rctval_status$input$message <- "Please specify a valid filename" 269 | } else { 270 | rctval_status$input$is_valid <- TRUE 271 | rctval_status$input$message <- 272 | paste("Ready to download file", rct_filename(), sep = ": ") 273 | } 274 | 275 | }, 276 | ignoreNULL = FALSE, # makes sure we evaluate on initialization 277 | priority = 1 # always execute before others 278 | ) 279 | 280 | # result 281 | # this code will not be useful until we can observe a download button 282 | # being clicked 283 | # observeEvent( 284 | # eventExpr = output$download, 285 | # handlerExpr = { 286 | # 287 | # rctval_status$result$index <- rctval_status$input$index 288 | # 289 | # # does downloadHandler give us some indication of success? 290 | # rctval_status$result$is_valid <- TRUE 291 | # rctval_status$result$message <- paste("Downloaded file:", rct_filename()) 292 | # 293 | # # if (is.null(input$file$datapath)){ 294 | # # rctval_status$result$is_valid <- FALSE 295 | # # rctval_status$result$message <- paste("Cannot find file:", input$file$name) 296 | # # } else { 297 | # # rctval_status$result$is_valid <- TRUE 298 | # # rctval_status$result$message <- paste("Uploaded file:", input$file$name) 299 | # # } 300 | # 301 | # } 302 | # ) 303 | 304 | shiny::observe( 305 | shiny::updateSelectizeInput( 306 | session, 307 | inputId = "delim", 308 | selected = update_selected(rct_delim_default(), c(",", ";", "\t")) 309 | ) 310 | ) 311 | 312 | shiny::observe({ 313 | shinyjs::toggleState(id = "delim", condition = rct_state()$has_data) 314 | shinyjs::toggleState(id = "file", condition = rct_state()$has_data) 315 | shinyjs::toggleState( 316 | id = "download", 317 | condition = rct_state()$has_txt && rct_state()$has_filename 318 | ) 319 | }) 320 | 321 | shiny::observe({ 322 | if (rct_static_alert()){ 323 | observe_class_swap(id = "status", rct_status_content()$class) 324 | } 325 | }) 326 | 327 | 328 | ## outputs ## 329 | ############# 330 | 331 | # sets the output for the status 332 | output$status <- 333 | shiny::renderText(rct_status_content()$message) 334 | 335 | # sets the output for the input dataframe 336 | output[["text_data"]] <- 337 | renderUI({ 338 | h <- 339 | withr::with_options( 340 | list(width = 10000, dpylr.width = Inf, dplyr.print_min = 6), 341 | capture.output(print(rct_data())) 342 | ) 343 | h <- paste(h, collapse = "
") 344 | h <- htmltools::HTML(h) 345 | 346 | h 347 | }) 348 | 349 | # sets the output for the raw text 350 | output[["text_preview"]] <- 351 | renderUI({ 352 | h <- rct_txt() 353 | h <- readr::read_lines(h, n_max = 7) 354 | h <- paste(h, collapse = "
") 355 | h <- htmltools::HTML(h) 356 | 357 | h 358 | }) 359 | 360 | 361 | # do the download 362 | output$download <- 363 | shiny::downloadHandler( 364 | filename = rct_filename, 365 | content = function(con){ 366 | writeChar(rct_txt(), con) 367 | }, 368 | contentType = "text/csv" 369 | ) 370 | 371 | 372 | 373 | result <- list( 374 | rct_data = rct_data, 375 | rct_state = rct_state 376 | ) 377 | 378 | result 379 | } 380 | -------------------------------------------------------------------------------- /R/write_delim_sidebar.R: -------------------------------------------------------------------------------- 1 | #' Sidebar layout for write_delim module 2 | #' 3 | #' These functions return the ui elements for a side panel and a main panel. 4 | #' 5 | #' The side elements are the inputs; the main elements are the outputs. 6 | #' 7 | #' @param id character, used to identify a namespace 8 | #' 9 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 10 | #' 11 | #' @examples 12 | #' shinyUI( 13 | #' fluidPage( 14 | #' shinyjs::useShinyjs(), 15 | #' sidebarLayout( 16 | #' sidebarPanel(write_delim_sidebar("foo")), 17 | #' mainPanel(read_delim_main("foo")) 18 | #' ) 19 | #' ) 20 | #' ) 21 | #' 22 | #' @export 23 | # 24 | write_delim_sidebar_side <- function(id){ 25 | sidebar_elems <- write_delim_ui_input(id) 26 | 27 | sidebar_elems 28 | } 29 | 30 | #' @rdname write_delim_sidebar_side 31 | #' @export 32 | # 33 | write_delim_sidebar_main <- function(id){ 34 | 35 | write_delim_ui_output(id) 36 | } 37 | 38 | #' @export 39 | # 40 | write_delim_sidebar_server <- function( 41 | input, output, session, 42 | data, 43 | delim = ",", 44 | filename = "data.csv", 45 | status_show = TRUE, 46 | status_alert = TRUE 47 | ) { 48 | 49 | list_rct <- write_delim_server( 50 | input, output, session, 51 | data = data, 52 | delim = delim, 53 | filename = filename, 54 | status_alert = status_alert 55 | ) 56 | 57 | rct_data <- list_rct$rct_data 58 | rct_state <- list_rct$rct_state 59 | 60 | rct_status_show <- reactive({ 61 | static(status_show) 62 | }) 63 | 64 | # manage the appearance according to the status 65 | shiny::observe({ 66 | shinyjs::toggle(id = "status", condition = rct_status_show()) 67 | shinyjs::toggle(id = "text_data", condition = rct_state()$has_data) 68 | shinyjs::toggle(id = "text_preview", condition = rct_state()$has_txt) 69 | }) 70 | 71 | rct_data 72 | } 73 | -------------------------------------------------------------------------------- /R/wx_ames.R: -------------------------------------------------------------------------------- 1 | #' Weather observations at Ames - Jan. 2014 2 | #' 3 | #' A dataset containing hourly weather observations at Ames, Iowa (US) for 4 | #' the month of January 2014. Data obtained from Weather Undergound's API, 5 | #' using the \code{rwunderground} package. 6 | #' 7 | #' @format A data frame with 983 rows and 19 variables: 8 | #' \describe{ 9 | #' \item{date}{POSIXct, instant of the observation} 10 | #' \item{temp}{double, dry-bulb temperature, °C} 11 | #' \item{dew_pt}{double, dew-point temperature, °C} 12 | #' \item{hum}{double, relative humidity, \%} 13 | #' \item{wind_spd}{double, wind-speed, m/s} 14 | #' \item{wind_gust}{double, wind-gust, m/s} 15 | #' \item{dir}{character, direction from which wind blows} 16 | #' \item{vis}{double, visibility, km} 17 | #' \item{pressure}{double, sea-level pressure, mbar} 18 | #' \item{wind_chill}{double, wind-chill temperature, °C} 19 | #' \item{heat_index}{double, head-index temperature, °C} 20 | #' \item{precip}{double, precipitation since previous observation, mm} 21 | #' \item{cond}{character, description of conditions} 22 | #' \item{fog}{integer, indicates if fog is present} 23 | #' \item{rain}{integer, indicates if it is raining is present} 24 | #' \item{snow}{integer, indicates if it is snowing} 25 | #' \item{hail}{integer, indicates if it is hailing} 26 | #' \item{thunder}{integer, indicates if thunder is present} 27 | #' \item{tornado}{integer, indicates if a tornado is present} 28 | #' } 29 | #' @source \url{http://www.wunderground.com/} 30 | "wx_ames" 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # shinypod 0.0.99 2 | 3 | As you write more-and-more shiny apps and they become more-and-more complex, you may notice a couple of things: 4 | 5 | 1. Among different apps, you may be doing the same things over and over again, like uploading and parsing csv files. 6 | 2. Within a given app, your ui and server functions may become difficult to manage as inputs, outputs, and reactives pile up. 7 | 8 | Adressing these problems is the motivation for shiny to [introduce modules](http://shiny.rstudio.com/articles/modules.html). 9 | 10 | The goals of this package are to propose a design framework for shiny modules, and provide some implementations. 11 | 12 | So far, we have reusable modules for: 13 | 14 | * uploading and parsing a CSV file into a data-frame (including handling time-zones) 15 | * configuring a two-y-axes dygraph using a data-frame 16 | 17 | ## Installation 18 | 19 | This package is not on CRAN; however, it is based on the new CRAN (0.13.0) version of shiny. To install: 20 | 21 | ```R 22 | devtools::install_github("ijlyttle/shinypod") 23 | ``` 24 | 25 | ## Philosophy 26 | 27 | For each module foo, we have fundamental functions: `foo_ui_input()`, `foo_ui_output()`, possibly `foo_ui_misc()`, and `foo_server()`. The fundamental UI functions each return a named `shiny::tagList`; the server function is called by `shiny::callModule`. 28 | 29 | For each module foo, we also have a couple of functions that return ui arrangements for a sidebar layout: `foo_ui_sidebar_side()` and `foo_ui_sidebar_main()`. These functions rely on the fundamental UI functions. 30 | 31 | Each of these functions has an associated arguement `id`, which is used to keep orderly the shiny namespace. 32 | 33 | ## Examples 34 | 35 | Let's say you wanted to be able to upload and parse a csv file, and have the dataframe be returned by a reactive function. 36 | 37 | We can write this app using the "all-in-one" approach: 38 | 39 | ```R 40 | library("shiny") 41 | library("shinyjs") 42 | library("shinyBS") 43 | library("shinypod") 44 | 45 | app <- shinyApp( 46 | ui = { 47 | shinyUI( 48 | fluidPage( 49 | useShinyjs(), 50 | sidebarLayout( 51 | sidebarPanel(read_delim_sidebar_side("read_csv")), 52 | mainPanel(read_delim_sidebar_main("read_csv")) 53 | ) 54 | ) 55 | ) 56 | }, 57 | server = { 58 | shinyServer(function(input, output, session) { 59 | 60 | rct_data <- callModule(read_delim_server, id = "read_csv") 61 | 62 | observe(print(rct_data())) 63 | }) 64 | } 65 | ) 66 | 67 | runApp(app) 68 | ``` 69 | 70 | ## Deployed examples 71 | 72 | Some simple shinypod apps deployed at shinyapps: 73 | 74 | - [Parse CSV file](https://ijlyttle.shinyapps.io/read_delim/) 75 | - [Parse CSV file and dygraph](https://ijlyttle.shinyapps.io/read_delim_dygraph/) 76 | -------------------------------------------------------------------------------- /data-raw/wx_ames_parse.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Ames Weather - rWunderground" 3 | author: "Ian Lyttle" 4 | date: "September 29, 2015" 5 | output: html_document 6 | --- 7 | 8 | ```{r library} 9 | library("rwunderground") 10 | library("lubridate") 11 | library("readr") 12 | library("dplyr") 13 | ``` 14 | 15 | ```{r directory} 16 | dir_read <- file.path("..", "inst", "extdata") 17 | ``` 18 | 19 | ```{r wx_read} 20 | wx_ames <- 21 | read_csv( 22 | file = file.path(dir_read, "wx_ames.csv"), 23 | locale = locale(tz = "America/Chicago") 24 | ) %>% 25 | mutate(heat_index = as.numeric(heat_index)) 26 | ``` 27 | 28 | ```{r} 29 | devtools::use_data(wx_ames, overwrite = TRUE) 30 | ``` 31 | -------------------------------------------------------------------------------- /data-raw/wx_ames_wxunderground.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Ames Weather - rWunderground" 3 | author: "Ian Lyttle" 4 | date: "September 29, 2015" 5 | output: html_document 6 | --- 7 | 8 | ```{r library} 9 | library("rwunderground") 10 | library("lubridate") 11 | library("readr") 12 | ``` 13 | 14 | ```{r directory} 15 | dir_write <- file.path("..", "inst", "extdata") 16 | ``` 17 | 18 | ```{r dates} 19 | date_start <- as.Date(ymd("2014-01-01")) 20 | date_end <- as.Date(ymd("2014-01-31")) 21 | 22 | fmt <- stamp_date("20140325") 23 | ``` 24 | 25 | ```{r wx_all} 26 | wx_all <- history_range( 27 | location = set_location(territory = "Iowa", city = "Ames"), 28 | date_start = fmt(date_start), 29 | date_end = fmt(date_end), 30 | use_metric = TRUE, 31 | key = Sys.getenv("WU_KEY") 32 | ) 33 | ``` 34 | 35 | ```{r wx_write} 36 | write_csv( 37 | wx_all, 38 | path = file.path(dir_write, "wx_ames.csv") 39 | ) 40 | ``` 41 | 42 | 43 | 44 | -------------------------------------------------------------------------------- /data/wx_ames.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ijlyttle/shinypod/81c636adfbec54a0ad5af4b8d1ae4e32d90572c5/data/wx_ames.rda -------------------------------------------------------------------------------- /inst/help/read_delim/tz.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: html_fragment 3 | --- 4 | 5 | ```{r echo=FALSE, message=FALSE} 6 | library("knitr") 7 | library("lubridate", quietly = TRUE) 8 | library("magrittr") 9 | 10 | opts_chunk$set(comment = "", echo = FALSE) 11 | 12 | fn_parse <- function(x, tz_parse, tz_display){ 13 | 14 | dtm <- lubridate::ymd_hms(x, tz = tz_parse) 15 | dtm <- lubridate::with_tz(dtm, tzone = tz_display) 16 | 17 | dtm 18 | } 19 | 20 | format_tz <- function(x){ 21 | paste0(format(x), " (", lubridate::tz(x), ")") 22 | } 23 | ``` 24 | 25 | ```{r intro} 26 | str_time <- "2015-09-27 21:45:00" 27 | 28 | tz_parse <- "America/Chicago" 29 | tz_display <- "Europe/Paris" 30 | ``` 31 | 32 | #### Short answer 33 | 34 | - **Timezone to parse**: describes the timezone used to write to the file. The timestamps and the parsing timezone *define* the instants in time. 35 | - **Timezone to display**: This is used to specify the display of these instants in time, but will *not* change the value of these instants. 36 | 37 | The default behavior of this app is to set the **display** timezone to value of the **parsing** timezone. 38 | 39 | #### Long answer 40 | 41 | There are two steps to processing text-based timestamps: 42 | 43 | 1. Determining the instants in time to which the timestamps refer. 44 | 2. Displaying those instants in time the way that you wish. 45 | 46 | Let's say your friend tells you that when she saw the peak of the ["blood moon" eclipse](http://news.nationalgeographic.com/2015/09/150924-super-total-lunar-eclipse-moon-sky-watching-viewing/), the clock read: 47 | 48 | ```{r} 49 | str_time %>% cat() 50 | ``` 51 | 52 | Knowing only what the clock read is not enough information to determine the instant in time when the eclipse happened; you need to know *where* the clock was. 53 | 54 | In this case, let's say your friend was in Chicago. Now we have enough information to fix the instant in time. We can **parse** the timestamp to describe the instant, by referring to the timezone by the place name "`r tz_parse`". 55 | 56 | ```{r} 57 | str_time %>% fn_parse(tz_parse, tz_parse) %>% format_tz() %>% cat() 58 | ``` 59 | 60 | Timezones are named either "UTC" (also known as GMT, or Zulu) or after locations inside each particular timezone, for example "America/Chicago", rather than the more-familiar "Central Time", or "US Central Time". 61 | 62 | Let's say that you are in Paris, and you would like to see what *your* clock would **display** at this instant in time. We would then apply the timezone reference named "`r tz_display`": 63 | 64 | ```{r} 65 | str_time %>% fn_parse(tz_parse, tz_display) %>% format_tz() %>% cat() 66 | ``` 67 | 68 | In order to **parse** and **display** the instants of time, we use these two separate contexts for the timezone. 69 | 70 | Please note: normally, the timezone will not be printed - we do so here to help illustrate the concepts. More examples are provided to demonstrate some different cases. 71 | 72 | #### Example 1 73 | 74 | ```{r ex_1} 75 | tz_parse <- "Europe/London" 76 | tz_display <- tz_parse 77 | 78 | str_time <- "2015-01-02 03:00:00" 79 | ``` 80 | 81 | Your file describes the energy usage at a facility in the United Kingdom. The timestamps are written using the local (UK) timezone; you wish to display the time in the local timezone. 82 | 83 | In the file, one of the timestamps may be written as: 84 | 85 | ```{r ex_1_str} 86 | str_time %>% cat() 87 | ``` 88 | 89 | In this case, use: 90 | 91 | - **Timezone to parse**: "`r tz_parse`" 92 | - **Timezone to display**: "`r tz_display`" 93 | 94 | The parsed timestamp will be displayed as: 95 | 96 | ```{r ex_1_dtm} 97 | str_time %>% fn_parse(tz_parse, tz_display) %>% format_tz() %>% cat() 98 | ``` 99 | 100 | #### Example 2 101 | 102 | ```{r ex_2} 103 | tz_parse <- "UTC" 104 | tz_display <- "Asia/Seoul" 105 | 106 | str_time <- "2015-04-05 06:00:00" 107 | ``` 108 | 109 | Your file describes weather observations in South Korea. The timestamps are written using UTC; you wish to display the time in the local (South Korean) timezone. 110 | 111 | In the file, one of the timestamps may be written as: 112 | 113 | ```{r ex_2_str} 114 | str_time %>% cat() 115 | ``` 116 | 117 | In this case, use: 118 | 119 | - **Timezone to parse**: "`r tz_parse`" 120 | - **Timezone to display**: "`r tz_display`" 121 | 122 | The parsed timestamp will display as: 123 | 124 | ```{r ex_2_dtm} 125 | str_time %>% fn_parse(tz_parse, tz_display) %>% format_tz() %>% cat() 126 | ``` 127 | 128 | #### Example 3 129 | 130 | ```{r ex_3} 131 | tz_parse <- "UTC" 132 | tz_display <- "America/Chicago" 133 | 134 | str_time <- "2015-07-08T09:00:00-0500" 135 | ``` 136 | 137 | Your file describes the energy-generation rate of a wind farm in Iowa (USA). The timestamps are written using [ISO-8601 format](https://en.wikipedia.org/wiki/ISO_8601); you wish to display the time in the local (Iowa) timezone. The closest major center in the same timezone is Chicago. 138 | 139 | In the file, one of the timestamps may be written as: 140 | 141 | ```{r ex_3_str} 142 | str_time %>% cat() 143 | ``` 144 | 145 | In this case, use: 146 | 147 | - **Timezone to parse**: *does not matter* 148 | - **Timezone to display**: "`r tz_display`" 149 | 150 | The parsed timestamp will display as: 151 | 152 | ```{r ex_3_dtm} 153 | str_time %>% fn_parse(tz_parse, tz_display) %>% format_tz() %>% cat() 154 | ``` 155 | 156 | You may wonder why it does not matter what you specify as the parsing timezone. The ISO-8601 format is designed such that the timestamp is always parsed using "UTC". In this case, it will not matter what we specify as the parsing timezone; only the display timezone is operative. 157 | -------------------------------------------------------------------------------- /inst/help/read_delim/tz.html: -------------------------------------------------------------------------------- 1 |
2 |

Short answer

3 | 7 |

The default behavior of this app is to set the display timezone to value of the parsing timezone.

8 |
9 |
10 |

Long answer

11 |

There are two steps to processing text-based timestamps:

12 |
    13 |
  1. Determining the instants in time to which the timestamps refer.
    2. 14 |
  2. Displaying those instants in time the way that you wish.
    3. 15 |
16 |

Let’s say your friend tells you that when she saw the peak of the “blood moon” eclipse, the clock read:

17 | 
2015-09-27 21:45:00
18 |

Knowing only what the clock read is not enough information to determine the instant in time when the eclipse happened; you need to know where the clock was.

19 |

In this case, let’s say your friend was in Chicago. Now we have enough information to fix the instant in time. We can parse the timestamp to describe the instant, by referring to the timezone by the place name “America/Chicago”.

20 | 
2015-09-27 21:45:00 (America/Chicago)
21 |

Timezones are named either “UTC” (also known as GMT, or Zulu) or after locations inside each particular timezone, for example “America/Chicago”, rather than the more-familiar “Central Time”, or “US Central Time”.

22 |

Let’s say that you are in Paris, and you would like to see what your clock would display at this instant in time. We would then apply the timezone reference named “Europe/Paris”:

23 | 
2015-09-28 04:45:00 (Europe/Paris)
24 |

In order to parse and display the instants of time, we use these two separate contexts for the timezone.

25 |

Please note: normally, the timezone will not be printed - we do so here to help illustrate the concepts. More examples are provided to demonstrate some different cases.

26 |
27 |
28 |

Example 1

29 |

Your file describes the energy usage at a facility in the United Kingdom. The timestamps are written using the local (UK) timezone; you wish to display the time in the local timezone.

30 |

In the file, one of the timestamps may be written as:

31 | 
2015-01-02 03:00:00
32 |

In this case, use:

33 | 37 |

The parsed timestamp will be displayed as:

38 | 
2015-01-02 03:00:00 (Europe/London)
39 |
40 |
41 |

Example 2

42 |

Your file describes weather observations in South Korea. The timestamps are written using UTC; you wish to display the time in the local (South Korean) timezone.

43 |

In the file, one of the timestamps may be written as:

44 | 
2015-04-05 06:00:00
45 |

In this case, use:

46 | 50 |

The parsed timestamp will display as:

51 | 
2015-04-05 15:00:00 (Asia/Seoul)
52 |
53 |
54 |

Example 3

55 |

Your file describes the energy-generation rate of a wind farm in Iowa (USA). The timestamps are written using ISO-8601 format; you wish to display the time in the local (Iowa) timezone. The closest major center in the same timezone is Chicago.

56 |

In the file, one of the timestamps may be written as:

57 | 
2015-07-08T09:00:00-0500
58 |

In this case, use:

59 | 63 |

The parsed timestamp will display as:

64 | 
2015-07-08 09:00:00 (America/Chicago)
65 |

You may wonder why it does not matter what you specify as the parsing timezone. The ISO-8601 format is designed such that the timestamp is always parsed using “UTC”. In this case, it will not matter what we specify as the parsing timezone; only the display timezone is operative.

66 |
67 | -------------------------------------------------------------------------------- /inst/shiny/read_delim/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Title: CSV parser 2 | Author: Ian Lyttle & Alex Shum 3 | AuthorUrl: https://ijlyttle.github.com/shinypod 4 | License: MIT + file LICENSE 5 | DisplayMode: Showcase 6 | Tags: shinypod shiny-modules 7 | Type: Shiny 8 | -------------------------------------------------------------------------------- /inst/shiny/read_delim/LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2016 2 | COPYRIGHT HOLDER: Schneider Electric 3 | -------------------------------------------------------------------------------- /inst/shiny/read_delim/README.md: -------------------------------------------------------------------------------- 1 | This is a very simple (if not functional) app that uses a shinypod to upload and parse a delimited file into a dataframe. 2 | 3 | To see this functionality combined with a dygraph, [another app](https://ijlyttle.shinyapps.io/read_delim_dygraph/) that uses shinypods is offered. 4 | 5 | For more information on shinypods, please see the [Github repository](https://github.com:ijlyttle/shinypod). 6 | -------------------------------------------------------------------------------- /inst/shiny/read_delim/rsconnect/shinyapps.io/ijlyttle/read_delim.dcf: -------------------------------------------------------------------------------- 1 | name: read_delim 2 | account: ijlyttle 3 | server: shinyapps.io 4 | appId: 80164 5 | bundleId: 362052 6 | url: https://ijlyttle.shinyapps.io/read_delim/ 7 | when: 1454166963.0509 8 | -------------------------------------------------------------------------------- /inst/shiny/read_delim/server.R: -------------------------------------------------------------------------------- 1 | library("shiny") 2 | library("shinyjs") 3 | library("dplyr") 4 | library("shinypod") 5 | 6 | shinyServer(function(input, output, session) { 7 | 8 | list_rct <- callModule(module = read_delim_sidebar_server, id = "csv") 9 | 10 | }) 11 | -------------------------------------------------------------------------------- /inst/shiny/read_delim/ui.R: -------------------------------------------------------------------------------- 1 | library("shiny") 2 | library("shinyjs") 3 | library("shinypod") 4 | 5 | shinyUI( 6 | fluidPage( 7 | useShinyjs(debug = TRUE), 8 | titlePanel("CSV parser"), 9 | sidebarLayout( 10 | sidebarPanel( 11 | read_delim_sidebar_side("csv") 12 | ), 13 | mainPanel( 14 | read_delim_sidebar_main("csv") 15 | ) 16 | ) 17 | ) 18 | ) 19 | -------------------------------------------------------------------------------- /inst/shiny/read_delim_dygraph/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Title: CSV parser & dygraph 2 | Author: Ian Lyttle & Alex Shum 3 | AuthorUrl: https://ijlyttle.github.com/shinypod 4 | License: MIT + file LICENSE 5 | DisplayMode: Showcase 6 | Tags: shinypod shiny-modules 7 | Type: Shiny 8 | -------------------------------------------------------------------------------- /inst/shiny/read_delim_dygraph/LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2016 2 | COPYRIGHT HOLDER: Schneider Electric 3 | -------------------------------------------------------------------------------- /inst/shiny/read_delim_dygraph/README.md: -------------------------------------------------------------------------------- 1 | This app uses [shiny modules](http://shiny.rstudio.com/articles/modules.html) to: 2 | 3 | - upload and parse a delimited file into a dataframe, using [readr](https://github.com/hadley/readr). 4 | - if that dataframe has time-indexed data, plots it using [dygraphs](https://rstudio.github.io/dygraphs/). 5 | 6 | Here is a sample [data file](https://raw.githubusercontent.com/ijlyttle/shinypod/master/inst/extdata/wx_ames.csv), describing weather observations in Ames, Iowa (USA) for a month. 7 | 8 | These modules are provided in a package, [shinypod](https://github.com:ijlyttle/shinypod), hosted at GitHub. 9 | -------------------------------------------------------------------------------- /inst/shiny/read_delim_dygraph/rsconnect/shinyapps.io/ijlyttle/read_delim_dygraph.dcf: -------------------------------------------------------------------------------- 1 | name: read_delim_dygraph 2 | account: ijlyttle 3 | server: shinyapps.io 4 | appId: 80158 5 | bundleId: 366337 6 | url: https://ijlyttle.shinyapps.io/read_delim_dygraph/ 7 | when: 1454614079.73991 8 | -------------------------------------------------------------------------------- /inst/shiny/read_delim_dygraph/server.R: -------------------------------------------------------------------------------- 1 | library("shiny") 2 | library("shinyjs") 3 | library("shinypod") 4 | library("dygraphs") 5 | library("dplyr") 6 | 7 | function(input, output, session) { 8 | 9 | rct_data <- callModule(module = read_delim_sidebar_server, id = "csv") 10 | 11 | rct_dyg <- callModule(dygraph_sidebar_server, "dyg", data = rct_data) 12 | 13 | observe({ 14 | shinyjs::toggle(id = "csv_dyg", condition = isValidy(rct_dyg())) 15 | }) 16 | 17 | output$csv_dyg <- renderDygraph({ 18 | rct_dyg() %>% 19 | dyOptions(useDataTimezone = TRUE) 20 | }) 21 | 22 | } 23 | -------------------------------------------------------------------------------- /inst/shiny/read_delim_dygraph/ui.R: -------------------------------------------------------------------------------- 1 | library("shiny") 2 | library("shinyjs") 3 | library("shinypod") 4 | library("dygraphs") 5 | 6 | fluidPage( 7 | useShinyjs(), 8 | titlePanel("CSV parser and dygraph"), 9 | sidebarLayout( 10 | sidebarPanel( 11 | read_delim_sidebar_side("csv"), 12 | tags$hr(), 13 | dygraph_sidebar_side("dyg") 14 | ), 15 | mainPanel( 16 | read_delim_sidebar_main("csv"), 17 | dygraph_sidebar_main("dyg"), 18 | dygraphOutput("csv_dyg") 19 | ) 20 | ) 21 | ) 22 | -------------------------------------------------------------------------------- /inst/shiny/read_delim_dygraph_panel/server.R: -------------------------------------------------------------------------------- 1 | library("shiny") 2 | library("shinyjs") 3 | library("shinypod") 4 | library("dygraphs") 5 | 6 | shinyServer(function(input, output, session) { 7 | 8 | rct_data <- callModule(module = read_delim_sidebar_server, id = "csv") 9 | 10 | rct_dyg <- callModule(dygraph_sidebar_server, "dyg", data = rct_data) 11 | 12 | observe({ 13 | shinyjs::toggle(id = "csv_dyg", condition = isValidy(rct_dyg())) 14 | }) 15 | 16 | output$csv_dyg <- renderDygraph({ 17 | rct_dyg() %>% 18 | dyOptions(useDataTimezone = TRUE) 19 | }) 20 | 21 | }) 22 | -------------------------------------------------------------------------------- /inst/shiny/read_delim_dygraph_panel/ui.R: -------------------------------------------------------------------------------- 1 | library("shiny") 2 | library("shinyjs") 3 | library("shinypod") 4 | library("shinythemes") 5 | library("shinypod") 6 | library("bsplus") 7 | library("dygraphs") 8 | 9 | tagList( 10 | includeCSS(system.file(file.path("css", "omnibus.css"), package = "bsplus")), 11 | useShinyjs(), 12 | navbarPage( 13 | title = "Parse CSV & Dygraph", 14 | windowTitle = "Parse CSV & Dygraph", 15 | tabPanel( 16 | title = "Main", 17 | collapse_sidebar_set( 18 | id_set = "set", 19 | bstype_open = "primary", 20 | bstype_closed = "info", 21 | collapse_sidebar_layout( 22 | id_layout = "layout_csv", 23 | collapse_sidebar_panel = 24 | collapse_sidebar_panel( 25 | title = "Parse CSV", 26 | read_delim_sidebar_side("csv") 27 | ), 28 | collapse_main_panel = 29 | collapse_main_panel( 30 | bs_panel_open( 31 | read_delim_sidebar_main("csv") 32 | ) 33 | ) 34 | ), 35 | collapse_sidebar_layout( 36 | id_layout = "layout_dygraph", 37 | collapse_sidebar_panel = 38 | collapse_sidebar_panel( 39 | title = "Dygraph", 40 | dygraph_sidebar_side("dyg") 41 | ), 42 | collapse_main_panel = 43 | collapse_main_panel( 44 | bs_panel_open( 45 | dygraph_sidebar_main("dyg"), 46 | dygraphOutput("csv_dyg") 47 | ) 48 | ) 49 | ) 50 | ) 51 | 52 | ) 53 | ), 54 | includeScript(system.file(file.path("js", "navbar_mod_shiny.js"), package = "bsplus")), 55 | includeScript(system.file(file.path("js", "collapse_panel_set.js"), package = "bsplus")), 56 | includeScript(system.file(file.path("js", "strong_color.js"), package = "bsplus")) 57 | ) 58 | 59 | -------------------------------------------------------------------------------- /inst/shiny/test_update_selected/server.R: -------------------------------------------------------------------------------- 1 | library("shiny") 2 | library("shinypod") 3 | 4 | shinyServer(function(input, output, session) { 5 | rct_data = reactive({ 6 | letters 7 | }) 8 | 9 | rct_choice_1 = reactive({ 10 | choice_1 = setdiff(rct_data(), input[["second"]]) 11 | 12 | choice_1 13 | }) 14 | 15 | rct_choice_2 = reactive({ 16 | choice_2 = setdiff(rct_data(), input[["first"]]) 17 | 18 | choice_2 19 | }) 20 | 21 | 22 | rct_choice_3 = reactive({ 23 | choice_3 = setdiff(rct_data(), input[["fourth"]]) 24 | 25 | choice_3 26 | }) 27 | 28 | 29 | rct_choice_4 = reactive({ 30 | choice_4 = setdiff(rct_data(), input[["third"]]) 31 | 32 | choice_4 33 | }) 34 | 35 | #choice 1 36 | shiny::observeEvent( 37 | eventExpr = rct_choice_1(), 38 | handlerExpr = { 39 | print("choice1::") 40 | print(rct_choice_1()) 41 | updateSelectInput( 42 | session, 43 | inputId = "first", 44 | choices = rct_choice_1(), 45 | selected = update_selected(input[["first"]], rct_choice_1(), index = 1) 46 | ) 47 | } 48 | ) 49 | 50 | #choice 2 51 | shiny::observeEvent( 52 | eventExpr = rct_choice_2(), 53 | handlerExpr = { 54 | print("choice2::") 55 | print(rct_choice_2()) 56 | updateSelectInput( 57 | session, 58 | inputId = "second", 59 | choices = rct_choice_2(), 60 | selected = update_selected(input[["second"]], rct_choice_2(), index = NULL) 61 | ) 62 | } 63 | ) 64 | 65 | #choice 3 66 | shiny::observeEvent( 67 | eventExpr = rct_choice_3(), 68 | handlerExpr = { 69 | updateSelectInput( 70 | session, 71 | inputId = "third", 72 | choices = rct_choice_3(), 73 | #selected = update_selected(input[["third"]], rct_choice_3(), index = 1) 74 | selected = rct_choice_3()[1] 75 | ) 76 | } 77 | ) 78 | 79 | #choice 4 80 | shiny::observeEvent( 81 | eventExpr = rct_choice_4(), 82 | handlerExpr = { 83 | updateSelectInput( 84 | session, 85 | inputId = "fourth", 86 | choices = rct_choice_4(), 87 | #selected = update_selected(input[["fourth"]], rct_choice_4(), index = NULL) 88 | selected = rct_choice_4()[2] 89 | ) 90 | } 91 | ) 92 | 93 | output$txt <- renderPrint({ 94 | input[["first"]] 95 | }) 96 | }) -------------------------------------------------------------------------------- /inst/shiny/test_update_selected/ui.R: -------------------------------------------------------------------------------- 1 | library("shiny") 2 | 3 | fluidPage( 4 | titlePanel("Test Update Select Function"), 5 | sidebarLayout( 6 | sidebarPanel( 7 | shiny::selectizeInput( 8 | inputId = "first", 9 | label = "first", 10 | choices = NULL, 11 | selected = NULL, 12 | multiple = TRUE 13 | #multiple = FALSE 14 | ), 15 | shiny::selectizeInput( 16 | inputId = "second", 17 | label = "second", 18 | choices = NULL, 19 | selected = NULL, 20 | multiple = TRUE 21 | #multiple = FALSE 22 | ), 23 | shiny::tags$hr(), 24 | shiny::selectizeInput( 25 | inputId = "third", 26 | label = "third", 27 | choices = NULL, 28 | selected = NULL, 29 | multiple = TRUE 30 | ), 31 | shiny::selectizeInput( 32 | inputId = "fourth", 33 | label = "fourth", 34 | choices = NULL, 35 | selected = NULL, 36 | multiple = TRUE 37 | ) 38 | ), 39 | mainPanel( 40 | verbatimTextOutput("txt") 41 | ) 42 | ) 43 | ) -------------------------------------------------------------------------------- /inst/shiny/write_delim/server.R: -------------------------------------------------------------------------------- 1 | library("shiny") 2 | library("shinyjs") 3 | library("shinypod") 4 | library("tibble") 5 | 6 | function(input, output, session) { 7 | callModule(write_delim_sidebar_server, "example", data = wx_ames, delim = ",", filename = "test.csv") 8 | } 9 | -------------------------------------------------------------------------------- /inst/shiny/write_delim/ui.R: -------------------------------------------------------------------------------- 1 | library("shiny") 2 | library("shinyjs") 3 | library("shinypod") 4 | 5 | fluidPage( 6 | useShinyjs(), 7 | titlePanel("Write CSV example"), 8 | sidebarLayout( 9 | sidebarPanel( 10 | write_delim_sidebar_side("example") 11 | ), 12 | mainPanel( 13 | write_delim_sidebar_main("example") 14 | ) 15 | ) 16 | ) 17 | -------------------------------------------------------------------------------- /inst/templates/pod.R: -------------------------------------------------------------------------------- 1 | #' UI input elements for module that {{{ description }}}. 2 | #' 3 | #' Used to define the UI input elements within the \code{ {{{ name }}} } shiny module. 4 | #' 5 | #' This function returns a \code{shiny::\link[shiny]{tagList}} with members: 6 | #' 7 | #' \describe{ 8 | #' \item{button_yell}{\code{shiny::\link[shiny]{fileInput}}, button to ivoke upper-case} 9 | #' } 10 | #' 11 | #' The purpose is to specify the UI elements - another set of functions can be used to specify layout. 12 | #' 13 | #' @family {{{ name }}} module functions 14 | # 15 | #' @param id, character used to specify namesapce, see \code{shiny::\link[shiny]{NS}} 16 | #' 17 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 18 | #' 19 | #' @export 20 | # 21 | {{{ name }}}_ui_input <- function(id){ 22 | 23 | ns <- shiny::NS(id) 24 | 25 | ui_input <- shiny::tagList() 26 | 27 | # action button 28 | ui_input$button <- 29 | shiny::actionButton( 30 | inputId = ns("button_yell"), 31 | label = "yell", 32 | class = "btn-primary" 33 | ) 34 | 35 | ui_input 36 | } 37 | 38 | #' UI output elements for module that {{{ description }}}. 39 | #' 40 | #' Used to define the UI output elements within the \code{ {{{ name }}} } shiny module. 41 | #' 42 | #' This function returns a \code{shiny::\link[shiny]{tagList}} with members: 43 | #' 44 | #' \describe{ 45 | #' \item{status}{\code{shiny::\link[shiny]{htmlOutput}}, used to display status of the module} 46 | #' } 47 | #' 48 | #' The purpose is to specify the UI elements - another set of functions can be used to specify layout. 49 | #' 50 | #' @family {{{ name }}} module functions 51 | # 52 | #' @param id, character used to specify namesapce, see \code{shiny::\link[shiny]{NS}} 53 | #' 54 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 55 | #' 56 | #' @export 57 | # 58 | {{{ name }}}_ui_output <- function(id){ 59 | 60 | ns <- shiny::NS(id) 61 | 62 | ui_output <- shiny::tagList() 63 | 64 | ui_output$status <- 65 | shiny::htmlOutput( 66 | outputId = ns("status"), 67 | container = shinypod::pre_scroll 68 | ) 69 | 70 | ui_output$data <- 71 | shiny::htmlOutput( 72 | outputId = ns("data"), 73 | container = shinypod::pre_scroll 74 | ) 75 | 76 | ui_output$data_new <- 77 | shiny::htmlOutput( 78 | outputId = ns("data_new"), 79 | container = shinypod::pre_scroll 80 | ) 81 | 82 | ui_output 83 | } 84 | 85 | #' UI miscellaneous elements for module that {{{ description }}}. 86 | #' 87 | #' Used to define the UI miscellaneous elements within the \code{ {{{ name }}} } shiny module. 88 | #' 89 | #' This function returns a \code{shiny::\link[shiny]{tagList}} with members: 90 | #' 91 | #' \describe{ 92 | #' } 93 | #' 94 | #' The purpose is to specify the UI elements - another set of functions can be used to specify layout. 95 | #' 96 | #' @family {{{ name }}} module functions 97 | # 98 | #' @param id, character used to specify namesapce, see \code{shiny::\link[shiny]{NS}} 99 | #' 100 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 101 | #' 102 | #' @export 103 | # 104 | {{{ name }}}_ui_misc <- function(id){ 105 | 106 | # this is for elements that are neither inputs nor outputs 107 | 108 | ui_misc <- shiny::tagList() 109 | 110 | ui_misc 111 | } 112 | 113 | #' Server function for {{{ description }}}. 114 | #' 115 | #' Used to define the server within the \code{ {{{ name }}} } shiny module. 116 | #' 117 | #' @family {{{ name }}} module functions 118 | # 119 | #' @param input standard \code{shiny} input 120 | #' @param output standard \code{shiny} output 121 | #' @param session standard \code{shiny} session 122 | #' @param data data.frame, possibly reactive 123 | #' @param status_show logical, possibly reactive, indicates if to show the status output 124 | #' @param status_alert logical, possibly reactive, indicates if to change alert-class of status output 125 | #' 126 | #' @return \code{ {{{ name }}}_server}: a list containing reactives that return a data.frame 127 | #' and a list of logicals that describe the state of the module, 128 | #' \code{ {{{ name }}}_sidebar_server}: a reactive that returns a data.frame 129 | #' 130 | #' @examples 131 | #' shinyServer(function(input, output, session) { 132 | #' 133 | #' list_rct <- callModule( 134 | #' module = {{{ name }}}_server, 135 | #' id = "foo" 136 | #' ) 137 | #' 138 | #' }) 139 | #' 140 | #' @export 141 | # 142 | {{{ name }}}_server <- function( 143 | input, output, session, 144 | data, 145 | status_alert = TRUE 146 | ){ 147 | 148 | ns <- session$ns 149 | 150 | ## reactives ## 151 | ############### 152 | 153 | rct_data <- 154 | shinypod::reactive_validate(data, is.data.frame, message = "Please supply a dataset") 155 | 156 | rct_status_alert <- shiny::reactive({ 157 | shinypod::static(status_alert) 158 | }) 159 | 160 | rct_state <- shiny::reactive({ 161 | list( 162 | has_data = shinypod::isValidy(rct_data()), 163 | has_data_new = shinypod::isValidy(rct_data_new()) 164 | ) 165 | }) 166 | 167 | # new data 168 | rctval <- shiny::reactiveValues(data_new = NULL) 169 | 170 | rct_data_new <- shiny::reactive(rctval$data_new) 171 | 172 | # status 173 | rctval_status <- 174 | shiny::reactiveValues( 175 | input = list(index = 0, is_valid = NULL, message = NULL), 176 | result = list(index = 0, is_valid = NULL, message = NULL) 177 | ) 178 | 179 | rct_status_content <- shiny::reactive(shinypod::status_content(rctval_status)) 180 | 181 | ## input updates ## 182 | ################### 183 | 184 | ## observers ## 185 | ############### 186 | 187 | # button should be active only when we have data 188 | observe({ 189 | shinyjs::toggleState(id = "button-scream", condition = rct_state()$has_data) 190 | }) 191 | 192 | # input 193 | observeEvent( 194 | eventExpr = { 195 | rct_data() 196 | }, 197 | handlerExpr = { 198 | 199 | rctval_status$input$index <- rctval_status$input$index + 1 200 | 201 | if (!shinypod::isValidy(rct_data())){ 202 | rctval_status$input$is_valid <- FALSE 203 | rctval_status$input$message <- "Please supply a dataset" 204 | } else { 205 | rctval_status$input$is_valid <- TRUE 206 | rctval_status$input$message <- "Ready to yell!" 207 | } 208 | 209 | }, 210 | ignoreNULL = FALSE, # makes sure we evaluate on initialization 211 | priority = 1 # always execute before others 212 | ) 213 | 214 | # result 215 | observeEvent( 216 | eventExpr = input$button_yell, 217 | handlerExpr = { 218 | 219 | rctval_status$result$index <- rctval_status$input$index 220 | 221 | # stuff that results from hitting the button 222 | rctval$data_new <- 223 | tryCatch( 224 | expr = { 225 | data_new <- rct_data() 226 | colnames(data_new) <- toupper(colnames(data_new)) 227 | data_new 228 | }, 229 | error = function(e){ 230 | error_message <<- e$message # this will be a side-effect 231 | NULL 232 | } 233 | ) 234 | 235 | if (is.null(rctval$data_new)){ 236 | rctval_status$result$is_valid <- FALSE 237 | rctval_status$result$message <- "Cannot make column names yell" 238 | } else { 239 | rctval_status$result$is_valid <- TRUE 240 | rctval_status$result$message <- "Column names are now YELLING!" 241 | } 242 | 243 | } 244 | ) 245 | 246 | # used to change the class of the status box 247 | observe({ 248 | if (rct_status_alert()){ 249 | shinypod::observe_class_swap(id = "status", rct_status_content()$class) 250 | } 251 | }) 252 | 253 | ## outputs ## 254 | ############# 255 | 256 | output$status <- 257 | shiny::renderText(rct_status_content()$message) 258 | 259 | # old dataframe 260 | output$data <- shiny::renderUI(shinypod::tibble_html(rct_data())) 261 | 262 | # NEW DATAFRAME 263 | output$data_new <- shiny::renderUI(shinypod::tibble_html(rct_data_new())) 264 | 265 | # returns a list 266 | list(rct_data = rct_data, rct_state = rct_state) 267 | } 268 | -------------------------------------------------------------------------------- /inst/templates/pod_sidebar.R: -------------------------------------------------------------------------------- 1 | #' Sidebar layout for {{{ name }}} module 2 | #' 3 | #' These functions return the ui elements for a side panel and a main panel. 4 | #' 5 | #' Generally, the side elements are the inputs; the main elements are the outputs. 6 | #' 7 | #' @param id character, used to identify a namespace 8 | #' 9 | #' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements 10 | #' 11 | #' @examples 12 | #' shinyUI( 13 | #' fluidPage( 14 | #' shinyjs::useShinyjs(), 15 | #' sidebarLayout( 16 | #' sidebarPanel({{{ name }}}_sidebar_side("foo")), 17 | #' mainPanel({{{ name }}}_sidebar_main("foo")) 18 | #' ) 19 | #' ) 20 | #' ) 21 | #' 22 | #' @export 23 | # 24 | {{{ name }}}_sidebar_side <- function(id){ 25 | 26 | ns <- shiny::NS(id) 27 | 28 | sidebar_elems <- {{{ name }}}_ui_input(id) 29 | 30 | sidebar_elems 31 | } 32 | 33 | #' @rdname {{{ name }}}_sidebar_side 34 | #' @export 35 | # 36 | {{{ name }}}_sidebar_main <- function(id){ 37 | 38 | main_elems <- {{{ name }}}_ui_output(id) 39 | 40 | main_elems 41 | } 42 | 43 | #' @seealso {{{ name }}}_sidebar_main 44 | #' @rdname {{{ name }}}_server 45 | #' @export 46 | # 47 | {{{ name }}}_sidebar_server <- function( 48 | input, output, session, 49 | data, 50 | status_show = TRUE, 51 | status_alert = TRUE 52 | ){ 53 | 54 | ## reactives ## 55 | ############### 56 | 57 | list_rct <- {{{ name }}}_server(input, output, session, data, status_alert) 58 | 59 | rct_data_new <- list_rct$rct_data_new 60 | rct_state <- list_rct$rct_state 61 | 62 | rct_status_show <- reactive({ 63 | shinypod::static(status_show) 64 | }) 65 | 66 | ## observers ## 67 | ############### 68 | 69 | # shows and hides controls based on the availabilty and nature of data 70 | shiny::observe({ 71 | # outputs 72 | shinyjs::toggle("status", condition = rct_status_show()) 73 | shinyjs::toggle("data", condition = rct_state()$has_data) 74 | shinyjs::toggle("data_new", condition = rct_state()$has_data_new) 75 | }) 76 | 77 | rct_data_new 78 | } 79 | -------------------------------------------------------------------------------- /man/df_names_inherits.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{df_names_inherits} 4 | \alias{df_names_inherits} 5 | \title{Get the names of all the columns of the dataframe 6 | that inherit from the supplied class name} 7 | \usage{ 8 | df_names_inherits(data, what) 9 | } 10 | \arguments{ 11 | \item{data}{dataframe} 12 | 13 | \item{what}{character, vector of class we wish to find} 14 | } 15 | \value{ 16 | character vector 17 | } 18 | \description{ 19 | Get the names of all the columns of the dataframe 20 | that inherit from the supplied class name 21 | } 22 | -------------------------------------------------------------------------------- /man/df_with_tz.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{df_with_tz} 4 | \alias{df_with_tz} 5 | \title{Sets the timezone of all time-based columns in a dataframe} 6 | \usage{ 7 | df_with_tz(data, tz = "UTC") 8 | } 9 | \arguments{ 10 | \item{data}{dataframe} 11 | 12 | \item{tz}{timezone, an Olson timezone or "UTC" (default)} 13 | } 14 | \value{ 15 | dataframe 16 | } 17 | \description{ 18 | Sets the timezone of all time-based columns in a dataframe 19 | } 20 | \examples{ 21 | df_with_tz(wx_ames, tz = "UTC") 22 | 23 | } 24 | -------------------------------------------------------------------------------- /man/dygraph_server.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dygraph.R 3 | \name{dygraph_server} 4 | \alias{dygraph_server} 5 | \title{Server function for dygraph module.} 6 | \usage{ 7 | dygraph_server(input, output, session, data) 8 | } 9 | \arguments{ 10 | \item{input}{standard \code{shiny} input} 11 | 12 | \item{output}{standard \code{shiny} output} 13 | 14 | \item{session}{standard \code{shiny} session} 15 | 16 | \item{data}{data frame or \code{shiny::\link[shiny]{reactive}} that returns a data frame} 17 | } 18 | \value{ 19 | a \code{shiny::\link[shiny]{reactive}} that returns a dygraph 20 | } 21 | \description{ 22 | Used to define the server within the \code{dygraph} shiny module. 23 | } 24 | \examples{ 25 | 26 | } 27 | \seealso{ 28 | Other dygraph module functions: \code{\link{dygraph_ui_input}}, 29 | \code{\link{dygraph_ui_misc}}, 30 | \code{\link{dygraph_ui_output}} 31 | } 32 | \concept{dygraph module functions} 33 | -------------------------------------------------------------------------------- /man/dygraph_sidebar_side.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dygraph_sidebar.R 3 | \name{dygraph_sidebar_side} 4 | \alias{dygraph_sidebar_side} 5 | \alias{dygraph_sidebar_main} 6 | \title{Sidebar layout for dygraph module} 7 | \usage{ 8 | dygraph_sidebar_side(id) 9 | 10 | dygraph_sidebar_main(id, help = TRUE) 11 | } 12 | \arguments{ 13 | \item{id}{character, used to identify a namespace} 14 | 15 | \item{help}{logical, indicates if help panels to be displayed} 16 | } 17 | \value{ 18 | a \code{shiny::\link[shiny]{tagList}} containing UI elements 19 | } 20 | \description{ 21 | These functions return the ui elements for a side panel and a main panel. 22 | } 23 | \details{ 24 | The side elements are the inputs; the main elements are the outputs. 25 | } 26 | \examples{ 27 | 28 | } 29 | -------------------------------------------------------------------------------- /man/dygraph_ui_input.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dygraph.R 3 | \name{dygraph_ui_input} 4 | \alias{dygraph_ui_input} 5 | \title{UI input elements for dygraph module.} 6 | \usage{ 7 | dygraph_ui_input(id) 8 | } 9 | \arguments{ 10 | \item{id, }{character used to specify namesapce, see \code{shiny::\link[shiny]{NS}}} 11 | } 12 | \value{ 13 | a \code{shiny::\link[shiny]{tagList}} containing UI elements 14 | } 15 | \description{ 16 | Used to define the UI input elements within the \code{dygraph} shiny module. 17 | } 18 | \details{ 19 | This function returns a \code{shiny::\link[shiny]{tagList}} with members: 20 | 21 | \describe{ 22 | \item{time}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify time variable} 23 | \item{y1}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify y1-axis variable} 24 | \item{y2}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify y2-axis variable} 25 | } 26 | 27 | The purpose is to specify the UI elements - another set of functions can be used to specify layout. 28 | } 29 | \seealso{ 30 | Other dygraph module functions: \code{\link{dygraph_server}}, 31 | \code{\link{dygraph_ui_misc}}, 32 | \code{\link{dygraph_ui_output}} 33 | } 34 | \concept{dygraph module functions} 35 | -------------------------------------------------------------------------------- /man/dygraph_ui_misc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dygraph.R 3 | \name{dygraph_ui_misc} 4 | \alias{dygraph_ui_misc} 5 | \title{UI miscellaneous elements for dygraph module.} 6 | \usage{ 7 | dygraph_ui_misc(id) 8 | } 9 | \arguments{ 10 | \item{id, }{character used to specify namesapce, see \code{shiny::\link[shiny]{NS}}} 11 | } 12 | \value{ 13 | a \code{shiny::\link[shiny]{tagList}} containing UI elements 14 | } 15 | \description{ 16 | Used to define the UI input elements within the \code{dygraph} shiny module. 17 | } 18 | \details{ 19 | This function returns a \code{shiny::\link[shiny]{tagList}} with members: 20 | 21 | \describe{ 22 | \item{help}{\code{shiny::\link[shiny]{tags}$pre}, contains guidance for using dygraph} 23 | } 24 | 25 | The purpose is to specify the UI elements - another set of functions can be used to specify layout. 26 | } 27 | \seealso{ 28 | Other dygraph module functions: \code{\link{dygraph_server}}, 29 | \code{\link{dygraph_ui_input}}, 30 | \code{\link{dygraph_ui_output}} 31 | } 32 | \concept{dygraph module functions} 33 | -------------------------------------------------------------------------------- /man/dygraph_ui_output.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dygraph.R 3 | \name{dygraph_ui_output} 4 | \alias{dygraph_ui_output} 5 | \title{UI output elements for dygraph module.} 6 | \usage{ 7 | dygraph_ui_output(id) 8 | } 9 | \arguments{ 10 | \item{id, }{character used to specify namesapce, see \code{shiny::\link[shiny]{NS}}} 11 | } 12 | \value{ 13 | a \code{shiny::\link[shiny]{tagList}} 14 | } 15 | \description{ 16 | Used to define the UI output elements within the \code{dygraph} shiny module. 17 | } 18 | \details{ 19 | This function returns a \code{shiny::\link[shiny]{tagList}} with members: 20 | 21 | \describe{ 22 | \item{status}{\code{shiny::\link[shiny]{htmlOutput}}, used to display status of the module} 23 | } 24 | 25 | The purpose is to specify the UI elements - another set of functions can be used to specify layout. 26 | } 27 | \seealso{ 28 | Other dygraph module functions: \code{\link{dygraph_server}}, 29 | \code{\link{dygraph_ui_input}}, 30 | \code{\link{dygraph_ui_misc}} 31 | } 32 | \concept{dygraph module functions} 33 | -------------------------------------------------------------------------------- /man/isValidy.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{isValidy} 4 | \alias{isValidy} 5 | \title{checks to see that an expression passes shiny validation} 6 | \usage{ 7 | isValidy(...) 8 | } 9 | \arguments{ 10 | \item{...}{expression to pass to \code{shiny::req()}} 11 | } 12 | \value{ 13 | logical, returns \code{TRUE} if shiny validation passes 14 | } 15 | \description{ 16 | Useful if you need to return \code{TRUE}/\code{FALSE} on the validity of a 17 | shiny reactive expression 18 | } 19 | -------------------------------------------------------------------------------- /man/observe_class_swap.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{observe_class_swap} 4 | \alias{observe_class_swap} 5 | \title{swap out classes on an html element} 6 | \usage{ 7 | observe_class_swap(id, expr, env = parent.frame(), quoted = FALSE) 8 | } 9 | \arguments{ 10 | \item{id}{A character vector to identify the html element to operate on.} 11 | 12 | \item{expr}{An expression that returns a character vector to add to the html element.} 13 | 14 | \item{env}{The environment in which to evaluate \code{expr}.} 15 | 16 | \item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})? This 17 | is useful if you want to save an expression in a variable.} 18 | } 19 | \value{ 20 | nothing 21 | } 22 | \description{ 23 | This function stores the value of the last class to be added (using this function), 24 | then removes that class before addding the new class. For example, this may be useful 25 | if you want to modify a panel to show an alert. 26 | } 27 | \details{ 28 | As this is an observer, there is no return value. It is called for the side-effect of 29 | changing the class of the html element. 30 | 31 | This is based on \code{shiny::renderText()} 32 | } 33 | -------------------------------------------------------------------------------- /man/pre_scroll.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{pre_scroll} 4 | \alias{pre_scroll} 5 | \title{html for scrollable pre-formatted text} 6 | \source{ 7 | \url{http://stackoverflow.com/questions/10374171/how-to-make-twitter-bootstraps-pre-blocks-scroll-horizontally} 8 | } 9 | \usage{ 10 | pre_scroll(...) 11 | } 12 | \arguments{ 13 | \item{...}{expression used to fill text} 14 | } 15 | \description{ 16 | This is used as the \code{container} argument in \code{shiny::\link[shiny]{htmlOutput}} 17 | } 18 | -------------------------------------------------------------------------------- /man/reactive_validate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{reactive_validate} 4 | \alias{reactive_validate} 5 | \title{combines handling of reactive and validating the contents} 6 | \usage{ 7 | reactive_validate(expr, .f = identity, message, label = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{expr}{expression, or reactive that returns an expressiondo} 11 | 12 | \item{.f}{function that takes a single arg (object), returns TRUE if valid} 13 | 14 | \item{message}{passed to need} 15 | 16 | \item{label}{passed to need} 17 | 18 | \item{...}{other args to pass along to .f} 19 | } 20 | \value{ 21 | reactive that returns the expression 22 | } 23 | \description{ 24 | combines handling of reactive and validating the contents 25 | } 26 | -------------------------------------------------------------------------------- /man/read_delim_server.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_delim.R, R/read_delim_sidebar.R 3 | \name{read_delim_server} 4 | \alias{read_delim_server} 5 | \alias{read_delim_sidebar_server} 6 | \title{Server function for delimted-file reader.} 7 | \usage{ 8 | read_delim_server(input, output, session, delim = ",", decimal_mark = ".") 9 | 10 | read_delim_sidebar_server(input, output, session, delim = ",", 11 | decimal_mark = ".") 12 | } 13 | \arguments{ 14 | \item{input}{standard \code{shiny} input} 15 | 16 | \item{output}{standard \code{shiny} output} 17 | 18 | \item{session}{standard \code{shiny} session} 19 | 20 | \item{delim}{character, default for parsing delimiter} 21 | 22 | \item{decimal_mark}{character, default for decimal mark} 23 | } 24 | \value{ 25 | a list with members: 26 | \code{rct_txt} \code{shiny::\link[shiny]{reactive}}, returns raw text 27 | \code{rct_data} \code{shiny::\link[shiny]{reactive}}, returns tbl_df of the parsed text 28 | } 29 | \description{ 30 | Used to define the server within the \code{read_delim} shiny module. 31 | } 32 | \examples{ 33 | shinyServer(function(input, output, session) { 34 | 35 | list_rct <- callModule( 36 | module = read_delim_server, 37 | id = "foo" 38 | ) 39 | 40 | observe(print(list_rct$rct_data())) 41 | }) 42 | 43 | } 44 | \seealso{ 45 | read_delim_sidebar_main 46 | 47 | Other read_delim module functions: \code{\link{read_delim_ui_input}}, 48 | \code{\link{read_delim_ui_misc}}, 49 | \code{\link{read_delim_ui_output}} 50 | } 51 | \concept{read_delim module functions} 52 | -------------------------------------------------------------------------------- /man/read_delim_sidebar_side.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_delim_sidebar.R 3 | \name{read_delim_sidebar_side} 4 | \alias{read_delim_sidebar_side} 5 | \alias{read_delim_sidebar_main} 6 | \title{Sidebar layout for read_delim module} 7 | \usage{ 8 | read_delim_sidebar_side(id) 9 | 10 | read_delim_sidebar_main(id) 11 | } 12 | \arguments{ 13 | \item{id}{character, used to identify a namespace} 14 | } 15 | \value{ 16 | a \code{shiny::\link[shiny]{tagList}} containing UI elements 17 | } 18 | \description{ 19 | These functions return the ui elements for a side panel and a main panel. 20 | } 21 | \details{ 22 | The side elements are the inputs; the main elements are the outputs. 23 | } 24 | \examples{ 25 | shinyUI( 26 | fluidPage( 27 | shinyjs::useShinyjs(), 28 | sidebarLayout( 29 | sidebarPanel(read_delim_sidebar_side("foo")), 30 | mainPanel(read_delim_sidebar_main("foo")) 31 | ) 32 | ) 33 | ) 34 | 35 | } 36 | -------------------------------------------------------------------------------- /man/read_delim_ui_input.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_delim.R 3 | \name{read_delim_ui_input} 4 | \alias{read_delim_ui_input} 5 | \title{UI input elements for delimited-file reader.} 6 | \usage{ 7 | read_delim_ui_input(id) 8 | } 9 | \arguments{ 10 | \item{id, }{character used to specify namesapce, see \code{shiny::\link[shiny]{NS}}} 11 | } 12 | \value{ 13 | a \code{shiny::\link[shiny]{tagList}} containing UI elements 14 | } 15 | \description{ 16 | Used to define the UI input elements within the \code{read_delim} shiny module. 17 | } 18 | \details{ 19 | This function returns a \code{shiny::\link[shiny]{tagList}} with members: 20 | 21 | \describe{ 22 | \item{file}{\code{shiny::\link[shiny]{fileInput}}, used to specify file} 23 | \item{delim}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify delimiter character} 24 | \item{decimal_mark}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify decimal mark} 25 | \item{tz_parse}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify timezone to parse} 26 | \item{tz_parse_modal}{\code{shinyBS::\link[shinyBS]{bsModal}}, used explain timezone-parsing} 27 | \item{tz_display}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify timezone to display} 28 | \item{tz_display_modal}{\code{shinyBS::\link[shinyBS]{bsModal}}, used explain timezone-parsing} 29 | } 30 | 31 | The purpose is to specify the UI elements - another set of functions can be used to specify layout. 32 | } 33 | \seealso{ 34 | Other read_delim module functions: \code{\link{read_delim_server}}, 35 | \code{\link{read_delim_ui_misc}}, 36 | \code{\link{read_delim_ui_output}} 37 | } 38 | \concept{read_delim module functions} 39 | -------------------------------------------------------------------------------- /man/read_delim_ui_misc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_delim.R 3 | \name{read_delim_ui_misc} 4 | \alias{read_delim_ui_misc} 5 | \title{UI miscellaneous elements for delimited-file reader.} 6 | \usage{ 7 | read_delim_ui_misc(id) 8 | } 9 | \arguments{ 10 | \item{id, }{character used to specify namesapce, see \code{shiny::\link[shiny]{NS}}} 11 | } 12 | \value{ 13 | a \code{shiny::\link[shiny]{tagList}} containing UI elements 14 | } 15 | \description{ 16 | Used to define the UI miscellaneous elements within the \code{read_delim} shiny module. 17 | } 18 | \seealso{ 19 | Other read_delim module functions: \code{\link{read_delim_server}}, 20 | \code{\link{read_delim_ui_input}}, 21 | \code{\link{read_delim_ui_output}} 22 | } 23 | \concept{read_delim module functions} 24 | -------------------------------------------------------------------------------- /man/read_delim_ui_output.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_delim.R 3 | \name{read_delim_ui_output} 4 | \alias{read_delim_ui_output} 5 | \title{UI output elements for delimited-file reader.} 6 | \usage{ 7 | read_delim_ui_output(id) 8 | } 9 | \arguments{ 10 | \item{id, }{character used to specify namesapce, see \code{shiny::\link[shiny]{NS}}} 11 | } 12 | \value{ 13 | a \code{shiny::\link[shiny]{tagList}} containing UI elements 14 | } 15 | \description{ 16 | Used to define the UI output elements within the \code{read_delim} shiny module. 17 | } 18 | \details{ 19 | This function returns a \code{shiny::\link[shiny]{tagList}} with members: 20 | 21 | \describe{ 22 | \item{status}{\code{shiny::\link[shiny]{htmlOutput}}, used to display status of the module} 23 | \item{text}{\code{shiny::\link[shiny]{htmlOutput}}, used to display first few lines of text from file} 24 | \item{data}{\code{shiny::\link[shiny]{htmlOutput}}, used to display first few lines of the parsed dataframe} 25 | } 26 | 27 | The purpose is to specify the UI elements - another set of functions can be used to specify layout. 28 | } 29 | \seealso{ 30 | Other read_delim module functions: \code{\link{read_delim_server}}, 31 | \code{\link{read_delim_ui_input}}, 32 | \code{\link{read_delim_ui_misc}} 33 | } 34 | \concept{read_delim module functions} 35 | -------------------------------------------------------------------------------- /man/static.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{static} 4 | \alias{static} 5 | \title{strip away the reactivity} 6 | \usage{ 7 | static(x) 8 | } 9 | \arguments{ 10 | \item{x}{} 11 | } 12 | \value{ 13 | \code{x}, if not reactive, \code{x()} if reactive 14 | } 15 | \description{ 16 | This is useful for functions where you want to be able to take either reactive 17 | arguements or static arguments. 18 | } 19 | -------------------------------------------------------------------------------- /man/status_content.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{status_content} 4 | \alias{status_content} 5 | \title{use input and result to generate message and class of status} 6 | \usage{ 7 | status_content(status) 8 | } 9 | \arguments{ 10 | \item{status}{list with components \code{input} and \code{result}} 11 | } 12 | \value{ 13 | list with components \code{class} and \code{message} 14 | } 15 | \description{ 16 | The argument \code{status} shall be a list with two members: \code{input} and \code{result}. 17 | Each of those lists shall have components \code{index}, \code{is_valid}, and \code{message}. 18 | } 19 | \details{ 20 | This return value is a list with members \code{class} and \code{message}. The \code{class} can be used by 21 | \link{observe_class_swap} to change the appearance of an output. The \code{message} can be used as the 22 | text displayed by the output. 23 | } 24 | -------------------------------------------------------------------------------- /man/text_html.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{text_html} 4 | \alias{text_html} 5 | \title{convert text into an html fragment} 6 | \usage{ 7 | text_html(text, n = 6) 8 | } 9 | \arguments{ 10 | \item{text, }{text with newline character} 11 | 12 | \item{n, }{number of lines to keep} 13 | } 14 | \value{ 15 | html fragment 16 | } 17 | \description{ 18 | convert text into an html fragment 19 | } 20 | -------------------------------------------------------------------------------- /man/tibble_html.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{tibble_html} 4 | \alias{tibble_html} 5 | \title{convert a tbl_df printout into an html fragment} 6 | \usage{ 7 | tibble_html(data) 8 | } 9 | \arguments{ 10 | \item{data, }{data.frame} 11 | } 12 | \value{ 13 | html fragment 14 | } 15 | \description{ 16 | convert a tbl_df printout into an html fragment 17 | } 18 | -------------------------------------------------------------------------------- /man/update_selected.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{update_selected} 4 | \alias{update_selected} 5 | \title{determine the proper selection} 6 | \usage{ 7 | update_selected(value, choices, index = NULL) 8 | } 9 | \arguments{ 10 | \item{value}{character vector, current value of an input} 11 | 12 | \item{choices}{character vector, new choices for an input} 13 | 14 | \item{index}{integer, if \code{value} is not in defualt \code{choices}, 15 | uses this index of \code{choices}.} 16 | } 17 | \value{ 18 | character vector of proposed selection 19 | } 20 | \description{ 21 | Used for \code{shiny::\link[shiny]{selectInput}} to allow you to 22 | update its selection when its choices change. 23 | } 24 | \examples{ 25 | update_selected("a", c("a", "b", "c")) 26 | update_selected("a", NULL) 27 | update_selected("d", c("a", "b", "c")) 28 | update_selected("d", c("a", "b", "c"), index = 1) 29 | 30 | } 31 | -------------------------------------------------------------------------------- /man/use_pod.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/infrastructure.R 3 | \name{use_pod} 4 | \alias{use_pod} 5 | \title{create a shinypod from a template} 6 | \usage{ 7 | use_pod(name, description, overwrite = FALSE) 8 | } 9 | \arguments{ 10 | \item{name}{character, name to prepend to the filenames} 11 | 12 | \item{description}{character, short description to use in the function documentation} 13 | 14 | \item{overwrite}{logical, indicates if an existing file can be overwritten} 15 | } 16 | \value{ 17 | list of TRUE values 18 | } 19 | \description{ 20 | This function is used to write out a template function for a shinypod, 21 | both for the functional layer, in \code{foo_pod.R}, and a presentation layer, in 22 | \code{foo_pod_sidebar.R} 23 | } 24 | \details{ 25 | This assumes that you are working in a directory in an R package; the files will be written to 26 | the \code{R} directory. 27 | } 28 | -------------------------------------------------------------------------------- /man/write_delim_server.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/write_delim.R 3 | \name{write_delim_server} 4 | \alias{write_delim_server} 5 | \title{Server function for delimted-file writer.} 6 | \usage{ 7 | write_delim_server(input, output, session, data, filename = "data.csv", 8 | delim = ",", status_alert = TRUE) 9 | } 10 | \arguments{ 11 | \item{input}{standard \code{shiny} input} 12 | 13 | \item{output}{standard \code{shiny} output} 14 | 15 | \item{session}{standard \code{shiny} session} 16 | 17 | \item{data}{data.frame} 18 | 19 | \item{delim}{character, possibly reactive, delimiter mark to use as a default} 20 | 21 | \item{status_alert}{logical, possibly reactive, indicates if to change alert-class of status output} 22 | } 23 | \value{ 24 | a \code{shiny::\link[shiny]{reactive}} containing a tbl_df of the parsed text 25 | } 26 | \description{ 27 | Used to define the server within the \code{write_delim} shiny module. 28 | } 29 | \examples{ 30 | shinyServer(function(input, output, session) { 31 | 32 | rct_data <- callModule( 33 | module = read_delim_server, 34 | id = "foo" 35 | ) 36 | 37 | observe(print(rct_data())) 38 | }) 39 | 40 | } 41 | \seealso{ 42 | Other write_delim module functions: \code{\link{write_delim_ui_input}}, 43 | \code{\link{write_delim_ui_output}} 44 | } 45 | \concept{write_delim module functions} 46 | -------------------------------------------------------------------------------- /man/write_delim_sidebar_side.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/write_delim_sidebar.R 3 | \name{write_delim_sidebar_side} 4 | \alias{write_delim_sidebar_side} 5 | \alias{write_delim_sidebar_main} 6 | \title{Sidebar layout for write_delim module} 7 | \usage{ 8 | write_delim_sidebar_side(id) 9 | 10 | write_delim_sidebar_main(id) 11 | } 12 | \arguments{ 13 | \item{id}{character, used to identify a namespace} 14 | } 15 | \value{ 16 | a \code{shiny::\link[shiny]{tagList}} containing UI elements 17 | } 18 | \description{ 19 | These functions return the ui elements for a side panel and a main panel. 20 | } 21 | \details{ 22 | The side elements are the inputs; the main elements are the outputs. 23 | } 24 | \examples{ 25 | shinyUI( 26 | fluidPage( 27 | shinyjs::useShinyjs(), 28 | sidebarLayout( 29 | sidebarPanel(write_delim_sidebar("foo")), 30 | mainPanel(read_delim_main("foo")) 31 | ) 32 | ) 33 | ) 34 | 35 | } 36 | -------------------------------------------------------------------------------- /man/write_delim_ui_input.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/write_delim.R 3 | \name{write_delim_ui_input} 4 | \alias{write_delim_ui_input} 5 | \title{UI input elements for delimited-file writer.} 6 | \usage{ 7 | write_delim_ui_input(id) 8 | } 9 | \arguments{ 10 | \item{id, }{character used to specify namesapce, see \code{shiny::\link[shiny]{NS}}} 11 | } 12 | \value{ 13 | a \code{shiny::\link[shiny]{tagList}} containing UI elements 14 | } 15 | \description{ 16 | Used to define the UI input elements within the \code{write_delim} shiny module. 17 | } 18 | \details{ 19 | This function returns a \code{shiny::\link[shiny]{tagList}} with members: 20 | 21 | \describe{ 22 | \item{delim}{\code{shiny::\link[shiny]{selectizeInput}}, used to specify delimiter character} 23 | \item{filename}{\code{shiny::\link[shiny]{textInput}}, used to specify file name} 24 | \item{download}{\code{shiny::\link[shiny]{downloadButton}}, download button} 25 | } 26 | 27 | The purpose is to specify the UI elements - another set of functions can be used to specify layout. 28 | } 29 | \seealso{ 30 | Other write_delim module functions: \code{\link{write_delim_server}}, 31 | \code{\link{write_delim_ui_output}} 32 | } 33 | \concept{write_delim module functions} 34 | -------------------------------------------------------------------------------- /man/write_delim_ui_output.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/write_delim.R 3 | \name{write_delim_ui_output} 4 | \alias{write_delim_ui_output} 5 | \title{UI output elements for delimited-file writer.} 6 | \usage{ 7 | write_delim_ui_output(id) 8 | } 9 | \arguments{ 10 | \item{id, }{character used to specify namesapce, see \code{shiny::\link[shiny]{NS}}} 11 | } 12 | \value{ 13 | a \code{shiny::\link[shiny]{tagList}} containing UI elements 14 | } 15 | \description{ 16 | Used to define the UI output elements within the \code{write_delim} shiny module. 17 | } 18 | \details{ 19 | This function returns a \code{shiny::\link[shiny]{tagList}} with members: 20 | 21 | \describe{ 22 | \item{data}{\code{shiny::\link[shiny]{htmlOutput}}, used to display first few lines of the dataframe} 23 | \item{text}{\code{shiny::\link[shiny]{htmlOutput}}, used to display first few lines of text from file} 24 | \item{text}{\code{shiny::\link[shiny]{htmlOutput}}, used to display first text status } 25 | } 26 | 27 | The purpose is to specify the UI elements - another set of functions can be used to specify layout. 28 | } 29 | \seealso{ 30 | Other write_delim module functions: \code{\link{write_delim_server}}, 31 | \code{\link{write_delim_ui_input}} 32 | } 33 | \concept{write_delim module functions} 34 | -------------------------------------------------------------------------------- /man/wx_ames.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/wx_ames.R 3 | \docType{data} 4 | \name{wx_ames} 5 | \alias{wx_ames} 6 | \title{Weather observations at Ames - Jan. 2014} 7 | \format{A data frame with 983 rows and 19 variables: 8 | \describe{ 9 | \item{date}{POSIXct, instant of the observation} 10 | \item{temp}{double, dry-bulb temperature, °C} 11 | \item{dew_pt}{double, dew-point temperature, °C} 12 | \item{hum}{double, relative humidity, \%} 13 | \item{wind_spd}{double, wind-speed, m/s} 14 | \item{wind_gust}{double, wind-gust, m/s} 15 | \item{dir}{character, direction from which wind blows} 16 | \item{vis}{double, visibility, km} 17 | \item{pressure}{double, sea-level pressure, mbar} 18 | \item{wind_chill}{double, wind-chill temperature, °C} 19 | \item{heat_index}{double, head-index temperature, °C} 20 | \item{precip}{double, precipitation since previous observation, mm} 21 | \item{cond}{character, description of conditions} 22 | \item{fog}{integer, indicates if fog is present} 23 | \item{rain}{integer, indicates if it is raining is present} 24 | \item{snow}{integer, indicates if it is snowing} 25 | \item{hail}{integer, indicates if it is hailing} 26 | \item{thunder}{integer, indicates if thunder is present} 27 | \item{tornado}{integer, indicates if a tornado is present} 28 | }} 29 | \source{ 30 | \url{http://www.wunderground.com/} 31 | } 32 | \usage{ 33 | wx_ames 34 | } 35 | \description{ 36 | A dataset containing hourly weather observations at Ames, Iowa (US) for 37 | the month of January 2014. Data obtained from Weather Undergound's API, 38 | using the \code{rwunderground} package. 39 | } 40 | \keyword{datasets} 41 | -------------------------------------------------------------------------------- /packrat/init.R: -------------------------------------------------------------------------------- 1 | local({ 2 | 3 | ## Helper function to get the path to the library directory for a 4 | ## given packrat project. 5 | getPackratLibDir <- function(projDir = NULL) { 6 | path <- file.path("packrat", "lib", R.version$platform, getRversion()) 7 | 8 | if (!is.null(projDir)) { 9 | 10 | ## Strip trailing slashes if necessary 11 | projDir <- sub("/+$", "", projDir) 12 | 13 | ## Only prepend path if different from current working dir 14 | if (!identical(normalizePath(projDir), normalizePath(getwd()))) 15 | path <- file.path(projDir, path) 16 | } 17 | 18 | path 19 | } 20 | 21 | ## Ensure that we set the packrat library directory relative to the 22 | ## project directory. Normally, this should be the working directory, 23 | ## but we also use '.rs.getProjectDirectory()' if necessary (e.g. we're 24 | ## rebuilding a project while within a separate directory) 25 | libDir <- if (exists(".rs.getProjectDirectory")) 26 | getPackratLibDir(.rs.getProjectDirectory()) 27 | else 28 | getPackratLibDir() 29 | 30 | ## Unload packrat in case it's loaded -- this ensures packrat _must_ be 31 | ## loaded from the private library. Note that `requireNamespace` will 32 | ## succeed if the package is already loaded, regardless of lib.loc! 33 | if ("packrat" %in% loadedNamespaces()) 34 | try(unloadNamespace("packrat"), silent = TRUE) 35 | 36 | if (suppressWarnings(requireNamespace("packrat", quietly = TRUE, lib.loc = libDir))) { 37 | 38 | # Check 'print.banner.on.startup' -- when NA and RStudio, don't print 39 | print.banner <- packrat::get_opts("print.banner.on.startup") 40 | if (print.banner == "auto" && is.na(Sys.getenv("RSTUDIO", unset = NA))) { 41 | print.banner <- TRUE 42 | } else { 43 | print.banner <- FALSE 44 | } 45 | return(packrat::on(print.banner = print.banner)) 46 | } 47 | 48 | ## Escape hatch to allow RStudio to handle bootstrapping. This 49 | ## enables RStudio to provide print output when automagically 50 | ## restoring a project from a bundle on load. 51 | if (!is.na(Sys.getenv("RSTUDIO", unset = NA)) && 52 | is.na(Sys.getenv("RSTUDIO_PACKRAT_BOOTSTRAP", unset = NA))) { 53 | Sys.setenv("RSTUDIO_PACKRAT_BOOTSTRAP" = "1") 54 | setHook("rstudio.sessionInit", function(...) { 55 | # Ensure that, on sourcing 'packrat/init.R', we are 56 | # within the project root directory 57 | if (exists(".rs.getProjectDirectory")) { 58 | owd <- getwd() 59 | setwd(.rs.getProjectDirectory()) 60 | on.exit(setwd(owd), add = TRUE) 61 | } 62 | source("packrat/init.R") 63 | }) 64 | return(invisible(NULL)) 65 | } 66 | 67 | ## Bootstrapping -- only performed in interactive contexts, 68 | ## or when explicitly asked for on the command line 69 | if (interactive() || "--bootstrap-packrat" %in% commandArgs(TRUE)) { 70 | 71 | message("Packrat is not installed in the local library -- ", 72 | "attempting to bootstrap an installation...") 73 | 74 | ## We need utils for the following to succeed -- there are calls to functions 75 | ## in 'restore' that are contained within utils. utils gets loaded at the 76 | ## end of start-up anyhow, so this should be fine 77 | library("utils", character.only = TRUE) 78 | 79 | ## Install packrat into local project library 80 | packratSrcPath <- list.files(full.names = TRUE, 81 | file.path("packrat", "src", "packrat") 82 | ) 83 | 84 | ## No packrat tarballs available locally -- try some other means of installation 85 | if (!length(packratSrcPath)) { 86 | 87 | message("> No source tarball of packrat available locally") 88 | 89 | ## There are no packrat sources available -- try using a version of 90 | ## packrat installed in the user library to bootstrap 91 | if (requireNamespace("packrat", quietly = TRUE) && packageVersion("packrat") >= "0.2.0.99") { 92 | message("> Using user-library packrat (", 93 | packageVersion("packrat"), 94 | ") to bootstrap this project") 95 | } 96 | 97 | ## Couldn't find a user-local packrat -- try finding and using devtools 98 | ## to install 99 | else if (requireNamespace("devtools", quietly = TRUE)) { 100 | message("> Attempting to use devtools::install_github to install ", 101 | "a temporary version of packrat") 102 | library(stats) ## for setNames 103 | devtools::install_github("rstudio/packrat") 104 | } 105 | 106 | ## Try downloading packrat from CRAN if available 107 | else if ("packrat" %in% rownames(available.packages())) { 108 | message("> Installing packrat from CRAN") 109 | install.packages("packrat") 110 | } 111 | 112 | ## Fail -- couldn't find an appropriate means of installing packrat 113 | else { 114 | stop("Could not automatically bootstrap packrat -- try running ", 115 | "\"'install.packages('devtools'); devtools::install_github('rstudio/packrat')\"", 116 | "and restarting R to bootstrap packrat.") 117 | } 118 | 119 | # Restore the project, unload the temporary packrat, and load the private packrat 120 | packrat::restore(prompt = FALSE, restart = TRUE) 121 | 122 | ## This code path only reached if we didn't restart earlier 123 | unloadNamespace("packrat") 124 | requireNamespace("packrat", lib.loc = libDir, quietly = TRUE) 125 | return(packrat::on()) 126 | 127 | } 128 | 129 | ## Multiple packrat tarballs available locally -- try to choose one 130 | ## TODO: read lock file and infer most appropriate from there; low priority because 131 | ## after bootstrapping packrat a restore should do the right thing 132 | if (length(packratSrcPath) > 1) { 133 | warning("Multiple versions of packrat available in the source directory;", 134 | "using packrat source:\n- ", shQuote(packratSrcPath)) 135 | packratSrcPath <- packratSrcPath[[1]] 136 | } 137 | 138 | 139 | lib <- file.path("packrat", "lib", R.version$platform, getRversion()) 140 | if (!file.exists(lib)) { 141 | dir.create(lib, recursive = TRUE) 142 | } 143 | lib <- normalizePath(lib, winslash = "/") 144 | 145 | message("> Installing packrat into project private library:") 146 | message("- ", shQuote(lib)) 147 | 148 | surround <- function(x, with) { 149 | if (!length(x)) return(character()) 150 | paste0(with, x, with) 151 | } 152 | 153 | ## The following is performed because a regular install.packages call can fail 154 | peq <- function(x, y) paste(x, y, sep = " = ") 155 | installArgs <- c( 156 | peq("pkgs", surround(packratSrcPath, with = "'")), 157 | peq("lib", surround(lib, with = "'")), 158 | peq("repos", "NULL"), 159 | peq("type", surround("source", with = "'")) 160 | ) 161 | installCmd <- paste(sep = "", 162 | "utils::install.packages(", 163 | paste(installArgs, collapse = ", "), 164 | ")") 165 | 166 | fullCmd <- paste( 167 | surround(file.path(R.home("bin"), "R"), with = "\""), 168 | "--vanilla", 169 | "--slave", 170 | "-e", 171 | surround(installCmd, with = "\"") 172 | ) 173 | system(fullCmd) 174 | 175 | ## Tag the installed packrat so we know it's managed by packrat 176 | ## TODO: should this be taking information from the lockfile? this is a bit awkward 177 | ## because we're taking an un-annotated packrat source tarball and simply assuming it's now 178 | ## an 'installed from source' version 179 | 180 | ## -- InstallAgent -- ## 181 | installAgent <- 'InstallAgent: packrat 0.4.6-1' 182 | 183 | ## -- InstallSource -- ## 184 | installSource <- 'InstallSource: source' 185 | 186 | packratDescPath <- file.path(lib, "packrat", "DESCRIPTION") 187 | DESCRIPTION <- readLines(packratDescPath) 188 | DESCRIPTION <- c(DESCRIPTION, installAgent, installSource) 189 | cat(DESCRIPTION, file = packratDescPath, sep = "\n") 190 | 191 | # Otherwise, continue on as normal 192 | message("> Attaching packrat") 193 | library("packrat", character.only = TRUE, lib.loc = lib) 194 | 195 | message("> Restoring library") 196 | restore(restart = FALSE) 197 | 198 | # If the environment allows us to restart, do so with a call to restore 199 | restart <- getOption("restart") 200 | if (!is.null(restart)) { 201 | message("> Packrat bootstrap successfully completed. ", 202 | "Restarting R and entering packrat mode...") 203 | return(restart()) 204 | } 205 | 206 | # Callers (source-erers) can define this hidden variable to make sure we don't enter packrat mode 207 | # Primarily useful for testing 208 | if (!exists(".__DONT_ENTER_PACKRAT_MODE__.") && interactive()) { 209 | message("> Packrat bootstrap successfully completed. Entering packrat mode...") 210 | packrat::on() 211 | } 212 | 213 | Sys.unsetenv("RSTUDIO_PACKRAT_BOOTSTRAP") 214 | 215 | } 216 | 217 | }) 218 | -------------------------------------------------------------------------------- /packrat/packrat.lock: -------------------------------------------------------------------------------- 1 | PackratFormat: 1.4 2 | PackratVersion: 0.4.6.1 3 | RVersion: 3.2.3 4 | Repos: CRAN=https://cran.rstudio.com/ 5 | 6 | Package: BH 7 | Source: CRAN 8 | Version: 1.60.0-1 9 | Hash: 889445e87a2acd4cc58440957f3b0d1a 10 | 11 | Package: DBI 12 | Source: CRAN 13 | Version: 0.3.1 14 | Hash: 096699d1ac1cf530acfc646a0c90ee5d 15 | 16 | Package: PKI 17 | Source: CRAN 18 | Version: 0.1-3 19 | Hash: aca3e459c659b6d8266538520f72ba19 20 | Requires: base64enc 21 | 22 | Package: R6 23 | Source: CRAN 24 | Version: 2.1.1 25 | Hash: 20a88b2c9c84aecff2702789a4d102f5 26 | 27 | Package: RCurl 28 | Source: CRAN 29 | Version: 1.95-4.7 30 | Hash: 7756ed9df5d79ca87bc9e93f85d89b87 31 | Requires: bitops 32 | 33 | Package: RJSONIO 34 | Source: CRAN 35 | Version: 1.3-0 36 | Hash: fb672e20eb6f3010a3639f855d8ef6de 37 | 38 | Package: Rcpp 39 | Source: CRAN 40 | Version: 0.12.3 41 | Hash: 11ace6a9a186c17a42e0fa2c49af1223 42 | 43 | Package: assertthat 44 | Source: CRAN 45 | Version: 0.1 46 | Hash: 0afb92b59b02593c70ff8046700ba9d3 47 | 48 | Package: base64enc 49 | Source: CRAN 50 | Version: 0.1-3 51 | Hash: c590d29e555926af053055e23ee79efb 52 | 53 | Package: bitops 54 | Source: CRAN 55 | Version: 1.0-6 56 | Hash: 67d0775189fd0041d95abca618c5c07e 57 | 58 | Package: brew 59 | Source: CRAN 60 | Version: 1.0-6 61 | Hash: 931f9972deae0f205e1c78a51f33149b 62 | 63 | Package: caTools 64 | Source: CRAN 65 | Version: 1.17.1 66 | Hash: 97cb6f6293cd18d17df77a6383cc6763 67 | Requires: bitops 68 | 69 | Package: crayon 70 | Source: CRAN 71 | Version: 1.3.1 72 | Hash: b61d34886cf0f4b4fc4e4f52ea249390 73 | Requires: memoise 74 | 75 | Package: curl 76 | Source: CRAN 77 | Version: 0.9.4 78 | Hash: f0845d30266233da7d910ac687a5174b 79 | 80 | Package: devtools 81 | Source: CRAN 82 | Version: 1.9.1 83 | Hash: 894e4e2f04fb749f786f15cf01181a0c 84 | Requires: curl, digest, evaluate, git2r, httr, jsonlite, memoise, 85 | roxygen2, rstudioapi, rversions, whisker 86 | 87 | Package: digest 88 | Source: CRAN 89 | Version: 0.6.9 90 | Hash: fd55d5a024f160fc001a5ece1e27782d 91 | 92 | Package: dplyr 93 | Source: CRAN 94 | Version: 0.4.3 95 | Hash: d7005d9f57021e610fa38635d7a0b8e0 96 | Requires: BH, DBI, R6, Rcpp, assertthat, lazyeval, magrittr 97 | 98 | Package: dygraphs 99 | Source: CRAN 100 | Version: 0.6 101 | Hash: b02fc4b803daadd33556094a1dce1186 102 | Requires: htmlwidgets, magrittr, xts, zoo 103 | 104 | Package: evaluate 105 | Source: CRAN 106 | Version: 0.8 107 | Hash: aac00bd789bac10970b50e3b7e0cab04 108 | Requires: stringr 109 | 110 | Package: formatR 111 | Source: CRAN 112 | Version: 1.2.1 113 | Hash: 54c730c712edd6087972ecf99bf87c55 114 | 115 | Package: git2r 116 | Source: CRAN 117 | Version: 0.13.1 118 | Hash: 10b695e315f922046c7d56b9dc7150db 119 | 120 | Package: highr 121 | Source: CRAN 122 | Version: 0.5.1 123 | Hash: 114ef5abcf58bebbf6ac083b9cacbbd8 124 | 125 | Package: htmltools 126 | Source: CRAN 127 | Version: 0.3 128 | Hash: 7ccc01f4d22d73d0d9b0d2a7781e7ff6 129 | Requires: digest 130 | 131 | Package: htmlwidgets 132 | Source: CRAN 133 | Version: 0.5 134 | Hash: 0aa33e8666baac6fcff4e376789b9c2e 135 | Requires: htmltools, jsonlite, yaml 136 | 137 | Package: httpuv 138 | Source: CRAN 139 | Version: 1.3.3 140 | Hash: d440b2e539ccef77b9105051291a7628 141 | Requires: Rcpp 142 | 143 | Package: httr 144 | Source: CRAN 145 | Version: 1.0.0 146 | Hash: 165c156aaf69073f9a1f8a4211c626d9 147 | Requires: R6, curl, digest, jsonlite, mime, stringr 148 | 149 | Package: jsonlite 150 | Source: CRAN 151 | Version: 0.9.19 152 | Hash: 4a983f753b6e88ae0f5a6ac152d8cc32 153 | 154 | Package: knitr 155 | Source: CRAN 156 | Version: 1.12.3 157 | Hash: d537760d13021cf23fa2446381d9e0b2 158 | Requires: digest, evaluate, formatR, highr, markdown, stringr, yaml 159 | 160 | Package: lazyeval 161 | Source: CRAN 162 | Version: 0.1.10 163 | Hash: 9679f1ac7f6bc07bc79755f34cd15e1f 164 | 165 | Package: lubridate 166 | Source: CRAN 167 | Version: 1.5.0 168 | Hash: 038715dfce23c748aef45c22f46e4b75 169 | Requires: stringr 170 | 171 | Package: magrittr 172 | Source: CRAN 173 | Version: 1.5 174 | Hash: bdc4d48c3135e8f3b399536ddf160df4 175 | 176 | Package: markdown 177 | Source: CRAN 178 | Version: 0.7.7 179 | Hash: fea2343a1119d61b0cc5c0a950d103a3 180 | Requires: mime 181 | 182 | Package: memoise 183 | Source: CRAN 184 | Version: 0.2.1 185 | Hash: 812e6a1dd77a0ca4da41f3239de8e447 186 | Requires: digest 187 | 188 | Package: mime 189 | Source: CRAN 190 | Version: 0.4 191 | Hash: b08c52dae92a0a11e64a4deea032ec33 192 | 193 | Package: packrat 194 | Source: CRAN 195 | Version: 0.4.6-1 196 | Hash: 29eacc43b096c5b1a82c8d54a49b030b 197 | 198 | Package: praise 199 | Source: CRAN 200 | Version: 1.0.0 201 | Hash: 77da8f1df873a4b91e5c4a68fe2fb1b6 202 | 203 | Package: readr 204 | Source: CRAN 205 | Version: 0.2.2 206 | Hash: 6650aa16750d22092970ea3e06a49e0e 207 | Requires: BH, Rcpp, curl 208 | 209 | Package: rmarkdown 210 | Source: CRAN 211 | Version: 0.9.2 212 | Hash: 62ef7e7066b3e768f7684feb9bf9d693 213 | Requires: caTools, htmltools, knitr, yaml 214 | 215 | Package: roxygen2 216 | Source: CRAN 217 | Version: 5.0.1 218 | Hash: 39ee3aba606f089cb378c4a1cdd6d499 219 | Requires: Rcpp, brew, digest, stringi, stringr 220 | 221 | Package: rsconnect 222 | Source: github 223 | Version: 0.4.1.11 224 | Hash: 8ce7759fc029371b15b700ea7a87c6b2 225 | Requires: PKI, RCurl, RJSONIO, digest, packrat, rstudioapi, yaml 226 | GithubRepo: rsconnect 227 | GithubUsername: rstudio 228 | GithubRef: master 229 | GithubSha1: 241966709451c599b57b647272490bdc9db8d4d5 230 | 231 | Package: rstudioapi 232 | Source: CRAN 233 | Version: 0.4.0 234 | Hash: 1daee7a586b46f99ab9114668aa05cc7 235 | 236 | Package: rversions 237 | Source: CRAN 238 | Version: 1.0.2 239 | Hash: c006a9eaa80a091dcd87bb4003887b12 240 | Requires: curl, xml2 241 | 242 | Package: shiny 243 | Source: CRAN 244 | Version: 0.13.0 245 | Hash: b4e074e7ffd1281dc9eaa83f91ee6e86 246 | Requires: R6, digest, htmltools, httpuv, jsonlite, mime, xtable 247 | 248 | Package: shinyBS 249 | Source: CRAN 250 | Version: 0.61 251 | Hash: 4644935bd93e62a0b82686b26af7efc2 252 | Requires: htmltools, shiny 253 | 254 | Package: shinyjs 255 | Source: CRAN 256 | Version: 0.4.0 257 | Hash: d8c48d8f86be1c442b27e493ab3521c9 258 | Requires: digest, htmltools, shiny 259 | 260 | Package: stringi 261 | Source: CRAN 262 | Version: 1.0-1 263 | Hash: cf342bc407bd5daec77ed1009d5244e1 264 | 265 | Package: stringr 266 | Source: CRAN 267 | Version: 1.0.0 268 | Hash: 2676dd5f88890910962b733b0f9540e1 269 | Requires: magrittr, stringi 270 | 271 | Package: testthat 272 | Source: CRAN 273 | Version: 0.11.0 274 | Hash: e10882241e569f584fb1f8c19599a13f 275 | Requires: crayon, digest, praise 276 | 277 | Package: whisker 278 | Source: CRAN 279 | Version: 0.3-2 280 | Hash: 803d662762e532705c2c066a82d066e7 281 | 282 | Package: withr 283 | Source: CRAN 284 | Version: 1.0.0 285 | Hash: f48f79f631cdcb7e45250c5da49174cd 286 | 287 | Package: xml2 288 | Source: CRAN 289 | Version: 0.1.2 290 | Hash: 97e011843386f179a5349f9ae80b4dca 291 | Requires: BH, Rcpp 292 | 293 | Package: xtable 294 | Source: CRAN 295 | Version: 1.8-0 296 | Hash: 3816a222bb6837b3344d230b54b4c3cc 297 | 298 | Package: xts 299 | Source: CRAN 300 | Version: 0.9-7 301 | Hash: fb3f81d7a2fa2323879b6b49722ddc5e 302 | Requires: zoo 303 | 304 | Package: yaml 305 | Source: CRAN 306 | Version: 2.1.13 307 | Hash: 4854ccabebc225e8a7309fb4a74980de 308 | 309 | Package: zoo 310 | Source: CRAN 311 | Version: 1.7-12 312 | Hash: 8ce4a89536cba4fa6023190959de5658 313 | -------------------------------------------------------------------------------- /packrat/packrat.opts: -------------------------------------------------------------------------------- 1 | auto.snapshot: TRUE 2 | use.cache: FALSE 3 | print.banner.on.startup: auto 4 | vcs.ignore.lib: TRUE 5 | vcs.ignore.src: FALSE 6 | external.packages: 7 | local.repos: 8 | load.external.packages.on.startup: TRUE 9 | ignored.packages: 10 | quiet.package.installation: TRUE 11 | snapshot.recommended.packages: FALSE 12 | -------------------------------------------------------------------------------- /scratch/test_textoutput/app.R: -------------------------------------------------------------------------------- 1 | # 2 | # This is a Shiny web application. You can run the application by clicking 3 | # the 'Run App' button above. 4 | # 5 | # Find out more about building applications with Shiny here: 6 | # 7 | # http://shiny.rstudio.com/ 8 | # 9 | 10 | library("shiny") 11 | library("shinyjs") 12 | library("shinypod") 13 | 14 | # Define UI for application that draws a histogram 15 | ui <- shinyUI(fluidPage( 16 | 17 | useShinyjs(), 18 | 19 | titlePanel("extend verbatim output"), 20 | 21 | sidebarLayout( 22 | sidebarPanel( 23 | textInput( 24 | inputId = "text", 25 | label = "type something" 26 | ), 27 | selectInput( 28 | inputId = "class", 29 | label = "class", 30 | choices = c( 31 | default = " ", 32 | success = "alert-success", 33 | info = "alert-info", 34 | warning = "alert-warning", 35 | danger = "alert-danger" 36 | ) 37 | ) 38 | ), 39 | 40 | mainPanel( 41 | shiny::htmlOutput( 42 | outputId = "regular", 43 | container = pre_scroll 44 | ) 45 | ) 46 | ) 47 | )) 48 | 49 | server <- shinyServer(function(input, output) { 50 | 51 | output$regular <- renderText(input$text) 52 | observe_class_swap(id = "regular", input$class) 53 | 54 | }) 55 | 56 | # Run the application 57 | shinyApp(ui = ui, server = server) 58 | 59 | -------------------------------------------------------------------------------- /shinypod.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(shinypod) 3 | 4 | test_check("shinypod") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-utils-select.R: -------------------------------------------------------------------------------- 1 | context("utils-select") 2 | 3 | choices <- c("a", "b", "c") 4 | 5 | test_that("update selection works", { 6 | expect_null(update_selected("d", choices)) 7 | expect_null(update_selected("d", NULL)) 8 | expect_equal(update_selected(c("a", "b"), choices), c("a", "b")) 9 | expect_equal(update_selected(c("a", "b", "d"), choices), c("a", "b")) 10 | expect_equal(update_selected("d", choices, index = 1), "a") 11 | }) 12 | -------------------------------------------------------------------------------- /tests/testthat/test-utils.R: -------------------------------------------------------------------------------- 1 | library("lubridate") 2 | library("tibble") 3 | library("dplyr") 4 | library("readr") 5 | 6 | context("df_with_tz") 7 | 8 | tz_new <- "Europe/Paris" 9 | wx_ames_new <- with_tz(wx_ames, tz_new) 10 | 11 | test_that("we can set the time columns in a dataframe", { 12 | expect_equal(tz(wx_ames_new$date), tz_new) 13 | }) 14 | 15 | context("df_names_inherits") 16 | 17 | names_posixct <- "date" 18 | names_numeric <- 19 | c("temp", "dew_pt", "wind_spd", "wind_gust", "vis", "pressure", "wind_chill", "heat_index", "precip") 20 | names_character <- c("dir", "cond") 21 | names_integer <- c("hum", "fog", "rain", "snow", "hail", "thunder", "tornado") 22 | 23 | test_that("we can find columns with given classes", { 24 | expect_equal(df_names_inherits(wx_ames, "POSIXct"), names_posixct) 25 | expect_equal(df_names_inherits(wx_ames, "numeric"), names_numeric) 26 | expect_equal(df_names_inherits(wx_ames, "character"), names_character) 27 | expect_equal(df_names_inherits(wx_ames, "integer"), names_integer) 28 | }) 29 | 30 | 31 | context("df_has_time_8601") 32 | 33 | # some setup 34 | df_ref <- data_frame( 35 | int = c(1L, 2L, 3L), 36 | dbl = c(1, 2, 3), 37 | char = c("a", "b", "c"), 38 | dtm_a = ymd("2012-01-02", tz = "UTC") + hours(seq(1, 3)), 39 | dtm_b = ymd("2012-01-02", tz = "UTC") + hours(seq(1, 3)) 40 | ) 41 | 42 | fmt_reg <- stamp("2012-03-04 05:06:07", quiet = TRUE) 43 | fmt_iso <- stamp("2012-03-04T05:06:07Z", quiet = TRUE) 44 | 45 | txt_reg <- 46 | df_ref %>% 47 | mutate(dtm_a = fmt_reg(dtm_a), dtm_b = fmt_reg(dtm_b)) %>% 48 | format_csv() 49 | 50 | txt_iso <- 51 | df_ref %>% 52 | mutate(dtm_a = fmt_iso(dtm_a), dtm_b = fmt_iso(dtm_b)) %>% 53 | format_csv() 54 | 55 | txt_reg_iso <- 56 | df_ref %>% 57 | mutate(dtm_a = fmt_reg(dtm_a), dtm_b = fmt_iso(dtm_b)) %>% 58 | format_csv() 59 | 60 | # ISO-8601 61 | str_date <- c("2015-01-02", "20150102") 62 | str_delim <- c("T", " ") 63 | str_time <- c( 64 | "03:04:05.678", "030405.678", 65 | "03:04:05", "030405", 66 | "03:04", "0304", 67 | "03" 68 | ) 69 | str_zone <- c("Z", "+0200", "-0200", "+02:00", "-02:00", "+02", "-02") 70 | 71 | str_iso_8601 <- 72 | expand.grid(date = str_date, delim = str_delim, time = str_time, zone = str_zone) %>% 73 | tbl_df() %>% 74 | mutate(string = paste0(date, delim, time, zone)) %>% 75 | `[[`("string") 76 | 77 | str_not_iso_8601 <- c( 78 | "hello", 79 | "2019-09-27 21:47:00" 80 | ) 81 | 82 | test_that("ISO-8601 regular expression works", { 83 | expect_true(all(is_time_8601(str_iso_8601))) 84 | expect_false(any(is_time_8601(str_not_iso_8601))) 85 | }) 86 | 87 | test_that("we detect non-iso 8601 in dataframes", { 88 | expect_true(df_has_time_non_8601(txt_reg, ",")) 89 | expect_false(df_has_time_non_8601(txt_iso, ",")) 90 | expect_true(df_has_time_non_8601(txt_reg_iso, ",")) 91 | }) 92 | -------------------------------------------------------------------------------- /vignettes/server-modules.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Server Modules" 3 | author: "Ian Lyttle & Alex Shum" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Design of Shinypods} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | This vignette derives from the RStudio [article on Shiny modules](http://shiny.rstudio.com/articles/modules.html). 13 | 14 | ```{r echo=FALSE} 15 | library("shinypod") 16 | ``` 17 | 18 | ## Structure of a server module 19 | 20 | Within a server-module function, we keep a certain order of elements within the module. This order was determined by looking over the shoulders at Andee Kaplan and Eric Hare's shiny code (thanks to both!). 21 | 22 | 1. **Formals** By definition these come first. 23 | 24 | 2. **Reactives** We arrange the reactives so that reactives that are depended-upon by other reactives are placed *above* the reactives that "do the depending". Reactives that validate data passed-in by the formals are put at the beginning. Keep in mind that code within reactives are called only on demand - if something downstream calls the reactive. 25 | 26 | 3. **Observers** Observers are always called if anything being observed changes. This is a handy place to put any code that changes the UI. This might be code to update an input, or it might be some `shinyjs` code to show or hide inputs. 27 | 28 | 4. **Outputs** One thing to keep in mind about outputs is that the code is run **only** if the output is visible in the UI. This is why it can be useful to put code that *needs* to run into observers. 29 | 30 | 5. **Return value** We are still figuring this one out. For something like a dygraph, it will ultimately be an output; perhaps you expect it to be returned as an output. However, because a dygraph can be customized, it can be useful to return the dygraph as a reactive, allowing you to customize it and put it into an output yourself. 31 | 32 | ### Formals 33 | 34 | ```R 35 | dygraph_server <- function( 36 | input, output, session, 37 | data) 38 | ``` 39 | 40 | The first three arguments are the standard server arguments: `input`, `output`, and `session`. 41 | 42 | Any additional arguments are passed from the server when `callModule` is invoked. By putting some extra logic in to the reactive that validates the data, we can allow additional arguments to be static or reactive. 43 | 44 | In this case, we expect `data` to be either: 45 | 46 | - a data frame 47 | - a reactive that returns a data frame 48 | 49 | ### Reactives 50 | 51 | #### Data 52 | 53 | The implementation to allow you to send either a dataframe or a reactive that returns a dataframe is inspired by ggvis (thanks!). 54 | 55 | ```R 56 | # dataset 57 | rct_data <- reactive({ 58 | 59 | # the `data` argument can contain either: 60 | # - a reactive that returns a data frame 61 | # - a data frame 62 | # 63 | # in either case, we want to examine the dataframe 64 | # 65 | if (shiny::is.reactive(data)) { 66 | static_data <- data() 67 | } else { 68 | static_data <- data 69 | } 70 | 71 | # make sure this is a data frame 72 | shiny::validate( 73 | shiny::need(is.data.frame(static_data), "Cannot display graph: no data") 74 | ) 75 | 76 | # this reactive returns the data frame 77 | static_data 78 | }) 79 | ``` 80 | 81 | This reactive, `rct_data`, is the **only** function or expression that uses the `data` argument; anything "downstream" will use `rct_data()`. 82 | 83 | #### Available variables 84 | 85 | 86 | The inputs for this shinypod need to know what are the variables available in the dataframe - be they datetime or numeric. 87 | 88 | ```R 89 | # names of time variables 90 | rct_var_time <- reactive({ 91 | 92 | var_time <- df_names_inherits(rct_data(), c("POSIXct")) 93 | 94 | shiny::validate( 95 | shiny::need(var_time, "Cannot display graph: dataset has no time variables") 96 | ) 97 | 98 | var_time 99 | }) 100 | 101 | # names of numeric variables 102 | rct_var_num <- reactive({ 103 | 104 | var_num <- df_names_inherits(rct_data(), c("numeric", "integer")) 105 | 106 | shiny::validate( 107 | shiny::need(var_num, "Cannot display graph: dataset has no numeric variables") 108 | ) 109 | 110 | var_num 111 | }) 112 | ``` 113 | 114 | The function `df_names_inherits()` returns a vector of names; these are the names of columns in the dataframe that inherit from the supplied classes. 115 | 116 | We use the functions here to find what are the available time and numeric variables, so as to populate the choices for the inputs. 117 | 118 | One thing to keep in mind is that if a variable is chosen for the y1 axis, it should not be available to the y2 axis. Hence, we have reactives that supply the names of the variables available to each axis. 119 | 120 | ```R 121 | # names of variables available to y1-axis control 122 | rct_choice_y1 <- reactive({ 123 | choice_y1 <- setdiff(rct_var_num(), input[["y2"]]) 124 | 125 | choice_y1 126 | }) 127 | 128 | # names of variables available to y2-axis control 129 | rct_choice_y2 <- reactive({ 130 | choice_y2 <- setdiff(rct_var_num(), input[["y1"]]) 131 | 132 | choice_y2 133 | }) 134 | ``` 135 | 136 | #### Dygraph 137 | 138 | The reactive that returns the dygraph has two main parts: validate the inputs, create a dygraph. 139 | 140 | The reason we validate the inputs again is that it is possible for `rct_data()` and the axis inputs to "get out of sync". This is our chance to offer a validation message, rather than an error, while the reactives and inputs catch up with each other. 141 | 142 | ```R 143 | # basic dygraph 144 | rct_dyg <- reactive({ 145 | 146 | var_time <- input[["time"]] 147 | var_y1 <- input[["y1"]] 148 | var_y2 <- input[["y2"]] 149 | 150 | shiny::validate( 151 | shiny::need( 152 | var_time %in% names(rct_data()), 153 | "Graph cannot display without a time-variable" 154 | ), 155 | shiny::need( 156 | c(var_y1, var_y2) %in% names(rct_data()), 157 | "Graph cannot display without any y-variables" 158 | ) 159 | ) 160 | 161 | dyg <- .dygraph(rct_data(), var_time, var_y1, var_y2) 162 | 163 | dyg 164 | }) 165 | ``` 166 | 167 | The second part is to call a function that returns a dygraph, given the validated inputs. It can be useful to write such functions outside of a reactive context, so that you can build and test them interactively. 168 | 169 | ```R 170 | # function that builds basic dygraph 171 | # .dygraph(wx_ames, "date", "temp", "hum") 172 | .dygraph <- function(data, var_time, var_y1, var_y2){ 173 | 174 | # create the mts object 175 | vec_time <- data[[var_time]] 176 | df_num <- data[c(var_y1, var_y2)] 177 | 178 | # if no tz, use UTC 179 | tz <- lubridate::tz(vec_time) 180 | if (identical(tz, "")) { 181 | tz <- "UTC" 182 | } 183 | 184 | dy_xts <- xts::xts(df_num, order.by = vec_time, tzone = tz) 185 | 186 | dyg <- dygraphs::dygraph(dy_xts) 187 | dyg <- dygraphs::dyAxis(dyg, "x", label = var_time) 188 | dyg <- dygraphs::dyAxis(dyg, "y", label = paste(var_y1, collapse = ", ")) 189 | dyg <- dygraphs::dyAxis(dyg, "y2", label = paste(var_y2, collapse = ", ")) 190 | 191 | # put stuff on y2 axis 192 | for(i in seq_along(var_y2)) { 193 | dyg <- dygraphs::dySeries(dyg, var_y2[i], axis = "y2") 194 | } 195 | 196 | dyg 197 | } 198 | ``` 199 | 200 | ### Observers 201 | 202 | We have one observer manage the showing/hiding of inputs, depending on the availability of variables in the data frame. 203 | 204 | ```R 205 | # shows and hides controls based on the availabilty and nature of data 206 | shiny::observe({ 207 | 208 | has_time <- length(df_names_inherits(rct_data(), c("POSIXct"))) > 0 209 | has_num <- length(df_names_inherits(rct_data(), c("numeric", "integer")) > 0) 210 | 211 | shinyjs::toggle("time", condition = has_time) 212 | shinyjs::toggle("y1", condition = has_num) 213 | shinyjs::toggle("y2", condition = has_num) 214 | 215 | }) 216 | ``` 217 | 218 | We have another set of observers to update the choices and selection for each of the selectInputs. 219 | 220 | ```R 221 | # update choices for time variable 222 | shiny::observeEvent( 223 | eventExpr = rct_var_time(), 224 | handlerExpr = { 225 | updateSelectInput( 226 | session, 227 | inputId = "time", 228 | choices = rct_var_time(), 229 | selected = update_selected(input[["time"]], rct_var_time(), index = 1) 230 | ) 231 | } 232 | ) 233 | ``` 234 | 235 | The purpose of `update_selected()` is to propose a selection, given an existing value and set of choices; it takes three arguments: 236 | 237 | - `value` is the current value of the input 238 | - `choices` are the available choices 239 | - `index` - if `value` is not among `choices` use this index 240 | 241 | The first step is to determine the members of `value` that appear in `choices`. If this result is not empty, it is returned. 242 | 243 | If this result is empty, then `index` is used to return that index of `choices`. 244 | 245 | Some examples: 246 | 247 | ```{r update_selected} 248 | choices <- c("a", "b", "c") 249 | 250 | update_selected(value = "b", choices = choices, index = 1) 251 | update_selected(value = "d", choices = choices, index = 1) 252 | update_selected(value = NULL, choices = choices, index = 1) 253 | 254 | update_selected(value = "d", choices = choices, index = NULL) 255 | update_selected(value = NULL, choices = choices, index = NULL) 256 | 257 | update_selected(value = "b", choices = NULL, index = 1) 258 | update_selected(value = "b", choices = NULL, index = NULL) 259 | ``` 260 | 261 | ### Outputs & return value 262 | 263 | One of the design choices made here was to return the dygraph as a reactive to be returned rather than as an output to be displayed. 264 | 265 | This forces a little more responsibility to the user, but there can be a benefit. 266 | 267 | A server function might contain lines like these: 268 | 269 | ```R 270 | rct_dyg <- callModule(dygraph_server, "dyg", data = rct_data) 271 | 272 | output$csv_dyg <- renderDygraph({ 273 | rct_dyg() 274 | }) 275 | ``` 276 | 277 | If you wanted to add some customization to the dygraph, you could do so easily in the server function. 278 | 279 | ```R 280 | output$csv_dyg <- renderDygraph({ 281 | rct_dyg() %>% 282 | dyOptions(useDataTimezone = TRUE) 283 | }) 284 | ``` 285 | 286 | -------------------------------------------------------------------------------- /vignettes/ui-layers.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Elemental and Presentation UI Layers" 3 | author: "Ian Lyttle & Alex Shum" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Design of Shinypods} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | ```{r prelim, echo=FALSE} 13 | library("shinypod") 14 | 15 | cat_r_file <- function(file){ 16 | cat("```R", readLines(file), "```", sep = "\n") 17 | } 18 | 19 | cat_r_fn <- function(fn){ 20 | cat("```R", capture.output(eval(fn)), "```", sep = "\n") 21 | } 22 | ``` 23 | 24 | In this vignette, we go into a little more detail of the structure of a shinypod. 25 | 26 | ## Essentials 27 | 28 | There are three essential functions for the UI. Let's consider the dygraph shinypod: 29 | 30 | - `dygraph_ui_input()` returns a named `shiny::tagList` of input elements 31 | - `dygraph_ui_output()` returns a named `shiny::tagList` of output elements 32 | - `dygraph_ui_misc()` returns a named `shiny::tagList` of miscellaneous elements, like help guides. 33 | 34 | ### Convention 35 | 36 | The functions `dygraph_sidebar_side()` and `dygraph_sidebar_main()` draw upon the elemental ui functions: `dygraph_ui_input()`, `dygraph_ui_output()` and `dygraph_ui_misc()`. 37 | 38 | Let's look at the code for `dygraph_ui_input()`: 39 | 40 | ```{r dygraph_ui_input, comment="", echo=FALSE, results = "asis"} 41 | cat_r_fn(dygraph_ui_input) 42 | ``` 43 | 44 | We see that this returns a named `tagList` of HTML elements. 45 | 46 | Note that we use the `shinyjs::hidden()` function to initally hide the inputs. We will use the server logic to show the controls when there is data available. 47 | 48 | Similarly for `dygraph_ui_output()`: 49 | 50 | ```{r dygraph_ui_output, comment="", echo=FALSE, results = "asis"} 51 | cat_r_fn(dygraph_ui_output) 52 | ``` 53 | 54 | This returns an empty `tagList`, but we keep the function for completeness. 55 | 56 | Finally for `dygraph_ui_misc()`: 57 | 58 | ```{r dygraph_ui_misc, comment="", echo=FALSE, results = "asis"} 59 | cat_r_fn(dygraph_ui_misc) 60 | ``` 61 | 62 | ## Presentation layer 63 | 64 | On top of the elemental layer, we make a presentation layer that consists of the functions: 65 | 66 | - `dygraph_sidebar_side()` 67 | - `dygraph_sidebar_main()` 68 | 69 | Here's `dygraph_sidebar_side()`: 70 | 71 | ```{r dygraph_sidebar_side, comment="", echo=FALSE, results = "asis"} 72 | cat_r_fn(dygraph_sidebar_side) 73 | ``` 74 | 75 | Here's `dygraph_sidebar_main()`: 76 | 77 | ```{r dygraph_sidebar_main, comment="", echo=FALSE, results = "asis"} 78 | cat_r_fn(dygraph_sidebar_main) 79 | ``` 80 | 81 | These are the functions that you would use - in putting togther a shiny app, I would suggest using these presentation functions. 82 | -------------------------------------------------------------------------------- /vignettes/using-shinypods.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Using Shinypods" 3 | author: "Ian Lyttle & Alex Shum" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Design of Shinypods} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | ```{r prelim, echo=FALSE} 13 | cat_r_file <- function(file){ 14 | cat("```R", readLines(file), "```", sep = "\n") 15 | } 16 | ``` 17 | 18 | Shiny modules make it much easier to design and build complex shiny apps. 19 | 20 | Imagine that you are designing an app that requires the user to upload a csv file to be parsed into a data frame. You will wish to use the data frame elsewhere in the app. Instead of writing the parser from scratch, you can use a set of **shinypod** functions in your app. 21 | 22 | Shinypod is simply an implementaton of a set of design guidelines to allow you to use, remix, and even build your own shiny modules. An advantage of using such guidelines is that we can all use each others' shinypods more quickly and reliably. 23 | 24 | Before getting started, you are referred to RStudio's [article on shiny modules](http://shiny.rstudio.com/articles/modules.html). 25 | 26 | ## First example - CSV parser 27 | 28 | This package, shinypod, offers functions that you can use to put a CSV parser into your app. 29 | 30 | Let's look at a `ui.R` file: 31 | 32 | ```{r read_delim_ui, comment="", echo=FALSE, results = "asis"} 33 | cat_r_file(system.file("shiny", "read_delim", "ui.R", package = "shinypod")) 34 | ``` 35 | 36 | And a `server.R` file: 37 | 38 | ```{r read_delim_server, comment="", echo=FALSE, results = "asis"} 39 | cat_r_file(system.file("shiny", "read_delim", "server.R", package = "shinypod")) 40 | ``` 41 | 42 | For this implementation we call upon three functions. 43 | 44 | - `read_delim_sidebar_side()` 45 | - `read_delim_sidebar_main()` 46 | - `read_delim_server()` 47 | 48 | The first two functions each return a named `shiny::tagList` of UI elements that can be used in a sidebar layout. The side panel contains the inputs, and the main panel contains the outputs. 49 | 50 | Other UI arrangements are possible; you are referred to the "remixing-shinypods" vignette. 51 | 52 | The third function is used in the server function to return a reactive element. This reactive returns the parsed dataframe. 53 | 54 | To use all three, all you have to do is call each of the three functions using the same `id`, in this case `"csv"` - this is to keep the shiny namespace tidy. 55 | 56 | If you like, try out the [deployed app](https://ijlyttle.shinyapps.io/read_delim/). 57 | 58 | ## Second example - CSV parser with dygraph 59 | 60 | In this example, we will look at what you can do by combining shinypods. Here, we will combine the pod used to parse a csv with a pod used to build a dygraph. 61 | 62 | Dygraphs are especially handy for visualizing time series. Often, time-series data may be available in a data frame (parsed from a csv), and we wish to visualize it. This is where we would use a set of dygraphs functions from shinypod. 63 | 64 | We can build onto our previous example by adding a dyraph shinypod. 65 | 66 | Let's look at a `ui.R` file: 67 | 68 | ```{r read_delim_dygraph_ui, comment="", echo=FALSE, results = "asis"} 69 | cat_r_file(system.file("shiny", "read_delim_dygraph", "ui.R", package = "shinypod")) 70 | ``` 71 | 72 | And a `server.R` file: 73 | 74 | ```{r read_delim_dygraph_server, comment="", echo=FALSE, results = "asis"} 75 | cat_r_file(system.file("shiny", "read_delim_dygraph", "server.R", package = "shinypod")) 76 | ``` 77 | 78 | 79 | A few things to note: 80 | 81 | - we use a different namespace id for the read_delim pod (`"csv"`) as for the dygraph pod (`"dyg"`). 82 | - we supply the reactive returned by the `read_delim_server()` function as an argument to the `dygraph_server()` function. This is how the data is moved around. 83 | - the `dygraph_server()` function returns a reactive that returns a dygraph. We use this to build the output for the app. Note also that the dygraph shinypod returns a basic dygraph; we can use functions from the dygraphs package to customize it. 84 | 85 | If you like, try out the [deployed app](https://ijlyttle.shinyapps.io/read_delim_dygraph/). 86 | 87 | 88 | 89 | 90 | 91 | 92 | --------------------------------------------------------------------------------