From fe3f351a2d84239fac689211aebab131d86ec635 Mon Sep 17 00:00:00 2001
From: Winston Chang <winston@stdout.org>
Date: Mon, 26 Feb 2018 16:00:15 -0600
Subject: [PATCH] Avoid rounding errors from pretty(). Fixes #1006

---
 NEWS.md                  |  2 ++
 R/input-slider.R         | 36 ++++++++++++++++++++++--------------
 tests/testthat/test-ui.R |  7 +++++++
 3 files changed, 31 insertions(+), 14 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index d8778be27..b86d6ee80 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -19,6 +19,8 @@ shiny 1.0.5.9000
 
 * Addressed [#1859](https://github.com/rstudio/shiny/issues/1859): Server-side selectize is now significantly faster. (Thanks to @dselivanov [#1861](https://github.com/rstudio/shiny/pull/1861))
 
+* Fixed [#1006](https://github.com/rstudio/shiny/issues/1006): Slider inputs sometimes showed too many digits. ([#1956](https://github.com/rstudio/shiny/pull/1956))
+
 ### Bug fixes
 
 * The internal `URLdecode()` function previously was a copy of `httpuv::decodeURIComponent()`, assigned at build time; now it invokes the httpuv function at run time.
diff --git a/R/input-slider.R b/R/input-slider.R
index 9c51e123e..8e72276b2 100644
--- a/R/input-slider.R
+++ b/R/input-slider.R
@@ -88,20 +88,6 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
 
   value <- restoreInput(id = inputId, default = value)
 
-  # If step is NULL, use heuristic to set the step size.
-  findStepSize <- function(min, max, step) {
-    if (!is.null(step)) return(step)
-
-    range <- max - min
-    # If short range or decimals, use continuous decimal with ~100 points
-    if (range < 2 || hasDecimals(min) || hasDecimals(max)) {
-      step <- pretty(c(min, max), n = 100)
-      step[2] - step[1]
-    } else {
-      1
-    }
-  }
-
   if (inherits(min, "Date")) {
     if (!inherits(max, "Date") || !inherits(value, "Date"))
       stop("`min`, `max`, and `value must all be Date or non-Date objects")
@@ -238,6 +224,28 @@ hasDecimals <- function(value) {
   return (!identical(value, truncatedValue))
 }
 
+
+# If step is NULL, use heuristic to set the step size.
+findStepSize <- function(min, max, step) {
+  if (!is.null(step)) return(step)
+
+  range <- max - min
+  # If short range or decimals, use continuous decimal with ~100 points
+  if (range < 2 || hasDecimals(min) || hasDecimals(max)) {
+    # Workaround for rounding errors (#1006): the intervals between the items
+    # returned by pretty() can have rounding errors. To avoid this, we'll use
+    # pretty() to find the min, max, and number of steps, and then use those
+    # values to calculate the step size.
+    pretty_steps <- pretty(c(min, max), n = 100)
+    n_steps <- length(pretty_steps) - 1
+    (max(pretty_steps) - min(pretty_steps)) / n_steps
+
+  } else {
+    1
+  }
+}
+
+
 #' @rdname sliderInput
 #'
 #' @param interval The interval, in milliseconds, between each animation step.
diff --git a/tests/testthat/test-ui.R b/tests/testthat/test-ui.R
index ef70874aa..e9bf7ac59 100644
--- a/tests/testthat/test-ui.R
+++ b/tests/testthat/test-ui.R
@@ -14,3 +14,10 @@ test_that("selectInput options are properly escaped", {
   expect_true(any(grepl("<option value=\"&#39;\">", si_str, fixed = TRUE)))
   expect_true(any(grepl("<optgroup label=\"&quot;Separators&quot;\">", si_str, fixed = TRUE)))
 })
+
+
+# For issue #1006
+test_that("sliderInput steps don't have rounding errors", {
+  # Need to use expect_identical; expect_equal is too forgiving of rounding error
+  expect_identical(findStepSize(-5.5, 4, NULL), 0.1)
+})