From f6e1d7985ef62132e1f9d17d1be2e159d5b31957 Mon Sep 17 00:00:00 2001 From: paleo13 Date: Fri, 21 Oct 2016 11:15:48 +1000 Subject: [PATCH] + bug fixes and enhancements for dySliderInput --- .gitignore | 2 + DESCRIPTION | 5 +- NAMESPACE | 6 + R/plugin.R | 103 ++++++ inst/NEWS | 1 + inst/examples/plugins/plugins.R | 3 +- inst/examples/plugins/sliderinput.js | 344 +++++++++++++++++++ inst/examples/{shiny => shiny_1}/DESCRIPTION | 0 inst/examples/{shiny => shiny_1}/server.R | 13 +- inst/examples/{shiny => shiny_1}/ui.R | 0 inst/examples/shiny_2/DESCRIPTION | 7 + inst/examples/shiny_2/bird.rds | Bin 0 -> 26024 bytes inst/examples/shiny_2/global.R | 31 ++ inst/examples/shiny_2/server.R | 40 +++ inst/examples/shiny_2/styles.css | 15 + inst/examples/shiny_2/ui.R | 12 + inst/htmlwidgets/dygraphs.js | 39 ++- man/dyCrosshair.Rd | 32 ++ man/dySliderInput.Rd | 39 +++ man/dyUnzoom.Rd | 30 ++ tests/testthat/test-crosshair.R | 9 + tests/testthat/test-sider-input.R | 9 + tests/testthat/test-unzoom.R | 9 + 23 files changed, 730 insertions(+), 19 deletions(-) create mode 100644 inst/examples/plugins/sliderinput.js rename inst/examples/{shiny => shiny_1}/DESCRIPTION (100%) rename inst/examples/{shiny => shiny_1}/server.R (56%) rename inst/examples/{shiny => shiny_1}/ui.R (100%) create mode 100644 inst/examples/shiny_2/DESCRIPTION create mode 100644 inst/examples/shiny_2/bird.rds create mode 100644 inst/examples/shiny_2/global.R create mode 100644 inst/examples/shiny_2/server.R create mode 100644 inst/examples/shiny_2/styles.css create mode 100644 inst/examples/shiny_2/ui.R create mode 100644 man/dyCrosshair.Rd create mode 100644 man/dySliderInput.Rd create mode 100644 man/dyUnzoom.Rd create mode 100644 tests/testthat/test-crosshair.R create mode 100644 tests/testthat/test-sider-input.R create mode 100644 tests/testthat/test-unzoom.R diff --git a/.gitignore b/.gitignore index 728e389..1fc9dd6 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,5 @@ .Rhistory .RData .DS_Store +.directory +rsconnect diff --git a/DESCRIPTION b/DESCRIPTION index 439a0d7..a63c1c0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -32,8 +32,9 @@ Imports: htmlwidgets (>= 0.6), htmltools (>= 0.3.5), zoo (>= 1.7-10), - xts (>= 0.9-7) + xts (>= 0.9-7), + shiny (>= 0.10.2.1) Suggests: testthat -Enhances: rmarkdown (>= 0.3.3), shiny (>= 0.10.2.1) +Enhances: rmarkdown (>= 0.3.3) RoxygenNote: 5.0.1 diff --git a/NAMESPACE b/NAMESPACE index b357d0c..a769ecb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,6 +7,7 @@ export(dyAnnotation) export(dyAxis) export(dyCSS) export(dyCallbacks) +export(dyCrosshair) export(dyEvent) export(dyHighlight) export(dyLegend) @@ -18,12 +19,17 @@ export(dyRoller) export(dySeries) export(dySeriesData) export(dyShading) +export(dySliderInput) +export(dyUnzoom) export(dygraph) export(dygraphOutput) export(renderDygraph) +importFrom(grDevices,col2rgb) importFrom(htmltools,htmlDependency) importFrom(htmlwidgets,JS) importFrom(magrittr,"%>%") +importFrom(shiny,animationOptions) +importFrom(shiny,icon) importFrom(stats,end) importFrom(stats,start) importFrom(zoo,as.yearmon) diff --git a/R/plugin.R b/R/plugin.R index e3395d5..c9440ab 100644 --- a/R/plugin.R +++ b/R/plugin.R @@ -49,3 +49,106 @@ dyPlugin <- function(dygraph, name, path, options = list(), version = "1.0") { # return dygraph dygraph } + +#' dyUnzoom +#' +#' @inheritParams dyPlugin +#' +#' @return A dygraph with the specified plugin enabled. +#' +#' @details The dyUnzoom plugin adds an "Unzoom" button to the graph when it's displaying +#' in a zoomed state (this is a bit more discoverable than the default double- +#' click gesture for unzooming). Note that this plugin has no options (see +#' below for an example with options). +#' +#' @examples +#' library(dygraphs) +#' dygraph(mdeaths) %>% +#' dyUnzoom() +#' +#' @export +dyUnzoom <-function(dygraph) { + dyPlugin( + dygraph = dygraph, + name = "Unzoom", + path = system.file("examples/plugins/unzoom.js", package = "dygraphs") + ) +} + +#' dyCrosshair +#' +#' @inheritParams dyPlugin +#' @param direction Direction for crosshairs. Defaults to 'both'. Valid arguments are +# 'both', 'horizontal', and 'vertical'. +#' +#' @return A dygraph with the specified plugin enabled. +#' +#' @details The dyCrosshair plugin draws a crosshair line over the point closest to the +#' mouse when the user hovers over the graph. It has a "direction" option which +#' is provided in the R wrapper function and then forwarded to the plugin using +#' the "options" argument to dyPlugin. +#' +#' @examples +#' library(dygraphs) +#' dygraph(mdeaths) %>% +#' dyCrosshair() +#' +#' @export +dyCrosshair <- function(dygraph, direction = c("both", "horizontal", "vertical")) { + dyPlugin( + dygraph = dygraph, + name = "Crosshair", + path = system.file("examples/plugins/crosshair.js", package = "dygraphs"), + options = list(direction = match.arg(direction)) + ) +} + +#' dySliderInput +#' +#' @inheritParams dyPlugin +#' @param color Color to draw slider. Defaults to 'red'. +#' @param strokePattern Line type for slider. Defaults to 'dashed'. Valid arguments are +#' 'dashed', 'solid', 'dotted', and 'dotdash'. +#' @param animate 'TRUE' to show simple animation controls with default settings; +#' 'FALSE' not to; or a custom settings list, such as those created using 'animationOptions'. +#' +#' @return A dygraph with the specified plugin enabled. +#' +#' @details The dySliderInput plugin turns the dyDygraph into a slider input widget. The +#' user can click on a point along the graph and the graph will place a vertical +#' line on the graph. The user can also use the animation options to scroll +#' through points along the graph. +#' +#' @examples +#' library(dygraphs) +#' dygraph(mdeaths) %>% +#' dySliderInput() +#' +#' @importFrom grDevices col2rgb +#' @importFrom shiny icon +#' @importFrom shiny animationOptions +#' +#' @export +dySliderInput <- function(dygraph, color = 'red', strokePattern = c('dashed', 'solid', 'dotted', 'dotdash'), animate = FALSE) { + # process args + stopifnot(length(color)==1) + col <- paste(col2rgb(color)[,1], collapse=',') + alpha <- (col2rgb(color, alpha=TRUE)[4,1] / 255) + if (identical(animate, TRUE)) + animate <- animationOptions() + if (identical(animate, FALSE)) + animate <- NULL + if (!is.null(animate)) { + if (is.null(animate$playButton)) + animate$playButton <- as.character(icon("play", lib = "glyphicon")) + if (is.null(animate$pauseButton)) + animate$pauseButton <- as.character(icon("pause", lib = "glyphicon")) + } + # add plugin + dyPlugin( + dygraph = dygraph, + name = "SliderInput", + path = system.file("examples/plugins/sliderinput.js", package = "dygraphs"), + options = list(strokeStyle = paste0(col, ',', alpha), strokePattern=resolveStrokePattern(match.arg(strokePattern)), animate = animate) + ) +} diff --git a/inst/NEWS b/inst/NEWS index fc68445..bd69c9c 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -5,6 +5,7 @@ dygraphs 1.1.1.3 (unreleased) * Support for non-date values in shiny input bindings (#132) +* Fix for inconsistant format in date-time callbacks dygraphs 1.1.1.2 -------------------------------------------------------------------------------- diff --git a/inst/examples/plugins/plugins.R b/inst/examples/plugins/plugins.R index ee62c54..2414e41 100644 --- a/inst/examples/plugins/plugins.R +++ b/inst/examples/plugins/plugins.R @@ -35,7 +35,6 @@ dyCrosshair <- function(dygraph, direction = c("both", "horizontal", "vertical") ) } - # Our plugin wrapper functions can now be incorporated directly into a dygraph # pipeline along with other dygraphs functions: @@ -43,7 +42,7 @@ library(dygraphs) dygraph(ldeaths) %>% dyRangeSelector() %>% dyUnzoom() %>% - dyCrosshair(direction = "vertical") + dyCrosshair(direction = "vertical") %>% diff --git a/inst/examples/plugins/sliderinput.js b/inst/examples/plugins/sliderinput.js new file mode 100644 index 0000000..75b9693 --- /dev/null +++ b/inst/examples/plugins/sliderinput.js @@ -0,0 +1,344 @@ +/** + * @license + * Copyright 2016 Jeffrey Owen Hanson (jeffrey.hanson@uqconnect.edu.au) + * MIT-licensed (http://opensource.org/licenses/) + */ + +/*global Dygraph:false */ +/*jshint globalstrict: true */ +Dygraph.Plugins.SliderInput = (function() { + "use strict"; + + /** + * Creates the sliderinput + * + * @constructor + */ + + var sliderinput = function(opt_options) { + /* create widgets */ + this.canvas_ = document.createElement("canvas"); // canvas to draw bars on + this.button_ = null + + /* pass arguments from R */ + opt_options = opt_options || {}; + this.strokeStyle_ = opt_options.strokeStyle || null; + this.strokePattern_ = opt_options.strokePattern || null; + this.animate_ = opt_options.animate || null; + + /* set default parameters */ + this.bar_point_ = null; // point associated with bar, if not drawn then null + this.closest_point_ = null; // closest point to cursor + this.over_ = false; // true when mouse is over the canvas + this.animated_ = false; // true when the graph is in an animated state + this.timer_ = null; // timer object used for animation + this.graph_height_= null; // graph height when mouse is over graph + this.graph_width_= null; // graph width when mouse is over graph + this.ignore_next_click_ = false; // should next click be ignored? + }; + + sliderinput.prototype.toString = function() { + return "SliderInput Plugin"; + }; + + /** + * @param {Dygraph} g Graph instance. + * @return {object.} Mapping of event names to callbacks. + */ + sliderinput.prototype.activate = function(g) { + /* initialise canvas */ + g.graphDiv.appendChild(this.canvas_); + + /* return methods */ + return { + willDrawChart: this.willDrawChart, + didDrawChart: this.didDrawChart, + select: this.select + }; + }; + + sliderinput.prototype.willDrawChart = function (e) { + /* initialise */ + var g = e.dygraph; + + // short-circuit: skip redeclaring all this stuff if we've already been over it + if (this.button_ !== null) { + var showButton = (this.animate_ !== null) && this.over_; + this.show(showButton); + return; + } + + // define click event + this.click = function(point) { + /* simulate the user clicking on a point in the graph */ + if (point !== null) { + Shiny.onInputChange(g.maindiv_.id + "_click", { + date: g.shinyValueFormatter(point.xval), + x_closest_point: g.shinyValueFormatter(point.xval), + y_closest_point: point.yval, + '.nonce': Math.random() // Force reactivity if click hasn't changed + }) + } else { + Shiny.onInputChange(g.maindiv_.id + "_click", { + date: 'NA', + x_closest_point: 'NA', + y_closest_point: 'NA', + '.nonce': Math.random() // Force reactivity if click hasn't changed + }) + } + }; + + // define function to determine if any points inside graph + this.anyPointsInsideGraph = function() { + var date_range = g.xAxisRange(); + var no_points_inside_range = (date_range[0] > g.layout_.points[0][0].xval) && (date_range[1] < g.layout_.points[0][1].xval) && (g.layout_.points[0].length == 2); + return(!no_points_inside_range); + }; + + // define function to get the first point inside a graph + this.getFirstPoint = function() { + var counter = 0; + var point = g.layout_.points[0][counter]; + var date_range = g.xAxisRange(); + while (point.xval < date_range[0]) { + counter++; + point = g.layout_.points[0][counter]; + } + return point; + } + + // define function to get the last point inside a graph + this.getLastPoint = function() { + var counter = g.layout_.points[0].length-1; + var point = g.layout_.points[0][counter]; + var date_range = g.xAxisRange(); + while (point.xval > date_range[1]) { + counter--; + point = g.layout_.points[0][counter]; + } + return point; + } + + /* animation button */ + // create the button + this.button_ = document.createElement('button'); + this.button_.innerHTML = this.animate_.playButton; + this.button_.style.display = 'none'; + this.button_.style.position = 'absolute'; + var area = g.plotter_.area; + this.button_.style.top = (area.y + 10) + 'px'; + this.button_.style.left = (area.x + 30) + 'px'; + this.button_.style.zIndex = 11; + var parent = g.graphDiv; + var main = g.maindiv_; + main.insertBefore(this.button_, main.firstChild); + + // add event hadling to the button + var self = this; + this.button_.onclick = (function() { + /* function definitions */ + + // move slider to first point + var resetSliderToStart = function() { + if (self.anyPointsInsideGraph()) { + var new_point = self.getFirstPoint(); + self.clear_bars(); // clear bars + self.add_bar(new_point); // add new bar + self.click(new_point); // click on point + } else { + self.stop_animation(); + } + }; + + // can slider to the next point? + var canStepNext = function() { + if (self.anyPointsInsideGraph()) { + return(self.bar_point_.idx < self.getLastPoint().idx); + } else { + self.stop_animation(); + } + }; + + // move slider to the next point + var stepSliderToNext = function() { + if (self.anyPointsInsideGraph()) { + var new_point = g.layout_.points[0][(self.bar_point_.idx - g.layout_.points[0][0].idx) + 1]; + self.clear_bars(); // clear bars + self.add_bar(new_point); // add new bar + self.click(new_point); // click on point + } else { + self.stop_animation(); + } + }; + + var start_animation = function() { + /* check that there are points on the graph, and if there are none then exit */ + if (!self.anyPointsInsideGraph()) { + return; + } + + /* start animation */ + // if no bar selected, then select first point in window + self.animated_ = true; + self.button_.innerHTML = self.animate_.pauseButton; + if (self.bar_point_ == null) { + resetSliderToStart(); + } + + // main animation function + var animation_workhorse = function() { + if (self.animate_.loop && !canStepNext()) { + resetSliderToStart(); + } else { + stepSliderToNext() + if (!self.animate_.loop && !canStepNext()) { + self.stop_animation(); + } + } + }; + + // start animation + self.timer_ = setInterval(animation_workhorse, self.animate_.interval); + }; + + self.stop_animation = function() { + /* stop animation */ + self.animated_ = false; + self.button_.innerHTML = self.animate_.playButton; + clearTimeout(self.timer_); + }; + + /* main operations */ + // swap state + self.animated_ = !self.animated_ + // start/stop animation + if (self.animated_) { + start_animation(); + } else { + self.stop_animation(); + } + }); + g.addAndTrackEvent(main, 'mouseover', function() { + /* show start/stop buttons */ + self.show(true); + self.over_ = true; + }); + g.addAndTrackEvent(main, 'mouseout', function() { + /* hide start/stop buttons */ + self.show(false); + self.over_ = false; + }); + g.addAndTrackEvent(parent, 'click', function() { + /* check if click should be ignored */ + if (self.ignore_next_click_) { + self.ignore_next_click_ = false; + return; + } + /* draw new bar */ + if (self.animated_) { + self.stop_animation(); // stop animation if animated + } + self.clear_bars(); // clear bars + if (self.anyPointsInsideGraph()) { + self.add_bar(self.closest_point_); // add new line if closest point with graph range + // click is handled automatically by dygraphs in-build event handler + } + }); + }; + + sliderinput.prototype.didDrawChart = function(e) { + /* initialise */ + var g = e.dygraph; + /* move bar when zooming in or out*/ + if ((this.bar_point_ !== null)) { + // draw new bar if any points inside plotting region + if (this.anyPointsInsideGraph()) { + if ((this.bar_point_.idx >= g.boundaryIds_[0][0]) && (this.bar_point_.idx <= g.boundaryIds_[0][1])) { + // redraw bar for point + var new_point = g.layout_.points[0][(this.bar_point_.idx - g.layout_.points[0][0].idx)]; + this.clear_bars(); // clear bars + this.add_bar(new_point); // add new bar + // do not simulate clicking a point since the same date-time will be returned as the previous + } else if (this.bar_point_.idx < g.boundaryIds_[0][0]) { + // draw bar on left side of plotting region + var new_point = g.getFirstPoint(); + this.clear_bars(); // clear bars + this.add_bar(new_point); // add new bar + this.click(new_point); // click on point + } else { + // draw bar on right side of plotting region + var new_point = g.getLastPoint(); + this.clear_bars(); // clear bars + this.add_bar(new_point); // add new bar + this.click(new_point); // click on point + } + } else { + this.clear_bars(); // clear bars + this.click(null); // return NA to indicate that no data is shown + } + + // ignore next click caused by zooming + this.ignore_next_click_ = true; + + } + }; + + sliderinput.prototype.add_bar = function(point) { + /* add bar to canvas */ + // extract values from point + var canvas_position = Math.floor(point.canvasx) + 0.5; + // set up canvas + var width = this.graph_width_; + var height = this.graph_height_; + this.canvas_.width = width; + this.canvas_.height = height; + this.canvas_.style.width = width + "px"; // for IE + this.canvas_.style.height = height + "px"; // for IE + // draw bar on canvas + var ctx = this.canvas_.getContext("2d"); + ctx.strokeStyle = "rgba("+this.strokeStyle_+")"; + ctx.setLineDash(this.strokePattern_); + ctx.beginPath(); + ctx.moveTo(canvas_position, 0); + ctx.lineTo(canvas_position, height); + ctx.stroke(); + ctx.closePath(); + this.bar_point_ = point; + }; + + sliderinput.prototype.clear_bars = function() { + /* clear all bars from graph */ + // remove points + var ctx = this.canvas_.getContext("2d"); + ctx.clearRect(0, 0, this.canvas_.width, this.canvas_.height); + this.bar_point_ = null; + }; + + sliderinput.prototype.show = function(enabled) { + /* show animation buttons */ + this.button_.style.display = enabled ? '' : 'none'; + }; + + sliderinput.prototype.select = function(e) { + /* set bar variables */ + this.graph_height_ = e.dygraph.height_; + this.graph_width_ = e.dygraph.width_; + this.closest_point_ = e.dygraph.selPoints_[0]; + }; + + sliderinput.prototype.destroy = function() { + this.button_.parentElement.removeChild(this.button_); + this.ignore_next_click = null; + this.bar_point_ = null; + this.over_ = null; + this.timer_ = null; + this.animated_ = null; + this.canvas_ = null; + this.x_closest_point_ = null; + this.graph_height_ = null; + this.graph_width_ = null; + }; + + return sliderinput; + +})(); diff --git a/inst/examples/shiny/DESCRIPTION b/inst/examples/shiny_1/DESCRIPTION similarity index 100% rename from inst/examples/shiny/DESCRIPTION rename to inst/examples/shiny_1/DESCRIPTION diff --git a/inst/examples/shiny/server.R b/inst/examples/shiny_1/server.R similarity index 56% rename from inst/examples/shiny/server.R rename to inst/examples/shiny_1/server.R index 4b48392..a5d9d1b 100644 --- a/inst/examples/shiny/server.R +++ b/inst/examples/shiny_1/server.R @@ -17,19 +17,22 @@ shinyServer(function(input, output) { }) output$from <- renderText({ - strftime(req(input$dygraph_date_window[[1]]), "%d %b %Y") + format(strptime(req(input$dygraph_date_window[[1]]), '%b %d, %Y %H:%M:%S'), '%Y/%m/%d %H:%M:%S') }) output$to <- renderText({ - strftime(req(input$dygraph_date_window[[2]]), "%d %b %Y") + format(strptime(req(input$dygraph_date_window[[2]]), '%b %d, %Y %H:%M:%S'), '%Y/%m/%d %H:%M:%S') }) output$clicked <- renderText({ - strftime(req(input$dygraph_click$x), "%d %b %Y") + format(strptime(req(input$dygraph_click$x), '%b %d, %Y %H:%M:%S'), '%Y/%m/%d %H:%M:%S') }) output$point <- renderText({ - paste0('X = ', strftime(req(input$dygraph_click$x_closest_point), "%d %b %Y"), - '; Y = ', req(input$dygraph_click$y_closest_point)) + paste0( + 'X = ', format(strptime(req(input$dygraph_click$x_closest_point), '%b %d, %Y %H:%M:%S'), '%Y/%m/%d %H:%M:%S'), + '; Y = ', req(input$dygraph_click$y_closest_point) + ) }) + }) diff --git a/inst/examples/shiny/ui.R b/inst/examples/shiny_1/ui.R similarity index 100% rename from inst/examples/shiny/ui.R rename to inst/examples/shiny_1/ui.R diff --git a/inst/examples/shiny_2/DESCRIPTION b/inst/examples/shiny_2/DESCRIPTION new file mode 100644 index 0000000..ffcc173 --- /dev/null +++ b/inst/examples/shiny_2/DESCRIPTION @@ -0,0 +1,7 @@ +Title: Fork-tailed Swift +Author: Jeffrey Owen Hanson +AuthorUrl: http://jeffrey-hanson.com +License: MIT +DisplayMode: normal +Type: Shiny + diff --git a/inst/examples/shiny_2/bird.rds b/inst/examples/shiny_2/bird.rds new file mode 100644 index 0000000000000000000000000000000000000000..97cfe4330199d14cf06b515b007c0cc9ab01a1a1 GIT binary patch literal 26024 zcmV(fK>EM^H+ooF0004LBHlIv03iVu0001VFXf}-uE=F-T>vZsd>Q$l_#1^2xbs9i zC)KE>9K}j@!|zX3x`OICdqd;>td=l-FjX5L%Ib6teQ4%xWTVFb%+pq`5tguQDD`2iOGMj`poA)+@>CC@C4~mtt&}g{}TD zeIg|gH28syby$cw)Qeuuy^3P$6O6ipC^WxtEt{OWGp! z>Y%~ydaT;r-_ZQUzco=AV*Qzv7@BtcN#L4ut_zS-f`z8b-T8nco%(gb<50<~#P)TumhAN;loF>au!i5pbuj z&53)qNQxhhbccDQ`~{KtOOT1$Alq$bpZzi`Yef9e;Z68#$}Z3)+y_{5QSNCib*}yW zYStbKP+8p`?q#^np$&0REDOy*^ZF#Em$tnK$rVWjoM`}mb_Mm)4^xo`$f`fi=5ZCn zfJo1GREt%Av_2XEA`+y${J9h`%O zFJcZX-)mczRt-YnzfAy`Q$oT=iblyH@FNX7RyEC2a;UK%kDjE!kBMg|*>~S+SyVj_ zdkrdAw(Z6%F>uA!xRhkw=h#pt160}Bc5`|Q*PD2Uz+1qnJ zb>z2YFnsMdKF2`I{PT5OxC^qiS}k6a8U)?tbbzqn0R;_H5bT6*-og-=OwYJH5`<6( z+)Efsr{BvZItDuE3weML&tTwwN;4B1c_BkVBTb4@44+nW3ZK}8y%vfHFqjl&?nQ_q zT#s&f052JKZKfCmsXi`UPUh_jw+BGqjxiuGAYgh{6|JFK9oc8GRga*p)q)1%VMlX3q6N791EZkhXfbVPQ zf)@@op;$+aPrV~X(s%#+=9gGTUW4gM#yHvA{IbldJ($S+qNxNZ0xBZP!hdob$ZM6g z)OgPj=9ghqwmFA}G6K)K1s6H(MiP2sd53&hzv5g|R3pz(GuzMSJ+s%ph+}9hMJy8_ z*xZj=2so$jr?RziM!b`E;(&eB`R04Qh4@6g3T1Mih=rZMX$9s*hZ&#{`R4l9FQlS6 zxyF*mRz=LWf~Rvs(nkW!A^$s{7EBS_R=03KXlx*nhyt}TuTvj-?Z}GCwL?n=m@#u8 ze>jm$jWp2N^wdAnQ|@XC+OuCo9fUTkQC|VFI6k}%EAp;w%cIhAWCv0v)Y>`I`(84) zPWIy)XLZm?CN)@?aq916J^}@jnp+#9!0U2ZhXHnY`5I!^Sk5LOKS_0kgm@}?^FC}U zA}PXa)B+e$pGYB#KBzA`ZpdG}61IXACh;B&g0H#d3cF5K4=xvUlO_8R);`k38KoZQ zUfnOMA{cF|LLCSbdl5~rrqoV+%&j=pp3KV?v->$0bSlaIfbf_zrz4O6X3FOU)@&mO z388o?#)$0&JGQc7++A3)rkTl}?dl*#E&)@X?NDN(qA5d0?*)%rPEkAif-*Ji!qTxyqO^f4N=j*JDm#Zo&sgMDAJFO(ewWzv8;v@TFN6 zEQVjrS_avS%S;6_8g<&3w4-f_pftgUa1sdStjK9g+e}05Fl^xRL6W;$;0;$#UBzN; zPrq}l+<&Hd08LJ!Nsi3Tv-ra_LeY&5G0;=s3+-#tiQrR%bYm$)AvmTs)0|si(o8yG zT4-ovG1DW+PYl@0Z8ZpCsJzGBGnGNp2~VQt2B7Sl!TZh_~B z4Pbo5Pvk^Co$fU=1_ZQ2*X@+`!v2jOY&;2y8SBqSiT$dkX@gZEidU(LE%}5srv0zI zk-Xhn>B+dEs7^>u$<%IMgqeUvL2XXdf(uBFr3$L$8e@nRI8+sf|Bl3-plQ?$=LEW$yn?%o98l-Q37TH1uD zy|_5EP&vt5bag$O700RIx(9n9n%w}*Kz^+Y8Wsh$Q(A(8I)^;vpL2Oy!29W_AI#cZ7Xc!(UKR}{YSmj z8#JQ`K>nhCJI;3`p?LJ!LaxandbUbW-^RF-h+9C5X8*$SLUK{g&i( zZ%m`+0lfL-tI#WQX5tzDOv0MwkwFfz!>$3Cas^i9uBS9OEN4>%Dx{V2#UGms9iLfs z&=V+-Mah}UKhTFsmKQqg@{3GM(k||q+aN|@3{KRp*)xZ5Q;{?d!9Z=k4f{DQ5fFAe zss!-Q&GVjx`xe{AnPv9?(-~U1U%Lf*L9`5C&I!p3ybop>q4EXL5jwS=>7m2<10>KhI0?+b||gc zLi#M-`%x&Q_KTx&KHfngzJK28||l6o)nar{u{2IBmb ztCu7zdK(hB<04@Y&517f06OQ=nz6R3q27* z6E0JxFp!BA;v?uc8+ZBoF`mEFPb%MaZ#?O|$R0CZmlacA+kM)GvlYvRwF@-9$v2vaj zCyJ~h57r`8aHcfuT2uN}lgn6NQ_+$Z4k%c+i%Mx;4_<6!@n*{!q?{`~m2ABFS3a{^ zH^2?2O!`~a;dZI6Lg$u9Z-mN;?YcX{Hvo1}PlOYES$HTtjUCU|Q=)$h5jDInOEPr- ziK*`g=Em)OpPl0dKW84i)t%eEFA;Q2H4*-wY#t{G3#)1n5BoA zea}DqD0G$=g?AlmCgq>^bEhI+v$;u=1(ERg8zg;>IJW{p{o z&)ay3w_9FVdFj6VOJE*@@(b^Rqr*6TDHqqjm|eHlG8V1sL|O5|VDg^|jsu~WQ7 z!UYFQEX;|A@SD*y`hS$Tx5u~kA3$R~4*j?O4Vn2ku33eaIm$bYKAhKKqrTF=#ggeD zZUl+HQqsX;ewqr-jHl3eh)0m&{WH5H5I?rPz~z1B`>4i9lI@!IiF2|Q#figMmvab z;P+NlW7owXWK>D|>pYP~p6gYNlsLd9pe43Jy`MYr^W{2Hegk+;!`bXo_jf1}Qz6Q= z=3~PXB^%qfw;=oB(3S8kuRSr=+?^ixg(dq-ZSc{7Dd|{Vr3J)};gb8aFY3c0*ilOl z3N>|b0eC+fX9;sPlDaSZ`3;`?{B7amp$D4I@gT{~irCQbhtQ{Mx&K&aQs|KWYW(sK zY|4n_v|Y)Tc)AHO_o#w*elLG3@5c98F+~oW9EwARf!15~}mtuaiqUz`s48 zNO20Y0%#}KbzSDRACU+&pLPk~YEDDdBg<4DM+Pd>2F6=x00yo*zE!ggB7j#7HQvC^ zldpunQeWWj?m{l$h#?aeU08*(kn-SNeRS*LL61m3{nKwwUt(pu^fdD`VCOqls#Dlf zU-zhEx81PF(ON@Ezy?M9S~aB~BdmN}eM)}}?%lq#yZ38ahvcrqcL?vrNugihZBlyMd%N-~9mqpdmQ3c7Jxf%8>g_&fqYRHovHpmf&tJt($) zY4ZCyMnrmXa`2FJXd~*B#I%;kY@P73&#ICndH4fSe#Y_UNZV@4>1beQO{w%o@8g~A z8bvCA7&HU5w@0){ZeTFk9X(Kc8)PR5w~t48py8o z9i<1T(Son9YwY7s=I$4gek{IRPnN5Mi!a{)K26*XK!@UHtc0En@@aeg9|mm_u!7jT z`?<=MtqpXE&s1o|?GyMS>z8z#0C!T}*HHbN_NVTz0^*+ZpGZH=^~Q2VofJMbHuoZ5 z-J3Lp99CK6lgOX7Fjr^Q0cgdlsI<30Zp9|O9%VS^ULTR+t?19X3f1Cj+*W>|0h|3U zKY~|lGl&mxrSyu}ZvZ`pW6KET@IL#Req(a*2@Y<hBqnr!Vc(EBIT92HP8$4Vfx#R# zmuF${Ir@MxRQT)A+W^~N+-6v-djgwja-JW+d-Xl$ie z`{jrlvzDV$I8QcV;TJXOy_>hBs-et{=37L`Mf%VC-MRe^OSj5FW`HoIL&-l{4x9>e zK9w<6+>c7qQ<-8mQ@7tvAHPtv-6$cWsEmaLfdhhOVZLS)2Wq)KJBwUu2#{W6@CMjs zhtwEL&&0jBaFvv!2R>`E`v`%bMqfZU8i+-$BiyEr?x4#eb8({j;VQL2u|Vm|6;S3d zULp*du4vq0o1{A<5r##n`pA4^*9wbkJ-~ec*`@Uzi?-WEvafguSTV$XQapB@$6@t# zoN#JX2#Bt2-N>jS!pYKp`yOZ4fuKa@3_U0c1tPfR9gGy|;wRg|1Js}&`52<{g?zWG z*jy-@Nu9Cyz_6YZ8c4_l=rs@`%=YHm`51 z)TrJd2-x3NhYQ?-!{BRkts>jTIG9_4%UL_USKu!MsZz!cpt9#)zI0bZ0)jd)P1`w(lF?A|7qG7);JOSEI)bM*&u?4PydJsG-Ne%+1Y~cCv z7p!!}HGxwtzzGNp-Gn6-UBTX{JUc7}B1+3GbG4>3S2&8Ynr2pSx5FL%S+ZxG&U+D> zKsE6LILn%#7rJaqp0Od~&=%yBwPKvUz4Y1peAeT*WSk@tP0yC!R>vQj;NVR6I0rWvYHg z=?Q{GupZPl-XsHrH;m>WYXt3cM%!n}H?;LWMw}dA=Gr3?29)UIFF8R&-b~!V{;sGD z$loa&-a0*|VDnOIozmp=_HEgKjdUjmUJ3{r>oLq$A2 zCC1I&k;9WTN)nx4sWp|7MxF@e!}QQpSvsz$@uDiopp8ipdo)%HS(w8Z2P)z2fLoTlB+#fw!+ zfzQEnrH?dF$iVV#u97sG&cwqfcvjL)o9Q(?&ts~E44g3Y?wdws94BMg_+J_H9~2LB zJ>y_p@p{=oR_PP@xs=TujI;XK@hx1Cb9Yf$@=AA&fh}yUX?BOx;ugLE(i4Ri< zh2RysUzM`ZMNqx(ay6Zy8vGj3c)a&d$#4i|Hw5gP2bQV6OQ>4epg0Ek<8s#3op(zK zSU3rm7*@0Fs0*41F@3$4*JNbfx99H8uQY$s^Gxq`7;i|7f!jAo$URZ?W9WOmV&y={ zr8kt(3O%;>ODY0B8B=FxpWaWBI4Z9~!VAs$-FA1Oag_6E)@!Dc&NEVD8L<>jNP^d8 z2jz-F|D_3yYmtN(349#1RbH?LOT5F>oQYt&hC9s18JQ{h$QUyO$~Vr8(a_Zh6F9_X zmiB|ho~L$^>_y}cNXFhli;B8XFzzUtT0nBS?6|6E+kk}3T07xfTNjK!b2VbXv+@!- z3@1BOO?G3NMkwl2H1|CgaYb zbH;RY=a1O{+pU=~{S}EdpFX4(y=5*;^k2D%odo~yrfHrxW!w)R3m2r-{ zw;v$82;^T9Z=}v$@U0X$yen2nH3pM}qKfp=$Q&dv9r}KZ8B_B@_$Jo5*>z&Rf}tY> z{eX6|x59Kue2w0JD;5B`=b^2hP}mE!Lk$Um@88o7?I&Li<>GlN* z^cuOROCFh&(q0rU8cO1>K&f%^qJL0|i)hUK2eGZ#n$#_EshRi(8a>|X*%ggDi6msh z;)vArUjh{M=|?i`3rd~y4W4v7PVH1XzLdPSMx9+(Oo)as(yqVTEOwS;y zB{q8^s0@7590}z0JosRkS;T2l6g-!crtWfPpbTxxlw^ZX^`(!&4Q8ls3;YStchD(@ zgt|iQ?9uAlmeAeZt9~2J8@lM6)xg1?^&S&f22D2YrRs11Wo-pNY+y^HgfEtz)}?r8 zB5V(rhxcvAWCH~$Qer+0ZnA&gU!D5-^3LVojigdm=TfNoDntE%MCf}wIip2hqaJhZ z^36;DrQr?n+yt>U8*Jw7RK~kaSgm_~IRD_KY~UaDlxp*AU~=YSKn~Nv8U(f8GXGO6 z;<6YeoH4)8F#WE+k>O|AE{svbb(;0Uyw==k^gv^)ix_mbsIl}&_df*GFv5W*BpZk( zNh9tOz=@reKo65>cl~&ZKgqv-Yk9Oxt%xRGUz$@gjI<6{R$yQU9Zh$oPTbANwZy|S zRzBy`jt&M{@g<>4&2`3=I7dg+yAMBOZG(sJCciLlW;0*rPuN~fRPf?H?BaEpI>PE| zR)b75{9r1pie6!D0JQHWXbKS>1=-=A@>LpsCDIb}L`(OVbZF;366fsnGcIrKu9BIU z_~b*y^SZjOr&fp}&f(bMWd2A0z6%t)&~YH)@Q_mU7uWS3Cg4RB2UZIH&N33)F4}@H z`6ti53aT>N#3Pfc6*CGczO1;lRhVt58vHRQym=;(XqJ!c8eAF1_P0p6^!Oc=78cfT$X68 zY3I5=%ZWZ_{{uNn5J=XG8GbO6xPeiuU(?r7T}P&X-r6Uv$-%65BNgMsM!FX{YqH@( zMag>XZCShZd*MA9%SU86hKmwBi@ereEn&deVj24TyAzVRLVsFRW(++LMfz|)O^93j za@qZF0$*WHG0tU9Yt)a8t!+PaAy8+2U-oNJ_duHdc1NKh15taLvv>c;US8fTK`S#_ zxe8T+o*Tb>F=0aB>q`J;|xCc zX3ohtqMzNjwhV5F2dvs7nzj0Iz9sNQfe>-KP$ zxUMB=`GV~_am+~*Hzdeov&f@h)U9SbkDi{)7hmQ)YgV5{@bvWzpjX5)b8#E99k{;? zLiic%g}ASUO}5Ja{C>f=4g6_dGz)R;;l%_E@sF%kNl>%!!1~_Z@9=-03^qD_rr~r9 z=SB%*g~?J*$IO>&=$k%bWTOhm+eVRjzfS$s5-l*}M@N!UydFbIQu)6g{2^>F(eFiL zh%3Y4v`9yZ@g-HfNciU{Ez;nF0%+&0n1aPfVoP;Ryc-GxG8Co%aq=9Noktoj7mcEa z8#*OXv)_Bpka009UsN4r{Lw#`(BfZs0*m!NmC8IElHguExx^alNc{#Vj9I&c*K)=H z$`bz?q5G}BBR00+HQsrgXOnmw_+4UT;RV-WgrBqXhFY-ysAOI;l8O%n-<%L9`+_QE zeG|;E{|pqPE=c8BjY0BGta&xZB1etjK2Ku6L6;CwTIQyB=e?B59Jm3zFc21Lm79y> zo}GmaUDc$;4~CHk8G~VR_2Ot;_#NoC#j|f9&&$D0SPnL0x$Z_O#I>FcJ$f2!lA4y)CUwCa3$1AP{_#7=jr$GWbEB_b5o5(3f2Ko zi6B#XL^RUrRkuMi)fjUQj3OBSo+vC+Z=HXOPRlGXCRcdsU`m00`kCZQMLH=HZxd70 zAtz!QIr2HPLS7r z2ipg1PinRp3~v${mZn+795R_7+p>FB9c9_LWgD^Tk6=E#eC?P?6dBu=X?R+-l5(gT zHs4LVA*Zlg8rkFf{N@(j&k9n+5iyP zBrF}dtM!Ml1$mjx&io(HO{c)IO+C=%1X5iet8DThc6?rd&LkPGX?d$7D)iD|`%^K8 zsRJ3N`Db~}g#Kt4RVi$&QcougV$Slb_XL$b8wS-_>JmNgoPOIj%!ZerPZTs(eIYfQ zjIyU^`Zn4Tmi9c|1VADsk_=lmBxb~px2d=GGXpmu8to(b#14Mpx{I?fzJm{vj{-D- z>Q|ho#!U)9dR7GUT{C7qQW57&9GULPibp{OEUh)WFUDKsg!IxMbuK_qyC>brQ>xoD z*iMS7h9|KsAbn6x&lrA%gRNdkJ^*N9_dndcjJTswzzaIx{7^@A(B4u2YdwCWslX8k zpa4xJqc?c4*gGb+9C~UQga?vELO&l0Q zSA=S~s;=K-Mm@MN+zUxHE+=+GU3!En9+t7M=E<|nuOftO%cXfKpcyiHHMJ3)Xq(!7 zR@xms@VQOKQHWSB>s%OUJ0I`=UgnS{y6bxfNQ+A*Gmq7Tg39>?F7UR9J{_ z#z9|2zMSM0L8vU%?L1cHnMLc*7`V`U58ssy?XNC~v#o-(@A;}w%KU=b4`KWXBKlaqYC)4W&52Skj0o12ZS4*3 zhEK!%8Gew6-?F{}M*QK}uKNOnsBwqWIvp_aOdnP#PA6VHqxJu|7bYURPulDVsxqmv znK~EteMuQ$9vIqp;sgeggV%W6&AZ)Q)!ekc4%#LB+^yl1#L!2KlApKXYa^k;#58{C z{TKw@uQM%^=n?V=bTCpQ!^L!XjNWd8?i#%sAnD=(v&HaIxt}f`_BEdB6H&6|BN1_O zvyF-zbvWb{4=`?B;d6+LrR%>es$0*^ZgIu#oygx}@Wr)hP54=s|FwK#|czNPl^@q-t@$aJbQ7eH2ev~07v*q028tvgB(NKvQAN% zK4Ij$P+rz7A@70Q5Gk@L+Rp_{QM1P;V@>E8)&S+)$si@JX|+Rq0ZQr~OAllAj}n`O zJ^R+mpV1NM1S zuW70_ct&`_Po&2X7wwYRL!UJ&9g1n&#BN6HO!iGkO5J_+B}4rGY3z}guzIQ7*LunU zG56ll~Vbbw5p5 zKZZxwKc_JF>)3Otw_f2iNvyxg5})48%^zg;;v{O0_giZ}lTo;q3{^&mFM6*M%bVZe zfg1t-hp4F0%wn-#Uoh2~CH+{9aQ|3mx0_Y~W8~kOjXX4hs(`Jf_*@EH2v#qimIcLQ zd}?68SN$;|&)p0D>a->DsxUOL+#Y+H*Sr;&5ucIUD6cv$e?F%@orRy|=h)d724Z)= zF}mtxKvsb=Z_SYdyM-c1l=&OwON2OZ3!weHd4HIkz6HIHFT6CR6TQyu(OtzUZ@@1^ zPUbYklZUrCZ0$b$AOaC@OXs*4Ah9?0srE0u4Bs5ePJiO)0=9#xURM-pJ-WlkTSWcbhFIho$_GKWq5_HQzn{aX4-x*`H(UC$rIit;%3Q=-Fk?@3uZC^Ti6;A3)vU z!Iw&)o9haDcJ>Iqb3DbZ9Kb1Fb`xlS=$B;gJ{PYa41HM@ z{d;8|v;2kF#dE?f_D+E-&ten)TN3r(bfn9E-#4~9{~jg;Xi2g!s3iQ58DBYkz%`x! z80qASva5ALZ|e4J%H3cNL?K7wDym%n)_GR7`p@Q+kJbtHDR9ML34{n-GsV;V=o3#}RlCdhG_g*MM%$h@ zVfz7!7GnQ*BKWT7)nj=;iGc95=mN`TSNmW_vlY6{80f{HCsu`UYP#%3(-ME%wej=h zqsLvru;F;$Td4UcsiIdw4Z4#H!(4V$)ZLc-VaKg-*7B^ac8G#P@~Ccw3kMJ+ys#b=ux3DYKE&bD_ps#{<#w-Xfq*$;XYc*TJr7j#WTx5PZO+Aj{^8o z_?MXy8Kw?C^Ln(oHkoc)Jl;XvH~r1wYK?W1g0&co1PacuIK$q3h2H>R0wGR~W81lF zk#;}(SxI8YF^g`dZC;WOZ_c)?ikJvac-L%JKSSUcFaj0lI)mQPlsz$=sV`AOSw=!#<{u!0TbAMwKgljA0SW z-(T<_IzD>G|7JjA-R?wQgUpB35AF@q{aGk7ci)xrHlaop)W|8@ubXlA6E8WKpZuSG z&;-(OLBO9KO(P+LV7vmh-CA4R{yBErQ`BfW#Fz` zR^;@=Pj3k!w|x&1iEuSHz+o+thuM*y1I4m6bgriw#omV69$$X1(PxkVS#ob$bR@T>v)GR1gxh;J zpVmgHwmv2uo--p6X|Mu}smsyW5Ugk!iPVHB#Ho{KhB_xzIoK1g?!3*Wq7FlXvOSv%%{I<9sNzc^u zxH<^Rx&hhZ%X{VOTmUftM+*BJ?|mJ#;(92sF&E(dh;c^4<5+s*_3gzKE+`V6?v?D!aauE+Qg z(V#1lY%UhUiLwA)407NBt9byKw=2GL6d`8R0LHuQh0Hz)0CJQlHP>&vYzweK{~6&a^MP8V3S5y%1ry;v$7gUTtV?#1o1S02V*}el`!3bxqx5B zuQB=<$@5Ot5wb>Xwkt2x>ff(l)sj<=*?G#=BvijE%cqw3XVoD-37@L}di1>Bti6Ix zD~B%2XW$XBOiH;>lE_Nq%seH62@^vF3SCKRtmIF2G!l$106T~Hjw%=OO}r?Wlv(rp zCP8wpJ5%3(ITG_|pb`5yP>mNu>T zhw=-!a!{e}w4h2qxxs~&ed?!vmK`n3Q%@f!iWC@T(smpteNc@n=wtJ1@@-p>GX!J% zBVHY%ssBNmu=lbq>4+;hyo7|uM6!~`>X=-}KB@$z1AJ@k(ra0SEW$pE7#M^GK3JCV zT@MWrz6;M2hCEe|nMnCGEo)U4F(nJZMyRT9Y+u9+5oD#EGJ%56Omv63R^+0u7zY!< zrp{l}sVdxSiRzV}WI6ve`w;dizs8$yr{h_Mwpzb;lWm3@q?AT zOv~!aA8^CS>M2iUD(~(Fep-p84Jik(aN<7;RpnIurl#pSN;N)V^8w^q`pYr>huC_5 z0MMBhP@4P+@1TVz;p6|$E_Rtl9+v7bQu}u;!I*?p7P2>#qG`sfu!T^$kMIZrjo8sS z<&D$ucB7$Jn8NY$!eD}@!riwHOI^?bb(c8mv4kyRnkW?;%n4Fa+&^Y`gWGQ7fta8euI@QJ7cAwaEHfA4-~8vvtphwQB^6qCYmUiD{J^%{{*wX z{{&>*Gzrt*#u~&Qy@j{_rVnx@W&-RXhzN$hZ;f5W>2|` zKK79_%s!>v5;~qd&~Mn|uygsJUmZk#G9fNx!cz6YOv)S@lK^9-{P@840Q+#LUZv@mMc4eh*9N+OKb z+F_nS)*R1CQ5+vnx)L2*vOwtmFdD_rHjHE*o$xFDJ?L-ZNKck~)uTz04Z7)mY5cMw zd%EYod=&3t%2Zl6nQW8&lv1p6se9U2EqB$4t^I7hXp}dErgEG zL)-_7u?)N9bH;OQ^_bgx<0P}Y2Jh3YzQ%(%joiRtoJ<4$9vmp~^CZW$5j?oGsWXBY zb=%Ib7R}5S&l}mG7>?#B&>$uSqYPCx;MTby*vs;~TwI^Gk^Z!7vy~U+{im~Ur3IHM zL^yr=W}Gl!JvY!b4r5*iTVqQ9oJ6Uf!oNw~Pj5b+9abtlrzO#`UGb9lSYV|9v@OeN ziO4qPPpyuxxQ>5>_{7Gw^bflCKqK4Su6aCu%CmQyHV{5Qb`hPKHC1F^xX|?vc|zAO zMN)87XB1BiV54O5XS5NTQB~Ijb-KcMZQ2!@BwV&zh|m|b)bT)>T&An#OM|b2!Mx~2 z`m1q2d~J``{x{!-fIyApztQEqRf9NRYTS@}^_})7H95N?ngDYnQzQ&X#JEZLl|*5SaOF}YmS1KXmXvl64uc;$wA)`@egj+D!h>cOXn$Di zr(w30Z^xr8b{ zVSDY9DS6heZvN-Ap8bR#1B^AV%^pWpVgq_T zQFC}Vr#XFsMkBMzO4LG|X|6r%OJ^oR9w<#Z8MaF@hCli{CK`F4wtr=Ae?L@jgC?$R zpTnL%kz@r2a+A`YW6Wbvp?mr_K?ne~9LsybqoT~rwWBt-JZd*$NZ2ry&X-`8ynGDg z+&7QA)X050tr)|4E=?#Eu{?lHtcHpUnh4nYsgh=wDSnl7-PhQHc??K7FY^0gwU5V6 zju{6ZF9{9vQr(P^9L3ZErf&x=XL}1}JR@eUy)Kk5h5Rl<&D1ea{h$j8%nUGK&~>FW zU#}Cgp}Q)ff(2Q6;-CgxEBjto$tvP8@%uhLj3n+1eghoq__s{it@yg#h%s5m!=4d1 zfE7LNMJqv46fhzC>a~Yztv*1l%e3i-eSsLqVim?U?2@~Sn@T4OBnp0Ulj3GO+;fkv zXMXJxxt|G(Ul>lyO>+rWP&Tb`5a03~m~ zR|1qk5O%d2;zZey&~GUQ<{b6nwv{+u?c3kxWy%q&E5jlKOC(<62gITgDWnxcy>y84 z1`@uNHNC{<;d#_BRWw;Pr^!5ONV^=II6D|`2@pV<@7V0tnr>aC;ag^jmg6exx$|_!L!y?SPL! zwhXiJWsTWD#vbkdo7J{miqQ-Nb)($N+5%IVw9nRd$qbUY`)M+s@h{(^neT90G94n+ zKlaFa(qUMNr7?!cQniTRs<9YvW#7Q@MeH*r**(u`^~3uMS76_S@dOx zlpNOoBAH6)!BFg_^mbwkh7r(+2=dX&MelIOV?57}STnzJ$D{L!{>NyhwCbG6MwRCw z^v8ByKN(0P!NyJeeRgaqq`bGwmD3^s`yPF*#APq5N?;kNk8Ml}YRY_b!?p(s5xx&_ z%p^Qx)5fNGg@u{bob}0Y4N;$Lx;cRBb_KtW^z9r%nu4iBTWF!YIql%5J%0^TblezN zx^N$4;38<&r=C*P0ziGJ{GAz?ksCTyWnI?)xNA4KYyXAts?0vCH zx~!VyQEi1Cn0TFC&p_IrS&2ZybK+YsWyleEUy0pX(#lZPv|Wx5TmmCHb6H@k&DF7# zJm8h&`lEk_Fe);4T`^}|pWKo|Q-UGH`|EMiy4iiv!qId}0h%31x8{iJzEu=v6vj&K zie+rl$|E5%)S3hFG&)cPb27*|af?0cK?@BdVApglMzlV9xT2U2JAERe9w=Kit&MIkT;c=9pAp>&(i6A%ZDU^MboFqPkDvs|Jae0gC)u>v%+Au@ zR&#k4`l{N2G8sb`YQK95d0+7}ga8jH6~wNlJ;kMpZl0dx%P~GZPxmV2A5^SwvS9_y z8Z!wcHfmazTmZXyo+UrW@D&kS4UX#0z@+BeZmTF3na`tft0&mbG;C3Q^yC`3xey?O z1@UgfP8W4;o|)vxU%>uU^05LHR2of{t5!xd-Z@Ae!=Wz>2_%KNE$bQ)I(B!krLV~I zs(G^L*IQi}G#Hk1I4M2t=`}{|B!b#@PsI(#3c9J`J9UNhC$WYE$>xRhqVY+#TzTPgB-?{&s@!yxA#{s|7xHVy) zCK!2XJ?Cknwfe<+t6BJA`+_t6iH@dPseGrSw=4ZnY9K2e4oRN{`hi7DpU0>SMGoW_9f9DHGId;)YlZSR5q?OSEyKzr4@_S#f2j_p zraN3GCv2EtN6?|9JDHRT2|FaNG3Kd+*CsW(|1D*AQTX58{5~hsYC&*S`x)O8UTtQQ z$YbF_HtU=l5_DPCxW(hW@$g;5E%DSkLG6d?Pjc{mrh10LCxoeN!ab(77QqI667#n? zy8VD-qx1zFylUgbcO?gTd1x?*4BU72_#=dw$GaA?<*b8{v2`!6o*0^kK;ff75v$4{ ze?ZH0&9ij|_{~x?$rr$~ZT%T9(@&K?RXJkw1h}~|tsV(xjP@=1&iC3~Cvy{XFIlg} zE#Go+-IC65UB`(^ZXjpwPW*ke8XY zyNQ_vHa(ZTasFhjEv?V*mj>_|fxYQ-HyXTSS|MCebuBm2#d|w1;%1x|;M@>CFH+MGus($r-`zm{fnxh*XS;)@ zZ0o&HU6e?d2T{Pr5Z2o1mF0C@X&_V`nHw#v^F<1X`CP_d!)tb4Lq+dQ+Uyw^-9%=A zxpwHPgCJaAF!#2x(VDtWf!;UT-t_`PHAr_n_D3TR&`fWLAkNOQ=fux0XJ0%$0nPvI z`bMVYMTnnfpYKB4cO!ZY^*{-NyYsMKm1Pb1EqqV(hMKpx2v6?LifQ63^|K8xtK@SA zZmg=@NZ&iSXqY{#R*~sx8qfVH9!Uqia|hN069>GkAJ&C4%pFTlKFFx?Eq`5!n+!u1 zT~L$!UW1RXTW0z1!PR#ew!7%l`uLyD!VXsB0fyxo?Ns%9KAQuAy<-TpT1&&TSGDtOAS2)f+Okw#_VIfzFGRI9Rj0 zb`9UzAlq6pNN+J}UtKsuqax$NW}VN7!n zxX2-Y*&i34O%K5E+$s6xH2^>sL<51)7V85o(RiIaGt~Jl%g8N#=6vRk0+@$W-A=Ym ztN+I^Tp7AJ48)_rAR62#)5l27a|pH=0{X!%o8N@JVgUq5F1#{#LGjxY7<)9e)R69i zN!UUb!q!C3hl%TC3@YWNUbAY29Na4()ow#5v+V7{AA+rmut94dY_-H}D?J#MxJ{2+ zZYJT?IBUpV7+?gAm%!L035B8xp?aUau7==0zY@_zO-v`gu?&n7=q0*;fJn!9D?4IB zK*UMkP6ay8p?Z(8wpEiLxB5aV{v)Zfu)y{c2=|Se?-tVwcC|Kb8hWiZ-7>|1ey{rP zR23wlS`p6MFXs1erOw{V>v;u=6W!lMRn-d`$BRe;p!85}$z+*4Byf^RR zw){q#-$6Q*z?pflO!(X9S;Tns+Idt0t5!_Cce~l%;0jmyf_DmIRVus%+C-@;d?j!> z-X#6i2%uxU@!eWRURJA`!x|Ex#4;AK*JESh-4FG2^hm4t1qddXgMyYdesrp20D61; z00~Q@Y_Q?diT(V+xV`Y(V)s(bj8jv)?lDAl%+`U*vaYn|w|A-G3a0z)&D$g;_In@v zKalwUcD$@RQ8HFZ$dga^rE#6|bK^HcA?prKa1*FH^nu+-J^zuVODVC1Amhg-bQ0_t zpss?f=|(67L4mOr)<|SmVcyv#65K^wi)%D`1C?>@&88PgyN-5hw~3OLyj0QRt%f>q`MbUZNi3(B_gQG( z0<_aN51aj=zqs24O&Nff#-U#X=8mfCa1!A`4@T6FiGESyvUDxnUY{Yz94`T8iPvNY zeA%D1o|`vg&au*eKDxL}N_8)+i4_XPue;}*rmgY?w}|hZq(B^Vo0hx*ISCf#?%X&< z!=bUed+RYjtTg_W^3dyXlKBB$M|`wBh=%!l8`wGUhxDQBcxkFerWH0J{=eeQz&YKP zq&WIN_BHPk+uNH|vVK#ly;>edn0$cmxu<4&ds@=rws`14tKv+)9%~KeonyM9Q;h3S z0Zp+0!eN(R^~iv*Uhu>}JHb~hWZ)ai7x^L7dS}jLo=!L(ESXImqMw#feNeG4*RN6m zYGSj-T4CebmiEkl=9zxJGtq0Diudf1gEcCCtG@lM5~3s&*o38R@bAb$)(K*h!C=q7 zK*UTt_mr2U2c7F}4`nU6Pxai5@-5@MXld65TaZP~2TbqIFrsFI$F9_VxBA9#2(q~p ztbyuTQfa0S8m~EOQp63`%I_}}_T#NQ{NO1_D~tMCH}GFyNA zcRp7{3oHxo-i3NxNn6VHX17fu&_=aKN_laUk^9qM9+1SYu>xw6L zPHCiC{C_PaY892Y(D|V_o(m!v7H5}l&4P=D&hn~LW4jmUm?kw`Ja5T73IjXs)xs@` zrvH&rWaqP7quY**l}g zfg$9o=(c$kZjCZjaS@1i+DO?d<3OFo{NnFC zBK}PwNwHz*7~7QokGH5X@_>WM3X~(v`p%17dd)x@f;A8 z&C9Sh%T=tqsbx>I_g3p=R}EUNP1Za(xHtmphi#-JW2Baky-7Y6dORjrs1VMY3$j)Q zxQ&zy<4wex42wzQz8Rfz>A=+W<0p+;7fABP+&<7ahrwBvdoa0c97X(8!ALbu=;*fs zao-64)mG>xxS;}G`Nh*#o+3P8R3ehw8W9PH%dUk$@#fM$eqWNiCQ@6V*R`_RQbdZwhB-$(M0xBIr>78q zIo}^`H*3TW3+X5736n@%Cy!2}i6^K8>@|B{h0z0>6V+l;CqD0;q4+fRIZm*a;uzG( zT>(R7KoJy_*pdh-qz9q!bInpS`aUiRxwO{g488afNZOyDGO#1UI}n_LSsQb}lAWSw zDnoFG1f|hE0wp3}Y^twcj6wP7h~mzRBBs)1B95DZ2tKPQjnkD>{ObAD9rfJVM&lv> zb;Bf||9kwSGq8fB^Nqj|0%mD90b!5Ykt>yUCxCVZ}k7~7>Md9g%(ZXc9 zisYxl2bhUnTb~w_f6*i?%1Qc(`ekUPPnYXEJ1dQv8LE2_^h64eg;qY9CTVKDQxBL9 zaWD*WsSM37JPH5#0~g`7MrfepXjU>nD#d2W+Z~2@i@?yv#@>h@UR`BcfOZk1;#!EYcc6(8lOAhRU9Db1*Op-gzvfD%+?_@wIRN z+uIh2jMGqsU#O5c9ULqHPfsa$n1xwFmRD!=grbiwHG0)D??cBv`@@ethD{?so5$%W zX|Gdfy6?YwVwO)R6=A#>oWRy}pk>uj2it}~cM!Dd4EVnZd;WfZ{))F{jDyVkso(6O zcOt8;j6x*w6nmERRt`%4z%-kM-8`=MQi)&3l3FJKMX!jVZ_O@ozRFIcMnXpCQV#!e z8o(t54N^+RhY|F&FdUL5;gIk1M3T*r%yGwt>XEY?27FiXq)s19`0$_5y2}q>VwmDH zIxVFz?BWM%vGTc4@mrbBDqt9ik5hY78ZFV&f=eD;$%bGRS0t7w200uGAOPY*{t$@P zF}&9ioivXZm9>A_yGoX(+4d1-mP!VY)*O0AonQT`(6m4Ro-GWX#pMF(NkSF0B@L6j zntlyldPTqPVO>t&8Nk_*2atw1@zLWr%6!MCR9!*Qz~__tXH#?4D)FD|>&Mn)qjs_f zOd!sk;S4YgmzAKGF-vuyw&RWZZ4y8FAR%5%Zra)J%1}=@&$c*|&e%xLi2!pP7sC5Z zs%zX=9_NeC_;Pjc8@1_d9ufT;I!&SJgemUS!6Ff7CtZF0=(zqPyk^R5uP}QXWK|>D z0*dp3~~0)=Z`**vP~#>jmDF$l{`{o=GKxCqQ9RXDCdR_K#?<`gp? z&I=Q%Y9@vVSD3D~RWYeufv%s$UoRSa#RpStzafX?LK+YEcuvzYa ze>+{OoFYa?@PXPW9(f2Tt8@03Dt}oon3)H1l`|Tt!q(uswGa@2lqL3FLAcz@L(fYs z0k<^VZ6y`W{2?%xAFh}kRqI>(%Ir*m7T~DU9H!9NLx2d6S?Tq*3h*#6c}fdtUDOc} zmXvC7Vl!6<1wE8sqW!CNG~~7DcQ_PQsMrr0w$$1Xr2#Oim&gN>3UY1H!O!thv1fU* z_vUOabGwu0eb8pgU_cureWyvN%3?r_ncSxq zHqqs?GB96Uz`#kyKV7Dp_OqvihKExPW?s!(Es;&9OPVxNd9hgX^CdueEOl}VxM$5s z5V@=}tshEuP7VUv+wrTm1G`H@iA_}V{(*qNM;B&d0G&&n2vU$L$2jKO^$I9dU6kpQ zZZ5W-NoK7F5=i=d9u`mtd^Dljg9bhgz+i}nDt2i3L2owZO8Wj=t*=es1!?MWMcV8y zKxP@KoRX@;LQ)8H&;5UbJGhg*y)^842Nr(fEi5)tQ-3IZ>WraC1+;f%Yyz3R>51ZM z`2}SYiNf^$ffLOiWIYTq4gb`|{HiYB;KwOSx=%`ZzZ6_4c7afo2;wpJ1^HJ_I>kdA zQf{?1>cST`>QZlA#ZrOx*l6hSI*i@KyU(h58E=D>NyJ!TloOr+Fn!FS*Hj^_PA~~W zf@Z0&?n4_RbMQGxHmpHU)X~IWG6Ajl%tv4sn&JA+h&p{e5UHEFkW1;6QzTM3_j{N> zJNwl|0mW>TStKv4OjBsQT6Iy38LlR|Xey zcNJ@#0QC*{qSOj8(!vkM7Y{~r2L!o;T85v@NNfkr4@craeZx3&8kQ}{&4E~m-%v+k z{z^8&-Hz>5MszV^@xE1X6A>Z7_`BV+^xq9R!Jez?0}z=fnXqre(9k1+aV#3%6;&_5 z-Sib1fzW8{jXinbM;CDBf;$jl<>Jj)yJxr@g!@F5=V&Xl5^X+dEaPV%sgj_?-p95e z%X|Nbd59Us6Bdg&fwd$%LlnMLaxoAW@!vFDa2bxzG)L7$ zJ+M!M$H2Y_<|wpNKTi-A5r>8!;tSBx@9z#qH-iVi{i9`s>m730Pog9Sjz?AS_U42H z?}8>TH4y^f>N{jUaG~k4;7rfcL){6)?T!H#F~JK(%B?k+Qfa{b_0-ifJF;;E7GG#5 z6|F9>uPTNJisBGP;_S!qmZS^(L+}2bJz56%sR-X;3^to+MEXpU>iaoOoAJEWdY?9= z4eK()_k~l^Rts4JGZEIaZ+S&`c+12^eQ!EW5OTUBB^qZOcenyN?CUwfJg1~cp16gLQ6 zdPN?_IoATmH~A)iY#VGcDBUpu^I>A*JU-Km$5Q_w5j+_z$`YmTW9BLOtu`y-!I(+qrr0i2HZ-$H)ySD-Pc@ zD( z;@8H-7H3!Vi$#f`n5+)p5dZUqt_tOq&RI4}rVnI8TsX9|1~?dfeP08gr>@lTKCJ6E z>AY?$Vo8dT#$5c5T0=D`_ci~jd~Ib5jjq4!>mvJ?1lG*#W!@+jW1s1$|57Yj;Z2-5 z5-t_FJ2XQubnr>}->iv4HrhaY8YOe1uCD6rKO%2oq$zLg zk3Lgyj|}h0RKSWK^w=7t0r1D!@X*{M=^R2=QhS4h@Fc=wa2XKdkS3KDwN!Egu~8Jt zZ%iT_s>N&E;|j#Jj%B!Uz!KwS%>poT+$uwGe-$#to+BL1zsD9vz!AF$`bj3w8xD$; zrk%BPq`I@I@wO*rT<@ub6>`v?UdmJ+Cx9`sbBg4lY3NAGwH8eaF0E1G$v9i7yAFAb ztL9gU)u;ypW-y{JL!Xwt2a$t#vIO9s9gnFUEBV!PRC@^2O;#d_$#%FL_tW_?x5)7J z4zP`8Jpxr7=1_tQJ*!lAfp96~Veu!>kTtEH&*gsPeAVO4Vh#e|`-Y1D7J zQ8#=ftdlGm!ZyDigGCmJMo}Ty`ixEMywgi!Sr#`vMDK9k*RGRr`-Wj?K83CwwC88U zX_qqA1%2;4rt(NKq_ke-e%=tHv z0sZA?WPnH1yBzgKh<7T7iHq{gTEjnWC&w@=#p?~#;40Wt!>W-h9nDnNi>XTzerDK# zYkxQruLXs6So&AFF$h4QV0reaxD0dUc{>~{GH)XHQtnFAiJUZ?(EzCa$%lq4L!Zv! z#JjfQ=Co~G@^h(1%ODL8wGnk8*^>Tja(RWj+7|7Vb5#Aa{Oy38G!CGP%vcHDg7w0^ zJ)@9u5AW7Vg_~WzI1h+Z`o|K+Z(X29c~ym+K+RD@XJH+6VuVYosC)m40{_AG7;bAC zw?WNS?Cj%UdqMVg;tH2gd_CMFh>IxMUflp(DR1@LMPhh)+qJjXaY0pnTneK&960WJ z%}8OTTA{w+eCduc$~EUCGaQyqgK94CA51!p9*4Oq#1WpQY*?vLzS2y0T(VcC4OQjP;EFc@GnRvGUPOi^-%9AfJB)PeBO*;Yg))oDhc5vwZqtS3=5#-9(&6CVl#< z8bKMC@{Gr?MU@u8;e`T^_OA_b*&o|tFC7_C(-;;MThFsAh%Vw6WC!`aqp1^VM%L3- zZ*{Z0o2OwS`l@YiyLKtQ5I!9dxcP(_mVq7SDTGhqPkLvmbDz2&2Tss+yGU5q9H6SX zMY?GE6e7^Tj6crc_h{mZMzCqtGo@y)L&TenN|7yYFS`!80XTdGG;#~2K$ICwqm`2S zbUrFZkQo+a(TwoeOz!5g+X>z_?jyHO7mLm4S6ibMuvBL5tO{*7YJ(OTlN05#@OEb}v05q}jE7Nv@}OFXStUMql&~YhgZ7nw&HboSlIY zXZ9MKVe#)SqH)$wC+J1XVf8`Yt3;Q(8uzh+498}5$XSy7$zJMAbNOsq=>(MM*R_;I zYRFH9Q>1;ffK!OB^^|J0oE$ct+xY-!6KD{TyN=Q=^?F)k?wa$~;QzR@MBIV)Mwj6p zojZWW3`Z9BBw}^=BcT(eLKx4+%7WeG_pxAzBAiU0SUlen@+B)%P^(8|@4$8OVBegS zvyj@_NXoh5?PY2dgH^Vd2(kiZO|+4Yxv6|r0a}|cK9H-74emw*VmSX~+pTL-rQoMd zvqu!r+O+ok@}+Mz^I+*P-lMy3m7(Hm$ZF9HI-@6T(V!=>41dDD&Wy5+f(cny1hv-G zJ=t35m3wg>Z_9I|b~*l?Q_nx;CsE>c_!HVT5`IE;XJd$SHXa$OEsHTG$M@jltK0F# z1Q0E0nY8aGm@bF0TcBxa71D4q?Kzbqd5X@zVq?|ZTmWobcZ&U#%GX{Xf*N2RDZxZc zhtFQGlVk-?flB&yJYzGgK2qifLLknN1-k$7kU;fHixw_8I z@u|mIueK_i;}b{wcI6tZR*jK9h!2EY{tESQBZQ!;MZo zwEE1gsixkX3Nw#8a+1~~C4--DMTvFUByHg}*=i@%@YaXk{+?aWH^=|1Jv1w-k~P+* zcL6!yE_9qIrRI8^%ZL8&@%5}Oilf)^a$-jF9Y~+HrAr!1fB2ptGOmqM-uB47?ndN* zOc~H+YPZT>09_j84M(hpD9hiiZ@r@wZj014N;USJH*S2bJ(f*2sSQ+Qo79Tj!zmVJ zt*V8%i)#nc@LhiHC)7DYfrl&{aVQlVmJwWLya|kED z@FKLZ3^s~7)fsL1=C@`d`!ig&_@Oe4i3K*@bvIqqVAb_S_TFdCm@D~FWP6mvXTbC@ z%#JfEoQ$-4!ca7j)o^e>X}nCDOMG!YP~D;8>gnU;w%!)Uu}D)_GA^s4lCp)@+1u~< z^O`1$X;>c~b{RVR1KF>H=nIyA{gB}WpfL{%OU90<`6ZbU^g$;U|Z zg*VW!H_WhIo-8?|es6S?{XXZ&@!VyWoO3*aYp0j;F9Wsl|79*K9m8HbHKTFN8`oO5 zC=>_9v{2Ff=67eGb|yi2v|r;%QT4(&(wgoKQA#&On_}va+~%}H^w1{Z6LS>CvMqqi z<$Ibr>E9q7gd=>VHTl=Iqwp&}>^SPSpB$)-+}{{$)+mEO@|j$Tk(WFzIZ8AJ*tLxW z@~cgk$6NW$1)ed2V@7H=0+hin~9j&nXcuX zI20We$fUjr5hN2=6s|J|`dq`_3L{jTFaSuQj01tVh;I4Tx>624&t`ZAb?9pD4Ce(# z=11W~;!bwn^*ja+X6F*4>DKV#?ogMO^Ko3UP7?F1ZYpZzm&pgm58+5klxd$Zc1O-a z4rW97Uj;Lo%~=2EGw=?wfC%SY{6r}7C|pZwVM~()rQrrY{qEtXvs!EAjwfw>TCd9l zT!(9{-Y*UP+8G*fg>16mT0QJVvvM}d16fT}jyp6(HBoUewlbIGrc2T8|F&ki*f_N_ zhRD4D7+^ugs2G4zHxCovM!F{{6*Q4p`1!Zu!#m@djv~Dn=%J9>TcB*9JbfmL1LVDW zb~-TH(WB=e37OGk?mlI$5;B&2w8uspf|_j67C=ZkK1seri1h2 zB(9vc`Fn=0xzck7^oVAjTy+AqfqJ&jdCR_*Oh?xCx->0agTNquf)7F{tm1m}xItz- zuscxjxRBmt7R%4!CuUKVvJU?24?oMs((ETl(qKlvyKIJC2{|&>8R6x*tNLK z|4+p^ob<3L=o%{Xv#5C!0EtAXVqjQx!~!tqt8+9SHzC1bly#1?HiCI|ba>~Qx}eb= z+z^QwXxKmLwJ=_f*yAOWIo0e%ER&Lhi0XoCtZJnM% + mutate(label=paste0("Recorded by: ", recordedBy)) %>% + select(name, longitude, latitude, eventDate, label) %>% + rename(date=eventDate) %>% + mutate(year_month = format(strptime(date, '%Y-%m-%d'), format='%Y-%m')) + saveRDS(bird, file='bird.rds', compress='xz') +} + +# calculate number of observations per year/month +bird.monthly <- bird %>% + mutate(year_month = format(strptime(date, '%Y-%m-%d'), format='%Y-%m')) %>% + group_by(year_month) %>% + summarise(n_observations = n()) +bird.monthly <- as.xts(bird.monthly$n_observations, order.by=as.Date(paste0(bird.monthly$year_month, '-01'), format='%Y-%m-%d')) + + diff --git a/inst/examples/shiny_2/server.R b/inst/examples/shiny_2/server.R new file mode 100644 index 0000000..b691db0 --- /dev/null +++ b/inst/examples/shiny_2/server.R @@ -0,0 +1,40 @@ +shinyServer(function(input, output) { + # map + output$map <- renderLeaflet({ + leaflet() %>% + addProviderTiles('Esri.WorldImagery') %>% + setView(lng=70, lat=-20, zoom=2) + }) + # dygraph + output$dygraph <- renderDygraph({ + dygraph(bird.monthly, main='Fork-tailed Swift') %>% + dySeries('V1', drawPoints=TRUE, label='GBIF Observations') %>% + dyRangeSelector() %>% + dySliderInput(color='red', strokePattern='dashed', animate=animationOptions(interval=2000, loop=TRUE)) + }) + # update map based on dygraph + observe({ + if (length(input$dygraph_click$x_closest_point) > 0) { + # clear map + p <- leafletProxy('map') %>% + clearMarkers() %>% + clearMarkerClusters() + + # update map with new data + if (!is.na(input$dygraph_click$x_closest_point)) { + # get date + curr.ym <- format(strptime(input$dygraph_click$x_closest_point, '%b %d, %Y %H:%M:%S'), format='%Y-%m') + # generate new data to plot + if (!is.na(curr.ym)) { + curr.obs <- bird %>% filter(year_month == curr.ym) + # add new data to plot + p <- p %>% addMarkers(lng=curr.obs$longitude, lat=curr.obs$latitude, + clusterOptions=markerClusterOptions(), popup=paste0(curr.obs$label)) + } + } + + # render map + p + } + }) +}) diff --git a/inst/examples/shiny_2/styles.css b/inst/examples/shiny_2/styles.css new file mode 100644 index 0000000..857013a --- /dev/null +++ b/inst/examples/shiny_2/styles.css @@ -0,0 +1,15 @@ +div.outer { + position: fixed; + top: 0; + left: 0; + right: 0; + bottom: 0; + overflow: hidden; + padding: 0; +} + +#controls { + background-color: white; + padding: 0 20px 20px 20px; +} + diff --git a/inst/examples/shiny_2/ui.R b/inst/examples/shiny_2/ui.R new file mode 100644 index 0000000..64b7450 --- /dev/null +++ b/inst/examples/shiny_2/ui.R @@ -0,0 +1,12 @@ +shinyUI(fluidPage( + div(class='outer', + tags$head( + includeCSS('styles.css') + ), + leafletOutput('map', width='100%', height='100%'), + absolutePanel( + id='controls', class='panel panel-default', fixed=TRUE, draggable=FALSE, top='auto', left='5%', right='5%', bottom=1, width='auto', height='auto', + dygraphOutput('dygraph', height=175) + ) + ) +)) diff --git a/inst/htmlwidgets/dygraphs.js b/inst/htmlwidgets/dygraphs.js index f942886..b206eb3 100644 --- a/inst/htmlwidgets/dygraphs.js +++ b/inst/htmlwidgets/dygraphs.js @@ -75,9 +75,16 @@ HTMLWidgets.widget({ if ((attrs.axes.x.ticker === undefined) && x.fixedtz) attrs.axes.x.ticker = this.customDateTickerFixedTZ(x.tzone); + if ((this.shinyValueFormatter === undefined) && x.fixedtz) + this.shinyValueFormatter = this.xValueFormatterFixedTZ('seconds', x.tzone); + // provide an automatic x value formatter if none is already specified if ((attrs.axes.x.valueFormatter === undefined) && (x.fixedtz != true)) attrs.axes.x.valueFormatter = this.xValueFormatter(x.scale); + + if ((this.shinyValueFormatter === undefined) && x.fixedtz != true) { + this.shinyValueFormatter = this.xValueFormatter('seconds'); + } // convert time to js time attrs.file[0] = attrs.file[0].map(function(value) { @@ -91,7 +98,6 @@ HTMLWidgets.widget({ } } - // transpose array attrs.file = HTMLWidgets.transposeArray2D(attrs.file); @@ -202,7 +208,10 @@ HTMLWidgets.widget({ dygraph.userDateWindow = attrs.dateWindow; if (x.group != null) groups[x.group].push(dygraph); - + + // add shinyValueFormatter so that plugins can access this for a consistent interface + dygraph.shinyValueFormatter = this.shinyValueFormatter; + // add shiny inputs for date window and click if (HTMLWidgets.shinyMode) { var isDate = x.format == "date"; @@ -408,7 +417,12 @@ HTMLWidgets.widget({ date.getDate() + ', ' + date.getFullYear(); else - return date.toLocaleString(); + return monthNames[date.getMonth()] + ' ' + + date.getDate() + ', ' + + date.getFullYear() + ' ' + + date.getHours() + ':' + + date.getMinutes() + ':' + + date.getSeconds(); } }, @@ -623,6 +637,8 @@ HTMLWidgets.widget({ // check for an existing drawCallback var prevDrawCallback = dygraph.getOption("drawCallback"); + // store formatter function + var shinyValueFormatter = this.shinyValueFormatter; // install the callback dygraph.updateOptions({ @@ -633,7 +649,7 @@ HTMLWidgets.widget({ // fire input change var range = dygraph.xAxisRange(); if (isDate) - range = [new Date(range[0]), new Date(range[1])]; + range = [shinyValueFormatter(range[0]), shinyValueFormatter(range[1])]; Shiny.onInputChange(id + "_date_window", range); } }); @@ -641,7 +657,10 @@ HTMLWidgets.widget({ addClickShinyInput: function(id, isDate) { + // check for an existing clickCallBackk var prevClickCallback = dygraph.getOption("clickCallback") + // store formatter function + var shinyValueFormatter = this.shinyValueFormatter; dygraph.updateOptions({ clickCallback: function(e, x, points) { @@ -650,13 +669,13 @@ HTMLWidgets.widget({ if (prevClickCallback) prevClickCallback(e, x, points); - // fire input change + // fire input change Shiny.onInputChange(el.id + "_click", { - x: isDate ? new Date(x) : x, - x_closest_point: isDate ? new Date(points[0].xval) : points[0].xval, - y_closest_point: points[0].yval, - '.nonce': Math.random() // Force reactivity if click hasn't changed - }); + x: isDate ? shinyValueFormatter(x) : x, + x_closest_point: isDate ? shinyValueFormatter(points[0].xval) : points[0].xval, + y_closest_point: points[0].yval, + '.nonce': Math.random() // Force reactivity if click hasn't changed + }); } }); }, diff --git a/man/dyCrosshair.Rd b/man/dyCrosshair.Rd new file mode 100644 index 0000000..a07da6e --- /dev/null +++ b/man/dyCrosshair.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plugin.R +\name{dyCrosshair} +\alias{dyCrosshair} +\title{dyCrosshair} +\usage{ +dyCrosshair(dygraph, direction = c("both", "horizontal", "vertical")) +} +\arguments{ +\item{dygraph}{Dygraph to add plugin to} + +\item{direction}{Direction for crosshairs. Defaults to 'both'. Valid arguments are} +} +\value{ +A dygraph with the specified plugin enabled. +} +\description{ +dyCrosshair +} +\details{ +The dyCrosshair plugin draws a crosshair line over the point closest to the +mouse when the user hovers over the graph. It has a "direction" option which +is provided in the R wrapper function and then forwarded to the plugin using +the "options" argument to dyPlugin. +} +\examples{ +library(dygraphs) +dygraph(mdeaths) \%>\% + dyCrosshair() + +} + diff --git a/man/dySliderInput.Rd b/man/dySliderInput.Rd new file mode 100644 index 0000000..90ad6a5 --- /dev/null +++ b/man/dySliderInput.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plugin.R +\name{dySliderInput} +\alias{dySliderInput} +\title{dySliderInput} +\usage{ +dySliderInput(dygraph, color = "red", strokePattern = c("dashed", "solid", + "dotted", "dotdash"), animate = FALSE) +} +\arguments{ +\item{dygraph}{Dygraph to add plugin to} + +\item{color}{Color to draw slider. Defaults to 'red'.} + +\item{strokePattern}{Line type for slider. Defaults to 'dashed'. Valid arguments are +'dashed', 'solid', 'dotted', and 'dotdash'.} + +\item{animate}{'TRUE' to show simple animation controls with default settings; +'FALSE' not to; or a custom settings list, such as those created using 'animationOptions'.} +} +\value{ +A dygraph with the specified plugin enabled. +} +\description{ +dySliderInput +} +\details{ +The dySliderInput plugin turns the dyDygraph into a slider input widget. The +user can click on a point along the graph and the graph will place a vertical +line on the graph. The user can also use the animation options to scroll +through points along the graph. +} +\examples{ +library(dygraphs) +dygraph(mdeaths) \%>\% + dySliderInput() + +} + diff --git a/man/dyUnzoom.Rd b/man/dyUnzoom.Rd new file mode 100644 index 0000000..56c1a11 --- /dev/null +++ b/man/dyUnzoom.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plugin.R +\name{dyUnzoom} +\alias{dyUnzoom} +\title{dyUnzoom} +\usage{ +dyUnzoom(dygraph) +} +\arguments{ +\item{dygraph}{Dygraph to add plugin to} +} +\value{ +A dygraph with the specified plugin enabled. +} +\description{ +dyUnzoom +} +\details{ +The dyUnzoom plugin adds an "Unzoom" button to the graph when it's displaying +in a zoomed state (this is a bit more discoverable than the default double- +click gesture for unzooming). Note that this plugin has no options (see +below for an example with options). +} +\examples{ +library(dygraphs) +dygraph(mdeaths) \%>\% + dyUnzoom() + +} + diff --git a/tests/testthat/test-crosshair.R b/tests/testthat/test-crosshair.R new file mode 100644 index 0000000..d5c2ae9 --- /dev/null +++ b/tests/testthat/test-crosshair.R @@ -0,0 +1,9 @@ + +context("dyCrosshair") + +test_that("crosshair creation", { + d <- dygraph(nhtemp, main = "New Haven Temperatures") %>% + dyCrosshair() + expect_identical(d$dependencies[[1]]$name, 'Dygraph.Plugins.Crosshair') +}) + diff --git a/tests/testthat/test-sider-input.R b/tests/testthat/test-sider-input.R new file mode 100644 index 0000000..e4f05cc --- /dev/null +++ b/tests/testthat/test-sider-input.R @@ -0,0 +1,9 @@ + +context("dySliderInput") + +test_that("slider input creation", { + d <- dygraph(nhtemp, main = "New Haven Temperatures") %>% + dySliderInput() + expect_identical(d$dependencies[[1]]$name, 'Dygraph.Plugins.SliderInput') +}) + diff --git a/tests/testthat/test-unzoom.R b/tests/testthat/test-unzoom.R new file mode 100644 index 0000000..d934d1d --- /dev/null +++ b/tests/testthat/test-unzoom.R @@ -0,0 +1,9 @@ + +context("dyUnzoom") + +test_that("unzoom input creation", { + d <- dygraph(nhtemp, main = "New Haven Temperatures") %>% + dyUnzoom() + expect_identical(d$dependencies[[1]]$name, 'Dygraph.Plugins.Unzoom') +}) +